[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.1003 and 1.1028.2.1

version 1.1003, 2011/05/03 21:38:40 version 1.1028.2.1, 2011/12/26 13:47:18
Line 154  sub ssi_with_retries { Line 154  sub ssi_with_retries {
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
 my %supported_language;  my %supported_language;
   my %latex_language; # Language name LaTeX uses for selecting hyphenation.
 my %cprtag;  my %cprtag;
 my %scprtag;  my %scprtag;
 my %fe; my %fd; my %fm;  my %fe; my %fd; my %fm;
Line 186  BEGIN { Line 187  BEGIN {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line=~/^\#/);                  next if ($line=~/^\#/);
                 chomp($line);                  chomp($line);
                 my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));                  my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
                 $language{$key}=$val.' - '.$enc;                  $language{$key}=$val.' - '.$enc;
                 if ($sup) {                  if ($sup) {
                     $supported_language{$key}=$sup;                      $supported_language{$key}=$sup;
                 }                  }
    if ($latex) {
       $latex_language{$two} = $latex;
    }
             }              }
             close($fh);              close($fh);
         }          }
Line 438  ENDSTDBRW Line 442  ENDSTDBRW
   
 sub resourcebrowser_javascript {  sub resourcebrowser_javascript {
    unless ($env{'request.course.id'}) { return ''; }     unless ($env{'request.course.id'}) { return ''; }
    return (<<'ENDSTDBRW');     return (<<'ENDRESBRW');
 <script type="text/javascript" language="Javascript">  <script type="text/javascript" language="Javascript">
 // <![CDATA[  // <![CDATA[
     var reseditbrowser;      var reseditbrowser;
     function openresbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {      function openresbrowser(formname,reslink) {
         var url = '/adm/pickresource?';          var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
         var title = 'Resource_Browser';          var title = 'Resource_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=500';
         stdeditbrowser = open(url,title,options,'1');          reseditbrowser = open(url,title,options,'1');
         stdeditbrowser.focus();          reseditbrowser.focus();
     }      }
 // ]]>  // ]]>
 </script>  </script>
 ENDSTDBRW  ENDRESBRW
 }  }
   
 sub selectstudent_link {  sub selectstudent_link {
Line 475  sub selectstudent_link { Line 479  sub selectstudent_link {
               &mt('Select User').'</a></span>';                &mt('Select User').'</a></span>';
    }     }
    if ($env{'request.role'}=~/^(au|dc|su)/) {     if ($env{'request.role'}=~/^(au|dc|su)/) {
        $callargs .= ",1";          $callargs .= ",'',1"; 
        return '<span class="LC_nobreak">'.         return '<span class="LC_nobreak">'.
               '<a href="javascript:openstdbrowser('.$callargs.');">'.                '<a href="javascript:openstdbrowser('.$callargs.');">'.
               &mt('Select User').'</a></span>';                &mt('Select User').'</a></span>';
Line 483  sub selectstudent_link { Line 487  sub selectstudent_link {
    return '';     return '';
 }  }
   
   sub selectresource_link {
      my ($form,$reslink,$arg)=@_;
      
      my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                         &Apache::lonhtmlcommon::entity_encode($reslink)."'";
      unless ($env{'request.course.id'}) { return $arg; }
      return '<span class="LC_nobreak">'.
                 '<a href="javascript:openresbrowser('.$callargs.');">'.
                 $arg.'</a></span>';
   }
   
   
   
 sub authorbrowser_javascript {  sub authorbrowser_javascript {
     return <<"ENDAUTHORBRW";      return <<"ENDAUTHORBRW";
 <script type="text/javascript" language="JavaScript">  <script type="text/javascript" language="JavaScript">
Line 619  ENDJS Line 636  ENDJS
   
 }  }
   
   sub javascript_array_indexof {
       return <<ENDJS;
   <script type="text/javascript" language="JavaScript">
   // <![CDATA[
   
   if (!Array.prototype.indexOf) {
       Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
           "use strict";
           if (this === void 0 || this === null) {
               throw new TypeError();
           }
           var t = Object(this);
           var len = t.length >>> 0;
           if (len === 0) {
               return -1;
           }
           var n = 0;
           if (arguments.length > 0) {
               n = Number(arguments[1]);
               if (n !== n) { // shortcut for verifying if it's NaN
                   n = 0;
               } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                   n = (n > 0 || -1) * Math.floor(Math.abs(n));
               }
           }
           if (n >= len) {
               return -1;
           }
           var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
           for (; k < len; k++) {
               if (k in t && t[k] === searchElement) {
                   return k;
               }
           }
           return -1;
       }
   }
   
   // ]]>
   </script>
   
   ENDJS
   
   }
   
 sub userbrowser_javascript {  sub userbrowser_javascript {
     my $id_functions = &javascript_index_functions();      my $id_functions = &javascript_index_functions();
     return <<"ENDUSERBRW";      return <<"ENDUSERBRW";
Line 789  sub selectcourse_link { Line 851  sub selectcourse_link {
    } elsif ($selecttype eq 'Course/Community') {     } elsif ($selecttype eq 'Course/Community') {
        $linktext = &mt('Select Course/Community');         $linktext = &mt('Select Course/Community');
        $type = '';         $type = '';
      } elsif ($selecttype eq 'Select') {
          $linktext = &mt('Select');
          $type = '';
    }     }
    return '<span class="LC_nobreak">'     return '<span class="LC_nobreak">'
          ."<a href='"           ."<a href='"
Line 1745  sub create_workbook { Line 1810  sub create_workbook {
         return (undef);          return (undef);
     }      }
     #      #
     $workbook->set_tempdir('/home/httpd/perl/tmp');      $workbook->set_tempdir(LONCAPA::tempdir());
     #      #
     my $format = &Apache::loncommon::define_excel_formats($workbook);      my $format = &Apache::loncommon::define_excel_formats($workbook);
     return ($workbook,$filename,$format);      return ($workbook,$filename,$format);
Line 3169  sub languagedescription { Line 3234  sub languagedescription {
     ($supported_language{$code}?' ('.&mt('interface available').')':'');      ($supported_language{$code}?' ('.&mt('interface available').')':'');
 }  }
   
   =pod
   
   =item * &plainlanguagedescription
   
   Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
   and the language character encoding (e.g. ISO) separated by a ' - ' string.
   
   =cut
   
 sub plainlanguagedescription {  sub plainlanguagedescription {
     my $code=shift;      my $code=shift;
     return $language{$code};      return $language{$code};
 }  }
   
   =pod
   
   =item * &supportedlanguagecode
   
   Returns the supported language code (e.g. sptutf maps to pt) given a language
   code.
   
   =cut
   
 sub supportedlanguagecode {  sub supportedlanguagecode {
     my $code=shift;      my $code=shift;
     return $supported_language{$code};      return $supported_language{$code};
Line 3181  sub supportedlanguagecode { Line 3264  sub supportedlanguagecode {
   
 =pod  =pod
   
   =item * &latexlanguage()
   
   Given a language key code returns the correspondnig language to use
   to select the correct hyphenation on LaTeX printouts.  This is undef if there
   is no supported hyphenation for the language code.
   
   =cut
   
   sub latexlanguage {
       my $code = shift;
       return $latex_language{$code};
   }
   
   =pod
   
 =item * &copyrightids()   =item * &copyrightids() 
   
 returns list of all copyrights  returns list of all copyrights
Line 3446  sub get_previous_attempt { Line 3544  sub get_previous_attempt {
   my $data=$parts[-1];    my $data=$parts[-1];
           next if ($data eq 'foilorder');            next if ($data eq 'foilorder');
   pop(@parts);    pop(@parts);
             $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
           if ($data eq 'type') {            if ($data eq 'type') {
               unless ($showsurv) {                unless ($showsurv) {
                   my $id = join(',',@parts);                    my $id = join(',',@parts);
Line 3454  sub get_previous_attempt { Line 3553  sub get_previous_attempt {
                       $lasthidden{$ign.'.'.$id} = 1;                        $lasthidden{$ign.'.'.$id} = 1;
                   }                    }
               }                }
               delete($lasthash{$key});            } 
           } else {  
       $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';  
           }  
  } else {   } else {
   if ($#parts == 0) {    if ($#parts == 0) {
     $prevattempts.='<th>'.$parts[0].'</th>';      $prevattempts.='<th>'.$parts[0].'</th>';
Line 3574  sub get_previous_attempt { Line 3670  sub get_previous_attempt {
   
 sub format_previous_attempt_value {  sub format_previous_attempt_value {
     my ($key,$value) = @_;      my ($key,$value) = @_;
     if ($key =~ /timestamp/) {      if (($key =~ /timestamp/) || ($key=~/duedate/)) {
  $value = &Apache::lonlocal::locallocaltime($value);   $value = &Apache::lonlocal::locallocaltime($value);
     } elsif (ref($value) eq 'ARRAY') {      } elsif (ref($value) eq 'ARRAY') {
  $value = '('.join(', ', @{ $value }).')';   $value = '('.join(', ', @{ $value }).')';
Line 4295  sub get_domainconf { Line 4391  sub get_domainconf {
                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {                      if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                         if ($key eq 'loginvia') {                          if ($key eq 'loginvia') {
                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {                              if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
                                 my @ids = &Apache::lonnet::current_machine_ids();                                  foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
                                 foreach my $hostname (@ids) {  
                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {                                      if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {                                          if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};                                              my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
Line 4305  sub get_domainconf { Line 4400  sub get_domainconf {
   
                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};                                                  $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                                             } else {                                              } else {
                                                  $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};                                                  $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                                             }                                              }
                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {                                              if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};                                                  $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
Line 4388  sub get_legacy_domconf { Line 4483  sub get_legacy_domconf {
             close($fh);              close($fh);
         }          }
     }      }
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {      if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";          $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
     }      }
     return %legacyhash;      return %legacyhash;
Line 4446  sub designparm { Line 4541  sub designparm {
         return $env{'environment.color.'.$which};          return $env{'environment.color.'.$which};
     }      }
     $domain=&determinedomain($domain);      $domain=&determinedomain($domain);
     my %domdesign = &get_domainconf($domain);      my %domdesign;
       unless ($domain eq 'public') {
           %domdesign = &get_domainconf($domain);
       }
     my $output;      my $output;
     if ($domdesign{$domain.'.'.$which} ne '') {      if ($domdesign{$domain.'.'.$which} ne '') {
         $output = $domdesign{$domain.'.'.$which};          $output = $domdesign{$domain.'.'.$which};
Line 4471  sub designparm { Line 4569  sub designparm {
   
 =item * &authorspace()  =item * &authorspace()
   
 Inputs: ./.  Inputs: $url (usually will be undef).
   
 Returns: Path to the Construction Space of the current user's  Returns: Path to Construction Space containing the resource or 
          accessed author space           directory being viewed (or for which action is being taken). 
          The author space will be that of the current user           If $url is provided, and begins /priv/<domain>/<uname>
          when accessing the own author space           the path will be that portion of the $context argument.
          and that of the co-author/assistent co-author           Otherwise the path will be for the author space of the current
          when accessing the co-author's/assistent co-author's           user when the current role is author, or for that of the 
          space           co-author/assistant co-author space when the current role 
            is co-author or assistant co-author.
   
 =cut  =cut
   
 sub authorspace {  sub authorspace {
       my ($url) = @_;
       if ($url ne '') {
           if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
              return $1;
           }
       }
     my $caname = '';      my $caname = '';
     if ($env{'request.role'} =~ /^ca|^aa/) {      my $cadom = '';
         (undef,$caname) =      if ($env{'request.role'} =~ /^(?:ca|aa)/) {
           ($cadom,$caname) =
             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);              ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
     } else {      } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
         $caname = $env{'user.name'};          $caname = $env{'user.name'};
           $cadom = $env{'user.domain'};
     }      }
     return '/priv/'.$caname.'/';      if (($caname ne '') && ($cadom ne '')) {
           return "/priv/$cadom/$caname/";
       }
       return;
 }  }
   
 ##############################################  ##############################################
Line 4519  sub head_subbox { Line 4629  sub head_subbox {
   
 =item * &CSTR_pageheader()  =item * &CSTR_pageheader()
   
 Inputs: ./.  Input: (optional) filename from which breadcrumb trail is built.
          In most cases no input as needed, as $env{'request.filename'}
          is appropriate for use in building the breadcrumb trail.
   
 Returns: HTML div with CSTR path and recent box  Returns: HTML div with CSTR path and recent box
          To be included on Construction Space pages           To be included on Construction Space pages
Line 4527  Returns: HTML div with CSTR path and rec Line 4639  Returns: HTML div with CSTR path and rec
 =cut  =cut
   
 sub CSTR_pageheader {  sub CSTR_pageheader {
     # this is for resources; directories have customtitle, and crumbs      my ($trailfile) = @_;
             # and select recent are created in lonpubdir.pm        if ($trailfile eq '') {
     my ($uname,$thisdisfn)=          $trailfile = $env{'request.filename'};
         ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);      }
     my $formaction='/priv/'.$uname.'/'.$thisdisfn;  
     $formaction=~s/\/+/\//g;  # this is for resources; directories have customtitle, and crumbs
   # and select recent are created in lonpubdir.pm
   
       my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
       my ($udom,$uname,$thisdisfn)=
           ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
       my $formaction = "/priv/$udom/$uname/$thisdisfn";
       $formaction =~ s{/+}{/}g;
   
     my $parentpath = '';      my $parentpath = '';
     my $lastitem = '';      my $lastitem = '';
Line 4549  sub CSTR_pageheader { Line 4668  sub CSTR_pageheader {
         .'<b>'.&mt('Construction Space:').'</b> '          .'<b>'.&mt('Construction Space:').'</b> '
         .'<form name="dirs" method="post" action="'.$formaction          .'<form name="dirs" method="post" action="'.$formaction
         .'" target="_top">' #FIXME lonpubdir: target="_parent"          .'" target="_top">' #FIXME lonpubdir: target="_parent"
         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv',undef,undef);          .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
   
     if ($lastitem) {      if ($lastitem) {
         $output .=          $output .=
Line 4948  form, .inline { Line 5067  form, .inline {
   text-decoration:none;    text-decoration:none;
 }  }
   
   .LC_setting {
     text-decoration:underline;
   }
   
 .LC_error {  .LC_error {
   color: red;    color: red;
   font-size: larger;    font-size: larger;
Line 5192  table.LC_nested { Line 5315  table.LC_nested {
   width: 100%;    width: 100%;
 }  }
   
 .ui-accordion,  
 .ui-accordion table.LC_data_table,  
 .ui-accordion table.LC_nested_outer{  
   border: 0px;  
   border-spacing: 0px;  
   margin: 3px;  
 }  
   
 table.LC_data_table tr th,  table.LC_data_table tr th,
 table.LC_calendar tr th,  table.LC_calendar tr th,
 table.LC_prior_tries tr th,  table.LC_prior_tries tr th,
Line 5315  table.LC_nested tr td.LC_right_item { Line 5430  table.LC_nested tr td.LC_right_item {
   text-align: right;    text-align: right;
 }  }
   
 .ui-accordion table.LC_nested tr.LC_odd_row td.LC_left_item,  
 .ui-accordion table.LC_nested tr.LC_even_row td.LC_left_item {  
   text-align: right;  
   width: 40%;  
   padding-right:10px;  
   vertical-align: top;  
   padding: 5px;  
 }  
   
 .ui-accordion table.LC_nested tr.LC_odd_row td.LC_right_item,  
 .ui-accordion table.LC_nested tr.LC_even_row td.LC_right_item {  
   text-align: left;  
   width: 60%;  
   padding: 2px 4px;  
 }  
   
 table.LC_nested tr.LC_odd_row td {  table.LC_nested tr.LC_odd_row td {
   background-color: #EEEEEE;    background-color: #EEEEEE;
 }  }
Line 6187  ul.LC_TabContent { Line 6286  ul.LC_TabContent {
   background: $sidebg;    background: $sidebg;
   border-bottom: solid 1px $lg_border_color;    border-bottom: solid 1px $lg_border_color;
   list-style:none;    list-style:none;
   margin: 0 -10px;    margin: -1px -10px 0 -10px;
   padding: 0;    padding: 0;
 }  }
   
Line 6210  ul.LC_TabContent li { Line 6309  ul.LC_TabContent li {
   padding: 0 16px 0 10px;    padding: 0 16px 0 10px;
   background-color:$tabbg;    background-color:$tabbg;
   border-bottom:solid 1px $lg_border_color;    border-bottom:solid 1px $lg_border_color;
   border-right: solid 1px $font;    border-left: solid 1px $font;
 }  }
   
 ul.LC_TabContent .right {  ul.LC_TabContent .right {
Line 6309  ul.LC_TabContentBigger li.active b { Line 6408  ul.LC_TabContentBigger li.active b {
   
 ul.LC_CourseBreadcrumbs {  ul.LC_CourseBreadcrumbs {
   background: $sidebg;    background: $sidebg;
   line-height: 32px;    height: 2em;
   padding-left: 10px;    padding-left: 10px;
   margin: 0 0 10px 0;    margin: 0;
   list-style-position: inside;    list-style-position: inside;
   
 }  }
   
 ol#LC_MenuBreadcrumbs,  ol#LC_MenuBreadcrumbs,
Line 6355  ol#LC_PathBreadcrumbs li a { Line 6453  ol#LC_PathBreadcrumbs li a {
   padding: 0 10px 10px 10px;    padding: 0 10px 10px 10px;
 }  }
   
   .LC_DocsBox {
     border: solid 1px $lg_border_color;
     padding: 0 0 10px 10px;
   }
   
 .LC_AboutMe_Image {  .LC_AboutMe_Image {
   float:left;    float:left;
   margin-right:10px;    margin-right:10px;
Line 6559  ul.LC_funclist li { Line 6662  ul.LC_funclist li {
   line-height: 150%;    line-height: 150%;
 }  }
   
 .ui-accordion .LC_advanced_toggle {  
   float: right;  
   font-size: 90%;  
   padding: 0px 4px  
 }  
   
 .LC_hidden {  .LC_hidden {
   display: none;    display: none;
 }  }
Line 6908  sub validate_page { Line 7005  sub validate_page {
   
   
 sub start_scrollbox {  sub start_scrollbox {
     my ($outerwidth,$width,$height)=@_;      my ($outerwidth,$width,$height,$id)=@_;
     unless ($outerwidth) { $outerwidth='520px'; }      unless ($outerwidth) { $outerwidth='520px'; }
     unless ($width) { $width='500px'; }      unless ($width) { $width='500px'; }
     unless ($height) { $height='200px'; }      unless ($height) { $height='200px'; }
     return "<table style='width: $outerwidth; border: 1px solid black;'><tr><td style='width: $width;' bgcolor='#FFFFFF'><div style='overflow:auto; width:$width; height: $height;'>";      my ($table_id,$div_id);
       if ($id ne '') {
           $table_id = " id='table_$id'";
           $div_id = " id='div_$id'";
       }
       return "<table style='width: $outerwidth; border: 1px solid none;'$table_id><tr><td style='width: $width;' bgcolor='#FFFFFF'><div style='overflow:auto; width:$width; height: $height;'$div_id>";
 }  }
   
 sub end_scrollbox {  sub end_scrollbox {
Line 6946  sub simple_error_page { Line 7048  sub simple_error_page {
     }      }
   
     sub start_data_table {      sub start_data_table {
  my ($add_class) = @_;   my ($add_class,$id) = @_;
  my $css_class = (join(' ','LC_data_table',$add_class));   my $css_class = (join(' ','LC_data_table',$add_class));
           my $table_id;
           if (defined($id)) {
               $table_id = ' id="'.$id.'"';
           }
  &start_data_table_count();   &start_data_table_count();
  return '<table class="'.$css_class.'">'."\n";   return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
     }      }
   
     sub end_data_table {      sub end_data_table {
Line 7076  sub get_users_function { Line 7182  sub get_users_function {
         $function='admin';          $function='admin';
     }      }
     if (($env{'request.role'}=~/^(au|ca|aa)/) ||      if (($env{'request.role'}=~/^(au|ca|aa)/) ||
         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {          ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
         $function='author';          $function='author';
     }      }
     return $function;      return $function;
Line 8400  sub ask_for_embedded_content { Line 8506  sub ask_for_embedded_content {
         $getpropath = 1;          $getpropath = 1;
     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||      } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
              ($actionurl eq '/adm/imsimport')) {                ($actionurl eq '/adm/imsimport')) { 
         ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$});          my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
         $url = '/home/'.$uname.'/public_html/';          $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
         $toplevel = $url;          $toplevel = $url;
         if ($rest ne '') {          if ($rest ne '') {
             $url .= $rest;              $url .= $rest;
Line 8451  sub ask_for_embedded_content { Line 8557  sub ask_for_embedded_content {
     foreach my $path (keys(%subdependencies)) {      foreach my $path (keys(%subdependencies)) {
         my %currsubfile;          my %currsubfile;
         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {           if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
             my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);              my ($sublistref,$listerror) =
             foreach my $line (@subdir_list) {                  &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                 my ($file_name,$rest) = split(/\&/,$line,2);              if (ref($sublistref) eq 'ARRAY') {
                 $currsubfile{$file_name} = 1;                  foreach my $line (@{$sublistref}) {
                       my ($file_name,$rest) = split(/\&/,$line,2);
                       $currsubfile{$file_name} = 1;
                   }
             }              }
         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {          } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
             if (opendir(my $dir,$url.'/'.$path)) {              if (opendir(my $dir,$url.'/'.$path)) {
Line 8477  sub ask_for_embedded_content { Line 8586  sub ask_for_embedded_content {
     }      }
     my %currfile;      my %currfile;
     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {      if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
         my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);          my ($dirlistref,$listerror) =
         foreach my $line (@dir_list) {              &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
             my ($file_name,$rest) = split(/\&/,$line,2);          if (ref($dirlistref) eq 'ARRAY') {
             $currfile{$file_name} = 1;              foreach my $line (@{$dirlistref}) {
                   my ($file_name,$rest) = split(/\&/,$line,2);
                   $currfile{$file_name} = 1;
               }
         }          }
     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {      } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
         if (opendir(my $dir,$url)) {          if (opendir(my $dir,$url)) {
Line 8759  sub upload_embedded { Line 8871  sub upload_embedded {
             my $fullpath = $dir_root.$dirpath.'/'.$path;              my $fullpath = $dir_root.$dirpath.'/'.$path;
             my $dest = $fullpath.$fname;              my $dest = $fullpath.$fname;
             my $url = $url_root.$dirpath.'/'.$path.$fname;              my $url = $url_root.$dirpath.'/'.$path.$fname;
             my @parts=split(/\//,$fullpath);              my @parts=split(/\//,"$dirpath/$path");
             my $count;              my $count;
             my $filepath = $dir_root;              my $filepath = $dir_root;
             for ($count=4;$count<=$#parts;$count++) {              foreach my $subdir (@parts) {
                 $filepath .= "/$parts[$count]";                  $filepath .= "/$subdir";
                 if ((-e $filepath)!=1) {                  if (!-e $filepath) {
                     mkdir($filepath,0770);                      mkdir($filepath,0770);
                 }                  }
             }              }
Line 8883  sub modify_html_refs { Line 8995  sub modify_html_refs {
     } elsif ($context eq 'coursedoc') {      } elsif ($context eq 'coursedoc') {
         $container = $env{'form.primaryurl'};          $container = $env{'form.primaryurl'};
     } else {      } else {
         $container = $env{'form.filename'};          $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
         $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2};  
     }      }
     my (%allfiles,%codebase,$output,$content);      my (%allfiles,%codebase,$output,$content);
     my @changes = &get_env_multiple('form.namechange');      my @changes = &get_env_multiple('form.namechange');
Line 8916  sub modify_html_refs { Line 9027  sub modify_html_refs {
                 if ($allfiles{$ref}) {                  if ($allfiles{$ref}) {
                     my $newname =  $orig;                      my $newname =  $orig;
                     my ($attrib_regexp,$codebase);                      my ($attrib_regexp,$codebase);
                     my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});                      $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
                     if ($attrib_regexp =~ /:/) {                      if ($attrib_regexp =~ /:/) {
                         $attrib_regexp =~ s/\:/|/g;                          $attrib_regexp =~ s/\:/|/g;
                     }                      }
Line 8925  sub modify_html_refs { Line 9036  sub modify_html_refs {
                         $count += $numchg;                          $count += $numchg;
                     }                      }
                     if ($env{'form.embedded_codebase_'.$i} ne '') {                      if ($env{'form.embedded_codebase_'.$i} ne '') {
                         my $codebase = &unescape($env{'form.embedded_codebase_'.$i});                          $codebase = &unescape($env{'form.embedded_codebase_'.$i});
                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs                          my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                         $codebasecount ++;                          $codebasecount ++;
                     }                      }
Line 8994  sub check_for_upload { Line 9105  sub check_for_upload {
                   &mt('Unable to upload [_1]. (size = [_2] bytes)',                     &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                       '<span class="LC_filename">'.$fname.'</span>',                        '<span class="LC_filename">'.$fname.'</span>',
                       $filesize).'<br />'.                        $filesize).'<br />'.
                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />';                    &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
                   '</span>';                    '</span>';
         return ('zero_bytes',$msg);          return ('zero_bytes',$msg);
     }      }
     $filesize =  $filesize/1000; #express in k (1024?)      $filesize =  $filesize/1000; #express in k (1024?)
     my $getpropath = 1;      my $getpropath = 1;
     my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,      my ($dirlistref,$listerror) =
                                             $getpropath);           &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
     my $found_file = 0;      my $found_file = 0;
     my $locked_file = 0;      my $locked_file = 0;
     my @lockers;      my @lockers;
Line 9009  sub check_for_upload { Line 9120  sub check_for_upload {
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         $navmap = Apache::lonnavmaps::navmap->new();          $navmap = Apache::lonnavmaps::navmap->new();
     }      }
     foreach my $line (@dir_list) {      if (ref($dirlistref) eq 'ARRAY') {
         my ($file_name,$rest)=split(/\&/,$line,2);          foreach my $line (@{$dirlistref}) {
         if ($file_name eq $fname){              my ($file_name,$rest)=split(/\&/,$line,2);
             $file_name = $path.$file_name;              if ($file_name eq $fname){
             if ($group ne '') {                  $file_name = $path.$file_name;
                 $file_name = $group.$file_name;                  if ($group ne '') {
             }                      $file_name = $group.$file_name;
             $found_file = 1;                  }
             if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {                  $found_file = 1;
                 foreach my $lock (@lockers) {                  if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                     if (ref($lock) eq 'ARRAY') {                      foreach my $lock (@lockers) {
                         my ($symb,$crsid) = @{$lock};                          if (ref($lock) eq 'ARRAY') {
                         if ($crsid eq $env{'request.course.id'}) {                              my ($symb,$crsid) = @{$lock};
                             if (ref($navmap)) {                              if ($crsid eq $env{'request.course.id'}) {
                                 my $res = $navmap->getBySymb($symb);                                  if (ref($navmap)) {
                                 foreach my $part (@{$res->parts()}) {                                       my $res = $navmap->getBySymb($symb);
                                     my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);                                      foreach my $part (@{$res->parts()}) { 
                                     unless (($slot_status == $res->RESERVED) ||                                          my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                                             ($slot_status == $res->RESERVED_LOCATION)) {                                          unless (($slot_status == $res->RESERVED) ||
                                         $locked_file = 1;                                                  ($slot_status == $res->RESERVED_LOCATION)) {
                                               $locked_file = 1;
                                           }
                                     }                                      }
                                   } else {
                                       $locked_file = 1;
                                 }                                  }
                             } else {                              } else {
                                 $locked_file = 1;                                  $locked_file = 1;
                             }                              }
                         } else {  
                             $locked_file = 1;  
                         }                          }
                     }                     }
                 }                  } else {
             } else {                      my @info = split(/\&/,$rest);
                 my @info = split(/\&/,$rest);                      my $currsize = $info[6]/1000;
                 my $currsize = $info[6]/1000;                      if ($currsize < $filesize) {
                 if ($currsize < $filesize) {                          my $extra = $filesize - $currsize;
                     my $extra = $filesize - $currsize;                          if (($current_disk_usage + $extra) > $disk_quota) {
                     if (($current_disk_usage + $extra) > $disk_quota) {                              my $msg = '<span class="LC_error">'.
                         my $msg = '<span class="LC_error">'.                                        &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
                                   &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',                                            '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                                       '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.                                        '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',                                                     $disk_quota,$current_disk_usage);
                                                $disk_quota,$current_disk_usage);                              return ('will_exceed_quota',$msg);
                         return ('will_exceed_quota',$msg);                          }
                     }                      }
                 }                  }
             }              }
Line 9122  sub check_for_traversal { Line 9235  sub check_for_traversal {
   
 =pod  =pod
   
   =item * &get_turnedin_filepath()
   
   Determines path in a user's portfolio file for storage of files uploaded
   to a specific essayresponse or dropbox item.
   
   Inputs: 3 required + 1 optional.
   $symb is symb for resource, $uname and $udom are for current user (required).
   $caller is optional (can be "submission", if routine is called when storing
   an upoaded file when "Submit Answer" button was pressed).
   
   Returns array containing $path and $multiresp. 
   $path is path in portfolio.  $multiresp is 1 if this resource contains more
   than one file upload item.  Callers of routine should append partid as a 
   subdirectory to $path in cases where $multiresp is 1.
   
   Called by: homework/essayresponse.pm and homework/structuretags.pm
   
   =cut
   
   sub get_turnedin_filepath {
       my ($symb,$uname,$udom,$caller) = @_;
       my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
       my $turnindir;
       my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
       $turnindir = $userhash{'turnindir'};
       my ($path,$multiresp);
       if ($turnindir eq '') {
           if ($caller eq 'submission') {
               $turnindir = &mt('turned in');
               $turnindir =~ s/\W+/_/g;
               my %newhash = (
                               'turnindir' => $turnindir,
                             );
               &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
           }
       }
       if ($turnindir ne '') {
           $path = '/'.$turnindir.'/';
           my ($multipart,$turnin,@pathitems);
           my $navmap = Apache::lonnavmaps::navmap->new();
           if (defined($navmap)) {
               my $mapres = $navmap->getResourceByUrl($map);
               if (ref($mapres)) {
                   my $pcslist = $mapres->map_hierarchy();
                   if ($pcslist ne '') {
                       foreach my $pc (split(/,/,$pcslist)) {
                           my $res = $navmap->getByMapPc($pc);
                           if (ref($res)) {
                               my $title = $res->compTitle();
                               $title =~ s/\W+/_/g;
                               if ($title ne '') {
                                   push(@pathitems,$title);
                               }
                           }
                       }
                   }
                   my $maptitle = $mapres->compTitle();
                   $maptitle =~ s/\W+/_/g;
                   if ($maptitle ne '') {
                       push(@pathitems,$maptitle);
                   }
                   unless ($env{'request.state'} eq 'construct') {
                       my $res = $navmap->getBySymb($symb);
                       if (ref($res)) {
                           my $partlist = $res->parts();
                           my $totaluploads = 0;
                           if (ref($partlist) eq 'ARRAY') {
                               foreach my $part (@{$partlist}) {
                                   my @types = $res->responseType($part);
                                   my @ids = $res->responseIds($part);
                                   for (my $i=0; $i < scalar(@ids); $i++) {
                                       if ($types[$i] eq 'essay') {
                                           my $partid = $part.'_'.$ids[$i];
                                           if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                                               $totaluploads ++;
                                           }
                                       }
                                   }
                               }
                               if ($totaluploads > 1) {
                                   $multiresp = 1;
                               }
                           }
                       }
                   }
               } else {
                   return;
               }
           } else {
               return;
           }
           my $restitle=&Apache::lonnet::gettitle($symb);
           $restitle =~ s/\W+/_/g;
           if ($restitle eq '') {
               $restitle = ($resurl =~ m{/[^/]+$});
               if ($restitle eq '') {
                   $restitle = time;
               }
           }
           push(@pathitems,$restitle);
           $path .= join('/',@pathitems);
       }
       return ($path,$multiresp);
   }
   
   =pod
   
 =back  =back
   
 =head1 CSV Upload/Handling functions  =head1 CSV Upload/Handling functions
Line 11252  sub init_user_environment { Line 11472  sub init_user_environment {
  }   }
   
         my %is_adv = ( is_adv => $env{'user.adv'} );          my %is_adv = ( is_adv => $env{'user.adv'} );
         my %domdef = &Apache::lonnet::get_domain_defaults($domain);          my %domdef;
           unless ($domain eq 'public') {
               %domdef = &Apache::lonnet::get_domain_defaults($domain);
           }
   
         foreach my $tool ('aboutme','blog','portfolio') {          foreach my $tool ('aboutme','blog','portfolio') {
             $userenv{'availabletools.'.$tool} =               $userenv{'availabletools.'.$tool} = 
Removed from v.1.1003  
changed lines
  Added in v.1.1028.2.1

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>