Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.146 and 1.1340

version 1.1075.2.146, 2020/05/22 20:48:01 version 1.1340, 2020/03/15 23:04:15
Line 71  use Apache::lonuserutils(); Line 71  use Apache::lonuserutils();
 use Apache::lonuserstate();  use Apache::lonuserstate();
 use Apache::courseclassifier();  use Apache::courseclassifier();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   use LONCAPA::LWPReq;
 use HTTP::Request;  use HTTP::Request;
 use DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale;  use DateTime::Locale;
 use Encode();  use Encode();
   use Text::Aspell;
 use Authen::Captcha;  use Authen::Captcha;
 use Captcha::reCAPTCHA;  use Captcha::reCAPTCHA;
 use JSON::DWIW;  use JSON::DWIW;
 use LWP::UserAgent;  
 use Crypt::DES;  use Crypt::DES;
 use DynaLoader; # for Crypt::DES version  use DynaLoader; # for Crypt::DES version
   use MIME::Lite;
   use MIME::Types;
 use File::Copy();  use File::Copy();
 use File::Path();  use File::Path();
   use String::CRC32();
   use Short::URL();
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);  use vars qw(%defaultdesign);
Line 167  sub ssi_with_retries { Line 172  sub ssi_with_retries {
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
 my %supported_language;  my %supported_language;
   my %supported_codes;
 my %latex_language; # For choosing hyphenation in <transl..>  my %latex_language; # For choosing hyphenation in <transl..>
 my %latex_language_bykey; # for choosing hyphenation from metadata  my %latex_language_bykey; # for choosing hyphenation from metadata
 my %cprtag;  my %cprtag;
Line 201  BEGIN { Line 207  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,$latex)=(split(/\t/,$line));                  my ($key,$code,$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;
       $supported_codes{$key}   = $code;
                 }                  }
  if ($latex) {   if ($latex) {
     $latex_language_bykey{$key} = $latex;      $latex_language_bykey{$key} = $latex;
     $latex_language{$two} = $latex;      $latex_language{$code} = $latex;
  }   }
             }              }
             close($fh);              close($fh);
Line 687  if (!Array.prototype.indexOf) { Line 694  if (!Array.prototype.indexOf) {
         var n = 0;          var n = 0;
         if (arguments.length > 0) {          if (arguments.length > 0) {
             n = Number(arguments[1]);              n = Number(arguments[1]);
             if (n !== n) { // shortcut for verifying if it's NaN              if (n !== n) { // shortcut for verifying if it is NaN
                 n = 0;                  n = 0;
             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {              } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                 n = (n > 0 || -1) * Math.floor(Math.abs(n));                  n = (n > 0 || -1) * Math.floor(Math.abs(n));
Line 888  sub selectcourse_link { Line 895  sub selectcourse_link {
    my $linktext = &mt('Select Course');     my $linktext = &mt('Select Course');
    if ($selecttype eq 'Community') {     if ($selecttype eq 'Community') {
        $linktext = &mt('Select Community');         $linktext = &mt('Select Community');
      } elsif ($selecttype eq 'Placement') {
          $linktext = &mt('Select Placement Test'); 
    } elsif ($selecttype eq 'Course/Community') {     } elsif ($selecttype eq 'Course/Community') {
        $linktext = &mt('Select Course/Community');         $linktext = &mt('Select Course/Community');
        $type = '';         $type = '';
Line 923  sub check_uncheck_jscript { Line 932  sub check_uncheck_jscript {
 function checkAll(field) {  function checkAll(field) {
     if (field.length > 0) {      if (field.length > 0) {
         for (i = 0; i < field.length; i++) {          for (i = 0; i < field.length; i++) {
             if (!field[i].disabled) {              if (!field[i].disabled) { 
                 field[i].checked = true;                  field[i].checked = true;
             }              }
         }          }
     } else {      } else {
         if (!field.disabled) {          if (!field.disabled) { 
             field.checked = true;              field.checked = true;
         }          }
     }      }
Line 1004  sub select_datelocale { Line 1013  sub select_datelocale {
                 }                  }
                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});                  $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
                 push(@possibles,$id);                  push(@possibles,$id);
             }              } 
         }          }
     }      }
     foreach my $item (sort(@possibles)) {      foreach my $item (sort(@possibles)) {
Line 1040  sub select_language { Line 1049  sub select_language {
   
 =pod  =pod
   
   
   =item * &list_languages()
   
   Returns an array reference that is suitable for use in language prompters.
   Each array element is itself a two element array.  The first element
   is the language code.  The second element a descsriptiuon of the 
   language itself.  This is suitable for use in e.g.
   &Apache::edit::select_arg (once dereferenced that is).
   
   =cut 
   
   sub list_languages {
       my @lang_choices;
   
       foreach my $id (&languageids()) {
    my $code = &supportedlanguagecode($id);
    if ($code) {
       my $selector    = $supported_codes{$id};
       my $description = &plainlanguagedescription($id);
       push(@lang_choices, [$selector, $description]);
    }
       }
       return \@lang_choices;
   }
   
   =pod
   
 =item * &linked_select_forms(...)  =item * &linked_select_forms(...)
   
 linked_select_forms returns a string containing a <script></script> block  linked_select_forms returns a string containing a <script></script> block
Line 1072  linked_select_forms takes the following Line 1108  linked_select_forms takes the following
 =item * $onchangesecond, additional javascript call to execute for an onchange  =item * $onchangesecond, additional javascript call to execute for an onchange
         event for the second <select> tag          event for the second <select> tag
   
   =item * $suffix, to differentiate separate uses of select2data javascript
           objects in a page.
   
 =back   =back 
   
 Below is an example of such a hash.  Only the 'text', 'default', and   Below is an example of such a hash.  Only the 'text', 'default', and 
Line 1126  sub linked_select_forms { Line 1165  sub linked_select_forms {
         $hashref,          $hashref,
         $menuorder,          $menuorder,
         $onchangefirst,          $onchangefirst,
         $onchangesecond          $onchangesecond,
           $suffix
         ) = @_;          ) = @_;
     my $second = "document.$formname.$secondselectname";      my $second = "document.$formname.$secondselectname";
     my $first = "document.$formname.$firstselectname";      my $first = "document.$formname.$firstselectname";
Line 1134  sub linked_select_forms { Line 1174  sub linked_select_forms {
     my $result = '';      my $result = '';
     $result.='<script type="text/javascript" language="JavaScript">'."\n";      $result.='<script type="text/javascript" language="JavaScript">'."\n";
     $result.="// <![CDATA[\n";      $result.="// <![CDATA[\n";
     $result.="var select2data = new Object();\n";      $result.="var select2data${suffix} = new Object();\n";
     $" = '","';      $" = '","';
     my $debug = '';      my $debug = '';
     foreach my $s1 (sort(keys(%$hashref))) {      foreach my $s1 (sort(keys(%$hashref))) {
         $result.="select2data.d_$s1 = new Object();\n";                  $result.="select2data${suffix}['d_$s1'] = new Object();\n";        
         $result.="select2data.d_$s1.def = new String('".          $result.="select2data${suffix}['d_$s1'].def = new String('".
             $hashref->{$s1}->{'default'}."');\n";              $hashref->{$s1}->{'default'}."');\n";
         $result.="select2data.d_$s1.values = new Array(";          $result.="select2data${suffix}['d_$s1'].values = new Array(";
         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));          my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {          if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
             @s2values = @{$hashref->{$s1}->{'order'}};              @s2values = @{$hashref->{$s1}->{'order'}};
         }          }
         $result.="\"@s2values\");\n";          $result.="\"@s2values\");\n";
         $result.="select2data.d_$s1.texts = new Array(";                  $result.="select2data${suffix}['d_$s1'].texts = new Array(";        
         my @s2texts;          my @s2texts;
         foreach my $value (@s2values) {          foreach my $value (@s2values) {
             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});              push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
Line 1157  sub linked_select_forms { Line 1197  sub linked_select_forms {
     $"=' ';      $"=' ';
     $result.= <<"END";      $result.= <<"END";
   
 function select1_changed() {  function select1${suffix}_changed() {
     // Determine new choice      // Determine new choice
     var newvalue = "d_" + $first.value;      var newvalue = "d_" + $first.options[$first.selectedIndex].value;
     // update select2      // update select2
     var values     = select2data[newvalue].values;      var values     = select2data${suffix}[newvalue].values;
     var texts      = select2data[newvalue].texts;      var texts      = select2data${suffix}[newvalue].texts;
     var select2def = select2data[newvalue].def;      var select2def = select2data${suffix}[newvalue].def;
     var i;      var i;
     // out with the old      // out with the old
     for (i = 0; i < $second.options.length; i++) {      $second.options.length = 0;
         $second.options[i] = null;      // in with the new
     }  
     // in with the nuclear  
     for (i=0;i<values.length; i++) {      for (i=0;i<values.length; i++) {
         $second.options[i] = new Option(values[i]);          $second.options[i] = new Option(values[i]);
         $second.options[i].value = values[i];          $second.options[i].value = values[i];
Line 1183  function select1_changed() { Line 1221  function select1_changed() {
 </script>  </script>
 END  END
     # output the initial values for the selection lists      # output the initial values for the selection lists
     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";      $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
     my @order = sort(keys(%{$hashref}));      my @order = sort(keys(%{$hashref}));
     if (ref($menuorder) eq 'ARRAY') {      if (ref($menuorder) eq 'ARRAY') {
         @order = @{$menuorder};          @order = @{$menuorder};
Line 1260  sub help_open_topic { Line 1298  sub help_open_topic {
     $topic=~s/\W/\_/g;      $topic=~s/\W/\_/g;
   
     if (!$stayOnPage) {      if (!$stayOnPage) {
         if ($env{'browser.mobile'}) {   $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
     $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";  
         } else {  
             $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";  
         }  
     } elsif ($stayOnPage eq 'popup') {      } elsif ($stayOnPage eq 'popup') {
         $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";          $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
     } else {      } else {
Line 1272  sub help_open_topic { Line 1306  sub help_open_topic {
     }      }
   
     # Add the text      # Add the text
       my $target = ' target="_top"';
       if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
           $target = '';
       }
     if ($text ne "") {      if ($text ne "") {
  $template.='<span class="LC_help_open_topic">'   $template.='<span class="LC_help_open_topic">'
                   .'<a target="_top" href="'.$link.'">'                    .'<a'.$target.' href="'.$link.'">'
                   .$text.'</a>';                    .$text.'</a>';
     }      }
   
Line 1284  sub help_open_topic { Line 1322  sub help_open_topic {
     if ($imgid ne '') {      if ($imgid ne '') {
         $imgid = ' id="'.$imgid.'"';          $imgid = ' id="'.$imgid.'"';
     }      }
     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'      $template.=' <a'.$target.' 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;"'.$imgid 
Line 1313  sub helpLatexCheatsheet { Line 1351  sub helpLatexCheatsheet {
   .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)    .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
   .'</span>';    .'</span>';
     unless ($not_author) {      unless ($not_author) {
         $out .= ' <span>'          $out .= '<span>'
        .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)                 .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
        .'</span> <span>'                 .'</span> <span>'
                .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)                 .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
                .'</span>';         .'</span>';
     }      }
     $out .= '</span>'; # End cheatsheet      $out .= '</span>'; # End cheatsheet
     return $out;      return $out;
Line 1380  sub help_open_menu { Line 1418  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;
     unless ($env{'environment.remote'} eq 'on') {  
         $stay_on_page = 1;  
     }  
     my ($link,$banner_link);      my ($link,$banner_link);
     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {      unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
         $link = ($stay_on_page) ? "javascript:helpMenu('display')"          $link = ($stay_on_page) ? "javascript:helpMenu('display')"
Line 1415  sub help_menu_js { Line 1451  sub help_menu_js {
  'js_ready'    => 1,   'js_ready'    => 1,
                                         'use_absolute' => $httphost,                                          'use_absolute' => $httphost,
  'add_entries' => {   'add_entries' => {
     'border' => '0',      'border' => '0', 
     'rows'   => "110,*",},});      'rows'   => "110,*",},});
     my $end_page =      my $end_page =
         &Apache::loncommon::end_page({'frameset' => 1,          &Apache::loncommon::end_page({'frameset' => 1,
Line 1479  sub help_open_bug { Line 1515  sub help_open_bug {
     {      {
  $link = $url;   $link = $url;
     }      }
   
       my $target = ' target="_top"';
       if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
           $target = '';
       }
     # Add the text      # Add the text
     if ($text ne "")      if ($text ne "")
     {      {
  $template .=    $template .= 
   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".    "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";    "<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
     }      }
   
     # Add the graphic      # Add the graphic
     my $title = &mt('Report a Bug');      my $title = &mt('Report a Bug');
     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");      my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>   <a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 1757  RESIZE Line 1798  RESIZE
 }  }
   
 sub colorfuleditor_js {  sub colorfuleditor_js {
       my $browse_or_search;
       my $respath;
       my ($cnum,$cdom) = &crsauthor_url();
       if ($cnum) {
           $respath = "/res/$cdom/$cnum/";
           my %js_lt = &Apache::lonlocal::texthash(
               sunm => 'Sub-directory name',
               save => 'Save page to make this permanent',
           );
           &js_escape(\%js_lt);
           $browse_or_search = <<"END";
   
       function toggleChooser(form,element,titleid,only,search) {
           var disp = 'none';
           if (document.getElementById('chooser_'+element)) {
               var curr = document.getElementById('chooser_'+element).style.display;
               if (curr == 'none') {
                   disp='inline';
                   if (form.elements['chooser_'+element].length) {
                       for (var i=0; i<form.elements['chooser_'+element].length; i++) {
                           form.elements['chooser_'+element][i].checked = false;
                       }
                   }
                   toggleResImport(form,element);
               }
               document.getElementById('chooser_'+element).style.display = disp;
           }
       }
   
       function toggleCrsFile(form,element,numdirs) {
           if (document.getElementById('chooser_'+element+'_crsres')) {
               var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
               if (curr == 'none') {
                   if (numdirs) {
                       form.elements['coursepath_'+element].selectedIndex = 0;
                       if (numdirs > 1) {
                           window['select1'+element+'_changed']();
                       }
                   }
               } 
               document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
               
           }
           if (document.getElementById('chooser_'+element+'_upload')) {
               document.getElementById('chooser_'+element+'_upload').style.display = 'none';
               if (document.getElementById('uploadcrsres_'+element)) {
                   document.getElementById('uploadcrsres_'+element).value = '';
               }
           }
           return;
       }
   
       function toggleCrsUpload(form,element,numcrsdirs) {
           if (document.getElementById('chooser_'+element+'_crsres')) {
               document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
           }
           if (document.getElementById('chooser_'+element+'_upload')) {
               var curr = document.getElementById('chooser_'+element+'_upload').style.display;
               if (curr == 'none') {
                   if (numcrsdirs) {
                      form.elements['crsauthorpath_'+element].selectedIndex = 0;
                      form.elements['newsubdir_'+element][0].checked = true;
                      toggleNewsubdir(form,element);
                   }
               }
               document.getElementById('chooser_'+element+'_upload').style.display = 'block';
           }
           return;
       }
   
       function toggleResImport(form,element) {
           var choices = new Array('crsres','upload');
           for (var i=0; i<choices.length; i++) {
               if (document.getElementById('chooser_'+element+'_'+choices[i])) {
                   document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
               }
           }
       }
   
       function toggleNewsubdir(form,element) {
           var newsub = form.elements['newsubdir_'+element];
           if (newsub) {
               if (newsub.length) {
                   for (var j=0; j<newsub.length; j++) {
                       if (newsub[j].checked) {
                           if (document.getElementById('newsubdirname_'+element)) {
                               if (newsub[j].value == '1') {
                                   document.getElementById('newsubdirname_'+element).type = "text";
                                   if (document.getElementById('newsubdir_'+element)) {
                                       document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
                                   }
                               } else {
                                   document.getElementById('newsubdirname_'+element).type = "hidden";
                                   document.getElementById('newsubdirname_'+element).value = "";
                                   document.getElementById('newsubdir_'+element).innerHTML = "";
                               }
                           }
                           break; 
                       }
                   }
               }
           }
       }
   
       function updateCrsFile(form,element) {
           var directory = form.elements['coursepath_'+element];
           var filename = form.elements['coursefile_'+element];
           var path = directory.options[directory.selectedIndex].value;
           var file = filename.options[filename.selectedIndex].value;
           form.elements[element].value = '$respath';
           if (path == '/') {
               form.elements[element].value += file;
           } else {
               form.elements[element].value += path+'/'+file;
           }
           unClean();
           if (document.getElementById('previewimg_'+element)) {
               document.getElementById('previewimg_'+element).src = form.elements[element].value;
               var newsrc = document.getElementById('previewimg_'+element).src; 
           }
           if (document.getElementById('showimg_'+element)) {
               document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
           }
           toggleChooser(form,element);
           return;
       }
   
       function uploadDone(suffix,name) {
           if (name) {
       document.forms["lonhomework"].elements[suffix].value = name;
               unClean();
               toggleChooser(document.forms["lonhomework"],suffix);
           }
       }
   
   \$(document).ready(function(){
   
       \$(document).delegate('form :submit', 'click', function( event ) {
           if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
               var buttonId = this.id;
               var suffix = buttonId.toString();
               suffix = suffix.replace(/^crsupload_/,'');
               event.preventDefault();
               document.lonhomework.target = 'crsupload_target_'+suffix;
               document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
               \$(this.form).submit();
               document.lonhomework.target = '';
               if (document.getElementById('crsuploadto_'+suffix)) {
                   document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
               }
               return false;
           }
       });
   });
   END
       }
     return <<"COLORFULEDIT"      return <<"COLORFULEDIT"
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[>  // <![CDATA[>
Line 1802  sub colorfuleditor_js { Line 1999  sub colorfuleditor_js {
             }              }
   
             // only iterate whole storage if nothing to override              // only iterate whole storage if nothing to override
             if(localStorage.getItem(key) == null){              if(localStorage.getItem(key) == null){        
   
                 // prevent storage from growing large                  // prevent storage from growing large
                 if(localStorage.length > 50){                  if(localStorage.length > 50){
                     var regex_getTimestamp = /^(?:\d)+;/;                      var regex_getTimestamp = /^(?:\d)+;/;
                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));                      var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                     var oldest_key;                      var oldest_key;
                       
                     for(var i = 1; i < localStorage.length; i++){                      for(var i = 1; i < localStorage.length; i++){
                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {                          if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                             oldest_key = localStorage.key(i);                              oldest_key = localStorage.key(i);
Line 1839  sub colorfuleditor_js { Line 2036  sub colorfuleditor_js {
                 pairs = valueArr[i].split(',');                  pairs = valueArr[i].split(',');
                 elements = document.getElementsByName(pairs[0]);                  elements = document.getElementsByName(pairs[0]);
   
                 for (var j = 0; j < elements.length; j++){                  for (var j = 0; j < elements.length; j++){  
                     elements[j].style.display = pairs[1];                      elements[j].style.display = pairs[1];
                     if (pairs[1] == "none"){                      if (pairs[1] == "none"){
                         var regex_id = /([_\\d]+)\$/;                          var regex_id = /([_\\d]+)\$/;
Line 1852  sub colorfuleditor_js { Line 2049  sub colorfuleditor_js {
     }      }
   
     function getTagList () {      function getTagList () {
           
         var stringToSearch = document.lonhomework.innerHTML;          var stringToSearch = document.lonhomework.innerHTML;
   
         var ret = new Array();          var ret = new Array();
Line 1860  sub colorfuleditor_js { Line 2057  sub colorfuleditor_js {
         var tag_list = stringToSearch.match(regex_findBlock);          var tag_list = stringToSearch.match(regex_findBlock);
   
         if(tag_list != null){          if(tag_list != null){
             for(var i = 0; i < tag_list.length; i++){              for(var i = 0; i < tag_list.length; i++){            
                 ret.push(tag_list[i].replace(/"/, ''));                  ret.push(tag_list[i].replace(/"/, ''));
             }              }
         }          }
Line 1897  sub colorfuleditor_js { Line 2094  sub colorfuleditor_js {
   
             for(var i = 0; i < tag_list.length; i++){              for(var i = 0; i < tag_list.length; i++){
                 elem_list = document.getElementsByName(tag_list[i]);                  elem_list = document.getElementsByName(tag_list[i]);
                   
                 if(elem_list.length > 0){                  if(elem_list.length > 0){
                     elem = elem_list[0];                      elem = elem_list[0];
                     break;                      break;
Line 1920  sub colorfuleditor_js { Line 2117  sub colorfuleditor_js {
             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */              rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
         );          );
     }      }
       
     function autosize(depth){      function autosize(depth){
         var cmInst = window['cm'+depth];          var cmInst = window['cm'+depth];
         var fitsizeButton = document.getElementById('fitsize'+depth);          var fitsizeButton = document.getElementById('fitsize'+depth);
Line 1939  sub colorfuleditor_js { Line 2136  sub colorfuleditor_js {
         }          }
     }      }
   
   $browse_or_search
   
 // ]]>  // ]]>
 </script>  </script>
Line 1987  sub insert_folding_button { Line 2184  sub insert_folding_button {
     my $curDepth = $Apache::lonxml::curdepth;      my $curDepth = $Apache::lonxml::curdepth;
     my $lastresource = $env{'request.ambiguous'};      my $lastresource = $env{'request.ambiguous'};
   
     return "<input type=\"button\" id=\"folding_btn_$curDepth\"      return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";              value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
 }  }
   
   sub crsauthor_url {
       my ($url) = @_;
       if ($url eq '') {
           $url = $ENV{'REQUEST_URI'};
       }
       my ($cnum,$cdom);
       if ($env{'request.course.id'}) {
           my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
           if ($audom ne '' && $auname ne '') {
               if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
                   ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
                   $cnum = $auname;
                   $cdom = $audom;
               }
           }
       }
       return ($cnum,$cdom);
   }
   
   sub import_crsauthor_form {
       my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
       return (0) unless ($env{'request.course.id'});
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
       my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
       return (0) unless (($cnum ne '') && ($cdom ne ''));
       my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
       my @ids=&Apache::lonnet::current_machine_ids();
       my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
       
       if (grep(/^\Q$crshome\E$/,@ids)) {
           $is_home = 1;
       }
       $relpath = "/priv/$cdom/$cnum";
       &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
       my %lt = &Apache::lonlocal::texthash (
           fnam => 'Filename',
           dire => 'Directory',
       );
       my $numdirs = scalar(keys(%files));
       my (%possexts,$singledir,@singledirfiles);
       if ($only) {
           map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
       }
       my (%nonemptydirs,$possdirs);
       if ($numdirs > 1) {
           my @order;
           foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
               if (ref($files{$key}) eq 'HASH') {
                   my $shown = $key;
                   if ($key eq '') {
                       $shown = '/';
                   }
                   my @ordered = ();
                   foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
                       next if ($file =~ /\.rights$/);
                       if ($only) {
                           my ($ext) = ($file =~ /\.([^.]+)$/);
                           unless ($possexts{lc($ext)}) {
                               next;
                           }
                       }
                       $selimport_menus{$key}->{'select2'}->{$file} = $file;
                       push(@ordered,$file);
                   }
                   if (@ordered) {
                       push(@order,$key);
                       $nonemptydirs{$key} = 1;
                       $selimport_menus{$key}->{'text'} = $shown;
                       $selimport_menus{$key}->{'default'} = '';
                       $selimport_menus{$key}->{'select2'}->{''} = '';
                       $selimport_menus{$key}->{'order'} = \@ordered;
                   }
               }
           }
           $possdirs = scalar(keys(%nonemptydirs));
           if ($possdirs > 1) {
               my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
               $output = $lt{'dire'}.
                         &linked_select_forms($form,'<br />'.
                                              $lt{'fnam'},'',
                                              $firstselectname,$secondselectname,
                                              \%selimport_menus,\@order,
                                              $onchangefirst,'',$suffix).'<br />';
           } elsif ($possdirs == 1) {
               $singledir = (keys(%nonemptydirs))[0];
               if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
                   @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
               }
               delete($selimport_menus{$singledir});
           }
       } elsif ($numdirs == 1) {
           $singledir = (keys(%files))[0];
           foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
               if ($only) {
                   my ($ext) = ($file =~ /\.([^.]+)$/);
                   unless ($possexts{lc($ext)}) {
                       next;
                   }
               } else {
                   next if ($file =~ /\.rights$/);
               }
               push(@singledirfiles,$file);
           }
           if (@singledirfiles) {
               $possdirs = 1;
           }
       }
       if (($possdirs == 1) && (@singledirfiles)) {
           my $showdir = $singledir;
           if ($singledir eq '') {
               $showdir = '/';
           }
           $output = $lt{'dire'}.
                     '<select name="'.$firstselectname.'">'.
                     '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
                     '</select><br />'.
                     $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
                     '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
           foreach my $file (@singledirfiles) {
               $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
           }
           $output .= '</select><br />'."\n";
       }
       return ($possdirs,$output);
   }
   
 =pod  =pod
   
Line 2179  sub create_text_file { Line 2502  sub create_text_file {
 # ------------------------------------------  # ------------------------------------------
   
 sub domain_select {  sub domain_select {
     my ($name,$value,$multiple)=@_;      my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
       my @possdoms;
       if (ref($incdoms) eq 'ARRAY') {
           @possdoms = @{$incdoms};
       } else {
           @possdoms = &Apache::lonnet::all_domains();
       }
   
     my %domains=map {       my %domains=map { 
  $_ => $_.' '. &Apache::lonnet::domain($_,'description')    $_ => $_.' '. &Apache::lonnet::domain($_,'description') 
     } &Apache::lonnet::all_domains();      } @possdoms;
   
       if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
           foreach my $dom (@{$excdoms}) {
               delete($domains{$dom});
           }
       }
   
     if ($multiple) {      if ($multiple) {
  $domains{''}=&mt('Any domain');   $domains{''}=&mt('Any domain');
  $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];   $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
Line 2259  option_name => displayed text. An option Line 2596  option_name => displayed text. An option
 a javascript onchange item, e.g., onchange="this.form.submit();".  a javascript onchange item, e.g., onchange="this.form.submit();".
 An optional arg -- $readonly -- if true will cause the select form  An optional arg -- $readonly -- if true will cause the select form
 to be disabled, e.g., for the case where an instructor has a section-  to be disabled, e.g., for the case where an instructor has a section-
 specific role, and is viewing/modifying parameters.    specific role, and is viewing/modifying parameters. 
   
 See lonrights.pm for an example invocation and use.  See lonrights.pm for an example invocation and use.
   
Line 2462  The optional $incdoms is a reference to Line 2799  The optional $incdoms is a reference to
   
 The optional $excdoms is a reference to an array of domains which will be excluded from the available options.  The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
   
 The optional $disabled argument, if true, adds the disabled attribute to the select tag.   The optional $disabled argument, if true, adds the disabled attribute to the select tag.
   
 =cut  =cut
   
Line 2483  sub select_dom_form { Line 2820  sub select_dom_form {
     }      }
     if ($includeempty) { @domains=('',@domains); }      if ($includeempty) { @domains=('',@domains); }
     if (ref($excdoms) eq 'ARRAY') {      if (ref($excdoms) eq 'ARRAY') {
         map { $exclude{$_} = 1; } @{$excdoms};          map { $exclude{$_} = 1; } @{$excdoms}; 
     }      }
     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";      my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
     foreach my $dom (@domains) {      foreach my $dom (@domains) {
Line 2711  This is not an optimal method, but it wo Line 3048  This is not an optimal method, but it wo
   
 =item * authform_filesystem  =item * authform_filesystem
   
   =item * authform_lti
   
 =back  =back
   
 See loncreateuser.pm for invocation and use examples.  See loncreateuser.pm for invocation and use examples.
Line 2839  sub authform_nochange { Line 3178  sub authform_nochange {
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
           );            );
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});       my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     my $result;      my $result;
     if (!$authnum) {      if (!$authnum) {
         $result = &mt('Under your current role you are not permitted to change login settings for this user');          $result = &mt('Under your current role you are not permitted to change login settings for this user');
Line 3033  sub authform_local { Line 3372  sub authform_local {
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     if ($in{'readonly'}) {      if ($in{'readonly'}) {
         $disabled = ' disabled="disabled"';          $disabled = ' disabled="disabled"';
     }      } 
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'loc') {          if ($in{'curr_authtype'} eq 'loc') {
             if ($can_assign{'loc'}) {              if ($can_assign{'loc'}) {
Line 3103  sub authform_filesystem { Line 3442  sub authform_filesystem {
             } else {              } else {
                 $result = &mt('Currently Filesystem Authenticated.');                  $result = &mt('Currently Filesystem Authenticated.');
                 return $result;                  return $result;
             }                         }
         }          }
     } else {      } else {
         if ($authnum == 1) {          if ($authnum == 1) {
Line 3127  sub authform_filesystem { Line 3466  sub authform_filesystem {
                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.                      $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'"'.$disabled.' />';                      $jscall.'"'.$disabled.' />';
     }      }
     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.      $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
                ' onchange="'.$jscall.'"'.$disabled.' />';                 ' onchange="'.$jscall.'"'.$disabled.' />';
     $result = &mt      $result = &mt
         ('[_1] Filesystem Authenticated (with initial password [_2])',          ('[_1] Filesystem Authenticated (with initial password [_2])',
          '<label><input type="radio" name="login" value="fsys" '.           '<label>'.$authtype,'</label>'.$autharg);
          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',      return $result;
          '</label><input type="password" size="10" name="fsysarg" value="" '.  }
                   'onchange="'.$jscall.'"'.$disabled.' />');  
   sub authform_lti {
       my %in = (
                 formname => 'document.cu',
                 kerb_def_dom => 'MSU.EDU',
                 @_,
                 );
       my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
       my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
       if (defined($in{'curr_authtype'})) {
           if ($in{'curr_authtype'} eq 'lti') {
               if ($can_assign{'lti'}) {
                   $lticheck = 'checked="checked" ';
                   if (defined($in{'mode'})) {
                       if ($in{'mode'} eq 'modifyuser') {
                           $lticheck = '';
                       }
                   }
               } else {
                   $result = &mt('Currently LTI Authenticated.');
                   return $result;
               }
           }
       } else {
           if ($authnum == 1) {
               $authtype = '<input type="hidden" name="login" value="lti" />';
           }
       }
       if (!$can_assign{'lti'}) {
           return;
       } elsif ($authtype eq '') {
           if (defined($in{'mode'})) {
               if ($in{'mode'} eq 'modifycourse') {
                   if ($authnum == 1) {
                       $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
                   }
               }
           }
       }
       $jscall = "javascript:changed_radio('lti',$in{'formname'});";
       if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
           $authtype = '<input type="radio" name="login" value="lti" '.
                       $lticheck.' onchange="'.$jscall.'" onclick="'.
                       $jscall.'"'.$disabled.' />';
       }
       $autharg = '<input type="hidden" name="ltiarg" value="" />';
       if ($authtype) {
           $result = &mt('[_1] LTI Authenticated',
                         '<label>'.$authtype.'</label>'.$autharg);
       } else {
           $result = '<b>'.&mt('LTI Authenticated').'</b>'.
                     $autharg;
       }
     return $result;      return $result;
 }  }
   
Line 3148  sub get_assignable_auth { Line 3542  sub get_assignable_auth {
                           krb5 => 1,                            krb5 => 1,
                           int  => 1,                            int  => 1,
                           loc  => 1,                            loc  => 1,
                             lti  => 1,
                      );                       );
     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);      my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
     if (ref($domconfig{'usercreation'}) eq 'HASH') {      if (ref($domconfig{'usercreation'}) eq 'HASH') {
Line 3420  sub get_related_words { Line 3815  sub get_related_words {
     untie %thesaurus_db;      untie %thesaurus_db;
     return @Words;      return @Words;
 }  }
   ###############################################################
   #
   #  Spell checking
   #
   
 =pod  =pod
   
 =back  =back
   
   =head1 Spell checking
   
   =over 4
   
   =item * &check_spelling($wordlist $language)
   
   Takes a string containing words and feeds it to an external
   spellcheck program via a pipeline. Returns a string containing
   them mis-spelled words.
   
   Parameters:
   
   =over 4
   
   =item - $wordlist
   
   String that will be fed into the spellcheck program.
   
   =item - $language
   
   Language string that specifies the language for which the spell
   check will be performed.
   
   =back
   
   =back
   
   Note: This sub assumes that aspell is installed.
   
   
 =cut  =cut
   
   
   sub check_spelling {
       my ($wordlist, $language) = @_;
       my @misspellings;
       
       # Generate the speller and set the langauge.
       # if explicitly selected:
   
       my $speller = Text::Aspell->new;
       if ($language) {
    $speller->set_option('lang', $language);
       }
   
       # Turn the word list into an array of words by splittingon whitespace
   
       my @words = split(/\s+/, $wordlist);
   
       foreach my $word (@words) {
    if(! $speller->check($word)) {
       push(@misspellings, $word);
    }
       }
       return join(' ', @misspellings);
       
   }
   
 # -------------------------------------------------------------- Plaintext name  # -------------------------------------------------------------- Plaintext name
 =pod  =pod
   
Line 3890  category Line 4345  category
   
 sub filecategorytypes {  sub filecategorytypes {
     my ($cat) = @_;      my ($cat) = @_;
     return @{$category_extensions{lc($cat)}};      if (ref($category_extensions{lc($cat)}) eq 'ARRAY') { 
           return @{$category_extensions{lc($cat)}};
       } else {
           return ();
       }
 }  }
   
 =pod  =pod
Line 4057  Return string with previous attempt on p Line 4516  Return string with previous attempt on p
   
 =item * $usec: section of the desired student  =item * $usec: section of the desired student
   
 =item * $identifier: counter for student (multiple students one problem) or  =item * $identifier: counter for student (multiple students one problem) or 
     problem (one student; whole sequence).      problem (one student; whole sequence).
   
 =back  =back
Line 4144  sub get_previous_attempt { Line 4603  sub get_previous_attempt {
             my (@hidden,@unsolved);              my (@hidden,@unsolved);
             if (%typeparts) {              if (%typeparts) {
                 foreach my $id (keys(%typeparts)) {                  foreach my $id (keys(%typeparts)) {
                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||                      if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {                          ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                         push(@hidden,$id);                          push(@hidden,$id);
                     } elsif ($identifier ne '') {                      } elsif ($identifier ne '') {
Line 4205  sub get_previous_attempt { Line 4664  sub get_previous_attempt {
                         if ($key =~ /\./) {                          if ($key =~ /\./) {
                             my $value = $returnhash{$version.':'.$key};                              my $value = $returnhash{$version.':'.$key};
                             if ($key =~ /\.rndseed$/) {                              if ($key =~ /\.rndseed$/) {
                                 my ($id) = ($key =~ /^(.+)\.rndseed$/);                                  my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {                                  if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};                                      $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                                 }                                  }
Line 4222  sub get_previous_attempt { Line 4681  sub get_previous_attempt {
                     next if ($key =~ /\.foilorder$/);                      next if ($key =~ /\.foilorder$/);
                     my $value = $returnhash{$version.':'.$key};                      my $value = $returnhash{$version.':'.$key};
                     if ($key =~ /\.rndseed$/) {                      if ($key =~ /\.rndseed$/) {
                         my ($id) = ($key =~ /^(.+)\.rndseed$/);                          my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {                          if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};                              $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                         }                          }
Line 4253  sub get_previous_attempt { Line 4712  sub get_previous_attempt {
                       if ($key =~/$regexp$/ && (defined &$gradesub)) {                        if ($key =~/$regexp$/ && (defined &$gradesub)) {
                           $value = &$gradesub($value);                            $value = &$gradesub($value);
                       }                        }
                       $prevattempts.='<td>'.$value.'&nbsp;</td>';                        $prevattempts.='<td>'. $value.'&nbsp;</td>';
                   } else {                    } else {
                       $prevattempts.='<td>&nbsp;</td>';                        $prevattempts.='<td>&nbsp;</td>';
                   }                    }
Line 4269  sub get_previous_attempt { Line 4728  sub get_previous_attempt {
       if ($key =~/$regexp$/ && (defined &$gradesub)) {        if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   $value = &$gradesub($value);                    $value = &$gradesub($value);
               }                }
       $prevattempts.='<td>'.$value.'&nbsp;</td>';       $prevattempts.='<td>'.$value.'&nbsp;</td>';
           }            }
       }        }
       $prevattempts.= &end_data_table_row().&end_data_table();        $prevattempts.= &end_data_table_row().&end_data_table();
     } else {      } else {
         my $msg;
         if ($symb =~ /ext\.tool$/) {
             $msg = &mt('No grade passed back.');
         } else {
             $msg = &mt('Nothing submitted - no attempts.');
         }
       $prevattempts=        $prevattempts=
   &start_data_table().&start_data_table_row().    &start_data_table().&start_data_table_row().
   '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.    '<td>'.$msg.'</td>'.
   &end_data_table_row().&end_data_table();    &end_data_table_row().&end_data_table();
     }      }
   } else {    } else {
Line 4290  sub get_previous_attempt { Line 4755  sub get_previous_attempt {
 sub format_previous_attempt_value {  sub format_previous_attempt_value {
     my ($key,$value) = @_;      my ($key,$value) = @_;
     if (($key =~ /timestamp/) || ($key=~/duedate/)) {      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 = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
     } elsif ($key =~ /answerstring$/) {      } elsif ($key =~ /answerstring$/) {
         my %answers = &Apache::lonnet::str2hash($value);          my %answers = &Apache::lonnet::str2hash($value);
           my @answer = %answers;
           %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
         my @anskeys = sort(keys(%answers));          my @anskeys = sort(keys(%answers));
         if (@anskeys == 1) {          if (@anskeys == 1) {
             my $answer = $answers{$anskeys[0]};              my $answer = $answers{$anskeys[0]};
Line 4317  sub format_previous_attempt_value { Line 4784  sub format_previous_attempt_value {
             }               } 
         }          }
     } else {      } else {
  $value = &unescape($value);          $value = &HTML::Entities::encode(&unescape($value), '"<>&');
     }      }
     return $value;      return $value;
 }  }
Line 4379  sub get_student_view { Line 4846  sub get_student_view {
   }    }
   if (defined($target)) { $form{'grade_target'} = $target; }    if (defined($target)) { $form{'grade_target'} = $target; }
   $feedurl=&Apache::lonnet::clutter($feedurl);    $feedurl=&Apache::lonnet::clutter($feedurl);
     if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
         $feedurl =~ s{^/adm/wrapper}{};
     }
   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);    my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
   $userview=~s/\<body[^\>]*\>//gi;    $userview=~s/\<body[^\>]*\>//gi;
   $userview=~s/\<\/body\>//gi;    $userview=~s/\<\/body\>//gi;
Line 4701  sub blockcheck { Line 5171  sub blockcheck {
     # boards, chat or groups, check for blocking in current course only.      # boards, chat or groups, check for blocking in current course only.
   
     if (($activity eq 'boards' || $activity eq 'chat' ||      if (($activity eq 'boards' || $activity eq 'chat' ||
          $activity eq 'groups' || $activity eq 'printout') &&           $activity eq 'groups' || $activity eq 'printout' ||
            $activity eq 'reinit' || $activity eq 'alert') &&
         ($env{'request.course.id'})) {          ($env{'request.course.id'})) {
         foreach my $key (keys(%live_courses)) {          foreach my $key (keys(%live_courses)) {
             if ($key ne $env{'request.course.id'}) {              if ($key ne $env{'request.course.id'}) {
Line 4809  sub blockcheck { Line 5280  sub blockcheck {
   
         # Retrieve blocking times and identity of blocker for course          # Retrieve blocking times and identity of blocker for course
         # of specified user, unless user has 'evb' privilege.          # of specified user, unless user has 'evb' privilege.
           
         my ($start,$end,$trigger) =           my ($start,$end,$trigger) = 
             &get_blocks($setters,$activity,$cdom,$cnum,$url);              &get_blocks($setters,$activity,$cdom,$cnum,$url);
         if (($start != 0) &&           if (($start != 0) && 
Line 4896  sub get_blocks { Line 5367  sub get_blocks {
                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};                   my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                 if ($start && $end) {                  if ($start && $end) {
                     if (($start <= time) && ($end >= time)) {                      if (($start <= time) && ($end >= time)) {
                         unless (grep(/^\Q$block\E$/,@blockers)) {                          if (ref($commblocks{$block}) eq 'HASH') {
                             push(@blockers,$block);                              if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                             $triggered{$block} = {                                  if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                                                    start => $start,                                      unless(grep(/^\Q$block\E$/,@blockers)) {
                                                    end   => $end,                                          push(@blockers,$block);
                                                    type  => $type,                                          $triggered{$block} = {
                                                  };                                                                 start => $start,
                                                                  end   => $end,
                                                                  type  => $type,
                                                                };
                                       }
                                   }
                               }
                         }                          }
                     }                      }
                 }                  }
Line 4984  sub blocking_status { Line 5461  sub blocking_status {
     my $querystring  = "?activity=$activity";      my $querystring  = "?activity=$activity";
 # $uname and $udom decide whose portfolio the user is trying to look at  # $uname and $udom decide whose portfolio the user is trying to look at
     if (($activity eq 'port') || ($activity eq 'passwd')) {      if (($activity eq 'port') || ($activity eq 'passwd')) {
         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);          $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);          $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
     } elsif ($activity eq 'docs') {      } elsif ($activity eq 'docs') {
         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');          $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
Line 5012  END_MYBLOCK Line 5489  END_MYBLOCK
         $text = &mt('Printing Blocked');          $text = &mt('Printing Blocked');
     } elsif ($activity eq 'passwd') {      } elsif ($activity eq 'passwd') {
         $text = &mt('Password Changing Blocked');          $text = &mt('Password Changing Blocked');
       } elsif ($activity eq 'alert') {
           $text = &mt('Checking Critical Messages Blocked');
       } elsif ($activity eq 'reinit') {
           $text = &mt('Checking Course Update Blocked');
     }      }
     $output .= <<"END_BLOCK";      $output .= <<"END_BLOCK";
 <div class='$class'>  <div class='$class'>
Line 5035  sub check_ip_acc { Line 5516  sub check_ip_acc {
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed=0;      my ($ip,$allowed);
     my $ip;  
     if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||      if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
         ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {          ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
         $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;          $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
Line 5045  sub check_ip_acc { Line 5525  sub check_ip_acc {
     }      }
   
     my $name;      my $name;
     foreach my $pattern (split(',',$acc)) {      my %access = (
         $pattern =~ s/^\s*//;                       allowfrom => 1,
         $pattern =~ s/\s*$//;                       denyfrom  => 0,
                    );
       my @allows;
       my @denies;
       foreach my $item (split(',',$acc)) {
           $item =~ s/^\s*//;
           $item =~ s/\s*$//;
           my $pattern;
           if ($item =~ /^\!(.+)$/) {
               push(@denies,$1);
           } else {
               push(@allows,$item);
           }
      }
      my $numdenies = scalar(@denies);
      my $numallows = scalar(@allows);
      my $count = 0;
      foreach my $pattern (@denies,@allows) {
           $count ++; 
           my $acctype = 'allowfrom';
           if ($count <= $numdenies) {
               $acctype = 'denyfrom';
           }
         if ($pattern =~ /\*$/) {          if ($pattern =~ /\*$/) {
             #35.8.*              #35.8.*
             $pattern=~s/\*//;              $pattern=~s/\*//;
             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }              if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {          } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
             #35.8.3.[34-56]              #35.8.3.[34-56]
             my $low=$2;              my $low=$2;
Line 5059  sub check_ip_acc { Line 5561  sub check_ip_acc {
             $pattern=$1;              $pattern=$1;
             if ($ip =~ /^\Q$pattern\E/) {              if ($ip =~ /^\Q$pattern\E/) {
                 my $last=(split(/\./,$ip))[3];                  my $last=(split(/\./,$ip))[3];
                 if ($last <=$high && $last >=$low) { $allowed=1; }                  if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
             }              }
         } elsif ($pattern =~ /^\*/) {          } elsif ($pattern =~ /^\*/) {
             #*.msu.edu              #*.msu.edu
Line 5069  sub check_ip_acc { Line 5571  sub check_ip_acc {
                 my $netaddr=inet_aton($ip);                  my $netaddr=inet_aton($ip);
                 ($name)=gethostbyaddr($netaddr,AF_INET);                  ($name)=gethostbyaddr($netaddr,AF_INET);
             }              }
             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }              if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {          } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
             #127.0.0.1              #127.0.0.1
             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }              if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
         } else {          } else {
             #some.name.com              #some.name.com
             if (!defined($name)) {              if (!defined($name)) {
Line 5080  sub check_ip_acc { Line 5582  sub check_ip_acc {
                 my $netaddr=inet_aton($ip);                  my $netaddr=inet_aton($ip);
                 ($name)=gethostbyaddr($netaddr,AF_INET);                  ($name)=gethostbyaddr($netaddr,AF_INET);
             }              }
             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }              if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
           }
           if ($allowed =~ /^(0|1)$/) { last; }
       }
       if ($allowed eq '') {
           if ($numdenies && !$numallows) {
               $allowed = 1;
           } else {
               $allowed = 0;
         }          }
         if ($allowed) { last; }  
     }      }
     return $allowed;      return $allowed;
 }  }
Line 5147  sub get_domainconf { Line 5656  sub get_domainconf {
                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};                                                  my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                                                 $designhash{$udom.'.login.loginvia'} = $server;                                                  $designhash{$udom.'.login.loginvia'} = $server;
                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {                                                  if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
   
                                                     $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'};
Line 5416  sub CSTR_pageheader { Line 5926  sub CSTR_pageheader {
         $lastitem = $thisdisfn;          $lastitem = $thisdisfn;
     }      }
   
       my ($crsauthor,$title);
       if (($env{'request.course.id'}) &&
           ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
           ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
           $crsauthor = 1;
           $title = &mt('Course Authoring Space');
       } else {
           $title = &mt('Authoring Space');
       }
   
       my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent"
       if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
           $target = '';
           $crumbtarget = '';
       }
   
     my $output =      my $output =
          '<div>'           '<div>'
         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?          .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
         .'<b>'.&mt('Authoring Space:').'</b> '          .'<b>'.$title.'</b> '
         .'<form name="dirs" method="post" action="'.$formaction          .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
         .'" target="_top">' #FIXME lonpubdir: target="_parent"          .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);  
   
     if ($lastitem) {      if ($lastitem) {
         $output .=          $output .=
Line 5430  sub CSTR_pageheader { Line 5955  sub CSTR_pageheader {
             .$lastitem              .$lastitem
             .'</span>';              .'</span>';
     }      }
     $output .=  
          '<br />'      if ($crsauthor) {
         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"          $output .= '</form>'.&Apache::lonmenu::constspaceform();
         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')      } else {
         .'</form>'          $output .=
         .&Apache::lonmenu::constspaceform()               '<br />'
         .'</div>';              #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
               .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
               .'</form>'
               .&Apache::lonmenu::constspaceform();
       }
       $output .= '</div>';
   
     return $output;      return $output;
 }  }
Line 5478  Inputs: Line 6008  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
             use_absolute     -> for external resource or syllabus, this will              use_absolute     -> for external resource or syllabus, this will
Line 5492  Inputs: Line 6019  Inputs:
             inlineremote items to be added in "Functions" menu below              inlineremote items to be added in "Functions" menu below
             breadcrumbs.              breadcrumbs.
   
   =item * $ltiscope, optional argument, will be one of: resource, map or
               course, if LON-CAPA is in LTI Provider context. Value is
               the scope of use, i.e., launch was for access to a single, a map
               or the entire course.
   
   =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
               context, this will contain the URL for the landing item in
               the course, after launch from an LTI Consumer
   
   =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
               context, this will contain a reference to hash of items
               to be included in the page header and/or inline menu.
   
 =back  =back
   
 Returns: A uniform header for LON-CAPA web pages.    Returns: A uniform header for LON-CAPA web pages.  
Line 5503  other decorations will be returned. Line 6043  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,$advtoolsref)=@_;          $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_;
   
     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 5547  sub bodytag { Line 6087  sub bodytag {
                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);                  $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
             }              }
         } else {          } else {
             $role = (split(/\//,$role,4))[-1];              $role = (split(/\//,$role,4))[-1]; 
         }          }
         if ($env{'request.course.sec'}) {          if ($env{'request.course.sec'}) {
             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};              $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
Line 5574  sub bodytag { Line 6114  sub bodytag {
     if ($public) {      if ($public) {
  undef($role);   undef($role);
     }      }
       
       if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
           if (ref($ltimenu) eq 'HASH') {
               unless ($ltimenu->{'role'}) {
                   undef($role);
               }
               unless ($ltimenu->{'coursetitle'}) {
                   $realm='&nbsp;';
               }
           }
       }
   
     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 5587  sub bodytag { Line 6138  sub bodytag {
         $dc_info =~ s/\s+$//;          $dc_info =~ s/\s+$//;
     }      }
   
     $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});      my $crstype;
       if ($env{'request.course.id'}) {
     if ($env{'request.state'} eq 'construct') { $forcereg=1; }          $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
       } elsif ($args->{'crstype'}) {
           $crstype = $args->{'crstype'};
       }
     my $funclist;      if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {          undef($role);
         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".  
                     Apache::lonmenu::serverform();  
         my $forbodytag;  
         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},  
                                             $forcereg,$args->{'group'},  
                                             $args->{'bread_crumbs'},  
                                             $advtoolsref,'','',\$forbodytag);  
         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {  
             $funclist = $forbodytag;  
         }  
     } else {      } else {
           $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
       }
   
           if ($env{'request.state'} eq 'construct') { $forcereg=1; }
   
         #    if ($env{'request.state'} eq 'construct') {          #    if ($env{'request.state'} eq 'construct') {
         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls          #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
Line 5614  sub bodytag { Line 6159  sub bodytag {
         $bodytag .= Apache::lonhtmlcommon::scripttag(          $bodytag .= Apache::lonhtmlcommon::scripttag(
             Apache::lonmenu::utilityfunctions($httphost), 'start');              Apache::lonmenu::utilityfunctions($httphost), 'start');
   
         my ($left,$right) = Apache::lonmenu::primary_menu();          unless ($args->{'no_primary_menu'}) {
               my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu);
   
         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {              if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
             if ($dc_info) {                  if ($dc_info) {
                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;                      $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   }
                   $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
                                  <em>$realm</em> $dc_info</div>|;
                   return $bodytag;
             }              }
             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />  
                            <em>$realm</em> $dc_info</div>|;  
             return $bodytag;  
         }  
   
         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {              unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;                  $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
         }              }
   
         $bodytag .= $right;              $bodytag .= $right;
   
         if ($dc_info) {              if ($dc_info) {
             $dc_info = &dc_courseid_toggle($dc_info);                  $dc_info = &dc_courseid_toggle($dc_info);
               }
               $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
         }          }
         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;  
   
         #if directed to not display the secondary menu, don't.          #if directed to not display the secondary menu, don't.  
         if ($args->{'no_secondary_menu'}) {          if ($args->{'no_secondary_menu'}) {
             return $bodytag;              return $bodytag;
         }          }
         #don't show menus for public users          #don't show menus for public users
         if (!$public){          if (!$public){
             $bodytag .= Apache::lonmenu::secondary_menu($httphost);              unless ($args->{'no_inline_menu'}) {
                   $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
                                                               $args->{'no_primary_menu'});
               }
             $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'},'','',$hostname);                                  $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
             } elsif ($forcereg) {              } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                             $args->{'group'},                                                              $args->{'group'},
                                                             $args->{'hide_buttons',                                                              $args->{'hide_buttons'},
                                                             $hostname});                                                              $hostname,$ltiscope,$ltiuri);
             } else {              } else {
                 my $forbodytag;                  $bodytag .= 
                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},                      &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                                     $forcereg,$args->{'group'},                                                          $forcereg,$args->{'group'},
                                                     $args->{'bread_crumbs'},                                                          $args->{'bread_crumbs'},
                                                     $advtoolsref,'',$hostname,                                                          $advtoolsref,'',$hostname);
                                                     \$forbodytag);  
                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {  
                     $bodytag .= $forbodytag;  
                 }  
             }              }
         }else{          }else{
             # this is to seperate menu from content when there's no secondary              # this is to seperate menu from content when there's no secondary
Line 5672  sub bodytag { Line 6218  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.'" />';  
   
     my $help=($no_inline_link?''  
               :&Apache::loncommon::top_nav_help('Help'));  
   
     # 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>|;  
     }  
   
     my $name = &plainname($env{'user.name'},$env{'user.domain'});  
     unless ($public) {  
         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},  
                                 undef,'LC_menubuttons_link');  
     }  
   
     unless ($env{'form.inhibitmenu'}) {  
         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>  
                        <ol class="LC_primary_menu LC_floatright LC_right">  
                        <li>$help</li>  
                        <li>$menu</li>  
                        </ol><div id="LC_realm"> $realm $dc_info</div>|;  
     }  
     if ($env{'request.state'} eq 'construct') {  
         if (!$public){  
             if ($env{'request.state'} eq 'construct') {  
                 $funclist = &Apache::lonhtmlcommon::scripttag(  
                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').  
                             &Apache::lonhtmlcommon::scripttag('','end').  
                             &Apache::lonmenu::innerregister($forcereg,  
                                                             $args->{'bread_crumbs'});  
             }  
         }  
     }  
     return $bodytag."\n".$funclist;  
 }  }
   
 sub dc_courseid_toggle {  sub dc_courseid_toggle {
Line 5751  sub make_attr_string { Line 6249  sub make_attr_string {
  delete($attr_ref->{$key});   delete($attr_ref->{$key});
     }      }
  }   }
         if ($env{'environment.remote'} eq 'on') {   $attr_ref->{'onload'}  = $on_load;
             $attr_ref->{'onload'}  =   $attr_ref->{'onunload'}= $on_unload;
                 &Apache::lonmenu::loadevents().  $on_load;  
             $attr_ref->{'onunload'}=  
                 &Apache::lonmenu::unloadevents().$on_unload;  
         } else {    
     $attr_ref->{'onload'}  = $on_load;  
     $attr_ref->{'onunload'}= $on_unload;  
         }  
     }      }
   
     my $attr_string;      my $attr_string;
Line 6083  ul.LC_breadcrumb_tools_outerlist li { Line 6574  ul.LC_breadcrumb_tools_outerlist li {
     float: right;      float: right;
 }  }
   
   .LC_placement_prog {
       padding-right: 20px;
       font-weight: bold;
       font-size: 90%;
   }
   
 table#LC_title_bar td {  table#LC_title_bar td {
   background: $tabbg;    background: $tabbg;
 }  }
Line 6174  td.LC_menubuttons_text { Line 6671  td.LC_menubuttons_text {
 }  }
   
 td.LC_zero_height {  td.LC_zero_height {
   line-height: 0;    line-height: 0; 
   cellpadding: 0;    cellpadding: 0;
 }  }
   
Line 6499  td.LC_parm_overview_restrictions  { Line 6996  td.LC_parm_overview_restrictions  {
   border-collapse: collapse;    border-collapse: collapse;
 }  }
   
   span.LC_parm_recursive,
   td.LC_parm_recursive {
     font-weight: bold;
     font-size: smaller;
   }
   
 table.LC_parm_overview_restrictions td {  table.LC_parm_overview_restrictions td {
   border-width: 1px 4px 1px 4px;    border-width: 1px 4px 1px 4px;
   border-style: solid;    border-style: solid;
Line 6851  table.LC_data_table tr > td.LC_docs_entr Line 7354  table.LC_data_table tr > td.LC_docs_entr
   color: #990000;    color: #990000;
 }  }
   
   .LC_docs_alias {
     color: #440055;  
   }
   
 .LC_domprefs_email,  .LC_domprefs_email,
   .LC_docs_alias_name,
 .LC_docs_reinit_warn,  .LC_docs_reinit_warn,
 .LC_docs_ext_edit {  .LC_docs_ext_edit {
   font-size: x-small;    font-size: x-small;
Line 7148  ol.LC_primary_menu li { Line 7656  ol.LC_primary_menu li {
   line-height: 1.5em;    line-height: 1.5em;
 }  }
   
 ol.LC_primary_menu li a,   ol.LC_primary_menu li a,
 ol.LC_primary_menu li p {  ol.LC_primary_menu li p {
   display: block;    display: block;
   margin: 0;    margin: 0;
Line 7163  ol.LC_primary_menu li p span.LC_primary_ Line 7671  ol.LC_primary_menu li p span.LC_primary_
 }  }
   
 ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {  ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
   display: inline-block;    display: inline-block;
   width: 5%;    width: 5%;
   float: right;    float: right;
   text-align: right;    text-align: right;
Line 7198  ol.LC_primary_menu li:hover li, ol.LC_pr Line 7706  ol.LC_primary_menu li:hover li, ol.LC_pr
   float: none;    float: none;
   border-left: 1px solid black;    border-left: 1px solid black;
   border-right: 1px solid black;    border-right: 1px solid black;
 /* A dark bottom border to visualize different menu options;  /* A dark bottom border to visualize different menu options; 
 overwritten in the create_submenu routine for the last border-bottom of the menu */  overwritten in the create_submenu routine for the last border-bottom of the menu */
   border-bottom: 1px solid $data_table_dark;    border-bottom: 1px solid $data_table_dark; 
 }  }
   
 ol.LC_primary_menu li li p:hover {  ol.LC_primary_menu li li p:hover {
Line 7769  pre.LC_wordwrap { Line 8277  pre.LC_wordwrap {
 }  }
   
 /*  /*
     styles used for response display
   */
   div.LC_radiofoil, div.LC_rankfoil {
     margin: .5em 0em .5em 0em;
   }
   table.LC_itemgroup {
     margin-top: 1em;
   }
   
   /*
   styles used by TTH when "Default set of options to pass to tth/m    styles used by TTH when "Default set of options to pass to tth/m
   when converting TeX" in course settings has been set    when converting TeX" in course settings has been set
   
Line 7789  span.roman {font-family: serif; font-sty Line 8307  span.roman {font-family: serif; font-sty
 span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}  span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
 span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}  span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
   
   /*
     sections with roles, for content only
   */
   section[class^="role-"] {
     padding-left: 10px;
     padding-right: 5px;
     margin-top: 8px;
     margin-bottom: 8px;
     border: 1px solid #2A4;
     border-radius: 5px;
     box-shadow: 0px 1px 1px #BBB;
   }
   section[class^="role-"]>h1 {
     position: relative;
     margin: 0px;
     padding-top: 10px;
     padding-left: 40px;
   }
   section[class^="role-"]>h1:before {
     position: absolute;
     left: -5px;
     top: 5px;
   }
   section.role-activity>h1:before {
     content:url('/adm/daxe/images/section_icons/activity.png');
   }
   section.role-advice>h1:before {
     content:url('/adm/daxe/images/section_icons/advice.png');
   }
   section.role-bibliography>h1:before {
     content:url('/adm/daxe/images/section_icons/bibliography.png');
   }
   section.role-citation>h1:before {
     content:url('/adm/daxe/images/section_icons/citation.png');
   }
   section.role-conclusion>h1:before {
     content:url('/adm/daxe/images/section_icons/conclusion.png');
   }
   section.role-definition>h1:before {
     content:url('/adm/daxe/images/section_icons/definition.png');
   }
   section.role-demonstration>h1:before {
     content:url('/adm/daxe/images/section_icons/demonstration.png');
   }
   section.role-example>h1:before {
     content:url('/adm/daxe/images/section_icons/example.png');
   }
   section.role-explanation>h1:before {
     content:url('/adm/daxe/images/section_icons/explanation.png');
   }
   section.role-introduction>h1:before {
     content:url('/adm/daxe/images/section_icons/introduction.png');
   }
   section.role-method>h1:before {
     content:url('/adm/daxe/images/section_icons/method.png');
   }
   section.role-more_information>h1:before {
     content:url('/adm/daxe/images/section_icons/more_information.png');
   }
   section.role-objectives>h1:before {
     content:url('/adm/daxe/images/section_icons/objectives.png');
   }
   section.role-prerequisites>h1:before {
     content:url('/adm/daxe/images/section_icons/prerequisites.png');
   }
   section.role-remark>h1:before {
     content:url('/adm/daxe/images/section_icons/remark.png');
   }
   section.role-reminder>h1:before {
     content:url('/adm/daxe/images/section_icons/reminder.png');
   }
   section.role-summary>h1:before {
     content:url('/adm/daxe/images/section_icons/summary.png');
   }
   section.role-syntax>h1:before {
     content:url('/adm/daxe/images/section_icons/syntax.png');
   }
   section.role-warning>h1:before {
     content:url('/adm/daxe/images/section_icons/warning.png');
   }
   
 #LC_minitab_header {  #LC_minitab_header {
   float:left;    float:left;
   width:100%;    width:100%;
Line 7879  sub headtag { Line 8478  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 8041  OFFLOAD Line 8640  OFFLOAD
     if (!$args->{'frameset'}) {      if (!$args->{'frameset'}) {
         $result .= ' /';          $result .= ' /';
     }      }
     $result .= '>'      $result .= '>' 
         .$inhibitprint          .$inhibitprint
  .$head_extra;   .$head_extra;
     my $clientmobile;      my $clientmobile;
Line 8074  sub font_settings { Line 8673  sub font_settings {
     my $headerstring='';      my $headerstring='';
     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||      if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {          ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
  $headerstring.=          $headerstring.=
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';              '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
         if (!$args->{'frameset'}) {          if (!$args->{'frameset'}) {
             $headerstring.= ' /';      $headerstring.= ' /';
         }          }
         $headerstring .= '>'."\n";   $headerstring .= '>'."\n";
     }      }
     return $headerstring;      return $headerstring;
 }  }
Line 8232  $args - additional optional args support Line 8831  $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
              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_component ->  if exists show it as headline else show only the breadcrumbs
              bread_crumbs_nomenu -> if true will pass false as the value of $menulink               bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                                     to lonhtmlcommon::breadcrumbs                                      to lonhtmlcommon::breadcrumbs
              group          -> includes the current group, if page is for a               group          -> includes the current group, if page is for a 
                                specific group                                 specific group
              use_absolute   -> for request for external resource or syllabus, this               use_absolute   -> for request for external resource or syllabus, this
                                will contain https://<hostname> if server uses                                 will contain https://<hostname> if server uses
Line 8257  sub start_page { Line 8854  sub start_page {
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));      #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
   
     $env{'internal.start_page'}++;      $env{'internal.start_page'}++;
     my ($result,@advtools);      my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu);
   
     if (! exists($args->{'skip_phases'}{'head'}) ) {      if (! exists($args->{'skip_phases'}{'head'}) ) {
         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);          $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
     }      }
   
       if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
           if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
               unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
                   $args->{'no_primary_menu'} = 1;
               }
               unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
                   $args->{'no_inline_menu'} = 1;
               }
               if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
                   map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
               }
           } else {
               my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
               my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
               if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
                   unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
                       $args->{'no_primary_menu'} = 1;
                   }
                   unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
                       $args->{'no_inline_menu'} = 1;
                   }
                   if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
                       map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
                   }
               }
           }
           ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
                                     $env{'course.'.$env{'request.course.id'}.'.domain'},
                                     $env{'course.'.$env{'request.course.id'}.'.num'});
       }
           
     if (! exists($args->{'skip_phases'}{'body'}) ) {      if (! exists($args->{'skip_phases'}{'body'}) ) {
  if ($args->{'frameset'}) {   if ($args->{'frameset'}) {
Line 8274  sub start_page { Line 8902  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,                     \@advtools);                           \@advtools,$ltiscope,$ltiuri,\%ltimenu);
         }          }
     }      }
   
Line 8310  sub start_page { Line 8938  sub start_page {
                 }                  }
                 my $menulink;                  my $menulink;
                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.                  # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                 if (exists($args->{'bread_crumbs_nomenu'})) {                  if ((exists($args->{'bread_crumbs_nomenu'})) ||
                        ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
                        ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
                        ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
                        (!$env{'request.role.adv'}))) {
                     $menulink = 0;                      $menulink = 0;
                 } else {                  } else {
                     undef($menulink);                      undef($menulink);
Line 8318  sub start_page { Line 8950  sub start_page {
  #if bread_crumbs_component exists show it as headline else show only the breadcrumbs   #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
  if(exists($args->{'bread_crumbs_component'})){   if(exists($args->{'bread_crumbs_component'})){
  $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);   $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
  }else{                  } else {
  $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);   $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
  }   }
     } elsif (($env{'environment.remote'} eq 'on') &&  
              ($env{'form.inhibitmenu'} ne 'yes') &&  
              ($env{'request.noversionuri'} =~ m{^/res/}) &&  
              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {  
         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';  
     }      }
     return $result;      return $result;
 }  }
Line 8472  sub modal_adhoc_inner { Line 9099  sub modal_adhoc_inner {
     my ($funcname,$width,$height,$content)=@_;      my ($funcname,$width,$height,$content)=@_;
     my $innerwidth=$width-20;      my $innerwidth=$width-20;
     $content=&js_ready(      $content=&js_ready(
                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).                   &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).                   &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                  $content.                   $content.
                  &end_scrollbox().                   &end_scrollbox().
Line 8844  function expand_div(caller) { Line 9471  function expand_div(caller) {
   
 sub simple_error_page {  sub simple_error_page {
     my ($r,$title,$msg,$args) = @_;      my ($r,$title,$msg,$args) = @_;
       my %displayargs;
     if (ref($args) eq 'HASH') {      if (ref($args) eq 'HASH') {
         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }          if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
           if ($args->{'only_body'}) {
               $displayargs{'only_body'} = 1;
           }
           if ($args->{'no_nav_bar'}) {
               $displayargs{'no_nav_bar'} = 1;
           }
     } else {      } else {
         $msg = &mt($msg);          $msg = &mt($msg);
     }      }
   
     my $page =      my $page =
  &Apache::loncommon::start_page($title).   &Apache::loncommon::start_page($title,'',\%displayargs).
  '<p class="LC_error">'.$msg.'</p>'.   '<p class="LC_error">'.$msg.'</p>'.
  &Apache::loncommon::end_page();   &Apache::loncommon::end_page();
     if (ref($r)) {      if (ref($r)) {
Line 9157  sub get_sections { Line 9791  sub get_sections {
         }          }
     }      }
   
     if ($check_students) {      if ($check_students) { 
  my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);   my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
  my $sec_index = &Apache::loncoursedata::CL_SECTION();   my $sec_index = &Apache::loncoursedata::CL_SECTION();
  my $status_index = &Apache::loncoursedata::CL_STATUS();   my $status_index = &Apache::loncoursedata::CL_STATUS();
Line 9479  Incoming parameters: Line 10113  Incoming parameters:
 2. user's domain  2. user's domain
 3. quota name - portfolio, author, or course  3. quota name - portfolio, author, or course
    (if no quota name provided, defaults to portfolio).     (if no quota name provided, defaults to portfolio).
 4. crstype - official, unofficial, textbook or community, if quota name is  4. crstype - official, unofficial, textbook, placement or community, 
    course     if quota name is course
   
 Returns:  Returns:
 1. Disk quota (in MB) assigned to student.  1. Disk quota (in MB) assigned to student.
Line 9553  sub get_user_quota { Line 10187  sub get_user_quota {
         if ($quota eq '' || wantarray) {          if ($quota eq '' || wantarray) {
             if ($quotaname eq 'course') {              if ($quotaname eq 'course') {
                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);                  my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||                  if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
                     ($crstype eq 'community') || ($crstype eq 'textbook')) {                      ($crstype eq 'community') || ($crstype eq 'textbook') ||
                       ($crstype eq 'placement')) { 
                     $defquota = $domdefs{$crstype.'quota'};                      $defquota = $domdefs{$crstype.'quota'};
                 }                  }
                 if ($defquota eq '') {                  if ($defquota eq '') {
Line 9702  Inputs: 7 Line 10337  Inputs: 7
 4. filename of file for which action is being requested  4. filename of file for which action is being requested
 5. filesize (kB) of file  5. filesize (kB) of file
 6. action being taken: copy or upload.  6. action being taken: copy or upload.
 7. quotatype (in course context -- official, unofficial, community or textbook).  7. quotatype (in course context -- official, unofficial, textbook, placement or community).
   
 Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,  Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
          otherwise return null.           otherwise return null.
Line 9738  sub excess_filesize_warning { Line 10373  sub excess_filesize_warning {
 ###############################################  ###############################################
   
   
   
   
 sub get_secgrprole_info {  sub get_secgrprole_info {
     my ($cdom,$cnum,$needroles,$type)  = @_;      my ($cdom,$cnum,$needroles,$type)  = @_;
     my %sections_count = &get_sections($cdom,$cnum);      my %sections_count = &get_sections($cdom,$cnum);
Line 9846  sub user_picker { Line 10483  sub user_picker {
         $allow_blank = 0;          $allow_blank = 0;
         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);          $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
     } else {      } else {
         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);          my $defdom = $env{'request.role.domain'};
           my ($trusted,$untrusted);
           if (($context eq 'requestcrs') || ($context eq 'course')) {
               ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
           } elsif ($context eq 'author') {
               ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
           } elsif ($context eq 'domain') {
               ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
           }
           $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
     }      }
     my $srchinsel = ' <select name="srchin">';      my $srchinsel = ' <select name="srchin">';
   
Line 10051  sub user_rule_check { Line 10697  sub user_rule_check {
     if (ref($usershash) eq 'HASH') {      if (ref($usershash) eq 'HASH') {
         if (keys(%{$usershash}) > 1) {          if (keys(%{$usershash}) > 1) {
             my (%by_username,%by_id,%userdoms);              my (%by_username,%by_id,%userdoms);
             my $checkid;              my $checkid; 
             if (ref($checks) eq 'HASH') {              if (ref($checks) eq 'HASH') {
                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {                  if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                     $checkid = 1;                      $checkid = 1;
Line 10062  sub user_rule_check { Line 10708  sub user_rule_check {
                 if ($checkid) {                  if ($checkid) {
                     if (ref($usershash->{$user}) eq 'HASH') {                      if (ref($usershash->{$user}) eq 'HASH') {
                         if ($usershash->{$user}->{'id'} ne '') {                          if ($usershash->{$user}->{'id'} ne '') {
                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;                              $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; 
                             $userdoms{$udom} = 1;                              $userdoms{$udom} = 1;
                             if (ref($inst_results) eq 'HASH') {                              if (ref($inst_results) eq 'HASH') {
                                 $inst_results->{$uname.':'.$udom} = {};                                  $inst_results->{$uname.':'.$udom} = {};
Line 10132  sub user_rule_check { Line 10778  sub user_rule_check {
                 if (ref($usershash->{$user}) eq 'HASH') {                  if (ref($usershash->{$user}) eq 'HASH') {
                     if (ref($checks) eq 'HASH') {                      if (ref($checks) eq 'HASH') {
                         if (defined($checks->{'username'})) {                          if (defined($checks->{'username'})) {
                             ($inst_response{$user},%{$inst_results->{$user}}) =                              ($inst_response{$user},%{$inst_results->{$user}}) = 
                                 &Apache::lonnet::get_instuser($udom,$uname);                                  &Apache::lonnet::get_instuser($udom,$uname);
                         } elsif (defined($checks->{'id'})) {                          } elsif (defined($checks->{'id'})) {
                             if ($usershash->{$user}->{'id'} ne '') {                              if ($usershash->{$user}->{'id'} ne '') {
Line 10155  sub user_rule_check { Line 10801  sub user_rule_check {
                         if (ref($domconfig{'usercreation'}) eq 'HASH') {                          if (ref($domconfig{'usercreation'}) eq 'HASH') {
                             foreach my $item ('username','id') {                              foreach my $item ('username','id') {
                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {                                  if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                                    $$curr_rules{$udom}{$item} =                                     $$curr_rules{$udom}{$item} = 
                                        $domconfig{'usercreation'}{$item.'_rule'};                                         $domconfig{'usercreation'}{$item.'_rule'};
                                 }                                  }
                             }                              }
Line 10178  sub user_rule_check { Line 10824  sub user_rule_check {
                     $id = $inst_results->{$user}->{'id'};                      $id = $inst_results->{$user}->{'id'};
                 }                  }
             }              }
             if ($id eq '') {              if ($id eq '') { 
                 if (ref($usershash->{$user})) {                  if (ref($usershash->{$user})) {
                     $id = $usershash->{$user}->{'id'};                      $id = $usershash->{$user}->{'id'};
                 }                  }
Line 10480  future_reservable - ref to hash of stude Line 11126  future_reservable - ref to hash of stude
   
     Keys in inner hash are:      Keys in inner hash are:
     (a) symb: either blank or symb to which slot use is restricted.      (a) symb: either blank or symb to which slot use is restricted.
     (b) startreserve:  start date of reservation period.      (b) startreserve: start date of reservation period.
     (c) uniqueperiod: start,end dates when slot is to be uniquely      (c) uniqueperiod: start,end dates when slot is to be uniquely
         selected.          selected.
   
Line 10490  future_reservable - ref to hash of stude Line 11136  future_reservable - ref to hash of stude
   
 sub get_future_slots {  sub get_future_slots {
     my ($cnum,$cdom,$now,$symb) = @_;      my ($cnum,$cdom,$now,$symb) = @_;
       my $map;
       if ($symb) {
           ($map) = &Apache::lonnet::decode_symb($symb);
       }
     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);      my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);      my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
     foreach my $slot (keys(%slots)) {      foreach my $slot (keys(%slots)) {
         next unless($slots{$slot}->{'type'} eq 'schedulable_student');          next unless($slots{$slot}->{'type'} eq 'schedulable_student');
         if ($symb) {          if ($symb) {
             next if (($slots{$slot}->{'symb'} ne '') &&               if ($slots{$slot}->{'symb'} ne '') {
                      ($slots{$slot}->{'symb'} ne $symb));                  my $canuse;
                   my %oksymbs;
                   my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
                   map { $oksymbs{$_} = 1; } @slotsymbs;
                   if ($oksymbs{$symb}) {
                       $canuse = 1;
                   } else {
                       foreach my $item (@slotsymbs) {
                           if ($item =~ /\.(page|sequence)$/) {
                               (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
                               if (($map ne '') && ($map eq $sloturl)) {
                                   $canuse = 1;
                                   last;
                               }
                           }
                       }
                   }
                   next unless ($canuse);
               }
         }          }
         if (($slots{$slot}->{'starttime'} > $now) &&          if (($slots{$slot}->{'starttime'} > $now) &&
             ($slots{$slot}->{'endtime'} > $now)) {              ($slots{$slot}->{'endtime'} > $now)) {
Line 10549  sub get_future_slots { Line 11217  sub get_future_slots {
                 $reservable_now{$slot} = {                  $reservable_now{$slot} = {
                                            symb       => $symb,                                             symb       => $symb,
                                            endreserve => $lastres,                                             endreserve => $lastres,
                                            uniqueperiod => $uniqueperiod,                                                uniqueperiod => $uniqueperiod,
                                          };                                           };
             } elsif (($startreserve > $now) &&              } elsif (($startreserve > $now) &&
                      (!$endreserve || $endreserve > $startreserve)) {                       (!$endreserve || $endreserve > $startreserve)) {
Line 10714  sub get_env_multiple { Line 11382  sub get_env_multiple {
     return(@values);      return(@values);
 }  }
   
   # Looks at given dependencies, and returns something depending on the context.
   # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
   # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
   # For all other contexts, returns ($output, $counter, $numpathchg).
   # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
   # $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
   # $numpathchg: integer with the number of cleaned up dependency paths.
   # \%existing: hash reference clean path -> 1 only for existing dependencies.
   # \%mapping: hash reference clean path -> original path for all dependencies.
   # @param {string} actionurl - The path to the handler, indicative of the context.
   # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
   # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
   # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
   # @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
   # @return {Array} - array depending on the context (not a reference)
 sub ask_for_embedded_content {  sub ask_for_embedded_content {
       # NOTE: documentation was added afterwards, it could be wrong
     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;      my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,      my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
         %currsubfile,%unused,$rem);          %currsubfile,%unused,$rem);
Line 10730  sub ask_for_embedded_content { Line 11414  sub ask_for_embedded_content {
     my $heading = &mt('Upload embedded files');      my $heading = &mt('Upload embedded files');
     my $buttontext = &mt('Upload');      my $buttontext = &mt('Upload');
   
       # fills these variables based on the context:
       # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
       # $path, $fileloc, $title, $rem, $filename
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         if ($actionurl eq '/adm/dependencies') {          if ($actionurl eq '/adm/dependencies') {
             $navmap = Apache::lonnavmaps::navmap->new();              $navmap = Apache::lonnavmaps::navmap->new();
Line 10737  sub ask_for_embedded_content { Line 11424  sub ask_for_embedded_content {
         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};          $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};          $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
     }      }
     if (($actionurl eq '/adm/portfolio') ||      if (($actionurl eq '/adm/portfolio') || 
         ($actionurl eq '/adm/coursegrp_portfolio')) {          ($actionurl eq '/adm/coursegrp_portfolio')) {
         my $current_path='/';          my $current_path='/';
         if ($env{'form.currentpath'}) {          if ($env{'form.currentpath'}) {
Line 10769  sub ask_for_embedded_content { Line 11456  sub ask_for_embedded_content {
             $toplevel = $url;              $toplevel = $url;
             if ($args->{'context'} eq 'paste') {              if ($args->{'context'} eq 'paste') {
                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});                  ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                 ($path) =                  ($path) = 
                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});                      ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);                  $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                 $fileloc =~ s{^/}{};                  $fileloc =~ s{^/}{};
             }              }
         }          }
     } elsif ($actionurl eq '/adm/dependencies') {      } elsif ($actionurl eq '/adm/dependencies')  {
         if ($env{'request.course.id'} ne '') {          if ($env{'request.course.id'} ne '') {
             if (ref($args) eq 'HASH') {              if (ref($args) eq 'HASH') {
                 $url = $args->{'docs_url'};                  $url = $args->{'docs_url'};
                 $title = $args->{'docs_title'};                  $title = $args->{'docs_title'};
                 $toplevel = $url;                  $toplevel = $url; 
                 unless ($toplevel =~ m{^/}) {                  unless ($toplevel =~ m{^/}) {
                     $toplevel = "/$url";                      $toplevel = "/$url";
                 }                  }
Line 10814  sub ask_for_embedded_content { Line 11501  sub ask_for_embedded_content {
         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';          $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
         $fileloc =~ s{^/}{};          $fileloc =~ s{^/}{};
     }      }
       
       # parses the dependency paths to get some info
       # fills $newfiles, $mapping, $subdependencies, $dependencies
       # $newfiles: hash URL -> 1 for new files or external URLs
       # (will be completed later)
       # $mapping:
       #   for external URLs: external URL -> external URL
       #   for relative paths: clean path -> original path
       # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
       # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
     foreach my $file (keys(%{$allfiles})) {      foreach my $file (keys(%{$allfiles})) {
         my $embed_file;          my $embed_file;
         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {          if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
Line 10856  sub ask_for_embedded_content { Line 11553  sub ask_for_embedded_content {
             }              }
         }          }
     }      }
       
       # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
       # and lists
       # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
       # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
       # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
       #                                    the path had to be cleaned up
       # $existing: hash clean path -> 1 if the file exists
       # $numexisting: number of keys in $existing
       # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
       # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
       #                                      dependency subdirectories that are
       #                                      not listed as dependencies, with some exceptions using $rem
     my $dirptr = 16384;      my $dirptr = 16384;
     foreach my $path (keys(%subdependencies)) {      foreach my $path (keys(%subdependencies)) {
         $currsubfile{$path} = {};          $currsubfile{$path} = {};
         if (($actionurl eq '/adm/portfolio') ||          if (($actionurl eq '/adm/portfolio') || 
             ($actionurl eq '/adm/coursegrp_portfolio')) {               ($actionurl eq '/adm/coursegrp_portfolio')) {
             my ($sublistref,$listerror) =              my ($sublistref,$listerror) =
                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);                  &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
             if (ref($sublistref) eq 'ARRAY') {              if (ref($sublistref) eq 'ARRAY') {
Line 10931  sub ask_for_embedded_content { Line 11641  sub ask_for_embedded_content {
             }              }
         }          }
     }      }
       
       # fills $currfile, hash file name -> 1 or [$size,$mtime]
       # for files in $url or $fileloc (target directory) in some contexts
     my %currfile;      my %currfile;
     if (($actionurl eq '/adm/portfolio') ||      if (($actionurl eq '/adm/portfolio') ||
         ($actionurl eq '/adm/coursegrp_portfolio')) {          ($actionurl eq '/adm/coursegrp_portfolio')) {
Line 10969  sub ask_for_embedded_content { Line 11682  sub ask_for_embedded_content {
             }              }
         }          }
     }      }
       # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
       # are not in subdirectories, using $currfile
     foreach my $file (keys(%dependencies)) {      foreach my $file (keys(%dependencies)) {
         if (exists($currfile{$file})) {          if (exists($currfile{$file})) {
             unless ($mapping{$file} eq $file) {              unless ($mapping{$file} eq $file) {
Line 10997  sub ask_for_embedded_content { Line 11712  sub ask_for_embedded_content {
             $unused{$file} = 1;              $unused{$file} = 1;
         }          }
     }      }
       
       # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&      if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
         ($args->{'context'} eq 'paste')) {          ($args->{'context'} eq 'paste')) {
         $counter = scalar(keys(%existing));          $counter = scalar(keys(%existing));
         $numpathchg = scalar(keys(%pathchanges));          $numpathchg = scalar(keys(%pathchanges));
         return ($output,$counter,$numpathchg,\%existing);          return ($output,$counter,$numpathchg,\%existing);
     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&      } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {               (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
         $counter = scalar(keys(%existing));          $counter = scalar(keys(%existing));
         $numpathchg = scalar(keys(%pathchanges));          $numpathchg = scalar(keys(%pathchanges));
         return ($output,$counter,$numpathchg,\%existing,\%mapping);          return ($output,$counter,$numpathchg,\%existing,\%mapping);
     }      }
       
       # returns HTML otherwise, with dependency results and to ask for more uploads
       
       # $upload_output: missing dependencies (with upload form)
       # $modify_output: uploaded dependencies (in use)
       # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {      foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
         if ($actionurl eq '/adm/dependencies') {          if ($actionurl eq '/adm/dependencies') {
             next if ($embed_file =~ m{^\w+://});              next if ($embed_file =~ m{^\w+://});
Line 11231  sub ask_for_embedded_content { Line 11954  sub ask_for_embedded_content {
   
 Performs clean-up of directories, subdirectories and filename in an  Performs clean-up of directories, subdirectories and filename in an
 embedded object, referenced in an HTML file which is being uploaded  embedded object, referenced in an HTML file which is being uploaded
 to a course or portfolio, where  to a course or portfolio, where 
 "Upload embedded images/multimedia files if HTML file" checkbox was  "Upload embedded images/multimedia files if HTML file" checkbox was
 checked.  checked.
   
Line 11250  sub clean_path { Line 11973  sub clean_path {
         @contents = ($embed_file);          @contents = ($embed_file);
     }      }
     my $lastidx = scalar(@contents)-1;      my $lastidx = scalar(@contents)-1;
     for (my $i=0; $i<=$lastidx; $i++) {      for (my $i=0; $i<=$lastidx; $i++) { 
         $contents[$i]=~s{\\}{/}g;          $contents[$i]=~s{\\}{/}g;
         $contents[$i]=~s/\s+/\_/g;          $contents[$i]=~s/\s+/\_/g;
         $contents[$i]=~s{[^/\w\.\-]}{}g;          $contents[$i]=~s{[^/\w\.\-]}{}g;
Line 11589  sub modify_html_refs { Line 12312  sub modify_html_refs {
     }      }
     my (%allfiles,%codebase,$output,$content);      my (%allfiles,%codebase,$output,$content);
     my @changes = &get_env_multiple('form.namechange');      my @changes = &get_env_multiple('form.namechange');
     unless ((@changes > 0)  || ($context eq 'syllabus')) {      unless ((@changes > 0) || ($context eq 'syllabus')) {
         if (wantarray) {          if (wantarray) {
             return ('',0,0);               return ('',0,0); 
         } else {          } else {
Line 11724  sub modify_html_refs { Line 12447  sub modify_html_refs {
                         }                          }
                     }                      }
                     if ($rewrites) {                      if ($rewrites) {
                         my $saveresult;                          my $saveresult; 
                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);                          my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                         if ($url eq $container) {                          if ($url eq $container) {
                             my ($fname) = ($container =~ m{/([^/]+)$});                              my ($fname) = ($container =~ m{/([^/]+)$});
Line 12250  sub process_decompression { Line 12973  sub process_decompression {
             }              }
             my $numskip = scalar(@to_skip);              my $numskip = scalar(@to_skip);
             my $numoverwrite = scalar(@to_overwrite);              my $numoverwrite = scalar(@to_overwrite);
             if (($numskip) && (!$numoverwrite)) {              if (($numskip) && (!$numoverwrite)) { 
                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');                           $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
             } elsif ($dir eq '') {              } elsif ($dir eq '') {
                 $error = &mt('Directory containing archive file unavailable.');                  $error = &mt('Directory containing archive file unavailable.');
Line 12260  sub process_decompression { Line 12983  sub process_decompression {
                     my $tempdir = time.'_'.$$.int(rand(10000));                      my $tempdir = time.'_'.$$.int(rand(10000));
                     mkdir("$dir/$tempdir",0755);                      mkdir("$dir/$tempdir",0755);
                     if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {                      if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
                         ($decompressed,$display) =                          ($decompressed,$display) = 
                             &decompress_uploaded_file($file,"$dir/$tempdir");                              &decompress_uploaded_file($file,"$dir/$tempdir");
                         foreach my $item (@to_skip) {                          foreach my $item (@to_skip) {
                             if (($item ne '') && ($item !~ /\.\./)) {                              if (($item ne '') && ($item !~ /\.\./)) {
                                 if (-f "$dir/$tempdir/$item") {                                  if (-f "$dir/$tempdir/$item") { 
                                     unlink("$dir/$tempdir/$item");                                      unlink("$dir/$tempdir/$item");
                                 } elsif (-d "$dir/$tempdir/$item") {                                  } elsif (-d "$dir/$tempdir/$item") {
                                     &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });                                      &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
Line 12304  sub process_decompression { Line 13027  sub process_decompression {
                     if (ref($newdirlistref) eq 'ARRAY') {                      if (ref($newdirlistref) eq 'ARRAY') {
                         foreach my $dir_line (@{$newdirlistref}) {                          foreach my $dir_line (@{$newdirlistref}) {
                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);                              my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                             unless (($item =~ /^\.+$/) || ($item eq $file)) {                               unless (($item =~ /^\.+$/) || ($item eq $file)) {
                                 push(@newitems,$item);                                  push(@newitems,$item);
                                 if ($dirptr&$testdir) {                                  if ($dirptr&$testdir) {
                                     $is_dir{$item} = 1;                                      $is_dir{$item} = 1;
Line 12359  sub process_decompression { Line 13082  sub process_decompression {
                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};                                      $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                                     $displayed{'folder'} = $i;                                      $displayed{'folder'} = $i;
                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||                                  } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {                                           (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
                                     $env{'form.archive_'.$i} = 'display';                                      $env{'form.archive_'.$i} = 'display';
                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};                                      $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                                     $displayed{'web'} = $i;                                      $displayed{'web'} = $i;
Line 12811  sub process_extracted_files { Line 13534  sub process_extracted_files {
         $folders{'0'} = $items[-2];          $folders{'0'} = $items[-2];
         if ($env{'form.folderpath'} =~ /\:1$/) {          if ($env{'form.folderpath'} =~ /\:1$/) {
             $containers{'0'}='page';              $containers{'0'}='page';
         } else {          } else {  
             $containers{'0'}='sequence';              $containers{'0'}='sequence';
         }          }
     }      }
Line 12892  sub process_extracted_files { Line 13615  sub process_extracted_files {
                             $newseqid{$i} = $newidx;                              $newseqid{$i} = $newidx;
                             unless ($errtext) {                              unless ($errtext) {
                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',                                  $result .=  '<li>'.&mt('Folder: [_1] added to course',
                                                        &HTML::Entities::encode($docstitle,'<>&"'))..                                                         &HTML::Entities::encode($docstitle,'<>&"')).
                                             '</li>'."\n";                                              '</li>'."\n";
                             }                              }
                         }                          }
Line 12917  sub process_extracted_files { Line 13640  sub process_extracted_files {
                                             $fetch =~ s/^\Q$prefix$dir\E//;                                              $fetch =~ s/^\Q$prefix$dir\E//;
                                             $prompttofetch{$fetch} = 1;                                              $prompttofetch{$fetch} = 1;
                                         }                                          }
                                    }                                      }
                                 }                                  }
                                 $LONCAPA::map::resources[$newidx]=                                  $LONCAPA::map::resources[$newidx]=
                                     $docstitle.':'.$url.':false:normal:res';                                      $docstitle.':'.$url.':false:normal:res';
Line 12942  sub process_extracted_files { Line 13665  sub process_extracted_files {
                 }                  }
             } else {              } else {
                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',                  $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                                 &HTML::Entities::encode($path,'<>&"')).'<br />';                                  &HTML::Entities::encode($path,'<>&"')).'<br />'; 
             }              }
         }          }
         for (my $i=1; $i<=$numitems; $i++) {          for (my $i=1; $i<=$numitems; $i++) {
Line 12964  sub process_extracted_files { Line 13687  sub process_extracted_files {
                         }                          }
                         if ($itemidx eq '') {                          if ($itemidx eq '') {
                             $itemidx =  0;                              $itemidx =  0;
                         }                          } 
                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {                          if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                             if ($mapinner{$referrer{$i}}) {                              if ($mapinner{$referrer{$i}}) {
                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";                                  $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
Line 13013  sub process_extracted_files { Line 13736  sub process_extracted_files {
                                     $showpath = "$relpath/$title";                                      $showpath = "$relpath/$title";
                                 } else {                                  } else {
                                     $showpath = "/$title";                                      $showpath = "/$title";
                                 }                                  } 
                                 $result .= '<li>'.&mt('[_1] included as a dependency',                                  $result .= '<li>'.&mt('[_1] included as a dependency',
                                                       &HTML::Entities::encode($showpath,'<>&"')).                                                        &HTML::Entities::encode($showpath,'<>&"')).
                                            '</li>'."\n";                                             '</li>'."\n";
                                 unless ($ishome) {                                  unless ($ishome) {
                                     my $fetch = "$fullpath/$title";                                      my $fetch = "$fullpath/$title";
                                     $fetch =~ s/^\Q$prefix$dir\E//;                                      $fetch =~ s/^\Q$prefix$dir\E//; 
                                     $prompttofetch{$fetch} = 1;                                      $prompttofetch{$fetch} = 1;
                                 }                                  }
                             }                              }
Line 14235  generated by lonerrorhandler.pm, CHECKRP Line 14958  generated by lonerrorhandler.pm, CHECKRP
 lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.  lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
   
 Inputs:  Inputs:
 defmail (scalar - email address of default recipient),  defmail (scalar - email address of default recipient), 
 mailing type (scalar: errormail, packagesmail, helpdeskmail,  mailing type (scalar: errormail, packagesmail, helpdeskmail,
 requestsmail, updatesmail, or idconflictsmail).  requestsmail, updatesmail, or idconflictsmail).
   
 defdom (domain for which to retrieve configuration settings),  defdom (domain for which to retrieve configuration settings),
   
 origmail (scalar - email address of recipient from loncapa.conf,  origmail (scalar - email address of recipient from loncapa.conf, 
 i.e., predates configuration by DC via domainprefs.pm  i.e., predates configuration by DC via domainprefs.pm
   
 $requname username of requester (if mailing type is helpdeskmail)  $requname username of requester (if mailing type is helpdeskmail)
Line 14250  $requdom domain of requester (if mailing Line 14973  $requdom domain of requester (if mailing
   
 $reqemail e-mail address of requester (if mailing type is helpdeskmail)  $reqemail e-mail address of requester (if mailing type is helpdeskmail)
   
   
 Returns: comma separated list of addresses to which to send e-mail.  Returns: comma separated list of addresses to which to send e-mail.
   
 =back  =back
Line 14493  sub build_recipient_list { Line 15217  sub build_recipient_list {
   
 =pod  =pod
   
   =over 4
   
   =item * &mime_email()
   
   Sends an email with a possible attachment
   
   Inputs:
   
   =over 4
   
   from -              Sender's email address
   
   to -                Email address of recipient
   
   subject -           Subject of email
   
   body -              Body of email
   
   cc_string -         Carbon copy email address
   
   bcc -               Blind carbon copy email address
   
   type -              File type of attachment
   
   attachment_path -   Path of file to be attached
   
   file_name -         Name of file to be attached
   
   attachment_text -   The body of an attachment of type "TEXT"
   
   =back
   
   =back
   
   =cut
   
   ############################################################
   ############################################################
   
   sub mime_email {
       my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, 
           $file_name, $attachment_text) = @_;
       my $msg = MIME::Lite->new(
                From    => $from,
                To      => $to,
                Subject => $subject,
                Type    =>'TEXT',
                Data    => $body,
                );
       if ($cc_string ne '') {
           $msg->add("Cc" => $cc_string);
       }
       if ($bcc ne '') {
           $msg->add("Bcc" => $bcc);
       }
       $msg->attr("content-type"         => "text/plain");
       $msg->attr("content-type.charset" => "UTF-8");
       # Attach file if given
       if ($attachment_path) {
           unless ($file_name) {
               if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
           }
           my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
           $msg->attach(Type     => $type,
                        Path     => $attachment_path,
                        Filename => $file_name
                        );
       # Otherwise attach text if given
       } elsif ($attachment_text) {
           $msg->attach(Type => 'TEXT',
                        Data => $attachment_text);
       }
       # Send it
       $msg->send('sendmail');
   }
   
   ############################################################
   ############################################################
   
   =pod
   
 =head1 Course Catalog Routines  =head1 Course Catalog Routines
   
 =over 4  =over 4
Line 14597  sub extract_categories { Line 15402  sub extract_categories {
                     $trailstr = &mt('Official courses (with institutional codes)');                      $trailstr = &mt('Official courses (with institutional codes)');
                 } elsif ($name eq 'communities') {                  } elsif ($name eq 'communities') {
                     $trailstr = &mt('Communities');                      $trailstr = &mt('Communities');
                   } elsif ($name eq 'placement') {
                       $trailstr = &mt('Placement Tests');
                 } else {                  } else {
                     $trailstr = $name;                      $trailstr = $name;
                 }                  }
Line 14663  sub recurse_categories { Line 15470  sub recurse_categories {
         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {          for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
             my $name = $cats->[$depth]{$category}[$k];              my $name = $cats->[$depth]{$category}[$k];
             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;              my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
             my $trailstr = join(' -&gt; ',(@{$parents},$category));              my $trailstr = join(' &raquo; ',(@{$parents},$category));
             if ($allitems->{$item} eq '') {              if ($allitems->{$item} eq '') {
                 push(@{$trails},$trailstr);                  push(@{$trails},$trailstr);
                 $allitems->{$item} = scalar(@{$trails})-1;                  $allitems->{$item} = scalar(@{$trails})-1;
Line 14746  sub assign_categories_table { Line 15553  sub assign_categories_table {
                     next if ($parent eq 'instcode');                      next if ($parent eq 'instcode');
                     if ($type eq 'Community') {                      if ($type eq 'Community') {
                         next unless ($parent eq 'communities');                          next unless ($parent eq 'communities');
                       } elsif ($type eq 'Placement') {
                           next unless ($parent eq 'placement');
                     } else {                      } else {
                         next if ($parent eq 'communities');                          next if (($parent eq 'communities') || ($parent eq 'placement'));
                     }                      }
                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';                      my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                     my $item = &escape($parent).'::0';                      my $item = &escape($parent).'::0';
Line 14760  sub assign_categories_table { Line 15569  sub assign_categories_table {
                     my $parent_title = $parent;                      my $parent_title = $parent;
                     if ($parent eq 'communities') {                      if ($parent eq 'communities') {
                         $parent_title = &mt('Communities');                          $parent_title = &mt('Communities');
                       } elsif ($parent eq 'placement') {
                           $parent_title = &mt('Placement Tests');
                     }                      }
                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.                      $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                               '<input type="checkbox" name="usecategory" value="'.                                '<input type="checkbox" name="usecategory" value="'.
Line 14990  sub commit_studentrole { Line 15801  sub commit_studentrole {
                     }                      }
                 }                  }
             } else {              } else {
                 if ($secchange) {                         if ($secchange) { 
                     $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;                      $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
                 } else {                  } else {
                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;                      $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
Line 15069  sub check_clone { Line 15880  sub check_clone {
  my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});   my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             if ($clonedesc{'type'} ne 'Community') {              if ($clonedesc{'type'} ne 'Community') {
                  $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});                  $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                 return ($can_clone, $clonemsg, $cloneid, $clonehome);                  return ($can_clone, $clonemsg, $cloneid, $clonehome);
             }              }
         }          }
Line 15087  sub check_clone { Line 15898  sub check_clone {
                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {                              if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                                 $can_clone = 1;                                  $can_clone = 1;
                             }                              }
                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&                          } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {                                   ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},                              if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {                                                                            $clonehash{'internal.coursecode'},$args->{'crscode'})) {
Line 15106  sub check_clone { Line 15917  sub check_clone {
                     $can_clone = 1;                      $can_clone = 1;
                 }                  }
                 unless ($can_clone) {                  unless ($can_clone) {
                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&                      if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {                          ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                         my (%gotdomdefaults,%gotcodedefaults);                          my (%gotdomdefaults,%gotcodedefaults);
                         foreach my $cloner (@cloners) {                          foreach my $cloner (@cloners) {
Line 15145  sub check_clone { Line 15956  sub check_clone {
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     $ccrole = 'co';                      $ccrole = 'co';
                 }                  }
                 my %roleshash =          my %roleshash =
                     &Apache::lonnet::get_my_roles($args->{'ccuname'},      &Apache::lonnet::get_my_roles($args->{'ccuname'},
                                                   $args->{'ccdomain'},            $args->{'ccdomain'},
                                                   'userroles',['active'],[$ccrole],                                                    'userroles',['active'],[$ccrole],
                                                   [$args->{'clonedomain'}]);            [$args->{'clonedomain'}]);
                 if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {          if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                     $can_clone = 1;                      $can_clone = 1;
                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},                  } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                                                           $args->{'ccuname'},$args->{'ccdomain'})) {                                                            $args->{'ccuname'},$args->{'ccdomain'})) {
Line 15162  sub check_clone { Line 15973  sub check_clone {
                     $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                 } else {                  } else {
                     $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
         }                  }
     }      }
         }          }
     }      }
Line 15199  sub construct_course { Line 16010  sub construct_course {
 #  #
 # Open course  # Open course
 #  #
     my $crstype = lc($args->{'crstype'});      my $showncrstype;
       if ($args->{'crstype'} eq 'Placement') {
           $showncrstype = 'placement test'; 
       } else {  
           $showncrstype = lc($args->{'crstype'});
       }
     my %cenv=();      my %cenv=();
     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},      $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                                              $args->{'cdescr'},                                               $args->{'cdescr'},
Line 15216  sub construct_course { Line 16032  sub construct_course {
     # Utils::Course. This needs to at least be output as a comment      # Utils::Course. This needs to at least be output as a comment
     # if anyone ever decides to not show this, and Utils::Course::new      # if anyone ever decides to not show this, and Utils::Course::new
     # will need to be suitably modified.      # will need to be suitably modified.
     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;      $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
     if ($$courseid =~ /^error:/) {      if ($$courseid =~ /^error:/) {
         return (0,$outcome);          return (0,$outcome);
     }      }
Line 15236  sub construct_course { Line 16052  sub construct_course {
 # Do the cloning  # Do the cloning
 #     #   
     if ($can_clone && $cloneid) {      if ($can_clone && $cloneid) {
  $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);   $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
  if ($context ne 'auto') {   if ($context ne 'auto') {
     $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';      $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
  }   }
Line 15404  sub construct_course { Line 16220  sub construct_course {
             $outcome .= $linefeed;              $outcome .= $linefeed;
         } else {          } else {
             $outcome .= "</ul><br /><br /></div>\n";              $outcome .= "</ul><br /><br /></div>\n";
         }          } 
     }      }
     if ($args->{'no_end_date'}) {      if ($args->{'no_end_date'}) {
         $args->{'endaccess'} = 0;          $args->{'endaccess'} = 0;
Line 15473  sub construct_course { Line 16289  sub construct_course {
             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {              if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;                  $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');                  my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
             }              } 
             if (ref($coderef)) {              if (ref($coderef)) {
                 $$coderef = $code;                  $$coderef = $code;
             }              }
Line 15510  sub construct_course { Line 16326  sub construct_course {
 # Open all assignments  # Open all assignments
 #  #
     if ($args->{'openall'}) {      if ($args->{'openall'}) {
        my $opendate = time;  
        if ($args->{'openallfrom'} =~ /^\d+$/) {  
            $opendate = $args->{'openallfrom'};  
        }  
        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';         my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
        my %storecontent = ($storeunder         => $opendate,         my %storecontent = ($storeunder         => time,
                            $storeunder.'.type' => 'date_start');                             $storeunder.'.type' => 'date_start');
        $outcome .= &mt('All assignments open starting [_1]',         
                        &Apache::lonlocal::locallocaltime($opendate)).': '.         $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
                    &Apache::lonnet::cput                   ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
                        ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;  
    }     }
 #  #
 # Set first page  # Set first page
Line 15550  sub construct_course { Line 16361  sub construct_course {
         $outcome .= ($fatal?$errtext:'write ok').$linefeed;          $outcome .= ($fatal?$errtext:'write ok').$linefeed;
     }      }
   
   # 
   # Set params for Placement Tests
   #
       if ($args->{'crstype'} eq 'Placement') {
          my %storecontent; 
          my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
          my %defaults = (
                           buttonshide   => { value => 'yes',
                                              type => 'string_yesno',},
                           type          => { value => 'randomizetry',
                                              type  => 'string_questiontype',},
                           maxtries      => { value => 1,
                                              type => 'int_pos',},
                           problemstatus => { value => 'no',
                                              type  => 'string_problemstatus',},
                         );
          foreach my $key (keys(%defaults)) {
              $storecontent{$prefix.$key} = $defaults{$key}{'value'};
              $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
          }
          &Apache::lonnet::cput
                    ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
       }
   
     return (1,$outcome);      return (1,$outcome);
 }  }
   
Line 15563  sub make_unique_code { Line 16398  sub make_unique_code {
     my $tries = 0;      my $tries = 0;
     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);      my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
     my ($code,$error);      my ($code,$error);
     
     while (($gotlock ne 'ok') && ($tries<3)) {      while (($gotlock ne 'ok') && ($tries<3)) {
         $tries ++;          $tries ++;
         sleep 1;          sleep 1;
Line 15610  sub generate_code { Line 16445  sub generate_code {
 ############################################################  ############################################################
 ############################################################  ############################################################
   
 #SD  # Community, Course and Placement Test
 # only Community and Course, or anything else?  
 sub course_type {  sub course_type {
     my ($cid) = @_;      my ($cid) = @_;
     if (!defined($cid)) {      if (!defined($cid)) {
Line 15629  sub group_term { Line 16463  sub group_term {
     my %names = (      my %names = (
                   'Course' => 'group',                    'Course' => 'group',
                   'Community' => 'group',                    'Community' => 'group',
                     'Placement' => 'group',
                 );                  );
     return $names{$crstype};      return $names{$crstype};
 }  }
   
 sub course_types {  sub course_types {
     my @types = ('official','unofficial','community','textbook');      my @types = ('official','unofficial','community','textbook','placement','lti');
     my %typename = (      my %typename = (
                          official   => 'Official course',                           official   => 'Official course',
                          unofficial => 'Unofficial course',                           unofficial => 'Unofficial course',
                          community  => 'Community',                           community  => 'Community',
                          textbook   => 'Textbook course',                           textbook   => 'Textbook course',
                            placement  => 'Placement test',
                            lti        => 'LTI provider',
                    );                     );
     return (\@types,\%typename);      return (\@types,\%typename);
 }  }
Line 15719  sub compare_arrays { Line 16556  sub compare_arrays {
     return @difference;      return @difference;
 }  }
   
   sub lon_status_items {
       my %defaults = (
                        E         => 100,
                        W         => 4,
                        N         => 1,
                        U         => 5,
                        threshold => 200,
                        sysmail   => 2500,
                      );
       my %names = (
                      E => 'Errors',
                      W => 'Warnings',
                      N => 'Notices',
                      U => 'Unsent',
                   );
       return (\%defaults,\%names);
   }
   
 # -------------------------------------------------------- Initialize user login  # -------------------------------------------------------- Initialize user login
 sub init_user_environment {  sub init_user_environment {
     my ($r, $username, $domain, $authhost, $form, $args) = @_;      my ($r, $username, $domain, $authhost, $form, $args) = @_;
Line 15726  sub init_user_environment { Line 16581  sub init_user_environment {
   
     my $public=($username eq 'public' && $domain eq 'public');      my $public=($username eq 'public' && $domain eq 'public');
   
 # See if old ID present, if so, remove  
   
     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);      my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
     my $now=time;      my $now=time;
   
Line 15749  sub init_user_environment { Line 16602  sub init_user_environment {
  }   }
  if (!$cookie) { $cookie="publicuser_$oldest"; }   if (!$cookie) { $cookie="publicuser_$oldest"; }
     } else {      } else {
  # if this isn't a robot, kill any existing non-robot sessions   # See if old ID present, if so, remove if this isn't a robot,
    # killing any existing non-robot sessions
  if (!$args->{'robot'}) {   if (!$args->{'robot'}) {
     opendir(DIR,$lonids);      opendir(DIR,$lonids);
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
Line 15805  sub init_user_environment { Line 16659  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) {
     } else {  
  undef(%userenv);   undef(%userenv);
     }      }
     if (($userenv{'interface'}) && (!$form->{'interface'})) {      if (($userenv{'interface'}) && (!$form->{'interface'})) {
Line 15877  sub init_user_environment { Line 16730  sub init_user_environment {
                                                       undef,\%userenv,\%domdef,\%is_adv);                                                        undef,\%userenv,\%domdef,\%is_adv);
             }              }
   
             foreach my $crstype ('official','unofficial','community','textbook') {              foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
                 $userenv{'canrequest.'.$crstype} =                  $userenv{'canrequest.'.$crstype} =
                     &Apache::lonnet::usertools_access($username,$domain,$crstype,                      &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                       'reload','requestcourses',                                                        'reload','requestcourses',
Line 15891  sub init_user_environment { Line 16744  sub init_user_environment {
             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],              my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                                                  $domain,$username);                                                   $domain,$username);
             my $reqstatus = $reqauthor{'author_status'};              my $reqstatus = $reqauthor{'author_status'};
             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {              if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                 if (ref($reqauthor{'author'}) eq 'HASH') {                  if (ref($reqauthor{'author'}) eq 'HASH') {
                     $userenv{'requestauthorqueued'} = $reqstatus.':'.                      $userenv{'requestauthorqueued'} = $reqstatus.':'.
                                                       $reqauthor{'author'}{'timestamp'};                                                        $reqauthor{'author'}{'timestamp'};
                 }                  }
             }              }
               my ($types,$typename) = &course_types();
               if (ref($types) eq 'ARRAY') {
                   my @options = ('approval','validate','autolimit');
                   my $optregex = join('|',@options);
                   my (%willtrust,%trustchecked);
                   foreach my $type (@{$types}) {
                       my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
                       if ($dom_str ne '') {
                           my $updatedstr = '';
                           my @possdomains = split(',',$dom_str);
                           foreach my $entry (@possdomains) {
                               my ($extdom,$extopt) = split(':',$entry);
                               unless ($trustchecked{$extdom}) {
                                   $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
                                   $trustchecked{$extdom} = 1;
                               }
                               if ($willtrust{$extdom}) {
                                   $updatedstr .= $entry.',';
                               }
                           }
                           $updatedstr =~ s/,$//;
                           if ($updatedstr) {
                               $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
                           } else {
                               delete($userenv{'reqcrsotherdom.'.$type});
                           }
                       }
                   }
               }
         }          }
   
  $env{'user.environment'} = "$lonids/$cookie.id";   $env{'user.environment'} = "$lonids/$cookie.id";
   
  if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",   if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
Line 16002  and quotacheck.pl Line 16883  and quotacheck.pl
   
 Inputs:  Inputs:
   
 filterlist - anonymous array of fields to include as potential filters  filterlist - anonymous array of fields to include as potential filters 
   
 crstype - course type  crstype - course type
   
 roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used  roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
               to pop-open a course selector (will contain "extra element").                to pop-open a course selector (will contain "extra element"). 
   
 multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1  multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
   
Line 16023  cloneruname - username of owner of new c Line 16904  cloneruname - username of owner of new c
   
 clonerudom - domain of owner of new course who wants to clone  clonerudom - domain of owner of new course who wants to clone
   
 typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)  typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
   
 codetitlesref - reference to array of titles of components in institutional codes (official courses)  codetitlesref - reference to array of titles of components in institutional codes (official courses)
   
 codedom - domain  codedom - domain
   
 formname - value of form element named "form".  formname - value of form element named "form". 
   
 fixeddom - domain, if fixed.  fixeddom - domain, if fixed.
   
 prevphase - value to assign to form element named "phase" when going back to the previous screen  prevphase - value to assign to form element named "phase" when going back to the previous screen  
   
 cnameelement - name of form element in form on opener page which will receive title of selected course  cnameelement - name of form element in form on opener page which will receive title of selected course 
   
 cnumelement - name of form element in form on opener page which will receive courseID  of selected course  cnumelement - name of form element in form on opener page which will receive courseID  of selected course
   
Line 16126  sub build_filters { Line 17007  sub build_filters {
         $createdfilterform = &timebased_select_form('createdfilter',$filter);          $createdfilterform = &timebased_select_form('createdfilter',$filter);
     }      }
   
       my $prefix = $crstype;
       if ($crstype eq 'Placement') {
           $prefix = 'Placement Test'
       }
     my %lt = &Apache::lonlocal::texthash(      my %lt = &Apache::lonlocal::texthash(
                 'cac' => "$crstype Activity",                  'cac' => "$prefix Activity",
                 'ccr' => "$crstype Created",                  'ccr' => "$prefix Created",
                 'cde' => "$crstype Title",                  'cde' => "$prefix Title",
                 'cdo' => "$crstype Domain",                  'cdo' => "$prefix Domain",
                 'ins' => 'Institutional Code',                  'ins' => 'Institutional Code',
                 'inc' => 'Institutional Categorization',                  'inc' => 'Institutional Categorization',
                 'cow' => "$crstype Owner/Co-owner",                  'cow' => "$prefix Owner/Co-owner",
                 'cop' => "$crstype Personnel Includes",                  'cop' => "$prefix Personnel Includes",
                 'cog' => 'Type',                  'cog' => 'Type',
              );               );
   
Line 16142  sub build_filters { Line 17027  sub build_filters {
         my $typeval = 'Course';          my $typeval = 'Course';
         if ($crstype eq 'Community') {          if ($crstype eq 'Community') {
             $typeval = 'Community';              $typeval = 'Community';
           } elsif ($crstype eq 'Placement') {
               $typeval = 'Placement';
         }          }
         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';          $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
     } else {      } else {
Line 16150  sub build_filters { Line 17037  sub build_filters {
             $typeselectform .= ' onchange="'.$onchange.'"';              $typeselectform .= ' onchange="'.$onchange.'"';
         }          }
         $typeselectform .= '>'."\n";          $typeselectform .= '>'."\n";
         foreach my $posstype ('Course','Community') {          foreach my $posstype ('Course','Community','Placement') {
               my $shown;
               if ($posstype eq 'Placement') {
                   $shown = &mt('Placement Test');
               } else {
                   $shown = &mt($posstype);
               }
             $typeselectform.='<option value="'.$posstype.'"'.              $typeselectform.='<option value="'.$posstype.'"'.
                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";                  ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
         }          }
         $typeselectform.="</select>";          $typeselectform.="</select>";
     }      }
Line 16177  sub build_filters { Line 17070  sub build_filters {
         if (exists($filter->{'instcodefilter'})) {          if (exists($filter->{'instcodefilter'})) {
 #            if (($fixeddom) || ($formname eq 'requestcrs') ||  #            if (($fixeddom) || ($formname eq 'requestcrs') ||
 #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {  #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
             if ($codedom) {              if ($codedom) { 
                 $officialjs = 1;                  $officialjs = 1;
                 ($instcodeform,$jscript,$$numtitlesref) =                  ($instcodeform,$jscript,$$numtitlesref) =
                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',                      &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
Line 16306  $typeelement Line 17199  $typeelement
     return $jscript.$clonewarning.$output;      return $jscript.$clonewarning.$output;
 }  }
   
 =pod  =pod 
   
 =item * &timebased_select_form()  =item * &timebased_select_form()
   
Line 16321  item - name of form element (sincefilter Line 17214  item - name of form element (sincefilter
 filter - anonymous hash of criteria and their values  filter - anonymous hash of criteria and their values
   
 Returns: HTML for a select box contained a blank, then six time selections,  Returns: HTML for a select box contained a blank, then six time selections,
          with value set in incoming form variables currently selected.           with value set in incoming form variables currently selected. 
   
 Side Effects: None  Side Effects: None
   
Line 16358  page load completion for page showing se Line 17251  page load completion for page showing se
   
 Inputs: None  Inputs: None
   
 Returns: markup containing updateFilters() and hideSearching() javascript functions.  Returns: markup containing updateFilters() and hideSearching() javascript functions. 
   
 Side Effects: None  Side Effects: None
   
Line 16397  to retrieve a hash for which keys are co Line 17290  to retrieve a hash for which keys are co
   
 Inputs:  Inputs:
   
 dom - domain being searched  dom - domain being searched 
   
 type - course type ('Course' or 'Community' or '.' if any).  type - course type ('Course' or 'Community' or '.' if any).
   
Line 16409  cloneruname - optional username of new c Line 17302  cloneruname - optional username of new c
   
 clonerudom - optional domain of new course owner  clonerudom - optional domain of new course owner
   
 domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,  domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
             (used when DC is using course creation form)              (used when DC is using course creation form)
   
 codetitles - reference to array of titles of components in institutional codes (official courses).  codetitles - reference to array of titles of components in institutional codes (official courses).
Line 16419  cc_clone - escaped comma separated list Line 17312  cc_clone - escaped comma separated list
   
 reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone  reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
   
 reqinstcode - institutional code of new course, where search_courses is used to identify potential  reqinstcode - institutional code of new course, where search_courses is used to identify potential 
               courses to clone                courses to clone 
   
 Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.  Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
   
Line 16546  $required - LON-CAPA version needed by c Line 17439  $required - LON-CAPA version needed by c
   
 Returns:  Returns:
   
 $switchserver - query string tp append to /adm/switchserver call (if  $switchserver - query string tp append to /adm/switchserver call (if 
                 current server's LON-CAPA version is too old.                  current server's LON-CAPA version is too old. 
   
 $warning - Message is displayed if no suitable server could be found.  $warning - Message is displayed if no suitable server could be found.
   
Line 16660  Inputs: Line 17553  Inputs:
 $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)  $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
   
 $interval (optional) - Time which may elapse (in s) between last check for content  $interval (optional) - Time which may elapse (in s) between last check for content
                        change in current course. (default: 600 s).                         change in current course. (default: 600 s).  
   
 Returns: an array; first element is:  Returns: an array; first element is:
   
Line 16668  Returns: an array; first element is: Line 17561  Returns: an array; first element is:
   
 'switch' - if content updates mean user's session  'switch' - if content updates mean user's session
            needs to be switched to a server running a newer LON-CAPA version             needs to be switched to a server running a newer LON-CAPA version
    
 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)  'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
            on current server hosting user's session             on current server hosting user's session                
   
 ''       - if no action required.  ''       - if no action required.
   
Line 16678  Returns: an array; first element is: Line 17571  Returns: an array; first element is:
   
 If first item element is 'switch':  If first item element is 'switch':
   
 second item is $switchwarning - Warning message if no suitable server found to host session.  second item is $switchwarning - Warning message if no suitable server found to host session. 
   
 third item is $switchserver - query string to append to /adm/switchserver containing lonHostID  third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                               and current role.                                and current role. 
   
 otherwise: no other elements returned.  otherwise: no other elements returned.
   
Line 16699  sub needs_coursereinit { Line 17592  sub needs_coursereinit {
         $interval = 600;          $interval = 600;
     }      }
     if (($now-$env{'request.course.timechecked'})>$interval) {      if (($now-$env{'request.course.timechecked'})>$interval) {
         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);  
         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});          &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
           my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
           if ($blocked) {
               return ();
           }
           my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
         if ($lastchange > $env{'request.course.tied'}) {          if ($lastchange > $env{'request.course.tied'}) {
             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');              my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {              if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
Line 16723  sub needs_coursereinit { Line 17620  sub needs_coursereinit {
 }  }
   
 sub update_content_constraints {  sub update_content_constraints {
     my ($cdom,$cnum,$chome,$cid) = @_;      my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');      my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});      my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
     my %checkresponsetypes;      my (%checkresponsetypes,%checkcrsrestypes);
     foreach my $key (keys(%Apache::lonnet::needsrelease)) {      foreach my $key (keys(%Apache::lonnet::needsrelease)) {
         my ($item,$name,$value) = split(/:/,$key);          my ($item,$name,$value) = split(/:/,$key);
         if ($item eq 'resourcetag') {          if ($item eq 'resourcetag') {
             if ($name eq 'responsetype') {              if ($name eq 'responsetype') {
                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}                  $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
             }              }
           } elsif ($item eq 'course') {
               if ($name eq 'courserestype') {
                   $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
               }
         }          }
     }      }
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
     if (defined($navmap)) {      if (defined($navmap)) {
         my %allresponses;          my (%allresponses,%allcrsrestypes);
         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {          foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
               if ($res->is_tool()) {
                   if ($allcrsrestypes{'exttool'}) {
                       $allcrsrestypes{'exttool'} ++;
                   } else {
                       $allcrsrestypes{'exttool'} = 1;
                   }
                   next;
               }
             my %responses = $res->responseTypes();              my %responses = $res->responseTypes();
             foreach my $key (keys(%responses)) {              foreach my $key (keys(%responses)) {
                 next unless(exists($checkresponsetypes{$key}));                  next unless(exists($checkresponsetypes{$key}));
Line 16751  sub update_content_constraints { Line 17660  sub update_content_constraints {
                 ($reqdmajor,$reqdminor) = ($major,$minor);                  ($reqdmajor,$reqdminor) = ($major,$minor);
             }              }
         }          }
           foreach my $key (keys(%allcrsrestypes)) {
               my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
               if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   ($reqdmajor,$reqdminor) = ($major,$minor);
               }
           }
         undef($navmap);          undef($navmap);
     }      }
       my (@resources,@order,@resparms,@zombies);
       if ($keeporder) {
           use LONCAPA::map;
           @resources = @LONCAPA::map::resources;
           @order = @LONCAPA::map::order;
           @resparms = @LONCAPA::map::resparms;
           @zombies = @LONCAPA::map::zombies;
       }
       my $suppmap = 'supplemental.sequence';
       my ($suppcount,$supptools,$errors) = (0,0,0);
       ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
                                                               $suppcount,$supptools,$errors);
       if ($keeporder) {
           @LONCAPA::map::resources = @resources;
           @LONCAPA::map::order = @order;
           @LONCAPA::map::resparms = @resparms;
           @LONCAPA::map::zombies = @zombies;
       }
       if ($supptools) {
           my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
           if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
               ($reqdmajor,$reqdminor) = ($major,$minor);
           }
       }
     unless (($reqdmajor eq '') && ($reqdminor eq '')) {      unless (($reqdmajor eq '') && ($reqdminor eq '')) {
         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);          &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
     }      }
Line 16773  sub allmaps_incourse { Line 17712  sub allmaps_incourse {
     if ($lastchange > $env{'request.course.tied'}) {      if ($lastchange > $env{'request.course.tied'}) {
         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");          my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
         unless ($ferr) {          unless ($ferr) {
             &update_content_constraints($cdom,$cnum,$chome,$cid);              &update_content_constraints($cdom,$cnum,$chome,$cid,1);
         }          }
     }      }
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
Line 16809  sub parse_supplemental_title { Line 17748  sub parse_supplemental_title {
 }  }
   
 sub recurse_supplemental {  sub recurse_supplemental {
     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;      my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
     if ($suppmap) {      if ($suppmap) {
         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);          my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
         if ($fatal) {          if ($fatal) {
Line 16820  sub recurse_supplemental { Line 17759  sub recurse_supplemental {
                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);                      my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                     if (($src ne '') && ($status eq 'res')) {                      if (($src ne '') && ($status eq 'res')) {
                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {                          if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);                              ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
                                                                      $numfiles,$numexttools,$errors);
                         } else {                          } else {
                               if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
                                   $numexttools ++;
                               }
                             $numfiles ++;                              $numfiles ++;
                         }                          }
                     }                      }
Line 16829  sub recurse_supplemental { Line 17772  sub recurse_supplemental {
             }              }
         }          }
     }      }
     return ($numfiles,$errors);      return ($numfiles,$numexttools,$errors);
 }  }
   
 sub symb_to_docspath {  sub symb_to_docspath {
Line 16905  sub symb_to_docspath { Line 17848  sub symb_to_docspath {
 sub captcha_display {  sub captcha_display {
     my ($context,$lonhost,$defdom) = @_;      my ($context,$lonhost,$defdom) = @_;
     my ($output,$error);      my ($output,$error);
     my ($captcha,$pubkey,$privkey,$version) =      my ($captcha,$pubkey,$privkey,$version) = 
         &get_captcha_config($context,$lonhost,$defdom);          &get_captcha_config($context,$lonhost,$defdom);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         $output = &create_captcha();          $output = &create_captcha();
Line 16976  sub get_captcha_config { Line 17919  sub get_captcha_config {
                 $captcha = 'recaptcha';                  $captcha = 'recaptcha';
                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};                  $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                 if ($version ne '2') {                  if ($version ne '2') {
                     $version = 1;                      $version = 1; 
                 }                  }
             } else {              } else {
                 $captcha = 'original';                  $captcha = 'original';
Line 17005  sub get_captcha_config { Line 17948  sub get_captcha_config {
                 $captcha = 'original';                  $captcha = 'original';
             }              }
         }          }
     }      } 
     return ($captcha,$pubkey,$privkey,$version);      return ($captcha,$pubkey,$privkey,$version);
 }  }
   
Line 17029  sub create_captcha { Line 17972  sub create_captcha {
             last;              last;
         }          }
     }      }
       if ($output eq '') {
           &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
       }
     return $output;      return $output;
 }  }
   
Line 17079  sub create_recaptcha { Line 18025  sub create_recaptcha {
                &mt('If the text is hard to read, [_1] will replace them.',                 &mt('If the text is hard to read, [_1] will replace them.',
                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').                     '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                '<br /><br />';                 '<br /><br />';
      }      }
 }  }
   
 sub check_recaptcha {  sub check_recaptcha {
     my ($privkey,$version) = @_;      my ($privkey,$version) = @_;
     my $captcha_chk;      my $captcha_chk;
     if ($version >= 2) {      if ($version >= 2) {
         my $ua = LWP::UserAgent->new;  
         $ua->timeout(10);  
         my %info = (          my %info = (
                      secret   => $privkey,                       secret   => $privkey, 
                      response => $env{'form.g-recaptcha-response'},                       response => $env{'form.g-recaptcha-response'},
                      remoteip => $ENV{'REMOTE_ADDR'},                       remoteip => $ENV{'REMOTE_ADDR'},
                    );                     );
         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);          my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
           $request->content(join('&',map {
                            my $name = escape($_);
                            "$name=" . ( ref($info{$_}) eq 'ARRAY'
                            ? join("&$name=", map {escape($_) } @{$info{$_}})
                            : &escape($info{$_}) );
           } keys(%info)));
           my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
         if ($response->is_success)  {          if ($response->is_success)  {
             my $data = JSON::DWIW->from_json($response->decoded_content);              my $data = JSON::DWIW->from_json($response->decoded_content);
             if (ref($data) eq 'HASH') {              if (ref($data) eq 'HASH') {
Line 17156  sub cleanup_html { Line 18107  sub cleanup_html {
   
 # Checks for critical messages and returns a redirect url if one exists.  # Checks for critical messages and returns a redirect url if one exists.
 # $interval indicates how often to check for messages.  # $interval indicates how often to check for messages.
   # $context is the calling context -- roles, grades, contents, menu or flip. 
 sub critical_redirect {  sub critical_redirect {
     my ($interval) = @_;      my ($interval,$context) = @_;
     if ((time-$env{'user.criticalcheck.time'})>$interval) {      if ((time-$env{'user.criticalcheck.time'})>$interval) {
         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},          if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
               my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
               my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
               my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
               if ($blocked) {
                   my $checkrole = "cm./$cdom/$cnum";
                   if ($env{'request.course.sec'} ne '') {
                       $checkrole .= "/$env{'request.course.sec'}";
                   }
                   unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                           ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                       return;
                   }
               }
           }
           my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                                         $env{'user.name'});                                          $env{'user.name'});
         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});          &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
         my $redirecturl;          my $redirecturl;
         if ($what[0]) {          if ($what[0]) {
             if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {      if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                 $redirecturl='/adm/email?critical=display';          $redirecturl='/adm/email?critical=display';
                 my $url=&Apache::lonnet::absolute_url().$redirecturl;          my $url=&Apache::lonnet::absolute_url().$redirecturl;
                 return (1, $url);                  return (1, $url);
             }              }
         }          }
     }      } 
     return ();      return ();
 }  }
   
Line 17224  sub des_decrypt { Line 18191  sub des_decrypt {
     return $plaintext;      return $plaintext;
 }  }
   
   sub make_short_symbs {
       my ($cdom,$cnum,$navmap) = @_;
       return unless (ref($navmap));
       my ($numnew,@errors);
       my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
       if (@toshorten) {
           my (%maps,%resources,%titles);
           &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                                                                  'shorturls',$cdom,$cnum);
           my %tocreate;
           if (keys(%resources)) {
               foreach my $item (sort {$a <=> $b} (@toshorten)) {
                   my $symb = $resources{$item};
                   if ($symb) {
                       $tocreate{$cnum.'&'.$symb} = 1;
                   }
               }
           }
           if (keys(%tocreate)) {
               my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
               my $su = Short::URL->new(no_vowels => 1);
               my $init = '';
               my (%newunique,%addcourse,%courseonly,%failed);
               # get lock on tiny db
               my $now = time;
               my $lockhash = {
                                   "lock\0$now" => $env{'user.name'}.
                                                   ':'.$env{'user.domain'},
                               };
               my $tries = 0;
               my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
               my ($code,$error);
               while (($gotlock ne 'ok') && ($tries<3)) {
                   $tries ++;
                   sleep 1;
                   $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
               }
               if ($gotlock eq 'ok') {
                   $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
                                          \%addcourse,\%courseonly,\%failed);
                   if (keys(%failed)) {
                       my $numfailed = scalar(keys(%failed));
                       push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
                   }
                   if (keys(%newunique)) {
                       my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
                       if ($putres eq 'ok') {
                           $numnew = scalar(keys(%newunique));
                           my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
                           unless ($newputres eq 'ok') {
                               push(@errors,&mt('error: could not store course look-up of short URLs'));
                           }
                       } else {
                           push(@errors,&mt('error: could not store unique six character URLs'));
                       }
                   }
                   my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
                   unless ($dellockres eq 'ok') {
                       push(@errors,&mt('error: could not release lockfile'));
                   }
               } else {
                   push(@errors,&mt('error: could not obtain lockfile'));
               }
               if (keys(%courseonly)) {
                   my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
                   if ($result ne 'ok') {
                       push(@errors,&mt('error: could not update course look-up of short URLs'));
                   }
               }
           }
       }
       return ($numnew,\@errors);
   }
   
   sub shorten_symbs {
       my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
       return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
                      (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
                      (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
       my (%possibles,%collisions);
       foreach my $key (keys(%{$tocreate})) {
           my $num = String::CRC32::crc32($key);
           my $tiny = $su->encode($num,$init);
           if ($tiny) {
               $possibles{$tiny} = $key;
           }
       }
       if (!$init) {
           $init = 1;
       } else {
           $init ++;
       }
       if (keys(%possibles)) {
           my @posstiny = keys(%possibles);
           my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
           my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
           if (keys(%currtiny)) {
               foreach my $key (keys(%currtiny)) {
                   next if ($currtiny{$key} eq '');
                   if ($currtiny{$key} eq $possibles{$key}) {
                       my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
                       unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
                           $courseonly->{$tsymb} = $key;
                       }
                   } else {
                       $collisions{$possibles{$key}} = 1;
                   }
                   delete($possibles{$key});
               }
           }
           foreach my $key (keys(%possibles)) {
               $newunique->{$key} = $possibles{$key};
               my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
               unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
                   $addcourse->{$tsymb} = $key;
               }
           }
       }
       if (keys(%collisions)) {
           if ($init <5) {
               if (!$init) {
                   $init = 1;
               } else {
                   $init ++;
               }
               $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
                                      $newunique,$addcourse,$courseonly,$failed);
           } else {
               foreach my $key (keys(%collisions)) {
                   $failed->{$key} = 1;
               }
           }
       }
       return $init;
   }
   
 sub is_nonframeable {  sub is_nonframeable {
     my ($url,$absolute,$hostname,$ip,$nocache) = @_;      my ($url,$absolute,$hostname,$ip,$nocache) = @_;
     my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);      my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
Line 17247  sub is_nonframeable { Line 18350  sub is_nonframeable {
     }      }
     my $uselink;      my $uselink;
     my $request = new HTTP::Request('HEAD',$url);      my $request = new HTTP::Request('HEAD',$url);
     my $ua = LWP::UserAgent->new;      my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
     $ua->timeout(5);  
     my $response=$ua->request($request);  
     if ($response->is_success()) {      if ($response->is_success()) {
         my $secpolicy = lc($response->header('content-security-policy'));          my $secpolicy = lc($response->header('content-security-policy'));
         my $xframeop = lc($response->header('x-frame-options'));          my $xframeop = lc($response->header('x-frame-options'));

Removed from v.1.1075.2.146  
changed lines
  Added in v.1.1340


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