Diff for /loncom/interface/loncommon.pm between versions 1.948.2.17 and 1.962

version 1.948.2.17, 2010/12/25 16:01:54 version 1.962, 2010/03/22 20:11:22
Line 900  sub select_language { Line 900  sub select_language {
             $langchoices{$code} = &plainlanguagedescription($id);              $langchoices{$code} = &plainlanguagedescription($id);
         }          }
     }      }
     return &select_form($selected,$name,\%langchoices);      return &select_form($selected,$name,%langchoices);
 }  }
   
 =pod  =pod
Line 1072  END Line 1072  END
   
 =pod  =pod
   
 =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)  =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
   
 Returns a string corresponding to an HTML link to the given help  Returns a string corresponding to an HTML link to the given help
 $topic, where $topic corresponds to the name of a .tex file in  $topic, where $topic corresponds to the name of a .tex file in
Line 1095  be useful for certain help topics with b Line 1095  be useful for certain help topics with b
 =cut  =cut
   
 sub help_open_topic {  sub help_open_topic {
     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     $width = 350 if (not defined $width);      $width = 350 if (not defined $width);
Line 1124  sub help_open_topic { Line 1124  sub help_open_topic {
     # (Always) Add the graphic      # (Always) Add the graphic
     my $title = &mt('Online Help');      my $title = &mt('Online Help');
     my $helpicon=&lonhttpdurl("/adm/help/help.png");      my $helpicon=&lonhttpdurl("/adm/help/help.png");
     if ($imgid ne '') {  
         $imgid = ' id="'.$imgid.'"';  
     }  
     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'      $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
               .'<img src="'.$helpicon.'" border="0"'                .'<img src="'.$helpicon.'" border="0"'
               .' alt="'.&mt('Help: [_1]',$topic).'"'                .' alt="'.&mt('Help: [_1]',$topic).'"'
               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid                .' title="'.$title.'" style="vertical-align:middle;"' 
               .' /></a>';                .' /></a>';
     if ($text ne "") {      if ($text ne "") {
         $template.='</span>';          $template.='</span>';
     }      }
     return $template;      return $template;
Line 1205  ENDOUTPUT Line 1202  ENDOUTPUT
 sub help_open_menu {  sub help_open_menu {
     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)       my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
  = @_;       = @_;    
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 1;
     # only use pop-up help (stayOnPage == 0)  
     # if environment.remote is on (using remote control UI)  
     if ($env{'environment.remote'} eq 'off' ) {  
         $stayOnPage=1;  
     }  
     my $output;      my $output;
     if ($component_help) {      if ($component_help) {
  if (!$text) {   if (!$text) {
Line 1231  sub help_open_menu { Line 1223  sub help_open_menu {
 sub top_nav_help {  sub top_nav_help {
     my ($text) = @_;      my ($text) = @_;
     $text = &mt($text);      $text = &mt($text);
     my $stay_on_page =       my $stay_on_page = 1;
  ($env{'environment.remote'} eq 'off' );  
     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"      my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                      : "javascript:helpMenu('open')";                       : "javascript:helpMenu('open')";
     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);      my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
Line 1247  END Line 1239  END
   
 sub help_menu_js {  sub help_menu_js {
     my ($text) = @_;      my ($text) = @_;
       my $stayOnPage = 1;
     my $stayOnPage =   
  ($env{'environment.remote'} eq 'off' );  
   
     my $width = 620;      my $width = 620;
     my $height = 600;      my $height = 600;
     my $helptopic=&general_help();      my $helptopic=&general_help();
Line 1307  sub help_open_bug { Line 1296  sub help_open_bug {
     unless ($env{'user.adv'}) { return ''; }      unless ($env{'user.adv'}) { return ''; }
     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }      unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);  
     if ($env{'environment.remote'} eq 'off' ) {  
  $stayOnPage=1;   $stayOnPage=1;
     }  
     $width = 600 if (not defined $width);      $width = 600 if (not defined $width);
     $height = 600 if (not defined $height);      $height = 600 if (not defined $height);
   
Line 1351  sub help_open_faq { Line 1337  sub help_open_faq {
     unless ($env{'user.adv'}) { return ''; }      unless ($env{'user.adv'}) { return ''; }
     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }      unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);  
     if ($env{'environment.remote'} eq 'off' ) {  
  $stayOnPage=1;   $stayOnPage=1;
     }  
     $width = 350 if (not defined $width);      $width = 350 if (not defined $width);
     $height = 400 if (not defined $height);      $height = 400 if (not defined $height);
   
Line 1803  sub domain_select { Line 1786  sub domain_select {
  return &multiple_select_form($name,$value,4,\%domains);   return &multiple_select_form($name,$value,4,\%domains);
     } else {      } else {
  $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];   $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
  return &select_form($name,$value,\%domains);   return &select_form($name,$value,%domains);
     }      }
 }  }
   
Line 1865  sub multiple_select_form { Line 1848  sub multiple_select_form {
   
 =pod  =pod
   
 =item * &select_form($defdom,$name,$hashref,$onchange)  =item * &select_form($defdom,$name,%hash)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select options from a ref to a hash containing:  allow a user to select options from a hash option_name => displayed text.  
 option_name => displayed text. An optional $onchange can include  
 a javascript onchange item, e.g., onchange="this.form.submit();"  
   
 See lonrights.pm for an example invocation and use.  See lonrights.pm for an example invocation and use.
   
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
 sub select_form {  sub select_form {
     my ($def,$name,$hashref,$onchange) = @_;      my ($def,$name,%hash) = @_;
     return unless (ref($hashref) eq 'HASH');      my $selectform = "<select name=\"$name\" size=\"1\">\n";
     if ($onchange) {  
         $onchange = ' onchange="'.$onchange.'"';  
     }  
     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";  
     my @keys;      my @keys;
     if (exists($hashref->{'select_form_order'})) {      if (exists($hash{'select_form_order'})) {
         @keys=@{$hashref->{'select_form_order'}};   @keys=@{$hash{'select_form_order'}};
     } else {      } else {
         @keys=sort(keys(%{$hashref}));   @keys=sort(keys(%hash));
     }      }
     foreach my $key (@keys) {      foreach my $key (@keys) {
         $selectform.=          $selectform.=
     '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.      '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
             ($key eq $def ? 'selected="selected" ' : '').              ($key eq $def ? 'selected="selected" ' : '').
                 ">".$hashref->{$key}."</option>\n";                  ">".$hash{$key}."</option>\n";
     }      }
     $selectform.="</select>";      $selectform.="</select>";
     return $selectform;      return $selectform;
Line 1912  sub display_filter { Line 1888  sub display_filter {
            &mt('Filter [_1]',             &mt('Filter [_1]',
    &select_form($env{'form.displayfilter'},     &select_form($env{'form.displayfilter'},
  'displayfilter',   'displayfilter',
  {'currentfolder' => 'Current folder/page',   ('currentfolder' => 'Current folder/page',
  'containing' => 'Containing phrase',   'containing' => 'Containing phrase',
  'none' => 'None'})).   'none' => 'None'))).
  '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';   '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
 }  }
   
Line 2284  function changed_text(choice,currentform Line 2260  function changed_text(choice,currentform
 }  }
   
 function set_auth_radio_buttons(newvalue,currentform) {  function set_auth_radio_buttons(newvalue,currentform) {
     var numauthchoices = currentform.login.length;  
     if (typeof numauthchoices  == "undefined") {  
         return;  
     }  
     var i=0;      var i=0;
     while (i < numauthchoices) {      while (i < currentform.login.length) {
         if (currentform.login[i].value == newvalue) { break; }          if (currentform.login[i].value == newvalue) { break; }
         i++;          i++;
     }      }
     if (i == numauthchoices) {      if (i == currentform.login.length) {
         return;          return;
     }      }
     current.radiovalue = newvalue;      current.radiovalue = newvalue;
Line 3260  sub filemimetype { Line 3232  sub filemimetype {
 sub filecategoryselect {  sub filecategoryselect {
     my ($name,$value)=@_;      my ($name,$value)=@_;
     return &select_form($value,$name,      return &select_form($value,$name,
  {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});   '' => &mt('Any category'),
    map { $_,$_ } sort(keys(%category_extensions)));
 }  }
   
 =pod  =pod
Line 3425  sub get_previous_attempt { Line 3398  sub get_previous_attempt {
       }        }
       $prevattempts=&start_data_table().&start_data_table_header_row();        $prevattempts=&start_data_table().&start_data_table_header_row();
       $prevattempts.='<th>'.&mt('History').'</th>';        $prevattempts.='<th>'.&mt('History').'</th>';
       my (%typeparts,%lasthidden);        my %typeparts;
       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});        my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
       foreach my $key (sort(keys(%lasthash))) {        foreach my $key (sort(keys(%lasthash))) {
  my ($ign,@parts) = split(/\./,$key);   my ($ign,@parts) = split(/\./,$key);
  if ($#parts > 0) {   if ($#parts > 0) {
   my $data=$parts[-1];    my $data=$parts[-1];
           next if ($data eq 'foilorder');  
   pop(@parts);    pop(@parts);
           if ($data eq 'type') {            if ($data eq 'type') {
               unless ($showsurv) {                unless ($showsurv) {
                   my $id = join(',',@parts);                    my $id = join(',',@parts);
                   $typeparts{$ign.'.'.$id} = $lasthash{$key};                    $typeparts{$ign.'.'.$id} = $lasthash{$key};
                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {  
                       $lasthidden{$ign.'.'.$id} = 1;  
                   }  
               }                }
               delete($lasthash{$key});                delete($lasthash{$key});
           } else {            } else {
Line 3454  sub get_previous_attempt { Line 3423  sub get_previous_attempt {
  }   }
       }        }
       $prevattempts.=&end_data_table_header_row();        $prevattempts.=&end_data_table_header_row();
         my %lasthidden;
       if ($getattempt eq '') {        if ($getattempt eq '') {
  for ($version=1;$version<=$returnhash{'version'};$version++) {   for ($version=1;$version<=$returnhash{'version'};$version++) {
             my @hidden;              my @hidden;
Line 3461  sub get_previous_attempt { Line 3431  sub get_previous_attempt {
                 foreach my $id (keys(%typeparts)) {                  foreach my $id (keys(%typeparts)) {
                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {                      if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                         push(@hidden,$id);                          push(@hidden,$id);
                           $lasthidden{$id} = 1;
                       } elsif ($lasthidden{$id}) {
                           if (exists($returnhash{$version.':'.$id.'.award'})) {
                               delete($lasthidden{$id});
                           }
                     }                      }
                 }                  }
             }              }
Line 3468  sub get_previous_attempt { Line 3443  sub get_previous_attempt {
                            '<td>'.&mt('Transaction [_1]',$version).'</td>';                             '<td>'.&mt('Transaction [_1]',$version).'</td>';
             if (@hidden) {              if (@hidden) {
                 foreach my $key (sort(keys(%lasthash))) {                  foreach my $key (sort(keys(%lasthash))) {
                     next if ($key =~ /\.foilorder$/);  
                     my $hide;                      my $hide;
                     foreach my $id (@hidden) {                      foreach my $id (@hidden) {
                         if ($key =~ /^\Q$id\E/) {                          if ($key =~ /^\Q$id\E/) {
Line 3497  sub get_previous_attempt { Line 3471  sub get_previous_attempt {
                 }                  }
             } else {              } else {
         foreach my $key (sort(keys(%lasthash))) {          foreach my $key (sort(keys(%lasthash))) {
                     next if ($key =~ /\.foilorder$/);  
     my $value = &format_previous_attempt_value($key,      my $value = &format_previous_attempt_value($key,
             $returnhash{$version.':'.$key});              $returnhash{$version.':'.$key});
     $prevattempts.='<td>'.$value.'&nbsp;</td>';      $prevattempts.='<td>'.$value.'&nbsp;</td>';
Line 3509  sub get_previous_attempt { Line 3482  sub get_previous_attempt {
       my @currhidden = keys(%lasthidden);        my @currhidden = keys(%lasthidden);
       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';        $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
       foreach my $key (sort(keys(%lasthash))) {        foreach my $key (sort(keys(%lasthash))) {
           next if ($key =~ /\.foilorder$/);  
           if (%typeparts) {            if (%typeparts) {
               my $hidden;                my $hidden;
               foreach my $id (@currhidden) {                foreach my $id (@currhidden) {
Line 3565  sub format_previous_attempt_value { Line 3537  sub format_previous_attempt_value {
  $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 }).')';
     } elsif ($key =~ /answerstring$/) {  
         my %answers = &Apache::lonnet::str2hash($value);  
         my @anskeys = sort(keys(%answers));  
         if (@anskeys == 1) {  
             my $answer = $answers{$anskeys[0]};  
             if ($answer =~ m{\Q\0\E}) {  
                 $answer =~ s{\Q\0\E}{, }g;  
             }  
             my $tag_internal_answer_name = 'INTERNAL';  
             if ($anskeys[0] eq $tag_internal_answer_name) {  
                 $value = $answer;  
             } else {  
                 $value = $anskeys[0].'='.$answer;  
             }  
         } else {  
             foreach my $ans (@anskeys) {  
                 my $answer = $answers{$ans};  
                 if ($answer =~ m{\Q\0\E}) {  
                     $answer =~ s{\Q\0\E}{, }g;  
                 }  
                 $value .=  $ans.'='.$answer.'<br />';;  
             }  
         }  
     } else {      } else {
  $value = &unescape($value);   $value = &unescape($value);
     }      }
Line 3866  sub findallcourses { Line 3815  sub findallcourses {
         $udom = $env{'user.domain'};          $udom = $env{'user.domain'};
     }      }
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {      if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
         my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});          my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,  
                                               $extra);  
         if (!%roles) {          if (!%roles) {
             %roles = (              %roles = (
                        cc => 1,                         cc => 1,
Line 4592  Inputs: Line 4539  Inputs:
   
 =item * $bgcolor, used to override the bgcolor on a webpage to a specific value  =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
   
 =item * $no_inline_link, if true and in remote mode, don't show the   
          'Switch To Inline Menu' link  
   
 =item * $args, optional argument valid values are  =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg              no_auto_mt_title -> prevents &mt()ing the title arg
             inherit_jsmath -> when creating popup window in a page,              inherit_jsmath -> when creating popup window in a page,
Line 4612  other decorations will be returned. Line 4556  other decorations will be returned.
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
         $no_nav_bar,$bgcolor,$no_inline_link,$args)=@_;          $no_nav_bar,$bgcolor,$args)=@_;
   
     my $public;      my $public;
     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))      if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
Line 4673  sub bodytag { Line 4617  sub bodytag {
     } else {      } else {
  $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});   $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
     }      }
       
     my $titleinfo = '<h1>'.$title.'</h1>';      my $titleinfo = '<h1>'.$title.'</h1>';
     #      #
     # Extra info if you are the DC      # Extra info if you are the DC
Line 4689  sub bodytag { Line 4633  sub bodytag {
     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;      $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);      &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
   
     if ($env{'environment.remote'} eq 'off') {  
         # No Remote  
         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') {           if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
             return $bodytag;               return $bodytag; 
         }           } 
Line 4732  sub bodytag { Line 4674  sub bodytag {
             $bodytag .= Apache::lonmenu::serverform();              $bodytag .= Apache::lonmenu::serverform();
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');              $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {              if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,'',                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,
                                 $args->{'bread_crumbs'});                                  $args->{'bread_crumbs'});
             } elsif ($forcereg) {               } elsif ($forcereg) { 
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);                  $bodytag .= &Apache::lonmenu::innerregister($forcereg);
Line 4745  sub bodytag { Line 4687  sub bodytag {
         }          }
   
         return $bodytag;          return $bodytag;
     }  
   
 #  
 # Top frame rendering, Remote is up  
 #  
   
     my $imgsrc = $img;  
     if ($img =~ /^\/adm/) {  
         $imgsrc = &lonhttpdurl($img);  
     }  
     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';  
   
     # Explicit link to get inline menu  
     my $menu= ($no_inline_link?''  
        :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');  
   
     if ($dc_info) {  
         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;  
     }  
   
     $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>  
             <ol class="LC_primary_menu LC_right">  
                 <li>$menu</li>  
             </ol><div id="LC_realm"> $realm $dc_info</div>| unless $env{'form.inhibitmenu'};  
     return(<<ENDBODY);  
 $bodytag  
 <table id="LC_title_bar" class="LC_with_remote">  
 <tr><td>$upperleft</td>  
     <td>$messages&nbsp;</td>  
 </tr>  
 <tr><td>$titleinfo $dc_info $menu</td>  
 </tr>  
 </table>  
 ENDBODY  
 }  }
   
 sub dc_courseid_toggle {  sub dc_courseid_toggle {
     my ($dc_info) = @_;      my ($dc_info) = @_;
     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.      return ' <span id="dccidtext" class="LC_cusr_subheading">'.
            '<a href="javascript:showCourseID();">'.             '<a href="javascript:showCourseID();">'.
            &mt('(More ...)').'</a></span>'.             &mt('(More ...)').'</a></span>'.
            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';             '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
Line 4810  sub make_attr_string { Line 4718  sub make_attr_string {
  delete($attr_ref->{$key});   delete($attr_ref->{$key});
     }      }
  }   }
  $attr_ref->{'onload'}  =   $attr_ref->{'onload'}  = $on_load;
     &Apache::lonmenu::loadevents().  $on_load;   $attr_ref->{'onunload'}= $on_unload;
  $attr_ref->{'onunload'}=  
     &Apache::lonmenu::unloadevents().$on_unload;  
     }  
   
 # Accessibility font enhance  
     if ($env{'browser.fontenhance'} eq 'on') {  
  my $style;  
  foreach my $key (keys(%{$attr_ref})) {  
     if (lc($key) eq 'style') {  
  $style.=$attr_ref->{$key}.';';  
  delete($attr_ref->{$key});  
     }  
  }  
  $attr_ref->{'style'}=$style.'; font-size: x-large;';  
     }      }
   
     my $attr_string;      my $attr_string;
Line 4899  sub standard_css { Line 4793  sub standard_css {
     my $vlink  = &designparm($function.'.vlink', $domain);      my $vlink  = &designparm($function.'.vlink', $domain);
     my $link   = &designparm($function.'.link',  $domain);      my $link   = &designparm($function.'.link',  $domain);
   
       my $loginbg = &designparm('login.sidebg',$domain);
       my $bgcol = &designparm('login.bgcol',$domain);
       my $textcol = &designparm('login.textcol',$domain);
   
     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';      my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
     my $mono                 = 'monospace';      my $mono                 = 'monospace';
     my $data_table_head      = $sidebg;      my $data_table_head      = $sidebg;
Line 4923  sub standard_css { Line 4821  sub standard_css {
       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'        $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                                              : '0 3px 0 4px';                                               : '0 3px 0 4px';
   
   
     return <<END;      return <<END;
   
 /* needed for iframe to allow 100% height in FF */  /* needed for iframe to allow 100% height in FF */
Line 5155  td.LC_table_cell_checkbox { Line 5054  td.LC_table_cell_checkbox {
   padding: 0;    padding: 0;
 }  }
   
 /* Preliminary fix to hide breadcrumbs inside remote control window */  
 #LC_remote #LC_breadcrumbs {  
   display:none;  
 }  
   
 #LC_head_subbox {  #LC_head_subbox {
   clear:both;    clear:both;
   background: #F8F8F8; /* $sidebg; */    background: #F8F8F8; /* $sidebg; */
   border: 1px solid $sidebg;    border: 1px solid $sidebg;
   margin: 0 0 10px 0;          margin: 0 0 10px 0;      
   padding: 3px;  
 }  }
   
 .LC_fontsize_medium {  .LC_fontsize_medium {
Line 5532  span.LC_parm_symb { Line 5425  span.LC_parm_symb {
   color: #AAAAAA;    color: #AAAAAA;
 }  }
   
 ul.LC_parm_parmlist li {  
   display: inline-block;  
   padding: 0.3em 0.8em;  
   vertical-align: top;  
   width: 150px;  
   border-top:1px solid $lg_border_color;  
 }  
   
 td.LC_parm_overview_level_menu,  td.LC_parm_overview_level_menu,
 td.LC_parm_overview_map_menu,  td.LC_parm_overview_map_menu,
 td.LC_parm_overview_parm_selectors,  td.LC_parm_overview_parm_selectors,
Line 6143  fieldset > legend { Line 6028  fieldset > legend {
   
 #LC_nav_bar {  #LC_nav_bar {
   float: left;    float: left;
   margin: 0 0 2px 0;    margin: 0;
 }  }
   
 #LC_realm {  #LC_realm {
Line 6158  fieldset > legend { Line 6043  fieldset > legend {
   font-style: normal;    font-style: normal;
 }  }
   
 /* Preliminary fix to hide nav_bar inside bookmarks window */  
 #LC_bookmarks #LC_nav_bar {  
   display:none;  
 }  
   
 ol.LC_primary_menu {  ol.LC_primary_menu {
   float: right;    float: right;
   margin: 0;    margin: 0;
 }  }
   
 span.LC_new_message{  
   font-weight:bold;  
   color: darkred;  
 }  
   
 ol#LC_PathBreadcrumbs {  ol#LC_PathBreadcrumbs {
   margin: 0;    margin: 0;
 }  }
Line 6193  ol.LC_primary_menu a { Line 6068  ol.LC_primary_menu a {
   text-decoration: none;    text-decoration: none;
 }  }
   
 ol.LC_docs_parameters {  ol.LC_primary_menu a.LC_new_message {
   margin-left: 0;    font-weight:bold;
   padding: 0;    color: darkred;
   list-style: none;  
 }  
   
 ol.LC_docs_parameters li {  
   margin: 0;  
   padding-right: 20px;  
   display: inline;  
 }  
   
 ol.LC_docs_parameters li:before {  
   content: "\\002022 \\0020";  
 }  
   
 li.LC_docs_parameters_title {  
   font-weight: bold;  
 }  
   
 ol.LC_docs_parameters li.LC_docs_parameters_title:before {  
   content: "";  
 }  }
   
 ul#LC_secondary_menu {  ul#LC_secondary_menu {
Line 6334  ul.LC_TabContentBigger li a { Line 6190  ul.LC_TabContentBigger li a {
   text-align: center;    text-align: center;
   display: block;    display: block;
   text-decoration: none;    text-decoration: none;
   outline: none;    outline: none;  
 }  }
   
 ul.LC_TabContentBigger li.active a {  ul.LC_TabContentBigger li.active a {
Line 6361  ul.LC_TabContentBigger li.active b { Line 6217  ul.LC_TabContentBigger li.active b {
   cursor:default;    cursor:default;
 }  }
   
   
 ul.LC_CourseBreadcrumbs {  ul.LC_CourseBreadcrumbs {
   background: $sidebg;    background: $sidebg;
   line-height: 32px;    line-height: 32px;
Line 6390  ul.LC_CourseBreadcrumbs li a { Line 6247  ul.LC_CourseBreadcrumbs li a {
   font-size:90%;    font-size:90%;
 }  }
   
 ol#LC_MenuBreadcrumbs h1 {  
   display: inline;  
   font-size: 90%;  
   line-height: 2.5em;  
   margin: 0;  
   padding: 0;  
 }  
   
 ol#LC_PathBreadcrumbs li a {  ol#LC_PathBreadcrumbs li a {
   text-decoration:none;    text-decoration:none;
   font-size:100%;    font-size:100%;
Line 6494  div.LC_columnSection>* { Line 6343  div.LC_columnSection>* {
   overflow:hidden;    overflow:hidden;
 }  }
   
   .LC_loginpage_container {
     text-align:left;
     margin : 0 auto;
     width:90%;
     padding: 10px;
     height: auto;
     background-color:#FFFFFF;
     border:1px solid #CCCCCC;
   }
   
   
   .LC_loginpage_loginContainer {
     float:left;
     width: 182px;
     padding: 2px;
     border:1px solid #CCCCCC;
     background-color:$loginbg;
   }
   
   .LC_loginpage_loginContainer h2 {
     margin-top: 0;
     display:block;
     background:$bgcol;
     color:$textcol;
     padding-left:5px;
   }
   
   .LC_loginpage_loginInfo {
     float:left;
     width:182px;
     border:1px solid #CCCCCC;
     padding:2px;
   }
   
   .LC_loginpage_space {
     clear: both;
     margin-bottom: 20px;
     border-bottom: 1px solid #CCCCCC;
   }
   
   .LC_loginpage_floatLeft {
     float: left;
     width: 200px;
     margin: 0;
   }
   
 table em {  table em {
   font-weight: bold;    font-weight: bold;
   font-style: normal;    font-style: normal;
Line 6529  a#LC_content_toolbar_firsthomework { Line 6424  a#LC_content_toolbar_firsthomework {
   background-image:url(/res/adm/pages/open-first-problem.gif);    background-image:url(/res/adm/pages/open-first-problem.gif);
 }  }
   
 a#LC_content_toolbar_launchnav {  
   background-image:url(/res/adm/pages/start-navigation.gif);  
 }  
   
 a#LC_content_toolbar_closenav {  
   background-image:url(/res/adm/pages/close-navigation.gif);  
 }  
   
 a#LC_content_toolbar_everything {  a#LC_content_toolbar_everything {
   background-image:url(/res/adm/pages/show-all.gif);    background-image:url(/res/adm/pages/show-all.gif);
 }  }
Line 6678  sub headtag { Line 6565  sub headtag {
     if (!$args->{'frameset'}) {      if (!$args->{'frameset'}) {
  $result .= &Apache::lonhtmlcommon::htmlareaheaders();   $result .= &Apache::lonhtmlcommon::htmlareaheaders();
     }      }
     if ($args->{'force_register'}) {      if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
  $result .= &Apache::lonmenu::registerurl(1);          $result .= Apache::lonxml::display_title();
     }      }
     if (!$args->{'no_nav_bar'}       if (!$args->{'no_nav_bar'} 
  && !$args->{'only_body'}   && !$args->{'only_body'}
Line 6705  ADDMETA Line 6592  ADDMETA
     $result .= '<title> LON-CAPA '.$title.'</title>'      $result .= '<title> LON-CAPA '.$title.'</title>'
  .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'   .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
  .$head_extra;   .$head_extra;
     return $result;      return $result.'</head>';
 }  }
   
 =pod  =pod
Line 6740  Inputs: none Line 6627  Inputs: none
 sub xml_begin {  sub xml_begin {
     my $output='';      my $output='';
   
       if ($env{'internal.start_page'}==1) {
    &Apache::lonhtmlcommon::init_htmlareafields();
       }
   
     if ($env{'browser.mathml'}) {      if ($env{'browser.mathml'}) {
  $output='<?xml version="1.0"?>'   $output='<?xml version="1.0"?>'
             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"              #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
Line 6758  sub xml_begin { Line 6649  sub xml_begin {
   
 =pod  =pod
   
 =item * &endheadtag()  
   
 Returns a uniform </head> for LON-CAPA web pages.  
   
 Inputs: none  
   
 =cut  
   
 sub endheadtag {  
     return '</head>';  
 }  
   
 =pod  
   
 =item * &head()  
   
 Returns a uniform complete <head>..</head> section for LON-CAPA web pages.  
   
 Inputs:  
   
 =over 4  
   
 $title - optional title for the page  
   
 $head_extra - optional extra HTML to put inside the <head>  
   
 =back  
   
 =cut  
   
 sub head {  
     my ($title,$head_extra,$args) = @_;  
     return &headtag($title,$head_extra,$args).&endheadtag();  
 }  
   
 =pod  
   
 =item * &start_page()  =item * &start_page()
   
 Returns a complete <html> .. <body> section for LON-CAPA web pages.  Returns a complete <html> .. <body> section for LON-CAPA web pages.
Line 6832  $args - additional optional args support Line 6686  $args - additional optional args support
              skip_phases    -> hash ref of                skip_phases    -> hash ref of 
                                     head -> skip the <html><head> generation                                      head -> skip the <html><head> generation
                                     body -> skip all <body> generation                                      body -> skip all <body> generation
              no_inline_link -> if true and in remote mode, don't show the   
                                     'Switch To Inline Menu' link  
              no_auto_mt_title -> prevent &mt()ing the title arg               no_auto_mt_title -> prevent &mt()ing the title arg
              inherit_jsmath -> when creating popup window in a page,               inherit_jsmath -> when creating popup window in a page,
                                     should it have jsmath forced on by the                                      should it have jsmath forced on by the
                                     current page                                      current page
              bread_crumbs ->             Array containing breadcrumbs               bread_crumbs ->             Array containing breadcrumbs
              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs               bread_crumbs_components ->  if exists show it as headline else show only the breadcrumbs
   
 =back  =back
   
Line 6864  sub start_page { Line 6716  sub start_page {
     if (! exists($args->{'skip_phases'}{'head'}) ) {      if (! exists($args->{'skip_phases'}{'head'}) ) {
  $result.=   $result.=
     &xml_begin().      &xml_begin().
     &headtag($title,$head_extra,\%head_args).&endheadtag();          &headtag($title,$head_extra,\%head_args);
     }      }
           
     if (! exists($args->{'skip_phases'}{'body'}) ) {      if (! exists($args->{'skip_phases'}{'body'}) ) {
Line 6878  sub start_page { Line 6730  sub start_page {
                          $args->{'function'},       $args->{'add_entries'},                           $args->{'function'},       $args->{'add_entries'},
                          $args->{'only_body'},      $args->{'domain'},                           $args->{'only_body'},      $args->{'domain'},
                          $args->{'force_register'}, $args->{'no_nav_bar'},                           $args->{'force_register'}, $args->{'no_nav_bar'},
                          $args->{'bgcolor'},        $args->{'no_inline_link'},                           $args->{'bgcolor'},        $args);
                          $args);  
         }          }
     }      }
   
Line 6899  sub start_page { Line 6750  sub start_page {
     return $result if $args->{'only_body'};      return $result if $args->{'only_body'};
   
     #Breadcrumbs for Construction Space provided by &bodytag.       #Breadcrumbs for Construction Space provided by &bodytag. 
     if (($env{'environment.remote'} eq 'off') && ($env{'request.state'} eq 'construct')) {      if (
           $env{'request.state'} eq 'construct') {
         return $result;          return $result;
     }      }
     
Line 6923  sub start_page { Line 6775  sub start_page {
     return $result;      return $result;
 }  }
   
   
 =pod  
   
 =item * &head()  
   
 Returns a complete </body></html> section for LON-CAPA web pages.  
   
 Inputs:         $args - additional optional args supported are:  
                  js_ready     -> return a string ready for being used in   
                                  a javascript writeln  
                  html_encode  -> return a string ready for being used in   
                                  a html attribute  
                  frameset     -> if true will start with a <frameset>  
                                  rather than <body>  
                  dicsussion   -> if true will get discussion from  
                                   lonxml::xmlend  
                                  (you can pass the target and parser arguments  
                                   through optional 'target' and 'parser' args  
                                   to this routine)  
   
 =cut  
   
 sub end_page {  sub end_page {
     my ($args) = @_;      my ($args) = @_;
     $env{'internal.end_page'}++;      $env{'internal.end_page'}++;
Line 7048  sub simple_error_page { Line 6878  sub simple_error_page {
     sub start_data_table {      sub start_data_table {
  my ($add_class) = @_;   my ($add_class) = @_;
  my $css_class = (join(' ','LC_data_table',$add_class));   my $css_class = (join(' ','LC_data_table',$add_class));
         &start_data_table_count();   &start_data_table_count();
  return '<table class="'.$css_class.'">'."\n";   return '<table class="'.$css_class.'">'."\n";
     }      }
   
     sub end_data_table {      sub end_data_table {
         &end_data_table_count();   &end_data_table_count();
  return '</table>'."\n";;   return '</table>'."\n";;
     }      }
   
Line 7232  role status: active, previous or future. Line 7062  role status: active, previous or future.
   
 sub check_user_status {  sub check_user_status {
     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;      my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
     my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});      my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);  
     my @uroles = keys %userinfo;      my @uroles = keys %userinfo;
     my $srchstr;      my $srchstr;
     my $active_chk = 'none';      my $active_chk = 'none';
Line 8272  sub get_institutional_codes { Line 8101  sub get_institutional_codes {
     return;      return;
 }  }
   
 sub get_standard_codeitems {  
     return ('Year','Semester','Department','Number','Section');  
 }  
   
 =pod  =pod
   
 =head1 Slot Helpers  =head1 Slot Helpers
Line 8467  sub get_env_multiple { Line 8292  sub get_env_multiple {
   
 sub ask_for_embedded_content {  sub ask_for_embedded_content {
     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;      my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);      my $upload_output = '
      <form name="upload_embedded" action="'.$actionurl.'"
                     method="post" enctype="multipart/form-data">';
       $upload_output .= $state;
       $upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();
   
     my $num = 0;      my $num = 0;
     my $numremref = 0;      foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
     my $numinvalid = 0;  
     my $numpathchg = 0;  
     my $numexisting = 0;  
     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);  
     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {  
         my $current_path='/';  
         if ($env{'form.currentpath'}) {  
             $current_path = $env{'form.currentpath'};  
         }  
         if ($actionurl eq '/adm/coursegrp_portfolio') {  
             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};  
             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};  
             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';  
         } else {  
             $udom = $env{'user.domain'};  
             $uname = $env{'user.name'};  
             $url = '/userfiles/portfolio';  
         }  
         $toplevel = $url.'/';  
         $url .= $current_path;  
         $getpropath = 1;  
     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||  
              ($actionurl eq '/adm/imsimport')) {  
         ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$});  
         $url = '/home/'.$uname.'/public_html/';  
         $toplevel = $url;  
         if ($rest ne '') {  
             $url .= $rest;  
         }  
     } elsif ($actionurl eq '/adm/coursedocs') {  
         if (ref($args) eq 'HASH') {  
            $url = $args->{'docs_url'};  
            $toplevel = $url;  
         }  
     }  
     my $now = time();  
     foreach my $embed_file (keys(%{$allfiles})) {  
         my $absolutepath;  
         if ($embed_file =~ m{^\w+://}) {  
             $newfiles{$embed_file} = 1;  
             $mapping{$embed_file} = $embed_file;  
         } else {  
             if ($embed_file =~ m{^/}) {  
                 $absolutepath = $embed_file;  
                 $embed_file =~ s{^(/+)}{};  
             }  
             if ($embed_file =~ m{/}) {  
                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});  
                 $path = &check_for_traversal($path,$url,$toplevel);  
                 my $item = $fname;  
                 if ($path ne '') {  
                     $item = $path.'/'.$fname;  
                     $subdependencies{$path}{$fname} = 1;  
                 } else {  
                     $dependencies{$item} = 1;  
                 }  
                 if ($absolutepath) {  
                     $mapping{$item} = $absolutepath;  
                 } else {  
                     $mapping{$item} = $embed_file;  
                 }  
             } else {  
                 $dependencies{$embed_file} = 1;  
                 if ($absolutepath) {  
                     $mapping{$embed_file} = $absolutepath;  
                 } else {  
                     $mapping{$embed_file} = $embed_file;  
                 }  
             }  
         }  
     }  
     foreach my $path (keys(%subdependencies)) {  
         my %currsubfile;  
         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {  
             my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);  
             foreach my $line (@subdir_list) {  
                 my ($file_name,$rest) = split(/\&/,$line,2);  
                 $currsubfile{$file_name} = 1;  
             }  
         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {  
             if (opendir(my $dir,$url.'/'.$path)) {  
                 my @subdir_list = grep(!/^\./,readdir($dir));  
                 map {$currsubfile{$_} = 1;} @subdir_list;  
             }  
         }  
         foreach my $file (keys(%{$subdependencies{$path}})) {  
             if ($currsubfile{$file}) {  
                 my $item = $path.'/'.$file;  
                 unless ($mapping{$item} eq $item) {  
                     $pathchanges{$item} = 1;  
                 }  
                 $existing{$item} = 1;  
                 $numexisting ++;  
             } else {  
                 $newfiles{$path.'/'.$file} = 1;  
             }  
         }  
     }  
     my %currfile;  
     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {  
         my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);  
         foreach my $line (@dir_list) {  
             my ($file_name,$rest) = split(/\&/,$line,2);  
             $currfile{$file_name} = 1;  
         }  
     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {  
         if (opendir(my $dir,$url)) {  
             my @dir_list = grep(!/^\./,readdir($dir));  
             map {$currfile{$_} = 1;} @dir_list;  
         }  
     }  
     foreach my $file (keys(%dependencies)) {  
         if ($currfile{$file}) {  
             unless ($mapping{$file} eq $file) {  
                 $pathchanges{$file} = 1;  
             }  
             $existing{$file} = 1;  
             $numexisting ++;  
         } else {  
             $newfiles{$file} = 1;  
         }  
     }  
     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {  
         $upload_output .= &start_data_table_row().          $upload_output .= &start_data_table_row().
                           '<td><span class="LC_filename">'.$embed_file.'</span>';              '<td>'.$embed_file.'</td><td>';
         unless ($mapping{$embed_file} eq $embed_file) {  
             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';  
         }  
         $upload_output .= '</td><td>';  
         if ($args->{'ignore_remote_references'}          if ($args->{'ignore_remote_references'}
             && $embed_file =~ m{^\w+://}) {              && $embed_file =~ m{^\w+://}) {
             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';              $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
             $numremref++;  
         } elsif ($args->{'error_on_invalid_names'}          } elsif ($args->{'error_on_invalid_names'}
             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {              && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
   
             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';              $upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';
             $numinvalid++;  
         } else {          } else {
             $upload_output .= &embedded_file_element('upload_embedded',$num,              $upload_output .='
                                                      $embed_file,\%mapping,             <input name="embedded_item_'.$num.'" type="file" value="" />
                                                      $allfiles,$codebase);             <input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
             $num++;              my $attrib = join(':',@{$$allfiles{$embed_file}});
         }              $upload_output .=
         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";                  "\n\t\t".
     }                  '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {                  $attrib.'" />';
         $upload_output .= &start_data_table_row().              if (exists($$codebase{$embed_file})) {
                           '<td><span class="LC_filename">'.$embed_file.'</span></td>'.                  $upload_output .=
                           '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.                      "\n\t\t".
                           &Apache::loncommon::end_data_table_row()."\n";                      '<input name="codebase_'.$num.'" type="hidden" value="'.
     }                      &escape($$codebase{$embed_file}).'" />';
     if ($upload_output) {              }
         $upload_output = &start_data_table().          }
                          $upload_output.          $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
                          &end_data_table()."\n";          $num++;
     }      }
     my $applies = 0;      $upload_output .= &Apache::loncommon::end_data_table().'<br />
     if ($numremref) {     <input type ="hidden" name="number_embedded_items" value="'.$num.'" />
         $applies ++;     <input type ="submit" value="'.&mt('Upload Listed Files').'" />
     }     '.&mt('(only files for which a location has been provided will be uploaded)').'
     if ($numinvalid) {     </form>';
         $applies ++;      return $upload_output;
     }  
     if ($numexisting) {  
         $applies ++;  
     }  
     if ($num) {  
         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.  
                   ' method="post" enctype="multipart/form-data">'."\n".  
                   $state.  
                   '<h3>'.&mt('Upload embedded files').  
                   ':</h3>'.$upload_output.'<br />'."\n".  
                   '<input type ="hidden" name="number_embedded_items" value="'.  
                   $num.'" />'."\n";  
         if ($actionurl eq '') {  
             $output .=  '<input type="hidden" name="phase" value="three" />';  
         }  
     } elsif ($applies) {  
         $output = '<b>'.&mt('Referenced files').'</b>:<br />';  
         if ($applies > 1) {  
             $output .=  
                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';  
             if ($numremref) {  
                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";  
             }  
             if ($numinvalid) {  
                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";  
             }  
             if ($numexisting) {  
                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";  
             }  
             $output .= '</ul><br />';  
         } elsif ($numremref) {  
             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';  
         } elsif ($numinvalid) {  
             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';  
         } elsif ($numexisting) {  
             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';  
         }  
         $output .= $upload_output.'<br />';  
     }  
     my ($pathchange_output,$chgcount);  
     $chgcount = $num;  
     if (keys(%pathchanges) > 0) {  
         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {  
             if ($num) {  
                 $output .= &embedded_file_element('pathchange',$chgcount,  
                                                   $embed_file,\%mapping,  
                                                   $allfiles,$codebase);  
             } else {  
                 $pathchange_output .=  
                     &start_data_table_row().  
                     '<td><input type ="checkbox" name="namechange" value="'.  
                     $chgcount.'" checked="checked" /></td>'.  
                     '<td>'.$mapping{$embed_file}.'</td>'.  
                     '<td>'.$embed_file.  
                     &embedded_file_element('pathchange',$numpathchg,$embed_file,  
                                            \%mapping,$allfiles,$codebase).  
                     '</td>'.&end_data_table_row();  
             }  
             $numpathchg ++;  
             $chgcount ++;  
         }  
     }  
     if ($num) {  
         if ($numpathchg) {  
             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.  
                        $numpathchg.'" />'."\n";  
         }  
         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||  
             ($actionurl eq '/adm/imsimport')) {  
             $output .= '<input type="hidden" name="phase" value="three" />'."\n";  
         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {  
             $output .= '<input type="hidden" name="action" value="upload_embedded" />';  
         }  
         $output .=  '<input type ="submit" value="'.&mt('Upload Listed Files').'" />'."\n".  
                     &mt('(only files for which a location has been provided will be uploaded)').'</form>'."\n";  
     } elsif ($numpathchg) {  
         my %pathchange = ();  
         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);  
         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {  
             $output .= '<p>'.&mt('or').'</p>';  
         }  
     }  
     return ($output,$num,$numpathchg);  
 }  
   
 sub embedded_file_element {  
     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;  
     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&  
                    (ref($codebase) eq 'HASH'));  
     my $output;  
     if ($context eq 'upload_embedded') {  
        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";  
     }  
     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.  
                &escape($embed_file).'" />';  
     unless (($context eq 'upload_embedded') &&  
             ($mapping->{$embed_file} eq $embed_file)) {  
         $output .='  
         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';  
     }  
     my $attrib;  
     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {  
         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));  
     }  
     $output .=  
         "\n\t\t".  
         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.  
         $attrib.'" />';  
     if (exists($codebase->{$mapping->{$embed_file}})) {  
         $output .=  
             "\n\t\t".  
             '<input name="codebase_'.$num.'" type="hidden" value="'.  
             &escape($codebase->{$mapping->{$embed_file}}).'" />';  
     }  
     return $output;  
 }  }
   
 sub upload_embedded {  sub upload_embedded {
     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,      my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
         $current_disk_usage,$hiddenstate,$actionurl) = @_;          $current_disk_usage) = @_;
     my (%pathchange,$output,$modifyform,$footer,$returnflag);      my $output;
     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {      for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));          next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
         my $orig_uploaded_filename =          my $orig_uploaded_filename =
             $env{'form.embedded_item_'.$i.'.filename'};              $env{'form.embedded_item_'.$i.'.filename'};
         foreach my $type ('orig','ref','attrib','codebase') {  
             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {          $env{'form.embedded_orig_'.$i} =
                 $env{'form.embedded_'.$type.'_'.$i} =              &unescape($env{'form.embedded_orig_'.$i});
                     &unescape($env{'form.embedded_'.$type.'_'.$i});  
             }  
         }  
         my ($path,$fname) =          my ($path,$fname) =
             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});              ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
         # no path, whole string is fname          # no path, whole string is fname
         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };          if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
   
           $path = $env{'form.currentpath'}.$path;
         $fname = &Apache::lonnet::clean_filename($fname);          $fname = &Apache::lonnet::clean_filename($fname);
         # See if there is anything left          # See if there is anything left
         next if ($fname eq '');          next if ($fname eq '');
Line 8779  sub upload_embedded { Line 8365  sub upload_embedded {
             if ($group ne '') {              if ($group ne '') {
                 $port_path = "groups/$group/$port_path";                  $port_path = "groups/$group/$port_path";
             }              }
             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,              ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
                                               $fname,$group,'embedded_item_'.$i,  
                                               $dir_root,$port_path,$disk_quota,                                                $dir_root,$port_path,$disk_quota,
                                               $current_disk_usage,$uname,$udom);                                                $current_disk_usage,$uname,$udom);
             if ($state eq 'will_exceed_quota'              if ($state eq 'will_exceed_quota'
                 || $state eq 'file_locked') {                  || $state eq 'file_locked'
                   || $state eq 'file_exists' ) {
                 $output .= $msg;                  $output .= $msg;
                 next;                  next;
             }              }
Line 8798  sub upload_embedded { Line 8384  sub upload_embedded {
         # Check if extension is valid          # Check if extension is valid
         if (($fname =~ /\.(\w+)$/) &&          if (($fname =~ /\.(\w+)$/) &&
             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {              (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
             $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';              $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
             next;              next;
         } elsif (($fname =~ /\.(\w+)$/) &&          } elsif (($fname =~ /\.(\w+)$/) &&
                  (!defined(&Apache::loncommon::fileembstyle($1)))) {                   (!defined(&Apache::loncommon::fileembstyle($1)))) {
             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';              $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
             next;              next;
         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {          } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
             $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';              $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
             next;              next;
         }          }
   
         $env{'form.embedded_item_'.$i.'.filename'}=$fname;          $env{'form.embedded_item_'.$i.'.filename'}=$fname;
         if ($context eq 'portfolio') {          if ($context eq 'portfolio') {
             my $result;              my $result=
             if ($state eq 'existingfile') {                  &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
                 $result=                                                  $dirpath.$path);
                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',  
                                                     $dirpath.$env{'form.currentpath'}.$path);  
             } else {  
                 $result=  
                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',  
                                                     $dirpath.  
                                                     $env{'form.currentpath'}.$path);  
                 if ($result !~ m|^/uploaded/|) {  
                     $output .= '<span class="LC_error">'  
                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'  
                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})  
                                .'</span><br />';  
                     next;  
                 } else {  
                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.  
                                $path.$fname.'</span>').'<br />';   
                 }  
             }  
         } elsif ($context eq 'coursedoc') {  
             my $result =  
                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',  
                                                 $dirpath.'/'.$path);  
             if ($result !~ m|^/uploaded/|) {              if ($result !~ m|^/uploaded/|) {
                 $output .= '<span class="LC_error">'                  $output .= '<span class="LC_error">'
                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'                        .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})                             ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                            .'</span><br />';                        .'</span><br />';
                     next;                  next;
             } else {              } else {
                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.                  $output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
                            $path.$fname.'</span>').'<br />';                             $path.$fname.'</span>').'</p>';     
             }              }
         } else {          } else {
 # Save the file  # Save the file
Line 8874  sub upload_embedded { Line 8438  sub upload_embedded {
                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).                                &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                               '</span><br />';                                '</span><br />';
                 } else {                  } else {
                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.                      if ($context eq 'testbank') {
                                $url.'</span>').'<br />';                          $output .= &mt('Embedded file uploaded successfully:').
                     unless ($context eq 'testbank') {                                     '&nbsp;<a href="'.$url.'">'.
                         $footer .= &mt('View embedded file: [_1]',                                     $orig_uploaded_filename.'</a><br />';
                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';  
                     }  
                 }  
                 close($fh);  
             }  
         }  
         if ($env{'form.embedded_ref_'.$i}) {  
             $pathchange{$i} = 1;  
         }  
     if ($output) {  
         $output = '<p>'.$output.'</p>';  
     }  
     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);  
     $returnflag = 'ok';  
     if (keys(%pathchange) > 0) {  
         if ($context eq 'portfolio') {  
             $output .= '<p>'.&mt('or').'</p>';  
         } elsif ($context eq 'testbank') {  
             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';  
             $returnflag = 'modify_orightml';  
         }  
     }  
     return ($output.$footer,$returnflag);  
 }  
   
 sub modify_html_form {  
     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;  
     my $end = 0;  
     my $modifyform;  
     if ($context eq 'upload_embedded') {  
         return unless (ref($pathchange) eq 'HASH');  
         if ($env{'form.number_embedded_items'}) {  
             $end += $env{'form.number_embedded_items'};  
         }  
         if ($env{'form.number_pathchange_items'}) {  
             $end += $env{'form.number_pathchange_items'};  
         }  
         if ($end) {  
             for (my $i=0; $i<$end; $i++) {  
                 if ($i < $env{'form.number_embedded_items'}) {  
                     next unless($pathchange->{$i});  
                 }  
                 $modifyform .=  
                     &start_data_table_row().  
                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.  
                     'checked="checked" /></td>'.  
                     '<td>'.$env{'form.embedded_ref_'.$i}.  
                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.  
                     &escape($env{'form.embedded_ref_'.$i}).'" />'.  
                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.  
                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.  
                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.  
                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.  
                     '<td>'.$env{'form.embedded_orig_'.$i}.  
                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.  
                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.  
                     &end_data_table_row();  
             }  
         }  
     } else {  
         $modifyform = $pathchgtable;  
         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {  
             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';  
         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {  
             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';  
         }  
     }  
     if ($modifyform) {  
         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".  
                '<p>'.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'<ol>'."\n".  
                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".  
                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".  
                '</ol></p>'."\n".'<p>'.  
                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".  
                '<form method="post" name="refchanger" action="'.$actionurl.'">'.  
                &start_data_table()."\n".  
                &start_data_table_header_row().  
                '<th>'.&mt('Change?').'</th>'.  
                '<th>'.&mt('Current reference').'</th>'.  
                '<th>'.&mt('Required reference').'</th>'.  
                &end_data_table_header_row()."\n".  
                $modifyform.  
                &end_data_table().'<br />'."\n".$hiddenstate.  
                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.  
                '</form>'."\n";  
     }  
     return;  
 }  
   
 sub modify_html_refs {  
     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;  
     my $container;  
     if ($context eq 'portfolio') {  
         $container = $env{'form.container'};  
     } elsif ($context eq 'coursedoc') {  
         $container = $env{'form.primaryurl'};  
     } else {  
         $container = $env{'form.filename'};  
         $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2};  
     }  
     my (%allfiles,%codebase,$output,$content);  
     my @changes = &get_env_multiple('form.namechange');  
     return unless (@changes > 0);  
     if (($context eq 'portfolio') || ($context eq 'coursedoc')) {  
         return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/});  
         $content = &Apache::lonnet::getfile($container);  
         return if ($content eq '-1');  
     } else {  
         return unless ($container =~ /^\Q$dir_root\E/);  
         if (open(my $fh,"<$container")) {  
             $content = join('', <$fh>);  
             close($fh);  
         } else {  
             return;  
         }  
     }  
     my ($count,$codebasecount) = (0,0);  
     my $mm = new File::MMagic;  
     my $mime_type = $mm->checktype_contents($content);  
     if ($mime_type eq 'text/html') {  
         my $parse_result =  
             &Apache::lonnet::extract_embedded_items($container,\%allfiles,  
                                                     \%codebase,\$content);  
         if ($parse_result eq 'ok') {  
             foreach my $i (@changes) {  
                 my $orig = &unescape($env{'form.embedded_orig_'.$i});  
                 my $ref = &unescape($env{'form.embedded_ref_'.$i});  
                 if ($allfiles{$ref}) {  
                     my $newname =  $orig;  
                     my ($attrib_regexp,$codebase);  
                     my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});  
                     if ($attrib_regexp =~ /:/) {  
                         $attrib_regexp =~ s/\:/|/g;  
                     }  
                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {  
                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);  
                         $count += $numchg;  
                     }  
                     if ($env{'form.embedded_codebase_'.$i} ne '') {  
                         my $codebase = &unescape($env{'form.embedded_codebase_'.$i});  
                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs  
                         $codebasecount ++;  
                     }  
                 }  
             }  
             if ($count || $codebasecount) {  
                 my $saveresult;  
                 if ($context eq 'portfolio' || $context eq 'coursedoc') {  
                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);  
                     if ($url eq $container) {  
                         my ($fname) = ($container =~ m{/([^/]+)$});  
                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',  
                                             $count,'<span class="LC_filename">'.  
                                             $fname.'</span>').'</p>';  
                     } else {                      } else {
                          $output = '<p class="LC_error">'.                          $output .= '<span class=\"LC_fontsize_large\">'.
                                    &mt('Error: update failed for: [_1].',                                     &mt('View embedded file: [_1]','<a href="'.$url.'">'.
                                    '<span class="LC_filename">'.                                     $orig_uploaded_filename.'</a>').'</span><br />';
                                    $container.'</span>').'</p>';  
                     }  
                 } else {  
                     if (open(my $fh,">$container")) {  
                         print $fh $content;  
                         close($fh);  
                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',  
                                   $count,'<span class="LC_filename">'.  
                                   $container.'</span>').'</p>';  
                     } else {  
                          $output = '<p class="LC_error">'.  
                                    &mt('Error: could not update [_1].',  
                                    '<span class="LC_filename">'.  
                                    $container.'</span>').'</p>';  
                     }                      }
                 }                  }
                   close($fh);
             }              }
         } else {  
             &logthis('Failed to parse '.$container.  
                      ' to modify references: '.$parse_result);  
         }          }
     }      }
     return $output;      return $output;
Line 9080  sub check_for_existing { Line 8474  sub check_for_existing {
 sub check_for_upload {  sub check_for_upload {
     my ($path,$fname,$group,$element,$portfolio_root,$port_path,      my ($path,$fname,$group,$element,$portfolio_root,$port_path,
         $disk_quota,$current_disk_usage,$uname,$udom) = @_;          $disk_quota,$current_disk_usage,$uname,$udom) = @_;
     my $filesize = length($env{'form.'.$element});      my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
     if (!$filesize) {  
         my $msg = '<span class="LC_error">'.  
                   &mt('Unable to upload [_1]. (size = [_2] bytes)',  
                       '<span class="LC_filename">'.$fname.'</span>',  
                       $filesize).'<br />'.  
                   &mt('Either the file you uploaded was empty, or your web browser was unable to read its contents.').'<br />';  
                   '</span>';  
         return ('zero_bytes',$msg);  
     }  
     $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 @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
                                             $getpropath);                                              $getpropath);
     my $found_file = 0;      my $found_file = 0;
     my $locked_file = 0;      my $locked_file = 0;
     foreach my $line (@dir_list) {      foreach my $line (@dir_list) {
         my ($file_name,$rest)=split(/\&/,$line,2);          my ($file_name)=split(/\&/,$line,2);
         if ($file_name eq $fname){          if ($file_name eq $fname){
             $file_name = $path.$file_name;              $file_name = $path.$file_name;
             if ($group ne '') {              if ($group ne '') {
Line 9106  sub check_for_upload { Line 8490  sub check_for_upload {
             $found_file = 1;              $found_file = 1;
             if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {              if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
                 $locked_file = 1;                  $locked_file = 1;
             } else {  
                 my @info = split(/\&/,$rest);  
                 my $currsize = $info[6]/1000;  
                 if ($currsize < $filesize) {  
                     my $extra = $filesize - $currsize;  
                     if (($current_disk_usage + $extra) > $disk_quota) {  
                         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.',  
                                       '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.  
                                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',  
                                                $disk_quota,$current_disk_usage);  
                         return ('will_exceed_quota',$msg);  
                     }  
                 }  
             }              }
         }          }
     }      }
Line 9137  sub check_for_upload { Line 8507  sub check_for_upload {
             return ('file_locked',$msg);              return ('file_locked',$msg);
         } else {          } else {
             my $msg = '<span class="LC_error">';              my $msg = '<span class="LC_error">';
             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});              $msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
             $msg .= '</span>';              $msg .= '</span>';
             return ('existingfile',$msg);              $msg .= '<br />';
               $msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
               return ('file_exists',$msg);
         }          }
     }      }
 }  }
   
 sub check_for_traversal {  
     my ($path,$url,$toplevel) = @_;  
     my @parts=split(/\//,$path);  
     my $cleanpath;  
     my $fullpath = $url;  
     for (my $i=0;$i<@parts;$i++) {  
         next if ($parts[$i] eq '.');  
         if ($parts[$i] eq '..') {  
             $fullpath =~ s{([^/]+/)$}{};  
         } else {  
             $fullpath .= $parts[$i].'/';  
         }  
     }  
     if ($fullpath =~ /^\Q$url\E(.*)$/) {  
         $cleanpath = $1;  
     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {  
         my $curr_toprel = $1;  
         my @parts = split(/\//,$curr_toprel);  
         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);  
         my @urlparts = split(/\//,$url_toprel);  
         my $doubledots;  
         my $startdiff = -1;  
         for (my $i=0; $i<@urlparts; $i++) {  
             if ($startdiff == -1) {  
                 unless ($urlparts[$i] eq $parts[$i]) {  
                     $startdiff = $i;  
                     $doubledots .= '../';  
                 }  
             } else {  
                 $doubledots .= '../';  
             }  
         }  
         if ($startdiff > -1) {  
             $cleanpath = $doubledots;  
             for (my $i=$startdiff; $i<@parts; $i++) {  
                 $cleanpath .= $parts[$i].'/';  
             }  
         }  
     }  
     $cleanpath =~ s{(/)$}{};  
     return $cleanpath;  
 }  
   
 =pod  =pod
   
Line 11091  sub construct_course { Line 10421  sub construct_course {
     $title=&mt('Syllabus');      $title=&mt('Syllabus');
             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';              $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
         } else {          } else {
             $title=&mt('Table of Contents');              $title=&mt('Navigate Contents');
             $url='/adm/navmaps';              $url='/adm/navmaps';
         }          }
   
Line 11108  sub construct_course { Line 10438  sub construct_course {
 ############################################################  ############################################################
 ############################################################  ############################################################
   
   #SD
   # only Community and Course, or anything else?
 sub course_type {  sub course_type {
     my ($cid) = @_;      my ($cid) = @_;
     if (!defined($cid)) {      if (!defined($cid)) {
Line 11273  sub init_user_environment { Line 10605  sub init_user_environment {
     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);      my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
     my ($tmp) = keys(%userenv);      my ($tmp) = keys(%userenv);
     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {      if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
  # default remote control to off  
  if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }  
     } else {      } else {
  undef(%userenv);   undef(%userenv);
     }      }
     if (($userenv{'interface'}) && (!$form->{'interface'})) {      if (($userenv{'interface'}) && (!$form->{'interface'})) {
  $form->{'interface'}=$userenv{'interface'};   $form->{'interface'}=$userenv{'interface'};
     }      }
     $env{'environment.remote'}=$userenv{'remote'};  
     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }      if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
   
 # --------------- Do not trust query string to be put directly into environment  # --------------- Do not trust query string to be put directly into environment
Line 11313  sub init_user_environment { Line 10642  sub init_user_environment {
     $initial_env{"browser.localres"}   = $form->{'localres'};      $initial_env{"browser.localres"}   = $form->{'localres'};
         }          }
   
  if ($public) {  
     $initial_env{"environment.remote"} = "off";  
  }  
  if ($form->{'interface'}) {   if ($form->{'interface'}) {
     $form->{'interface'}=~s/\W//gs;      $form->{'interface'}=~s/\W//gs;
     $initial_env{"browser.interface"} = $form->{'interface'};      $initial_env{"browser.interface"} = $form->{'interface'};
     $env{'browser.interface'}=$form->{'interface'};      $env{'browser.interface'}=$form->{'interface'};
  }   }
         my %is_adv = ( is_adv => $env{'user.adv'} );  
         my %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} = 
                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',                  &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
                                                   undef,\%userenv,\%domdef,\%is_adv);  
         }          }
   
         foreach my $crstype ('official','unofficial','community') {          foreach my $crstype ('official','unofficial','community') {
             $userenv{'canrequest.'.$crstype} =              $userenv{'canrequest.'.$crstype} =
                 &Apache::lonnet::usertools_access($username,$domain,$crstype,                  &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                   'reload','requestcourses',                                                    'reload','requestcourses');
                                                   \%userenv,\%domdef,\%is_adv);  
         }          }
   
  $env{'user.environment'} = "$lonids/$cookie.id";   $env{'user.environment'} = "$lonids/$cookie.id";
Line 11413  sub clean_symb { Line 10735  sub clean_symb {
     return ($symb,$enc);      return ($symb,$enc);
 }  }
   
 sub build_release_hashes {  
     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;  
     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&  
                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&  
                   (ref($randomizetry) eq 'HASH'));  
     foreach my $key (keys(%Apache::lonnet::needsrelease)) {  
         my ($item,$name,$value) = split(/:/,$key);  
         if ($item eq 'parameter') {  
             if (ref($checkparms->{$name}) eq 'ARRAY') {  
                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {  
                     push(@{$checkparms->{$name}},$value);  
                 }  
             } else {  
                 push(@{$checkparms->{$name}},$value);  
             }  
         } elsif ($item eq 'resourcetag') {  
             if ($name eq 'responsetype') {  
                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}  
             }  
         } elsif ($item eq 'course') {  
             if ($name eq 'crstype') {  
                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};  
             }  
         }  
     }  
     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});  
     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});  
     return;  
 }  
   
 =pod  =pod
   
 =back  =back

Removed from v.1.948.2.17  
changed lines
  Added in v.1.962


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