Diff for /loncom/interface/loncommon.pm between versions 1.1231 and 1.1293

version 1.1231, 2016/01/22 22:42:47 version 1.1293, 2017/08/13 23:21:04
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 DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale::Catalog;  use DateTime::Locale;
 use Encode();  use Encode();
 use Text::Aspell;  use Text::Aspell;
 use Authen::Captcha;  use Authen::Captcha;
 use Captcha::reCAPTCHA;  use Captcha::reCAPTCHA;
   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::Lite;
 use MIME::Types;  use MIME::Types;
   use File::Copy();
   use File::Path::Tiny();
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);  use vars qw(%defaultdesign);
Line 265  BEGIN { Line 270  BEGIN {
  next if ($line =~ /^\#/);   next if ($line =~ /^\#/);
  chomp($line);   chomp($line);
                 my ($extension,$category)=(split(/\s+/,$line,2));                  my ($extension,$category)=(split(/\s+/,$line,2));
                 push @{$category_extensions{lc($category)}},$extension;                  push(@{$category_extensions{lc($category)}},$extension);
             }              }
             close($fh);              close($fh);
         }          }
Line 588  sub coursebrowser_javascript { Line 593  sub coursebrowser_javascript {
         if (formname == 'ccrs') {          if (formname == 'ccrs') {
             var ownername = document.forms[formid].ccuname.value;              var ownername = document.forms[formid].ccuname.value;
             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;              var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
             url += '&cloner='+ownername+':'+ownerdom+'&crscode='+document.forms[formid].crscode.value;              url += '&cloner='+ownername+':'+ownerdom;
               if (type == 'Course') {
                   url += '&crscode='+document.forms[formid].crscode.value;
               }
         }          }
         if (formname == 'requestcrs') {          if (formname == 'requestcrs') {
             url += '&crsdom=$domainfilter&crscode=$instcode';              url += '&crsdom=$domainfilter&crscode=$instcode';
Line 876  sub selectcourse_link { Line 884  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 936  ENDSCRT Line 946  ENDSCRT
 }  }
   
 sub select_timezone {  sub select_timezone {
    my ($name,$selected,$onchange,$includeempty)=@_;     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
    if ($includeempty) {     if ($includeempty) {
        $output .= '<option value=""';         $output .= '<option value=""';
        if (($selected eq '') || ($selected eq 'local')) {         if (($selected eq '') || ($selected eq 'local')) {
Line 958  sub select_timezone { Line 968  sub select_timezone {
 }  }
   
 sub select_datelocale {  sub select_datelocale {
     my ($name,$selected,$onchange,$includeempty)=@_;      my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";      my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
     if ($includeempty) {      if ($includeempty) {
         $output .= '<option value=""';          $output .= '<option value=""';
         if ($selected eq '') {          if ($selected eq '') {
Line 967  sub select_datelocale { Line 977  sub select_datelocale {
         }          }
         $output .= '> </option>';          $output .= '> </option>';
     }      }
       my @languages = &Apache::lonlocal::preferred_languages();
     my (@possibles,%locale_names);      my (@possibles,%locale_names);
     my @locales = DateTime::Locale::Catalog::Locales;      my @locales = DateTime::Locale->ids();
     foreach my $locale (@locales) {      foreach my $id (@locales) {
         if (ref($locale) eq 'HASH') {          if ($id ne '') {
             my $id = $locale->{'id'};              my ($en_terr,$native_terr);
             if ($id ne '') {              my $loc = DateTime::Locale->load($id);
                 my $en_terr = $locale->{'en_territory'};              if (ref($loc)) {
                 my $native_terr = $locale->{'native_territory'};                  $en_terr = $loc->name();
                 my @languages = &Apache::lonlocal::preferred_languages();                  $native_terr = $loc->native_name();
                 if (grep(/^en$/,@languages) || !@languages) {                  if (grep(/^en$/,@languages) || !@languages) {
                     if ($en_terr ne '') {                      if ($en_terr ne '') {
                         $locale_names{$id} = '('.$en_terr.')';                          $locale_names{$id} = '('.$en_terr.')';
Line 990  sub select_datelocale { Line 1001  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 1010  sub select_datelocale { Line 1021  sub select_datelocale {
 }  }
   
 sub select_language {  sub select_language {
     my ($name,$selected,$includeempty) = @_;      my ($name,$selected,$includeempty,$noedit) = @_;
     my %langchoices;      my %langchoices;
     if ($includeempty) {      if ($includeempty) {
         %langchoices = ('' => 'No language preference');          %langchoices = ('' => 'No language preference');
Line 1022  sub select_language { Line 1033  sub select_language {
         }          }
     }      }
     %langchoices = &Apache::lonlocal::texthash(%langchoices);      %langchoices = &Apache::lonlocal::texthash(%langchoices);
     return &select_form($selected,$name,\%langchoices);      return &select_form($selected,$name,\%langchoices,undef,$noedit);
 }  }
   
 =pod  =pod
Line 1046  sub list_languages { Line 1057  sub list_languages {
  if ($code) {   if ($code) {
     my $selector    = $supported_codes{$id};      my $selector    = $supported_codes{$id};
     my $description = &plainlanguagedescription($id);      my $description = &plainlanguagedescription($id);
     push (@lang_choices, [$selector, $description]);      push(@lang_choices, [$selector, $description]);
  }   }
     }      }
     return \@lang_choices;      return \@lang_choices;
Line 1086  linked_select_forms takes the following Line 1097  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 1140  sub linked_select_forms { Line 1154  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 1148  sub linked_select_forms { Line 1163  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});
         }          }
         $result.="\"@s2texts\");\n";          $result.="\"@s2texts\");\n";
     }      }
     $"=' ';      $"=' ';
     $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 1197  function select1_changed() { Line 1210  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 1765  RESIZE Line 1778  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 1947  sub colorfuleditor_js { Line 2116  sub colorfuleditor_js {
         }          }
     }      }
   
   $browse_or_search
   
 // ]]>  // ]]>
 </script>  </script>
Line 1999  sub insert_folding_button { Line 2168  sub insert_folding_button {
             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}}))) {
                       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;
                   }
               }
               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
   
 =head1 Excel and CSV file utility routines  =head1 Excel and CSV file utility routines
Line 2186  sub create_text_file { Line 2479  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 2258  sub multiple_select_form { Line 2565  sub multiple_select_form {
   
 =pod  =pod
   
 =item * &select_form($defdom,$name,$hashref,$onchange)  =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select options from a ref to a hash containing:  allow a user to select options from a ref to a hash containing:
 option_name => displayed text. An optional $onchange can include  option_name => displayed text. An optional $onchange can include
 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
   to be disabled, e.g., for the case where an instructor has a section-
   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 2449  sub select_level_form { Line 2759  sub select_level_form {
   
 =pod  =pod
   
 =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)  =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select the domain to preform an operation in.    allow a user to select the domain to preform an operation in.  
Line 2466  The optional $incdoms is a reference to Line 2776  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.
   
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
 sub select_dom_form {  sub select_dom_form {
     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;      my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
     }      }
       if ($disabled) {
           $disabled = ' disabled="disabled"';
       }
     my (@domains,%exclude);      my (@domains,%exclude);
     if (ref($incdoms) eq 'ARRAY') {      if (ref($incdoms) eq 'ARRAY') {
         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});          @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
Line 2484  sub select_dom_form { Line 2799  sub select_dom_form {
     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>\n";      my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
     foreach my $dom (@domains) {      foreach my $dom (@domains) {
         next if ($exclude{$dom});          next if ($exclude{$dom});
         $selectdomain.="<option value=\"$dom\" ".          $selectdomain.="<option value=\"$dom\" ".
Line 2860  sub authform_kerberos { Line 3175  sub authform_kerberos {
               @_,                @_,
               );                );
     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,      my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
         $autharg,$jscall);          $autharg,$jscall,$disabled);
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     if ($in{'kerb_def_auth'} eq 'krb5') {      if ($in{'kerb_def_auth'} eq 'krb5') {
        $check5 = ' checked="checked"';         $check5 = ' checked="checked"';
     } else {      } else {
        $check4 = ' checked="checked"';         $check4 = ' checked="checked"';
     }      }
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
     $krbarg = $in{'kerb_def_dom'};      $krbarg = $in{'kerb_def_dom'};
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'krb') {          if ($in{'curr_authtype'} eq 'krb') {
Line 2911  sub authform_kerberos { Line 3229  sub authform_kerberos {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="krb" />';                      $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2920  sub authform_kerberos { Line 3238  sub authform_kerberos {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="krb" '.          $authtype = '<input type="radio" name="login" value="krb" '.
                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.                      'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                     $krbcheck.' />';                      $krbcheck.$disabled.' />';
     }      }
     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||      if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&          ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
Line 2933  sub authform_kerberos { Line 3251  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               'onchange="'.$jscall.'"'.$disabled.' />',
          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',           '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',           '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
  '</label>');   '</label>');
     } elsif ($can_assign{'krb4'}) {      } elsif ($can_assign{'krb4'}) {
         $result .= &mt          $result .= &mt
Line 2944  sub authform_kerberos { Line 3262  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               'onchange="'.$jscall.'"'.$disabled.' />',
          '<label><input type="hidden" name="krbver" value="4" />',           '<label><input type="hidden" name="krbver" value="4" />',
          '</label>');           '</label>');
     } elsif ($can_assign{'krb5'}) {      } elsif ($can_assign{'krb5'}) {
Line 2954  sub authform_kerberos { Line 3272  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               'onchange="'.$jscall.'"'.$disabled.' />',
          '<label><input type="hidden" name="krbver" value="5" />',           '<label><input type="hidden" name="krbver" value="5" />',
          '</label>');           '</label>');
     }      }
Line 2967  sub authform_internal { Line 3285  sub authform_internal {
                 kerb_def_dom => 'MSU.EDU',                  kerb_def_dom => 'MSU.EDU',
                 @_,                  @_,
                 );                  );
     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);      my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'int') {          if ($in{'curr_authtype'} eq 'int') {
             if ($can_assign{'int'}) {              if ($can_assign{'int'}) {
Line 2997  sub authform_internal { Line 3318  sub authform_internal {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="int" />';                      $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 3005  sub authform_internal { Line 3326  sub authform_internal {
     $jscall = "javascript:changed_radio('int',$in{'formname'});";      $jscall = "javascript:changed_radio('int',$in{'formname'});";
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.          $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';                      ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
     }      }
     $autharg = '<input type="password" size="10" name="intarg" value="'.      $autharg = '<input type="password" size="10" name="intarg" value="'.
                $intarg.'" onchange="'.$jscall.'" />';                 $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
     $result = &mt      $result = &mt
         ('[_1] Internally authenticated (with initial password [_2])',          ('[_1] Internally authenticated (with initial password [_2])',
          '<label>'.$authtype,'</label>'.$autharg);           '<label>'.$authtype,'</label>'.$autharg);
     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';      $result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
     return $result;      return $result;
 }  }
   
Line 3022  sub authform_local { Line 3343  sub authform_local {
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);      my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
       if ($in{'readonly'}) {
           $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 3052  sub authform_local { Line 3376  sub authform_local {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="loc" />';                      $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 3061  sub authform_local { Line 3385  sub authform_local {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="loc" '.          $authtype = '<input type="radio" name="login" value="loc" '.
                     $loccheck.' onchange="'.$jscall.'" onclick="'.                      $loccheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'" />';                      $jscall.'"'.$disabled.' />';
     }      }
     $autharg = '<input type="text" size="10" name="locarg" value="'.      $autharg = '<input type="text" size="10" name="locarg" value="'.
                $locarg.'" onchange="'.$jscall.'" />';                 $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
     $result = &mt('[_1] Local Authentication with argument [_2]',      $result = &mt('[_1] Local Authentication with argument [_2]',
                   '<label>'.$authtype,'</label>'.$autharg);                    '<label>'.$authtype,'</label>'.$autharg);
     return $result;      return $result;
Line 3076  sub authform_filesystem { Line 3400  sub authform_filesystem {
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my ($fsyscheck,$result,$authtype,$autharg,$jscall);      my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'fsys') {          if ($in{'curr_authtype'} eq 'fsys') {
             if ($can_assign{'fsys'}) {              if ($can_assign{'fsys'}) {
Line 3090  sub authform_filesystem { Line 3417  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 3103  sub authform_filesystem { Line 3430  sub authform_filesystem {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="fsys" />';                      $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 3112  sub authform_filesystem { Line 3439  sub authform_filesystem {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="fsys" '.          $authtype = '<input type="radio" name="login" value="fsys" '.
                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.                      $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'" />';                      $jscall.'"'.$disabled.' />';
     }      }
     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.      $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                ' onchange="'.$jscall.'" />';                 ' 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><input type="radio" name="login" value="fsys" '.
          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',           $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
          '</label><input type="password" size="10" name="fsysarg" value="" '.           '</label><input type="password" size="10" name="fsysarg" value="" '.
                   'onchange="'.$jscall.'" />');                    'onchange="'.$jscall.'"'.$disabled.' />');
     return $result;      return $result;
 }  }
   
Line 3143  sub get_assignable_auth { Line 3470  sub get_assignable_auth {
             my $context;              my $context;
             if ($env{'request.role'} =~ /^au/) {              if ($env{'request.role'} =~ /^au/) {
                 $context = 'author';                  $context = 'author';
             } elsif ($env{'request.role'} =~ /^dc/) {              } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
                 $context = 'domain';                  $context = 'domain';
             } elsif ($env{'request.course.id'}) {              } elsif ($env{'request.course.id'}) {
                 $context = 'course';                  $context = 'course';
Line 3864  category Line 4191  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 4677  sub blockcheck { Line 5008  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 4761  sub blockcheck { Line 5093  sub blockcheck {
                                                                 $tdom,$spec,$trest,$area);                                                                  $tdom,$spec,$trest,$area);
                         }                          }
                     }                      }
                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);                      my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {                      if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                         if ($1) {                          if ($1) {
                             $no_userblock = 1;                              $no_userblock = 1;
Line 4785  sub blockcheck { Line 5117  sub blockcheck {
   
         # Retrieve blocking times and identity of locker for course          # Retrieve blocking times and identity of locker 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 4872  sub get_blocks { Line 5204  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 4959  sub blocking_status { Line 5297  sub blocking_status {
 # build a link to a popup window containing the details  # build a link to a popup window containing the details
     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') {      if (($activity eq 'port') || ($activity eq 'passwd')) {
         $querystring .= "&amp;udom=$udom"      if $udom;          $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
         $querystring .= "&amp;uname=$uname"    if $uname;          $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 4986  END_MYBLOCK Line 5324  END_MYBLOCK
         $class = '';          $class = '';
     } elsif ($activity eq 'printout') {      } elsif ($activity eq 'printout') {
         $text = &mt('Printing Blocked');          $text = &mt('Printing Blocked');
       } elsif ($activity eq 'passwd') {
           $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 5010  sub check_ip_acc { Line 5354  sub check_ip_acc {
         return 1;          return 1;
     }      }
     my $allowed;      my $allowed;
     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;      my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
   
     my $name;      my $name;
     my %access = (      my %access = (
Line 5414  sub CSTR_pageheader { Line 5758  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 $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="_top">' #FIXME lonpubdir: target="_parent"          .'" target="_top">' #FIXME lonpubdir: target="_parent"
         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);          .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
Line 5428  sub CSTR_pageheader { Line 5782  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.'/','_top','/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 5837  Inputs:
   
 =item * $args, optional argument valid values are  =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg              no_auto_mt_title -> prevents &mt()ing the title arg
             inherit_jsmath -> when creating popup window in a page,              use_absolute     -> for external resource or syllabus, this will
                               should it have jsmath forced on by the                                  contain https://<hostname> if server uses
                               current page                                  https (as per hosts.tab), but request is for http
               hostname         -> hostname, from $r->hostname().
   
 =item * $advtoolsref, optional argument, ref to an array containing  =item * $advtoolsref, optional argument, ref to an array containing
             inlineremote items to be added in "Functions" menu below              inlineremote items to be added in "Functions" menu below
Line 5506  sub bodytag { Line 5866  sub bodytag {
     }      }
     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }      if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
     my $httphost = $args->{'use_absolute'};      my $httphost = $args->{'use_absolute'};
       my $hostname = $args->{'hostname'};
   
     $function = &get_users_function() if (!$function);      $function = &get_users_function() if (!$function);
     my $img =    &designparm($function.'.img',$domain);      my $img =    &designparm($function.'.img',$domain);
Line 5533  sub bodytag { Line 5894  sub bodytag {
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         if ($env{'request.role'} !~ /^cr/) {          if ($env{'request.role'} !~ /^cr/) {
             $role = &Apache::lonnet::plaintext($role,&course_type());              $role = &Apache::lonnet::plaintext($role,&course_type());
           } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
               if ($env{'request.role.desc'}) {
                   $role = $env{'request.role.desc'};
               } else {
                   $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
               }
           } else {
               $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 5548  sub bodytag { Line 5917  sub bodytag {
   
 # construct main body tag  # construct main body tag
     my $bodytag = "<body $extra_body_attr>".      my $bodytag = "<body $extra_body_attr>".
  &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});   &Apache::lontexconvert::init_math_support();
   
     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);      &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
   
Line 5572  sub bodytag { Line 5941  sub bodytag {
         $dc_info =~ s/\s+$//;          $dc_info =~ s/\s+$//;
     }      }
   
     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;      my $crstype;
       if ($env{'request.course.id'}) {
           $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
       } elsif ($args->{'crstype'}) {
           $crstype = $args->{'crstype'};
       }
       if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
           undef($role);
       } 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') { $forcereg=1; }
   
Line 5583  sub bodytag { Line 5962  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();          my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
   
         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {          if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
              if ($dc_info) {               if ($dc_info) {
Line 5616  sub bodytag { Line 5995  sub bodytag {
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');              $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {              if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,
                                 $args->{'bread_crumbs'});                                  $args->{'bread_crumbs'},'','',$hostname);
             } elsif ($forcereg) {              } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                             $args->{'group'});                                                              $args->{'group'},
                                                               $args->{'hide_buttons'},
                                                               $hostname);
             } else {              } else {
                 $bodytag .=                   $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);                                                          $advtoolsref,'',$hostname);
             }              }
         }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 5701  sub endbodytag { Line 6082  sub endbodytag {
     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {      unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
         $endbodytag='</body>';          $endbodytag='</body>';
     }      }
     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;  
     if ( exists( $env{'internal.head.redirect'} ) ) {      if ( exists( $env{'internal.head.redirect'} ) ) {
         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {          if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
     $endbodytag=      $endbodytag=
Line 5876  div.LC_confirm_box .LC_success img { Line 6256  div.LC_confirm_box .LC_success img {
   vertical-align: middle;    vertical-align: middle;
 }  }
   
   .LC_maxwidth {
     max-width: 100%;
     height: auto;
   }
   
   .LC_textsize_mobile {
     \@media only screen and (max-device-width: 480px) {
         -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
     }
   }
   
 .LC_icon {  .LC_icon {
   border: none;    border: none;
   vertical-align: middle;    vertical-align: middle;
Line 5981  ul.LC_breadcrumb_tools_outerlist li { Line 6372  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 5997  table#LC_menubuttons img { Line 6394  table#LC_menubuttons img {
   vertical-align: middle;    vertical-align: middle;
 }  }
   
   .LC_breadcrumbs_hoverable {
     background: $sidebg;
   }
   
 td.LC_table_cell_checkbox {  td.LC_table_cell_checkbox {
   text-align: center;    text-align: center;
 }  }
Line 6067  td.LC_menubuttons_text { Line 6468  td.LC_menubuttons_text {
   background: $tabbg;    background: $tabbg;
 }  }
   
   td.LC_zero_height {
     line-height: 0; 
     cellpadding: 0;
   }
   
 table.LC_data_table {  table.LC_data_table {
   border: 1px solid #000000;    border: 1px solid #000000;
   border-collapse: separate;    border-collapse: separate;
Line 6388  td.LC_parm_overview_restrictions  { Line 6794  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 6739  table.LC_data_table tr > td.LC_docs_entr Line 7151  table.LC_data_table tr > td.LC_docs_entr
   color: #990000;    color: #990000;
 }  }
   
   .LC_docs_alias {
     color: #440055;  
   }
   
   .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 7759  section.role-warning>h1:before { Line 8177  section.role-warning>h1:before {
   content:url('/adm/daxe/images/section_icons/warning.png');    content:url('/adm/daxe/images/section_icons/warning.png');
 }  }
   
   #LC_minitab_header {
     float:left;
     width:100%;
     background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
     font-size:93%;
     line-height:normal;
     margin: 0.5em 0 0.5em 0;
   }
   #LC_minitab_header ul {
     margin:0;
     padding:10px 10px 0;
     list-style:none;
   }
   #LC_minitab_header li {
     float:left;
     background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
     margin:0;
     padding:0 0 0 9px;
   }
   #LC_minitab_header a {
     display:block;
     background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
     padding:5px 15px 4px 6px;
   }
   #LC_minitab_header #LC_current_minitab {
     background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
   }
   #LC_minitab_header #LC_current_minitab a {
     background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
     padding-bottom:5px;
   }
   
   
 END  END
 }  }
   
Line 7940  OFFLOAD Line 8391  OFFLOAD
     $result .= '>'       $result .= '>' 
         .$inhibitprint          .$inhibitprint
  .$head_extra;   .$head_extra;
     if ($env{'browser.mobile'}) {      my $clientmobile;
       if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
           (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
       } else {
           $clientmobile = $env{'browser.mobile'};
       }
       if ($clientmobile) {
         $result .= '          $result .= '
 <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">  <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
 <meta name="apple-mobile-web-app-capable" content="yes" />';  <meta name="apple-mobile-web-app-capable" content="yes" />';
     }      }
       $result .= '<meta name="google" content="notranslate" />'."\n";
     return $result.'</head>';      return $result.'</head>';
 }  }
   
Line 8122  $args - additional optional args support Line 8580  $args - additional optional args support
                                     head -> skip the <html><head> generation                                      head -> skip the <html><head> generation
                                     body -> skip all <body> generation                                      body -> skip all <body> generation
              no_auto_mt_title -> prevent &mt()ing the title arg               no_auto_mt_title -> prevent &mt()ing the title arg
              inherit_jsmath -> when creating popup window in a page,  
                                     should it have jsmath forced on by the  
                                     current page  
              bread_crumbs ->             Array containing breadcrumbs               bread_crumbs ->             Array containing breadcrumbs
              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs               bread_crumbs_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
                                       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
                                  will contain https://<hostname> if server uses
                                  https (as per hosts.tab), but request is for http
                hostname       -> hostname, originally from $r->hostname(), (optional).
   
 =back  =back
   
Line 8192  sub start_page { Line 8653  sub start_page {
                 if (@advtools > 0) {                  if (@advtools > 0) {
                     &Apache::lonmenu::advtools_crumbs(@advtools);                      &Apache::lonmenu::advtools_crumbs(@advtools);
                 }                  }
                   my $menulink;
                   # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                   if ((exists($args->{'bread_crumbs_nomenu'})) ||
                        ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
                        ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
                        (!$env{'request.role.adv'}))) {
                       $menulink = 0;
                   } else {
                       undef($menulink);
                   }
  #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'});   $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
  }else{                  } else {
  $result .= &Apache::lonhtmlcommon::breadcrumbs();   $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
  }   }
     }      }
     return $result;      return $result;
Line 8294  var modalWindow = { Line 8764  var modalWindow = {
 };  };
  var openMyModal = function(source,width,height,scrolling,transparency,style)   var openMyModal = function(source,width,height,scrolling,transparency,style)
  {   {
                 source = source.replace("'","&#39;");                  source = source.replace(/'/g,"&#39;");
  modalWindow.windowId = "myModal";   modalWindow.windowId = "myModal";
  modalWindow.width = width;   modalWindow.width = width;
  modalWindow.height = height;   modalWindow.height = height;
Line 9313  Incoming parameters: Line 9783  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 9388  sub get_user_quota { Line 9858  sub get_user_quota {
             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 9536  Inputs: 7 Line 10007  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 9612  sub get_secgrprole_info { Line 10083  sub get_secgrprole_info {
 }  }
   
 sub user_picker {  sub user_picker {
     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;      my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
     my $currdom = $dom;      my $currdom = $dom;
       my @alldoms = &Apache::lonnet::all_domains();
       if (@alldoms == 1) {
           my %domsrch = &Apache::lonnet::get_dom('configuration',
                                                  ['directorysrch'],$alldoms[0]);
           my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
           my $showdom = $domdesc;
           if ($showdom eq '') {
               $showdom = $dom;
           }
           if (ref($domsrch{'directorysrch'}) eq 'HASH') {
               if ((!$domsrch{'directorysrch'}{'available'}) &&
                   ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
                   return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
               }
           }
       }
     my %curr_selected = (      my %curr_selected = (
                         srchin => 'dom',                          srchin => 'dom',
                         srchby => 'lastname',                          srchby => 'lastname',
Line 9660  sub user_picker { Line 10147  sub user_picker {
                                        );                                         );
     &html_escape(\%html_lt);      &html_escape(\%html_lt);
     &js_escape(\%js_lt);      &js_escape(\%js_lt);
     my $domform = &select_dom_form($currdom,'srchdomain',1,1);      my $domform;
       my $allow_blank = 1;
       if ($fixeddom) {
           $allow_blank = 0;
           $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
       } else {
           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">';
   
     my @srchins = ('crs','dom','alc','instd');      my @srchins = ('crs','dom','alc','instd');
Line 9672  sub user_picker { Line 10175  sub user_picker {
         next if ($option eq 'alc');          next if ($option eq 'alc');
         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));            next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
         next if ($option eq 'crs' && !$env{'request.course.id'});          next if ($option eq 'crs' && !$env{'request.course.id'});
           next if (($option eq 'instd') && ($noinstd));
         if ($curr_selected{'srchin'} eq $option) {          if ($curr_selected{'srchin'} eq $option) {
             $srchinsel .= '               $srchinsel .= ' 
    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
Line 9854  END_BLOCK Line 10358  END_BLOCK
                &Apache::lonhtmlcommon::row_closure(1)                 &Apache::lonhtmlcommon::row_closure(1)
                &Apache::lonhtmlcommon::end_pick_box().                 &Apache::lonhtmlcommon::end_pick_box().
                '<br />';                 '<br />';
     return $output;      return ($output,1);
 }  }
   
 sub user_rule_check {  sub user_rule_check {
Line 10169  sub get_institutional_codes { Line 10673  sub get_institutional_codes {
         foreach (@currxlists) {          foreach (@currxlists) {
             if (m/^([^:]+):(\w*)$/) {              if (m/^([^:]+):(\w*)$/) {
                 unless (grep/^$1$/,@{$allcourses}) {                  unless (grep/^$1$/,@{$allcourses}) {
                     push @{$allcourses},$1;                      push(@{$allcourses},$1);
                     $$LC_code{$1} = $2;                      $$LC_code{$1} = $2;
                 }                  }
             }              }
Line 10182  sub get_institutional_codes { Line 10686  sub get_institutional_codes {
                 my $sec = $coursecode.$1;                  my $sec = $coursecode.$1;
                 my $lc_sec = $2;                  my $lc_sec = $2;
                 unless (grep/^$sec$/,@{$allcourses}) {                  unless (grep/^$sec$/,@{$allcourses}) {
                     push @{$allcourses},$sec;                      push(@{$allcourses},$sec);
                     $$LC_code{$sec} = $lc_sec;                      $$LC_code{$sec} = $lc_sec;
                 }                  }
             }              }
Line 10280  reservable_now - ref to hash of student_ Line 10784  reservable_now - ref to hash of student_
   
     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) endreserve: end date of reservation period.       (b) endreserve: end date of reservation period.
       (c) uniqueperiod: start,end dates when slot is to be uniquely
           selected.
   
 sorted_future - ref to array of student_schedulable slots reservable in  sorted_future - ref to array of student_schedulable slots reservable in
                 the future, ordered by start date of reservation period.                  the future, ordered by start date of reservation period.
Line 10290  future_reservable - ref to hash of stude Line 10796  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
           selected.
   
 =back  =back
   
Line 10366  sub get_future_slots { Line 10874  sub get_future_slots {
             my $startreserve = $slots{$slot}->{'startreserve'};              my $startreserve = $slots{$slot}->{'startreserve'};
             my $endreserve = $slots{$slot}->{'endreserve'};              my $endreserve = $slots{$slot}->{'endreserve'};
             my $symb = $slots{$slot}->{'symb'};              my $symb = $slots{$slot}->{'symb'};
               my $uniqueperiod;
               if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
               }
             if (($startreserve < $now) &&              if (($startreserve < $now) &&
                 (!$endreserve || $endreserve > $now)) {                  (!$endreserve || $endreserve > $now)) {
                 my $lastres = $endreserve;                  my $lastres = $endreserve;
Line 10374  sub get_future_slots { Line 10886  sub get_future_slots {
                 }                  }
                 $reservable_now{$slot} = {                  $reservable_now{$slot} = {
                                            symb       => $symb,                                             symb       => $symb,
                                            endreserve => $lastres                                             endreserve => $lastres,
                                              uniqueperiod => $uniqueperiod,
                                          };                                           };
             } elsif (($startreserve > $now) &&              } elsif (($startreserve > $now) &&
                      (!$endreserve || $endreserve > $startreserve)) {                       (!$endreserve || $endreserve > $startreserve)) {
                 $future_reservable{$slot} = {                  $future_reservable{$slot} = {
                                               symb         => $symb,                                                symb         => $symb,
                                               startreserve => $startreserve                                                startreserve => $startreserve,
                                                 uniqueperiod => $uniqueperiod,
                                             };                                              };
             }              }
         }          }
Line 10538  sub get_env_multiple { Line 11052  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 10554  sub ask_for_embedded_content { Line 11084  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 10638  sub ask_for_embedded_content { Line 11171  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 10680  sub ask_for_embedded_content { Line 11223  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} = {};
Line 10755  sub ask_for_embedded_content { Line 11311  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 10793  sub ask_for_embedded_content { Line 11352  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 10821  sub ask_for_embedded_content { Line 11382  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));
Line 10832  sub ask_for_embedded_content { Line 11395  sub ask_for_embedded_content {
         $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 12027  sub decompress_uploaded_file { Line 12596  sub decompress_uploaded_file {
   
 sub process_decompression {  sub process_decompression {
     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;      my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
       unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
           return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                  &mt('Unexpected file path.').'</p>'."\n";
       }
       unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
           return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                  &mt('Unexpected course context.').'</p>'."\n";
       }
       unless ($file eq &Apache::lonnet::clean_filename($file)) {
           return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                  &mt('Filename contained unexpected characters.').'</p>'."\n";
       }
     my ($dir,$error,$warning,$output);      my ($dir,$error,$warning,$output);
     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {      if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
         $error = &mt('Filename not a supported archive file type.').          $error = &mt('Filename not a supported archive file type.').
Line 12061  sub process_decompression { Line 12642  sub process_decompression {
                 }                  }
             }              }
             my $numskip = scalar(@to_skip);              my $numskip = scalar(@to_skip);
             if (($numskip > 0) &&               my $numoverwrite = scalar(@to_overwrite);
                 ($numskip == $env{'form.archive_itemcount'})) {              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.');
             } elsif (!$error) {              } elsif (!$error) {
                 my ($decompressed,$display);                  my ($decompressed,$display);
                 if ($numskip > 0) {                  if (($numskip) || ($numoverwrite)) {
                     my $tempdir = time.'_'.$$.int(rand(10000));                      my $tempdir = time.'_'.$$.int(rand(10000));
                     mkdir("$dir/$tempdir",0755);                      mkdir("$dir/$tempdir",0755);
                     system("mv $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") {
                                 system("rm -rf $dir/$tempdir/$item");                                      &File::Path::Tiny::rm("$dir/$tempdir/$item");
                                   }
                               }
                           }
                           foreach my $item (@to_overwrite) {
                               if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
                                   if (($item ne '') && ($item !~ /\.\./)) {
                                       if (-f "$dir/$item") {
                                           unlink("$dir/$item");
                                       } elsif (-d "$dir/$item") {
                                           &File::Path::Tiny::rm("$dir/$item");
                                       }
                                       &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
                                   }
                             }                              }
                         }                          }
                           if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
                               &File::Path::Tiny::rm("$dir/$tempdir");
                           }
                     }                      }
                     system("mv $dir/$tempdir/* $dir");  
                     rmdir("$dir/$tempdir");     
                 } else {                  } else {
                     ($decompressed,$display) =                       ($decompressed,$display) = 
                         &decompress_uploaded_file($file,$dir);                          &decompress_uploaded_file($file,$dir);
Line 12102  sub process_decompression { Line 12697  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)) {
                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {  
                                 push(@newitems,$item);                                  push(@newitems,$item);
                                 if ($dirptr&$testdir) {                                  if ($dirptr&$testdir) {
                                     $is_dir{$item} = 1;                                      $is_dir{$item} = 1;
Line 12706  sub process_extracted_files { Line 13300  sub process_extracted_files {
                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");                                  mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                             }                              }
                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {                              if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");                                  if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";                                      $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                                 unless ($ishome) {                                      unless ($ishome) {
                                     my $fetch = "$newdest{$i}/$title";                                          my $fetch = "$newdest{$i}/$title";
                                     $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]=
Line 12791  sub process_extracted_files { Line 13386  sub process_extracted_files {
                         }                          }
                         if ($fullpath ne '') {                          if ($fullpath ne '') {
                             if (-e "$prefix$path") {                              if (-e "$prefix$path") {
                                 system("mv $prefix$path $fullpath/$title");                                  unless (rename("$prefix$path","$fullpath/$title")) {
                                        $warning .= &mt('Failed to rename dependency').'<br />';
                                   }
                             }                              }
                             if (-e "$fullpath/$title") {                              if (-e "$fullpath/$title") {
                                 my $showpath;                                  my $showpath;
Line 12801  sub process_extracted_files { Line 13398  sub process_extracted_files {
                                     $showpath = "/$title";                                      $showpath = "/$title";
                                 }                                   } 
                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";                                  $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</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 13103  sub upfile_store { Line 13700  sub upfile_store {
   
 =pod  =pod
   
 =item * &load_tmp_file($r)  =item * &load_tmp_file($r,$datatoken)
   
 Load uploaded file from tmp, $r should be the HTTP Request object,  Load uploaded file from tmp, $r should be the HTTP Request object,
 needs $env{'form.datatoken'},  $datatoken is the name to assign to the temporary file.
 sets $env{'form.upfile'} to the contents of the file  sets $env{'form.upfile'} to the contents of the file
   
 =cut  =cut
   
 sub load_tmp_file {  sub load_tmp_file {
     my $r=shift;      my ($r,$datatoken) = @_;
       return if ($datatoken eq '');
     my @studentdata=();      my @studentdata=();
     {      {
         my $studentfile = $r->dir_config('lonDaemons').          my $studentfile = $r->dir_config('lonDaemons').
                               '/tmp/'.$env{'form.datatoken'}.'.tmp';                                '/tmp/'.$datatoken.'.tmp';
         if ( open(my $fh,"<$studentfile") ) {          if ( open(my $fh,"<$studentfile") ) {
             @studentdata=<$fh>;              @studentdata=<$fh>;
             close($fh);              close($fh);
Line 13125  sub load_tmp_file { Line 13723  sub load_tmp_file {
     $env{'form.upfile'}=join('',@studentdata);      $env{'form.upfile'}=join('',@studentdata);
 }  }
   
   sub valid_datatoken {
       my ($datatoken) = @_;
       if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) {
           return $datatoken;
       }
       return;
   }
   
 =pod  =pod
   
 =item * &upfile_record_sep()  =item * &upfile_record_sep()
Line 13565  sub DrawBarGraph { Line 14171  sub DrawBarGraph {
         @Labels = @$labels;          @Labels = @$labels;
     } else {      } else {
         for (my $i=0;$i<@{$Values[0]};$i++) {          for (my $i=0;$i<@{$Values[0]};$i++) {
             push (@Labels,$i+1);              push(@Labels,$i+1);
         }          }
     }      }
     #      #
Line 14024  Returns: comma separated list of address Line 14630  Returns: comma separated list of address
 sub build_recipient_list {  sub build_recipient_list {
     my ($defmail,$mailing,$defdom,$origmail) = @_;      my ($defmail,$mailing,$defdom,$origmail) = @_;
     my @recipients;      my @recipients;
     my $otheremails;      my ($otheremails,$lastresort,$allbcc,$addtext);
     my %domconfig =      my %domconfig =
          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
     if (ref($domconfig{'contacts'}) eq 'HASH') {      if (ref($domconfig{'contacts'}) eq 'HASH') {
         if (exists($domconfig{'contacts'}{$mailing})) {          if (exists($domconfig{'contacts'}{$mailing})) {
             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {              if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
Line 14038  sub build_recipient_list { Line 14644  sub build_recipient_list {
                             push(@recipients,$addr);                              push(@recipients,$addr);
                         }                          }
                     }                      }
                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};                  }
                   $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   if ($mailing eq 'helpdeskmail') {
                       if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
                           my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
                           my @ok_bccs;
                           foreach my $bcc (@bccs) {
                               $bcc =~ s/^\s+//g;
                               $bcc =~ s/\s+$//g;
                               if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                                   if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                                       push(@ok_bccs,$bcc);
                                   }
                               }
                           }
                           if (@ok_bccs > 0) {
                               $allbcc = join(', ',@ok_bccs);
                           }
                       }
                       $addtext = $domconfig{'contacts'}{$mailing}{'include'};
                 }                  }
             }              }
         } elsif ($origmail ne '') {          } elsif ($origmail ne '') {
             push(@recipients,$origmail);              $lastresort = $origmail;
         }          }
     } elsif ($origmail ne '') {      } elsif ($origmail ne '') {
         push(@recipients,$origmail);          $lastresort = $origmail;
       }
   
       if (($mailing eq 'helpdesk') && ($lastresort ne '')) {
           unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
               my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
               my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
               my %what = (
                             perlvar => 1,
                          );
               my $primary = &Apache::lonnet::domain($defdom,'primary');
               if ($primary) {
                   my $gotaddr;
                   my ($result,$returnhash) =
                       &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
                   if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
                       if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
                           $lastresort = $returnhash->{'lonSupportEMail'};
                           $gotaddr = 1;
                       }
                   }
                   unless ($gotaddr) {
                       my $uintdom = &Apache::lonnet::internet_dom($primary);
                       my $intdom = &Apache::lonnet::internet_dom($lonhost);
                       unless ($uintdom eq $intdom) {
                           my %domconfig =
                               &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
                           if (ref($domconfig{'contacts'}) eq 'HASH') {
                               if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
                                   my @contacts = ('adminemail','supportemail');
                                   foreach my $item (@contacts) {
                                       if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
                                           my $addr = $domconfig{'contacts'}{$item};
                                           if (!grep(/^\Q$addr\E$/,@recipients)) {
                                               push(@recipients,$addr);
                                           }
                                       }
                                   }
                                   if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
                                       $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
                                   }
                                   if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
                                       my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
                                       my @ok_bccs;
                                       foreach my $bcc (@bccs) {
                                           $bcc =~ s/^\s+//g;
                                           $bcc =~ s/\s+$//g;
                                           if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                                               if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                                                   push(@ok_bccs,$bcc);
                                               }
                                           }
                                       }
                                       if (@ok_bccs > 0) {
                                           $allbcc = join(', ',@ok_bccs);
                                       }
                                   }
                                   $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
                               }
                           }
                       }
                   }
               }
           }
     }      }
     if (defined($defmail)) {      if (defined($defmail)) {
         if ($defmail ne '') {          if ($defmail ne '') {
Line 14065  sub build_recipient_list { Line 14753  sub build_recipient_list {
             }              }
         }          }
     }      }
     my $recipientlist = join(',',@recipients);       if ($mailing eq 'helpdesk') {
     return $recipientlist;          if ((!@recipients) && ($lastresort ne '')) {
               push(@recipients,$lastresort);
           }
       } elsif ($lastresort ne '') {
           if (!grep(/^\Q$lastresort\E$/,@recipients)) {
               push(@recipients,$lastresort);
           }
       }
       my $recipientlist = join(',',@recipients);
       if (wantarray) {
           return ($recipientlist,$allbcc,$addtext);
       } else {
           return $recipientlist;
       }
 }  }
   
 ############################################################  ############################################################
Line 14257  sub extract_categories { Line 14958  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 14371  currcat - scalar with an & separated lis Line 15074  currcat - scalar with an & separated lis
   
 type    - scalar contains course type (Course or Community).  type    - scalar contains course type (Course or Community).
   
   disabled - scalar (optional) contains disabled="disabled" if input elements are
              to be readonly (e.g., Domain Helpdesk role viewing course settings).
   
 Returns: $output (markup to be displayed)   Returns: $output (markup to be displayed) 
   
 =cut  =cut
   
 sub assign_categories_table {  sub assign_categories_table {
     my ($cathash,$currcat,$type) = @_;      my ($cathash,$currcat,$type,$disabled) = @_;
     my $output;      my $output;
     if (ref($cathash) eq 'HASH') {      if (ref($cathash) eq 'HASH') {
         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);          my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
Line 14395  sub assign_categories_table { Line 15101  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 14409  sub assign_categories_table { Line 15117  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="'.
                               $item.'"'.$checked.' />'.$parent_title.'</span>'.                                $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';                                '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
                     my $depth = 1;                      my $depth = 1;
                     push(@path,$parent);                      push(@path,$parent);
                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);                      $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
                     pop(@path);                      pop(@path);
                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';                      $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
                     $itemcount ++;                      $itemcount ++;
Line 14455  path - Array containing all categories b Line 15165  path - Array containing all categories b
   
 currcategories - reference to array of current categories assigned to the course  currcategories - reference to array of current categories assigned to the course
   
   disabled - scalar (optional) contains disabled="disabled" if input elements are
              to be readonly (e.g., Domain Helpdesk role viewing course settings).
   
 Returns: $output (markup to be displayed).  Returns: $output (markup to be displayed).
   
 =cut  =cut
   
 sub assign_category_rows {  sub assign_category_rows {
     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;      my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
     my ($text,$name,$item,$chgstr);      my ($text,$name,$item,$chgstr);
     if (ref($cats) eq 'ARRAY') {      if (ref($cats) eq 'ARRAY') {
         my $maxdepth = scalar(@{$cats});          my $maxdepth = scalar(@{$cats});
Line 14483  sub assign_category_rows { Line 15196  sub assign_category_rows {
                     }                      }
                     $text .= '<tr><td><span class="LC_nobreak"><label>'.                      $text .= '<tr><td><span class="LC_nobreak"><label>'.
                              '<input type="checkbox" name="usecategory" value="'.                               '<input type="checkbox" name="usecategory" value="'.
                              $item.'"'.$checked.' />'.$name.'</label></span>'.                               $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
                              '<input type="hidden" name="catname" value="'.$name.'" />'.                               '<input type="hidden" name="catname" value="'.$name.'" />'.
                              '</td><td>';                               '</td><td>';
                     if (ref($path) eq 'ARRAY') {                      if (ref($path) eq 'ARRAY') {
                         push(@{$path},$name);                          push(@{$path},$name);
                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);                          $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
                         pop(@{$path});                          pop(@{$path});
                     }                      }
                     $text .= '</td></tr>';                      $text .= '</td></tr>';
Line 14715  sub check_clone { Line 15428  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);
             }              }
         }          }
  if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&    if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {              (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
     $can_clone = 1;      $can_clone = 1;
  } else {   } else {
Line 14816  sub check_clone { Line 15529  sub check_clone {
 }  }
   
 sub construct_course {  sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;      my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
           $cnum,$category,$coderef) = @_;
     my $outcome;      my $outcome;
     my $linefeed =  '<br />'."\n";      my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {      if ($context eq 'auto') {
Line 14844  sub construct_course { Line 15558  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 14861  sub construct_course { Line 15580  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 14881  sub construct_course { Line 15600  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 14964  sub construct_course { Line 15683  sub construct_course {
                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});                  my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                 $cenv{'internal.sectionnums'} .= $item.',';                  $cenv{'internal.sectionnums'} .= $item.',';
                 unless ($addcheck eq 'ok') {                  unless ($addcheck eq 'ok') {
                     push @badclasses, $class;                      push(@badclasses,$class);
                 }                  }
             }              }
             $cenv{'internal.sectionnums'} =~ s/,$//;              $cenv{'internal.sectionnums'} =~ s/,$//;
Line 14992  sub construct_course { Line 15711  sub construct_course {
                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});                  my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                 $cenv{'internal.crosslistings'} .= $item.',';                  $cenv{'internal.crosslistings'} .= $item.',';
                 unless ($addcheck eq 'ok') {                  unless ($addcheck eq 'ok') {
                     push @badclasses, $xl;                      push(@badclasses,$xl);
                 }                  }
             }              }
             $cenv{'internal.crosslistings'} =~ s/,$//;              $cenv{'internal.crosslistings'} =~ s/,$//;
Line 15027  sub construct_course { Line 15746  sub construct_course {
     }      }
     if (@badclasses > 0) {      if (@badclasses > 0) {
         my %lt=&Apache::lonlocal::texthash(          my %lt=&Apache::lonlocal::texthash(
                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.  However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',                  'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
                 'dnhr' => 'does not have rights to access enrollment in these classes',                  'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
                 'adby' => 'as determined by the policies of your institution on access to official classlists'                  'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
         );          );
         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.          my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
                            ' ('.$lt{'adby'}.')';                             &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
         if ($context eq 'auto') {          if ($context eq 'auto') {
             $outcome .= $badclass_msg.$linefeed;              $outcome .= $badclass_msg.$linefeed;
           } else {
             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";              $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
             foreach my $item (@badclasses) {          }
                 if ($context eq 'auto') {          foreach my $item (@badclasses) {
                     $outcome .= " - $item\n";  
                 } else {  
                     $outcome .= "<li>$item</li>\n";  
                 }  
             }  
             if ($context eq 'auto') {              if ($context eq 'auto') {
                 $outcome .= $linefeed;                  $outcome .= " - $item\n";
             } else {              } else {
                 $outcome .= "</ul><br /><br /></div>\n";                  $outcome .= "<li>$item</li>\n";
             }              }
           }
           if ($context eq 'auto') {
               $outcome .= $linefeed;
           } else {
               $outcome .= "</ul><br /><br /></div>\n";
         }           } 
     }      }
     if ($args->{'no_end_date'}) {      if ($args->{'no_end_date'}) {
Line 15080  sub construct_course { Line 15800  sub construct_course {
        if ($args->{'setcontent'}) {         if ($args->{'setcontent'}) {
            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};             $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
        }         }
          if ($args->{'setcomment'}) {
              $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
          }
     }      }
     if ($args->{'reshome'}) {      if ($args->{'reshome'}) {
  $cenv{'reshome'}=$args->{'reshome'}.'/';   $cenv{'reshome'}=$args->{'reshome'}.'/';
Line 15186  sub construct_course { Line 15909  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 15246  sub generate_code { Line 15993  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 15265  sub group_term { Line 16011  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');
     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',
                    );                     );
     return (\@types,\%typename);      return (\@types,\%typename);
 }  }
Line 15362  sub init_user_environment { Line 16110  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 15385  sub init_user_environment { Line 16131  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 15425  sub init_user_environment { Line 16172  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 15478  sub init_user_environment { Line 16224  sub init_user_environment {
             $env{'user.noloadbalance'} = $lonhost;              $env{'user.noloadbalance'} = $lonhost;
         }          }
   
         my %is_adv = ( is_adv => $env{'user.adv'} );          if ($form->{'noloadbalance'}) {
         my %domdef;              my @hosts = &Apache::lonnet::current_machine_ids();
         unless ($domain eq 'public') {              my $hosthere = $form->{'noloadbalance'};
             %domdef = &Apache::lonnet::get_domain_defaults($domain);              if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   $initial_env{"user.noloadbalance"} = $hosthere;
                   $env{'user.noloadbalance'} = $hosthere;
               }
         }          }
   
         foreach my $tool ('aboutme','blog','webdav','portfolio') {          unless ($domain eq 'public') {
             $userenv{'availabletools.'.$tool} =               my %is_adv = ( is_adv => $env{'user.adv'} );
                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',              my %domdef = &Apache::lonnet::get_domain_defaults($domain);
                                                   undef,\%userenv,\%domdef,\%is_adv);  
         }  
   
         foreach my $crstype ('official','unofficial','community','textbook') {              foreach my $tool ('aboutme','blog','webdav','portfolio') {
             $userenv{'canrequest.'.$crstype} =                  $userenv{'availabletools.'.$tool} = 
                 &Apache::lonnet::usertools_access($username,$domain,$crstype,                      &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                                                   'reload','requestcourses',                                                        undef,\%userenv,\%domdef,\%is_adv);
                                                   \%userenv,\%domdef,\%is_adv);              }
         }  
   
         $userenv{'canrequest.author'} =              foreach my $crstype ('official','unofficial','community','textbook','placement') {
             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',                  $userenv{'canrequest.'.$crstype} =
                                         'reload','requestauthor',                      &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                         \%userenv,\%domdef,\%is_adv);                                                        'reload','requestcourses',
         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],                                                        \%userenv,\%domdef,\%is_adv);
                                              $domain,$username);  
         my $reqstatus = $reqauthor{'author_status'};  
         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {   
             if (ref($reqauthor{'author'}) eq 'HASH') {  
                 $userenv{'requestauthorqueued'} = $reqstatus.':'.  
                                                   $reqauthor{'author'}{'timestamp'};  
             }              }
         }  
   
               $userenv{'canrequest.author'} =
                   &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                                                     'reload','requestauthor',
                                                     \%userenv,\%domdef,\%is_adv);
               my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                                                    $domain,$username);
               my $reqstatus = $reqauthor{'author_status'};
               if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   if (ref($reqauthor{'author'}) eq 'HASH') {
                       $userenv{'requestauthorqueued'} = $reqstatus.':'.
                                                         $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 15738  sub build_filters { Line 16520  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 15754  sub build_filters { Line 16540  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 15762  sub build_filters { Line 16550  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 16115  sub search_courses { Line 16909  sub search_courses {
                 if (ref($courses{$cid}) eq 'HASH') {                  if (ref($courses{$cid}) eq 'HASH') {
                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {                      if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {                          if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                             push (@{$courses{$cid}{roles}},$courserole);                              push(@{$courses{$cid}{roles}},$courserole);
                         }                          }
                     } else {                      } else {
                         $courses{$cid}{roles} = [$courserole];                          $courses{$cid}{roles} = [$courserole];
Line 16311  sub needs_coursereinit { Line 17105  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 16340  sub update_content_constraints { Line 17138  sub update_content_constraints {
     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});      my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
     my %checkresponsetypes;      my %checkresponsetypes;
     foreach my $key (keys(%Apache::lonnet::needsrelease)) {      foreach my $key (keys(%Apache::lonnet::needsrelease)) {
         my ($item,$name,$value,$valmatch) = 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}
Line 16445  sub recurse_supplemental { Line 17243  sub recurse_supplemental {
 }  }
   
 sub symb_to_docspath {  sub symb_to_docspath {
     my ($symb) = @_;      my ($symb,$navmapref) = @_;
     return unless ($symb);      return unless ($symb && ref($navmapref));
     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);      my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
     if ($resurl=~/\.(sequence|page)$/) {      if ($resurl=~/\.(sequence|page)$/) {
         $mapurl=$resurl;          $mapurl=$resurl;
Line 16454  sub symb_to_docspath { Line 17252  sub symb_to_docspath {
         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};          $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
     }      }
     my $mapresobj;      my $mapresobj;
     my $navmap = Apache::lonnavmaps::navmap->new();      unless (ref($$navmapref)) {
     if (ref($navmap)) {          $$navmapref = Apache::lonnavmaps::navmap->new();
         $mapresobj = $navmap->getResourceByUrl($mapurl);      }
       if (ref($$navmapref)) {
           $mapresobj = $$navmapref->getResourceByUrl($mapurl);
     }      }
     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};      $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
     my $type=$2;      my $type=$2;
Line 16466  sub symb_to_docspath { Line 17266  sub symb_to_docspath {
         if ($pcslist ne '') {          if ($pcslist ne '') {
             foreach my $pc (split(/,/,$pcslist)) {              foreach my $pc (split(/,/,$pcslist)) {
                 next if ($pc <= 1);                  next if ($pc <= 1);
                 my $res = $navmap->getByMapPc($pc);                  my $res = $$navmapref->getByMapPc($pc);
                 if (ref($res)) {                  if (ref($res)) {
                     my $thisurl = $res->src();                      my $thisurl = $res->src();
                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};                      $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
Line 16515  sub symb_to_docspath { Line 17315  sub symb_to_docspath {
 sub captcha_display {  sub captcha_display {
     my ($context,$lonhost) = @_;      my ($context,$lonhost) = @_;
     my ($output,$error);      my ($output,$error);
     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);      my ($captcha,$pubkey,$privkey,$version) = 
           &get_captcha_config($context,$lonhost);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         $output = &create_captcha();          $output = &create_captcha();
         unless ($output) {          unless ($output) {
             $error = 'captcha';              $error = 'captcha';
         }          }
     } elsif ($captcha eq 'recaptcha') {      } elsif ($captcha eq 'recaptcha') {
         $output = &create_recaptcha($pubkey);          $output = &create_recaptcha($pubkey,$version);
         unless ($output) {          unless ($output) {
             $error = 'recaptcha';              $error = 'recaptcha';
         }          }
     }      }
     return ($output,$error,$captcha);      return ($output,$error,$captcha,$version);
 }  }
   
 sub captcha_response {  sub captcha_response {
     my ($context,$lonhost) = @_;      my ($context,$lonhost) = @_;
     my ($captcha_chk,$captcha_error);      my ($captcha_chk,$captcha_error);
     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);      my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         ($captcha_chk,$captcha_error) = &check_captcha();          ($captcha_chk,$captcha_error) = &check_captcha();
     } elsif ($captcha eq 'recaptcha') {      } elsif ($captcha eq 'recaptcha') {
         $captcha_chk = &check_recaptcha($privkey);          $captcha_chk = &check_recaptcha($privkey,$version);
     } else {      } else {
         $captcha_chk = 1;          $captcha_chk = 1;
     }      }
Line 16546  sub captcha_response { Line 17347  sub captcha_response {
   
 sub get_captcha_config {  sub get_captcha_config {
     my ($context,$lonhost) = @_;      my ($context,$lonhost) = @_;
     my ($captcha,$pubkey,$privkey,$hashtocheck);      my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
     my $hostname = &Apache::lonnet::hostname($lonhost);      my $hostname = &Apache::lonnet::hostname($lonhost);
     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);      my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);      my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
Line 16562  sub get_captcha_config { Line 17363  sub get_captcha_config {
                     }                      }
                     if ($privkey && $pubkey) {                      if ($privkey && $pubkey) {
                         $captcha = 'recaptcha';                          $captcha = 'recaptcha';
                           $version = $hashtocheck->{'recaptchaversion'};
                           if ($version ne '2') {
                               $version = 1;
                           }
                     } else {                      } else {
                         $captcha = 'original';                          $captcha = 'original';
                     }                      }
Line 16579  sub get_captcha_config { Line 17384  sub get_captcha_config {
             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};              $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
             if ($privkey && $pubkey) {              if ($privkey && $pubkey) {
                 $captcha = 'recaptcha';                  $captcha = 'recaptcha';
                   $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   if ($version ne '2') {
                       $version = 1; 
                   }
             } else {              } else {
                 $captcha = 'original';                  $captcha = 'original';
             }              }
Line 16586  sub get_captcha_config { Line 17395  sub get_captcha_config {
             $captcha = 'original';              $captcha = 'original';
         }          }
     }      }
     return ($captcha,$pubkey,$privkey);      return ($captcha,$pubkey,$privkey,$version);
 }  }
   
 sub create_captcha {  sub create_captcha {
Line 16645  sub check_captcha { Line 17454  sub check_captcha {
 }  }
   
 sub create_recaptcha {  sub create_recaptcha {
     my ($pubkey) = @_;      my ($pubkey,$version) = @_;
     my $use_ssl;      if ($version >= 2) {
     if ($ENV{'SERVER_PORT'} == 443) {          return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
         $use_ssl = 1;      } else {
     }          my $use_ssl;
     my $captcha = Captcha::reCAPTCHA->new;          if ($ENV{'SERVER_PORT'} == 443) {
     return $captcha->get_options_setter({theme => 'white'})."\n".              $use_ssl = 1;
            $captcha->get_html($pubkey,undef,$use_ssl).          }
            &mt('If the text is hard to read, [_1] will replace them.',          my $captcha = Captcha::reCAPTCHA->new;
                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').          return $captcha->get_options_setter({theme => 'white'})."\n".
            '<br /><br />';                 $captcha->get_html($pubkey,undef,$use_ssl).
                  &mt('If the text is hard to read, [_1] will replace them.',
                      '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                  '<br /><br />';
       }
 }  }
   
 sub check_recaptcha {  sub check_recaptcha {
     my ($privkey) = @_;      my ($privkey,$version) = @_;
     my $captcha_chk;      my $captcha_chk;
     my $captcha = Captcha::reCAPTCHA->new;      if ($version >= 2) {
     my $captcha_result =          my %info = (
         $captcha->check_answer(                       secret   => $privkey, 
                                 $privkey,                       response => $env{'form.g-recaptcha-response'},
                                 $ENV{'REMOTE_ADDR'},                       remoteip => $ENV{'REMOTE_ADDR'},
                                 $env{'form.recaptcha_challenge_field'},                     );
                                 $env{'form.recaptcha_response_field'},          my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
                               );          $request->content(join('&',map {
     if ($captcha_result->{is_valid}) {                           my $name = escape($_);
         $captcha_chk = 1;                           "$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)  {
               my $data = JSON::DWIW->from_json($response->decoded_content);
               if (ref($data) eq 'HASH') {
                   if ($data->{'success'}) {
                       $captcha_chk = 1;
                   }
               }
           }
       } else {
           my $captcha = Captcha::reCAPTCHA->new;
           my $captcha_result =
               $captcha->check_answer(
                                       $privkey,
                                       $ENV{'REMOTE_ADDR'},
                                       $env{'form.recaptcha_challenge_field'},
                                       $env{'form.recaptcha_response_field'},
                                     );
           if ($captcha_result->{is_valid}) {
               $captcha_chk = 1;
           }
     }      }
     return $captcha_chk;      return $captcha_chk;
 }  }
   
 sub emailusername_info {  sub emailusername_info {
     my @fields = ('firstname','lastname','institution','web','location','officialemail');      my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
     my %titles = &Apache::lonlocal::texthash (      my %titles = &Apache::lonlocal::texthash (
                      lastname      => 'Last Name',                       lastname      => 'Last Name',
                      firstname     => 'First Name',                       firstname     => 'First Name',
Line 16684  sub emailusername_info { Line 17521  sub emailusername_info {
                      location      => "School's city, state/province, country",                       location      => "School's city, state/province, country",
                      web           => "School's web address",                       web           => "School's web address",
                      officialemail => 'E-mail address at institution (if different)',                       officialemail => 'E-mail address at institution (if different)',
                        id            => 'Student/Employee ID',
                  );                   );
     return (\@fields,\%titles);      return (\@fields,\%titles);
 }  }
Line 16712  sub cleanup_html { Line 17550  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) {
           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'},           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});
Line 16764  sub des_decrypt { Line 17618  sub des_decrypt {
     } else {      } else {
         $cypher=new DES $keybin;          $cypher=new DES $keybin;
     }      }
     my $plaintext=      my $plaintext='';
         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));      my $cypherlength = length($cyphertext);
     $plaintext.=      my $numchunks = int($cypherlength/32);
         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));      for (my $j=0; $j<$numchunks; $j++) {
     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );          my $start = $j*32;
           my $cypherblock = substr($cyphertext,$start,32);
           my $chunk =
               $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
           $chunk .=
               $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
           $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
           $plaintext .= $chunk;
       }
     return $plaintext;      return $plaintext;
 }  }
   

Removed from v.1.1231  
changed lines
  Added in v.1.1293


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