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

Diff for /loncom/interface/loncommon.pm between versions 1.989 and 1.1075.2.134

version 1.989, 2010/12/18 23:53:57 version 1.1075.2.134, 2019/07/30 11:10:55
Line 67  use Apache::lonhtmlcommon(); Line 67  use Apache::lonhtmlcommon();
 use Apache::loncoursedata();  use Apache::loncoursedata();
 use Apache::lontexconvert();  use Apache::lontexconvert();
 use Apache::lonclonecourse();  use Apache::lonclonecourse();
   use Apache::lonuserutils();
   use Apache::lonuserstate();
   use Apache::courseclassifier();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale::Catalog;  use DateTime::Locale;
   use Encode();
   use Authen::Captcha;
   use Captcha::reCAPTCHA;
   use JSON::DWIW;
   use LWP::UserAgent;
   use Crypt::DES;
   use DynaLoader; # for Crypt::DES version
   use File::Copy();
   use File::Path();
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);  use vars qw(%defaultdesign);
Line 154  sub ssi_with_retries { Line 166  sub ssi_with_retries {
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
 my %supported_language;  my %supported_language;
   my %latex_language; # For choosing hyphenation in <transl..>
   my %latex_language_bykey; # for choosing hyphenation from metadata
 my %cprtag;  my %cprtag;
 my %scprtag;  my %scprtag;
 my %fe; my %fd; my %fm;  my %fe; my %fd; my %fm;
Line 182  BEGIN { Line 196  BEGIN {
     {      {
         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                                    '/language.tab';                                     '/language.tab';
         if ( open(my $fh,"<$langtabfile") ) {          if ( open(my $fh,'<',$langtabfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line=~/^\#/);                  next if ($line=~/^\#/);
                 chomp($line);                  chomp($line);
                 my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));                  my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
                 $language{$key}=$val.' - '.$enc;                  $language{$key}=$val.' - '.$enc;
                 if ($sup) {                  if ($sup) {
                     $supported_language{$key}=$sup;                      $supported_language{$key}=$sup;
                 }                  }
    if ($latex) {
       $latex_language_bykey{$key} = $latex;
       $latex_language{$two} = $latex;
    }
             }              }
             close($fh);              close($fh);
         }          }
Line 199  BEGIN { Line 217  BEGIN {
     {      {
         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.          my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/copyright.tab';                                    '/copyright.tab';
         if ( open (my $fh,"<$copyrightfile") ) {          if ( open (my $fh,'<',$copyrightfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line=~/^\#/);                  next if ($line=~/^\#/);
                 chomp($line);                  chomp($line);
Line 213  BEGIN { Line 231  BEGIN {
     {      {
         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.          my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/source_copyright.tab';                                    '/source_copyright.tab';
         if ( open (my $fh,"<$sourcecopyrightfile") ) {          if ( open (my $fh,'<',$sourcecopyrightfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line =~ /^\#/);                  next if ($line =~ /^\#/);
                 chomp($line);                  chomp($line);
Line 227  BEGIN { Line 245  BEGIN {
 # -------------------------------------------------------------- default domain designs  # -------------------------------------------------------------- default domain designs
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     my $designfile = $designdir.'/default.tab';      my $designfile = $designdir.'/default.tab';
     if ( open (my $fh,"<$designfile") ) {      if ( open (my $fh,'<',$designfile) ) {
         while (my $line = <$fh>) {          while (my $line = <$fh>) {
             next if ($line =~ /^\#/);              next if ($line =~ /^\#/);
             chomp($line);              chomp($line);
Line 241  BEGIN { Line 259  BEGIN {
     {      {
         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                                   '/filecategories.tab';                                    '/filecategories.tab';
         if ( open (my $fh,"<$categoryfile") ) {          if ( open (my $fh,'<',$categoryfile) ) {
     while (my $line = <$fh>) {      while (my $line = <$fh>) {
  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 256  BEGIN { Line 274  BEGIN {
     {      {
         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                '/filetypes.tab';                 '/filetypes.tab';
         if ( open (my $fh,"<$typesfile") ) {          if ( open (my $fh,'<',$typesfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
  next if ($line =~ /^\#/);   next if ($line =~ /^\#/);
  chomp($line);   chomp($line);
Line 409  sub studentbrowser_javascript { Line 427  sub studentbrowser_javascript {
 <script type="text/javascript" language="Javascript">  <script type="text/javascript" language="Javascript">
 // <![CDATA[  // <![CDATA[
     var stdeditbrowser;      var stdeditbrowser;
     function openstdbrowser(formname,uname,udom,roleflag,ignorefilter,courseadvonly) {      function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
         var url = '/adm/pickstudent?';          var url = '/adm/pickstudent?';
         var filter;          var filter;
  if (!ignorefilter) {   if (!ignorefilter) {
Line 421  sub studentbrowser_javascript { Line 439  sub studentbrowser_javascript {
    }     }
         }          }
         url += 'form=' + formname + '&unameelement='+uname+          url += 'form=' + formname + '&unameelement='+uname+
                                     '&udomelement='+udom;                                      '&udomelement='+udom+
                                       '&clicker='+clicker;
  if (roleflag) { url+="&roles=1"; }   if (roleflag) { url+="&roles=1"; }
         if (courseadvonly) { url+="&courseadvonly=1"; }          if (courseadvonly) { url+="&courseadvonly=1"; }
         var title = 'Student_Browser';          var title = 'Student_Browser';
Line 435  sub studentbrowser_javascript { Line 454  sub studentbrowser_javascript {
 ENDSTDBRW  ENDSTDBRW
 }  }
   
   sub resourcebrowser_javascript {
      unless ($env{'request.course.id'}) { return ''; }
      return (<<'ENDRESBRW');
   <script type="text/javascript" language="Javascript">
   // <![CDATA[
       var reseditbrowser;
       function openresbrowser(formname,reslink) {
           var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
           var title = 'Resource_Browser';
           var options = 'scrollbars=1,resizable=1,menubar=0';
           options += ',width=700,height=500';
           reseditbrowser = open(url,title,options,'1');
           reseditbrowser.focus();
       }
   // ]]>
   </script>
   ENDRESBRW
   }
   
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele,$courseadvonly)=@_;     my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
    my $callargs = "'".$form."','".$unameele."','".$udomele."'";     my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                         &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                         &Apache::lonhtmlcommon::entity_encode($udomele)."'";
    if ($env{'request.course.id'}) {       if ($env{'request.course.id'}) {  
        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})         if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
    && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.     && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
  '/'.$env{'request.course.sec'})) {   '/'.$env{'request.course.sec'})) {
    return '';     return '';
        }         }
          $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
        if ($courseadvonly)  {         if ($courseadvonly)  {
            $callargs .= ",'',1,1";             $callargs .= ",'',1,1";
        }         }
Line 452  sub selectstudent_link { Line 493  sub selectstudent_link {
               &mt('Select User').'</a></span>';                &mt('Select User').'</a></span>';
    }     }
    if ($env{'request.role'}=~/^(au|dc|su)/) {     if ($env{'request.role'}=~/^(au|dc|su)/) {
        $callargs .= ",1";          $callargs .= ",'',1"; 
        return '<span class="LC_nobreak">'.         return '<span class="LC_nobreak">'.
               '<a href="javascript:openstdbrowser('.$callargs.');">'.                '<a href="javascript:openstdbrowser('.$callargs.');">'.
               &mt('Select User').'</a></span>';                &mt('Select User').'</a></span>';
Line 460  sub selectstudent_link { Line 501  sub selectstudent_link {
    return '';     return '';
 }  }
   
   sub selectresource_link {
      my ($form,$reslink,$arg)=@_;
      
      my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                         &Apache::lonhtmlcommon::entity_encode($reslink)."'";
      unless ($env{'request.course.id'}) { return $arg; }
      return '<span class="LC_nobreak">'.
                 '<a href="javascript:openresbrowser('.$callargs.');">'.
                 $arg.'</a></span>';
   }
   
   
   
 sub authorbrowser_javascript {  sub authorbrowser_javascript {
     return <<"ENDAUTHORBRW";      return <<"ENDAUTHORBRW";
 <script type="text/javascript" language="JavaScript">  <script type="text/javascript" language="JavaScript">
Line 482  ENDAUTHORBRW Line 536  ENDAUTHORBRW
 }  }
   
 sub coursebrowser_javascript {  sub coursebrowser_javascript {
     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;      my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
           $credits_element,$instcode) = @_;
     my $wintitle = 'Course_Browser';      my $wintitle = 'Course_Browser';
     if ($crstype eq 'Community') {      if ($crstype eq 'Community') {
         $wintitle = 'Community_Browser';          $wintitle = 'Community_Browser';
Line 533  sub coursebrowser_javascript { Line 588  sub coursebrowser_javascript {
             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;              url += '&cloner='+ownername+':'+ownerdom;
               if (type == 'Course') {
                   url += '&crscode='+document.forms[formid].crscode.value;
               }
           }
           if (formname == 'requestcrs') {
               url += '&crsdom=$domainfilter&crscode=$instcode';
         }          }
         if (multflag !=null && multflag != '') {          if (multflag !=null && multflag != '') {
             url += '&multiple='+multflag;              url += '&multiple='+multflag;
Line 545  sub coursebrowser_javascript { Line 606  sub coursebrowser_javascript {
     }      }
 $id_functions  $id_functions
 ENDSTDBRW  ENDSTDBRW
     if (($sec_element ne '') || ($role_element ne '')) {      if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
         $output .= &setsec_javascript($sec_element,$formname,$role_element);          $output .= &setsec_javascript($sec_element,$formname,$role_element,
                                         $credits_element);
     }      }
     $output .= '      $output .= '
 // ]]>  // ]]>
Line 596  ENDJS Line 658  ENDJS
   
 }  }
   
   sub javascript_array_indexof {
       return <<ENDJS;
   <script type="text/javascript" language="JavaScript">
   // <![CDATA[
   
   if (!Array.prototype.indexOf) {
       Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
           "use strict";
           if (this === void 0 || this === null) {
               throw new TypeError();
           }
           var t = Object(this);
           var len = t.length >>> 0;
           if (len === 0) {
               return -1;
           }
           var n = 0;
           if (arguments.length > 0) {
               n = Number(arguments[1]);
               if (n !== n) { // shortcut for verifying if it's NaN
                   n = 0;
               } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                   n = (n > 0 || -1) * Math.floor(Math.abs(n));
               }
           }
           if (n >= len) {
               return -1;
           }
           var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
           for (; k < len; k++) {
               if (k in t && t[k] === searchElement) {
                   return k;
               }
           }
           return -1;
       }
   }
   
   // ]]>
   </script>
   
   ENDJS
   
   }
   
 sub userbrowser_javascript {  sub userbrowser_javascript {
     my $id_functions = &javascript_index_functions();      my $id_functions = &javascript_index_functions();
     return <<"ENDUSERBRW";      return <<"ENDUSERBRW";
Line 658  ENDUSERBRW Line 765  ENDUSERBRW
 }  }
   
 sub setsec_javascript {  sub setsec_javascript {
     my ($sec_element,$formname,$role_element) = @_;      my ($sec_element,$formname,$role_element,$credits_element) = @_;
     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,      my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
         $communityrolestr);          $communityrolestr);
     if ($role_element ne '') {      if ($role_element ne '') {
Line 753  function setRole(crstype) { Line 860  function setRole(crstype) {
 }  }
 |;  |;
     }      }
       if ($credits_element) {
           $setsections .= qq|
   function setCredits(defaultcredits) {
       document.$formname.$credits_element.value = defaultcredits;
       return;
   }
   |;
       }
     return $setsections;      return $setsections;
 }  }
   
Line 766  sub selectcourse_link { Line 881  sub selectcourse_link {
    } elsif ($selecttype eq 'Course/Community') {     } elsif ($selecttype eq 'Course/Community') {
        $linktext = &mt('Select Course/Community');         $linktext = &mt('Select Course/Community');
        $type = '';         $type = '';
      } elsif ($selecttype eq 'Select') {
          $linktext = &mt('Select');
          $type = '';
    }     }
    return '<span class="LC_nobreak">'     return '<span class="LC_nobreak">'
          ."<a href='"           ."<a href='"
Line 795  sub check_uncheck_jscript { Line 913  sub check_uncheck_jscript {
 function checkAll(field) {  function checkAll(field) {
     if (field.length > 0) {      if (field.length > 0) {
         for (i = 0; i < field.length; i++) {          for (i = 0; i < field.length; i++) {
             field[i].checked = true ;              if (!field[i].disabled) {
                   field[i].checked = true;
               }
         }          }
     } else {      } else {
         field.checked = true          if (!field.disabled) {
               field.checked = true;
           }
     }      }
 }  }
     
Line 816  ENDSCRT Line 938  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 838  sub select_timezone { Line 960  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 847  sub select_datelocale { Line 969  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 869  sub select_datelocale { Line 992  sub select_datelocale {
                         $locale_names{$id} = '('.$en_terr.')';                          $locale_names{$id} = '('.$en_terr.')';
                     }                      }
                 }                  }
                 push (@possibles,$id);                  $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
                   push(@possibles,$id);
             }              }
         }          }
     }      }
Line 880  sub select_datelocale { Line 1004  sub select_datelocale {
         }          }
         $output.=">$item";          $output.=">$item";
         if ($locale_names{$item} ne '') {          if ($locale_names{$item} ne '') {
             $output.="  $locale_names{$item}</option>\n";              $output.='  '.$locale_names{$item};
         }          }
         $output.="</option>\n";          $output.="</option>\n";
     }      }
Line 889  sub select_datelocale { Line 1013  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 900  sub select_language { Line 1024  sub select_language {
             $langchoices{$code} = &plainlanguagedescription($id);              $langchoices{$code} = &plainlanguagedescription($id);
         }          }
     }      }
     return &select_form($selected,$name,\%langchoices);      %langchoices = &Apache::lonlocal::texthash(%langchoices);
       return &select_form($selected,$name,\%langchoices,undef,$noedit);
 }  }
   
 =pod  =pod
Line 931  linked_select_forms takes the following Line 1056  linked_select_forms takes the following
   
 =item * $menuorder, the order of values in the first menu  =item * $menuorder, the order of values in the first menu
   
   =item * $onchangefirst, additional javascript call to execute for an onchange
           event for the first <select> tag
   
   =item * $onchangesecond, additional javascript call to execute for an onchange
           event for the second <select> tag
   
 =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 984  sub linked_select_forms { Line 1115  sub linked_select_forms {
         $secondselectname,           $secondselectname, 
         $hashref,          $hashref,
         $menuorder,          $menuorder,
           $onchangefirst,
           $onchangesecond
         ) = @_;          ) = @_;
     my $second = "document.$formname.$secondselectname";      my $second = "document.$formname.$secondselectname";
     my $first = "document.$formname.$firstselectname";      my $first = "document.$formname.$firstselectname";
Line 1007  sub linked_select_forms { Line 1140  sub linked_select_forms {
         $result.="select2data.d_$s1.texts = new Array(";                  $result.="select2data.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";
     }      }
Line 1040  function select1_changed() { Line 1173  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()\">\n";      $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_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 1053  END Line 1186  END
     $result .= "</select>\n";      $result .= "</select>\n";
     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};      my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
     $result .= $middletext;      $result .= $middletext;
     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";      $result .= "<select size=\"1\" name=\"$secondselectname\"";
       if ($onchangesecond) {
           $result .= ' onchange="'.$onchangesecond.'"';
       }
       $result .= ">\n";
     my $seconddefault = $hashref->{$firstdefault}->{'default'};      my $seconddefault = $hashref->{$firstdefault}->{'default'};
           
     my @secondorder = sort(keys(%select2));      my @secondorder = sort(keys(%select2));
Line 1102  sub help_open_topic { Line 1239  sub help_open_topic {
     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;      my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     $width = 350 if (not defined $width);      $width = 500 if (not defined $width);
     $height = 400 if (not defined $height);      $height = 400 if (not defined $height);
     my $filename = $topic;      my $filename = $topic;
     $filename =~ s/ /_/g;      $filename =~ s/ /_/g;
Line 1113  sub help_open_topic { Line 1250  sub help_open_topic {
     $topic=~s/\W/\_/g;      $topic=~s/\W/\_/g;
   
     if (!$stayOnPage) {      if (!$stayOnPage) {
  $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";          if ($env{'browser.mobile'}) {
       $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
           } else {
               $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
           }
       } elsif ($stayOnPage eq 'popup') {
           $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
     } else {      } else {
  $link = "/adm/help/${filename}.hlp";   $link = "/adm/help/${filename}.hlp";
     }      }
Line 1146  sub help_open_topic { Line 1289  sub help_open_topic {
 # This is a quicky function for Latex cheatsheet editing, since it   # This is a quicky function for Latex cheatsheet editing, since it 
 # appears in at least four places  # appears in at least four places
 sub helpLatexCheatsheet {  sub helpLatexCheatsheet {
     my ($topic,$text,$not_author) = @_;      my ($topic,$text,$not_author,$stayOnPage) = @_;
     my $out;      my $out;
     my $addOther = '';      my $addOther = '';
     if ($topic) {      if ($topic) {
  $addOther = '<span>'.&Apache::loncommon::help_open_topic($topic,&mt($text),   $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
        undef, undef, 600).  
    '</span> ';  
     }      }
     $out = '<span>' # Start cheatsheet      $out = '<span>' # Start cheatsheet
   .$addOther    .$addOther
           .'<span>'            .'<span>'
   .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'),    .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
        undef,undef,600)  
   .'</span> <span>'    .'</span> <span>'
   .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'),    .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
        undef,undef,600)  
   .'</span>';    .'</span>';
     unless ($not_author) {      unless ($not_author) {
         $out .= ' <span>'          $out .= ' <span>'
        .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),         .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
                                             undef,undef,600)         .'</span> <span>'
        .'</span>';                 .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
                  .'</span>';
     }      }
     $out .= '</span>'; # End cheatsheet      $out .= '</span>'; # End cheatsheet
     return $out;      return $out;
Line 1230  sub help_open_menu { Line 1370  sub help_open_menu {
 sub top_nav_help {  sub top_nav_help {
     my ($text) = @_;      my ($text) = @_;
     $text = &mt($text);      $text = &mt($text);
     my $stay_on_page = 1;      my $stay_on_page;
       unless ($env{'environment.remote'} eq 'on') {
     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"          $stay_on_page = 1;
                      : "javascript:helpMenu('open')";      }
     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);      my ($link,$banner_link);
       unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
           $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                            : "javascript:helpMenu('open')";
           $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
       }
     my $title = &mt('Get help');      my $title = &mt('Get help');
       if ($link) {
     return <<"END";          return <<"END";
 $banner_link  $banner_link
  <a href="$link" title="$title">$text</a>  <a href="$link" title="$title">$text</a>
 END  END
       } else {
           return '&nbsp;'.$text.'&nbsp;';
       }
 }  }
   
 sub help_menu_js {  sub help_menu_js {
     my ($text) = @_;      my ($httphost) = @_;
     my $stayOnPage = 1;      my $stayOnPage = 1;
     my $width = 620;      my $width = 620;
     my $height = 600;      my $height = 600;
     my $helptopic=&general_help();      my $helptopic=&general_help();
     my $details_link = '/adm/help/'.$helptopic.'.hlp';      my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();      my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
     my $start_page =      my $start_page =
         &Apache::loncommon::start_page('Help Menu', undef,          &Apache::loncommon::start_page('Help Menu', undef,
        {'frameset'    => 1,         {'frameset'    => 1,
  'js_ready'    => 1,   'js_ready'    => 1,
                                           'use_absolute' => $httphost, 
  'add_entries' => {   'add_entries' => {
     'border' => '0',      'border' => '0',
     'rows'   => "110,*",},});      'rows'   => "110,*",},});
Line 1287  function helpMenu(target) { Line 1435  function helpMenu(target) {
     return;      return;
 }  }
 function writeHelp(caller) {  function writeHelp(caller) {
     caller.document.writeln('$start_page<frame name="bannerframe"  src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')      caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
     caller.document.close()      caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
     caller.focus()      caller.document.close();
       caller.focus();
 }  }
 // END LON-CAPA Internal -->  // END LON-CAPA Internal -->
 // ]]>  // ]]>
Line 1597  RESIZE Line 1746  RESIZE
   
 }  }
   
   sub colorfuleditor_js {
       return <<"COLORFULEDIT"
   <script type="text/javascript">
   // <![CDATA[>
       function fold_box(curDepth, lastresource){
   
       // we need a list because there can be several blocks you need to fold in one tag
           var block = document.getElementsByName('foldblock_'+curDepth);
       // but there is only one folding button per tag
           var foldbutton = document.getElementById('folding_btn_'+curDepth);
   
           if(block.item(0).style.display == 'none'){
   
               foldbutton.value = '@{[&mt("Hide")]}';
               for (i = 0; i < block.length; i++){
                   block.item(i).style.display = '';
               }
           }else{
   
               foldbutton.value = '@{[&mt("Show")]}';
               for (i = 0; i < block.length; i++){
                   // block.item(i).style.visibility = 'collapse';
                   block.item(i).style.display = 'none';
               }
           };
           saveState(lastresource);
       }
   
       function saveState (lastresource) {
   
           var tag_list = getTagList();
           if(tag_list != null){
               var timestamp = new Date().getTime();
               var key = lastresource;
   
               // the value pattern is: 'time;key1,value1;key2,value2; ... '
               // starting with timestamp
               var value = timestamp+';';
   
               // building the list of key-value pairs
               for(var i = 0; i < tag_list.length; i++){
                   value += tag_list[i]+',';
                   value += document.getElementsByName(tag_list[i])[0].style.display+';';
               }
   
               // only iterate whole storage if nothing to override
               if(localStorage.getItem(key) == null){
   
                   // prevent storage from growing large
                   if(localStorage.length > 50){
                       var regex_getTimestamp = /^(?:\d)+;/;
                       var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                       var oldest_key;
   
                       for(var i = 1; i < localStorage.length; i++){
                           if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                               oldest_key = localStorage.key(i);
                               oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                           }
                       }
                       localStorage.removeItem(oldest_key);
                   }
               }
               localStorage.setItem(key,value);
           }
       }
   
       // restore folding status of blocks (on page load)
       function restoreState (lastresource) {
           if(localStorage.getItem(lastresource) != null){
               var key = lastresource;
               var value = localStorage.getItem(key);
               var regex_delTimestamp = /^\d+;/;
   
               value.replace(regex_delTimestamp, '');
   
               var valueArr = value.split(';');
               var pairs;
               var elements;
               for (var i = 0; i < valueArr.length; i++){
                   pairs = valueArr[i].split(',');
                   elements = document.getElementsByName(pairs[0]);
   
                   for (var j = 0; j < elements.length; j++){
                       elements[j].style.display = pairs[1];
                       if (pairs[1] == "none"){
                           var regex_id = /([_\\d]+)\$/;
                           regex_id.exec(pairs[0]);
                           document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                       }
                   }
               }
           }
       }
   
       function getTagList () {
   
           var stringToSearch = document.lonhomework.innerHTML;
   
           var ret = new Array();
           var regex_findBlock = /(foldblock_.*?)"/g;
           var tag_list = stringToSearch.match(regex_findBlock);
   
           if(tag_list != null){
               for(var i = 0; i < tag_list.length; i++){
                   ret.push(tag_list[i].replace(/"/, ''));
               }
           }
           return ret;
       }
   
       function saveScrollPosition (resource) {
           var tag_list = getTagList();
   
           // we dont always want to jump to the first block
           // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
           if(\$(window).scrollTop() > 170){
               if(tag_list != null){
                   var result;
                   for(var i = 0; i < tag_list.length; i++){
                       if(isElementInViewport(tag_list[i])){
                           result += tag_list[i]+';';
                       }
                   }
                   sessionStorage.setItem('anchor_'+resource, result);
               }
           } else {
               // we dont need to save zero, just delete the item to leave everything tidy
               sessionStorage.removeItem('anchor_'+resource);
           }
       }
   
       function restoreScrollPosition(resource){
   
           var elem = sessionStorage.getItem('anchor_'+resource);
           if(elem != null){
               var tag_list = elem.split(';');
               var elem_list;
   
               for(var i = 0; i < tag_list.length; i++){
                   elem_list = document.getElementsByName(tag_list[i]);
   
                   if(elem_list.length > 0){
                       elem = elem_list[0];
                       break;
                   }
               }
               elem.scrollIntoView();
           }
       }
   
       function isElementInViewport(el) {
   
           // change to last element instead of first
           var elem = document.getElementsByName(el);
           var rect = elem[0].getBoundingClientRect();
   
           return (
               rect.top >= 0 &&
               rect.left >= 0 &&
               rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
               rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
           );
       }
   
       function autosize(depth){
           var cmInst = window['cm'+depth];
           var fitsizeButton = document.getElementById('fitsize'+depth);
   
           // is fixed size, switching to dynamic
           if (sessionStorage.getItem("autosized_"+depth) == null) {
               cmInst.setSize("","auto");
               fitsizeButton.value = "@{[&mt('Fixed size')]}";
               sessionStorage.setItem("autosized_"+depth, "yes");
   
           // is dynamic size, switching to fixed
           } else {
               cmInst.setSize("","300px");
               fitsizeButton.value = "@{[&mt('Dynamic size')]}";
               sessionStorage.removeItem("autosized_"+depth);
           }
       }
   
   
   
   // ]]>
   </script>
   COLORFULEDIT
   }
   
   sub xmleditor_js {
       return <<XMLEDIT
   <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
   <script type="text/javascript">
   // <![CDATA[>
   
       function saveScrollPosition (resource) {
   
           var scrollPos = \$(window).scrollTop();
           sessionStorage.setItem(resource,scrollPos);
       }
   
       function restoreScrollPosition(resource){
   
           var scrollPos = sessionStorage.getItem(resource);
           \$(window).scrollTop(scrollPos);
       }
   
       // unless internet explorer
       if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
   
           \$(document).ready(function() {
                \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
           });
       }
   
       // inserts text at cursor position into codemirror (xml editor only)
       function insertText(text){
           cm.focus();
           var curPos = cm.getCursor();
           cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
       }
   // ]]>
   </script>
   XMLEDIT
   }
   
   sub insert_folding_button {
       my $curDepth = $Apache::lonxml::curdepth;
       my $lastresource = $env{'request.ambiguous'};
   
       return "<input type=\"button\" id=\"folding_btn_$curDepth\"
               value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
   }
   
   
 =pod  =pod
   
 =head1 Excel and CSV file utility routines  =head1 Excel and CSV file utility routines
   
 =over 4  
   
 =cut  =cut
   
 ###############################################################  ###############################################################
Line 1610  RESIZE Line 1993  RESIZE
   
 =pod  =pod
   
   =over 4
   
 =item * &csv_translate($text)   =item * &csv_translate($text) 
   
 Translate $text to allow it to be output as a 'comma separated values'   Translate $text to allow it to be output as a 'comma separated values' 
Line 1661  Inputs: $workbook Line 2046  Inputs: $workbook
   
 Returns: $format, a hash reference.  Returns: $format, a hash reference.
   
   
 =cut  =cut
   
 ###############################################################  ###############################################################
Line 1722  sub create_workbook { Line 2108  sub create_workbook {
         return (undef);          return (undef);
     }      }
     #      #
     $workbook->set_tempdir('/home/httpd/perl/tmp');      $workbook->set_tempdir(LONCAPA::tempdir());
     #      #
     my $format = &Apache::loncommon::define_excel_formats($workbook);      my $format = &Apache::loncommon::define_excel_formats($workbook);
     return ($workbook,$filename,$format);      return ($workbook,$filename,$format);
Line 1855  sub multiple_select_form { Line 2241  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 1868  See lonrights.pm for an example invocati Line 2257  See lonrights.pm for an example invocati
   
 #-------------------------------------------  #-------------------------------------------
 sub select_form {  sub select_form {
     my ($def,$name,$hashref,$onchange) = @_;      my ($def,$name,$hashref,$onchange,$readonly) = @_;
     return unless (ref($hashref) eq 'HASH');      return unless (ref($hashref) eq 'HASH');
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
     }      }
     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";      my $disabled;
       if ($readonly) {
           $disabled = ' disabled="disabled"';
       }
       my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
     my @keys;      my @keys;
     if (exists($hashref->{'select_form_order'})) {      if (exists($hashref->{'select_form_order'})) {
  @keys=@{$hashref->{'select_form_order'}};   @keys=@{$hashref->{'select_form_order'}};
Line 1893  sub select_form { Line 2286  sub select_form {
 # For display filters  # For display filters
   
 sub display_filter {  sub display_filter {
       my ($context) = @_;
     if (!$env{'form.show'}) { $env{'form.show'}=10; }      if (!$env{'form.show'}) { $env{'form.show'}=10; }
     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }      if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
     return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',      my $phraseinput = 'hidden';
       my $includeinput = 'hidden';
       my ($checked,$includetypestext);
       if ($env{'form.displayfilter'} eq 'containing') {
           $phraseinput = 'text'; 
           if ($context eq 'parmslog') {
               $includeinput = 'checkbox';
               if ($env{'form.includetypes'}) {
                   $checked = ' checked="checked"';
               }
               $includetypestext = &mt('Include parameter types');
           }
       } else {
           $includetypestext = '&nbsp;';
       }
       my ($additional,$secondid,$thirdid);
       if ($context eq 'parmslog') {
           $additional = 
               '<label><input type="'.$includeinput.'" name="includetypes"'. 
               $checked.' name="includetypes" value="1" id="includetypes" />'.
               '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
               '</label>';
           $secondid = 'includetypes';
           $thirdid = 'includetypestext';
       }
       my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                                                       '$secondid','$thirdid')";
       return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
        &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,         &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
    (&mt('all'),10,20,50,100,1000,10000))).     (&mt('all'),10,20,50,100,1000,10000))).
    '</label></span> <span class="LC_nobreak">'.     '</label></span> <span class="LC_nobreak">'.
            &mt('Filter [_1]',             &mt('Filter: [_1]',
    &select_form($env{'form.displayfilter'},     &select_form($env{'form.displayfilter'},
  'displayfilter',   'displayfilter',
  {'currentfolder' => 'Current folder/page',   {'currentfolder' => 'Current folder/page',
  'containing' => 'Containing phrase',   'containing' => 'Containing phrase',
  'none' => 'None'})).   'none' => 'None'},$onchange)).'&nbsp;'.
  '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';   '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                            &HTML::Entities::encode($env{'form.containingphrase'}).
                            '" />'.$additional;
   }
   
   sub display_filter_js {
       my $includetext = &mt('Include parameter types');
       return <<"ENDJS";
     
   function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
       var firstType = 'hidden';
       if (setter.options[setter.selectedIndex].value == 'containing') {
           firstType = 'text';
       }
       firstObject = document.getElementById(firstid);
       if (typeof(firstObject) == 'object') {
           if (firstObject.type != firstType) {
               changeInputType(firstObject,firstType);
           }
       }
       if (context == 'parmslog') {
           var secondType = 'hidden';
           if (firstType == 'text') {
               secondType = 'checkbox';
           }
           secondObject = document.getElementById(secondid);  
           if (typeof(secondObject) == 'object') {
               if (secondObject.type != secondType) {
                   changeInputType(secondObject,secondType);
               }
           }
           var textItem = document.getElementById(thirdid);
           var currtext = textItem.innerHTML;
           var newtext;
           if (firstType == 'text') {
               newtext = '$includetext';
           } else {
               newtext = '&nbsp;';
           }
           if (currtext != newtext) {
               textItem.innerHTML = newtext;
           }
       }
       return;
   }
   
   function changeInputType(oldObject,newType) {
       var newObject = document.createElement('input');
       newObject.type = newType;
       if (oldObject.size) {
           newObject.size = oldObject.size;
       }
       if (oldObject.value) {
           newObject.value = oldObject.value;
       }
       if (oldObject.name) {
           newObject.name = oldObject.name;
       }
       if (oldObject.id) {
           newObject.id = oldObject.id;
       }
       oldObject.parentNode.replaceChild(newObject,oldObject);
       return;
   }
   
   ENDJS
 }  }
   
 sub gradeleveldescription {  sub gradeleveldescription {
Line 1949  sub select_level_form { Line 2435  sub select_level_form {
   
 =pod  =pod
   
 =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)  =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 1962  If the $showdomdesc flag is set, the dom Line 2448  If the $showdomdesc flag is set, the dom
   
 The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.  The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
   
 The optional $incdoms is a reference to an array of domains which will be the only available options.   The optional $incdoms is a reference to an array of domains which will be the only 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) = @_;      my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
     }      }
     my @domains;      if ($disabled) {
           $disabled = ' disabled="disabled"';
       }
       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});
     } else {      } else {
         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());          @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
     }      }
     if ($includeempty) { @domains=('',@domains); }      if ($includeempty) { @domains=('',@domains); }
     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";      if (ref($excdoms) eq 'ARRAY') {
           map { $exclude{$_} = 1; } @{$excdoms};
       }
       my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
     foreach my $dom (@domains) {      foreach my $dom (@domains) {
           next if ($exclude{$dom});
         $selectdomain.="<option value=\"$dom\" ".          $selectdomain.="<option value=\"$dom\" ".
             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;              ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
         if ($showdomdesc) {          if ($showdomdesc) {
Line 2101  Outputs: Line 2598  Outputs:
   
 =item * $clientos  =item * $clientos
   
   =item * $clientmobile
   
   =item * $clientinfo
   
   =item * $clientosversion
   
 =back  =back
   
 =back   =back 
Line 2119  sub decode_user_agent { Line 2622  sub decode_user_agent {
     my $clientversion='0';      my $clientversion='0';
     my $clientmathml='';      my $clientmathml='';
     my $clientunicode='0';      my $clientunicode='0';
       my $clientmobile=0;
       my $clientosversion='';
     for (my $i=0;$i<=$#browsertype;$i++) {      for (my $i=0;$i<=$#browsertype;$i++) {
         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);          my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
  if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {   if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
     $clientbrowser=$bname;      $clientbrowser=$bname;
             $httpbrowser=~/$vreg/i;              $httpbrowser=~/$vreg/i;
Line 2130  sub decode_user_agent { Line 2635  sub decode_user_agent {
  }   }
     }      }
     my $clientos='unknown';      my $clientos='unknown';
       my $clientinfo;
     if (($httpbrowser=~/linux/i) ||      if (($httpbrowser=~/linux/i) ||
         ($httpbrowser=~/unix/i) ||          ($httpbrowser=~/unix/i) ||
         ($httpbrowser=~/ux/i) ||          ($httpbrowser=~/ux/i) ||
Line 2139  sub decode_user_agent { Line 2645  sub decode_user_agent {
     if ($httpbrowser=~/next/i) { $clientos='next'; }      if ($httpbrowser=~/next/i) { $clientos='next'; }
     if (($httpbrowser=~/mac/i) ||      if (($httpbrowser=~/mac/i) ||
         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }          ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
     if ($httpbrowser=~/win/i) { $clientos='win'; }      if ($httpbrowser=~/win/i) {
           $clientos='win';
           if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
               $clientosversion = $1;
           }
       }
     if ($httpbrowser=~/embed/i) { $clientos='pda'; }      if ($httpbrowser=~/embed/i) { $clientos='pda'; }
       if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
           $clientmobile=lc($1);
       }
       if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
           $clientinfo = 'firefox-'.$1;
       } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
           $clientinfo = 'chromeframe-'.$1;
       }
     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,      return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
             $clientunicode,$clientos,);              $clientunicode,$clientos,$clientmobile,$clientinfo,
               $clientosversion);
 }  }
   
 ###############################################################  ###############################################################
Line 2294  END Line 2814  END
     return $result;      return $result;
 }  }
   
 sub authform_authorwarning{  sub authform_authorwarning {
     my $result='';      my $result='';
     $result='<i>'.      $result='<i>'.
         &mt('As a general rule, only authors or co-authors should be '.          &mt('As a general rule, only authors or co-authors should be '.
Line 2303  sub authform_authorwarning{ Line 2823  sub authform_authorwarning{
     return $result;      return $result;
 }  }
   
 sub authform_nochange{    sub authform_nochange {
     my %in = (      my %in = (
               formname => 'document.cu',                formname => 'document.cu',
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
           );            );
     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});       my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
     my $result;      my $result;
     if (keys(%can_assign) == 0) {      if (!$authnum) {
         $result = &mt('Under you current role you are not permitted to change login settings for this user');            $result = &mt('Under your current role you are not permitted to change login settings for this user');
     } else {      } else {
         $result = '<label>'.&mt('[_1] Do not change login data',          $result = '<label>'.&mt('[_1] Do not change login data',
                   '<input type="radio" name="login" value="nochange" '.                    '<input type="radio" name="login" value="nochange" '.
Line 2331  sub authform_kerberos { Line 2851  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 2382  sub authform_kerberos { Line 2905  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="hidden" name="login" value="krb" />';                      $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2391  sub authform_kerberos { Line 2914  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'} &&
          $in{'curr_authtype'} eq 'krb5') ||           $in{'curr_authtype'} eq 'krb5') ||
         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&           (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
          $in{'curr_authtype'} eq 'krb4')) {           $in{'curr_authtype'} eq 'krb4')) {
         $result .= &mt          $result .= &mt
         ('[_1] Kerberos authenticated with domain [_2] '.          ('[_1] Kerberos authenticated with domain [_2] '.
Line 2404  sub authform_kerberos { Line 2927  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 2415  sub authform_kerberos { Line 2938  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 2425  sub authform_kerberos { Line 2948  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>');
     }      }
     return $result;      return $result;
 }  }
   
 sub authform_internal{    sub authform_internal {
     my %in = (      my %in = (
                 formname => 'document.cu',                  formname => 'document.cu',
                 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 2468  sub authform_internal{ Line 2994  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="hidden" name="login" value="int" />';                      $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2476  sub authform_internal{ Line 3002  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;
 }  }
   
 sub authform_local{    sub authform_local {
     my %in = (      my %in = (
               formname => 'document.cu',                formname => 'document.cu',
               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 2523  sub authform_local{ Line 3052  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="hidden" name="login" value="loc" />';                      $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2532  sub authform_local{ Line 3061  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;
 }  }
   
 sub authform_filesystem{    sub authform_filesystem {
     my %in = (      my %in = (
               formname => 'document.cu',                formname => 'document.cu',
               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 2574  sub authform_filesystem{ Line 3106  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="hidden" name="login" value="fsys" />';                      $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2583  sub authform_filesystem{ Line 3115  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 2614  sub get_assignable_auth { Line 3146  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 2769  database which holds them. Line 3301  database which holds them.
   
 Uses global $thesaurus_db_file.  Uses global $thesaurus_db_file.
   
   
 =cut  =cut
   
 ###############################################################  ###############################################################
Line 3001  sub screenname { Line 3534  sub screenname {
 # ------------------------------------------------------------- Confirm Wrapper  # ------------------------------------------------------------- Confirm Wrapper
 =pod  =pod
   
 =item confirmwrapper  =item * &confirmwrapper($message)
   
 Wrap messages about completion of operation in box  Wrap messages about completion of operation in box
   
Line 3040  sub noteswrapper { Line 3573  sub noteswrapper {
 # ------------------------------------------------------------- Aboutme Wrapper  # ------------------------------------------------------------- Aboutme Wrapper
   
 sub aboutmewrapper {  sub aboutmewrapper {
     my ($link,$username,$domain,$target)=@_;      my ($link,$username,$domain,$target,$class)=@_;
     if (!defined($username)  && !defined($domain)) {      if (!defined($username)  && !defined($domain)) {
         return;          return;
     }      }
     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.      return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
  ($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';   ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
 }  }
   
 # ------------------------------------------------------------ Syllabus Wrapper  # ------------------------------------------------------------ Syllabus Wrapper
Line 3146  sub languagedescription { Line 3679  sub languagedescription {
     ($supported_language{$code}?' ('.&mt('interface available').')':'');      ($supported_language{$code}?' ('.&mt('interface available').')':'');
 }  }
   
   =pod
   
   =item * &plainlanguagedescription
   
   Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
   and the language character encoding (e.g. ISO) separated by a ' - ' string.
   
   =cut
   
 sub plainlanguagedescription {  sub plainlanguagedescription {
     my $code=shift;      my $code=shift;
     return $language{$code};      return $language{$code};
 }  }
   
   =pod
   
   =item * &supportedlanguagecode
   
   Returns the supported language code (e.g. sptutf maps to pt) given a language
   code.
   
   =cut
   
 sub supportedlanguagecode {  sub supportedlanguagecode {
     my $code=shift;      my $code=shift;
     return $supported_language{$code};      return $supported_language{$code};
Line 3158  sub supportedlanguagecode { Line 3709  sub supportedlanguagecode {
   
 =pod  =pod
   
   =item * &latexlanguage()
   
   Given a language key code returns the correspondnig language to use
   to select the correct hyphenation on LaTeX printouts.  This is undef if there
   is no supported hyphenation for the language code.
   
   =cut
   
   sub latexlanguage {
       my $code = shift;
       return $latex_language{$code};
   }
   
   =pod
   
   =item * &latexhyphenation()
   
   Same as above but what's supplied is the language as it might be stored
   in the metadata.
   
   =cut
   
   sub latexhyphenation {
       my $key = shift;
       return $latex_language_bykey{$key};
   }
   
   =pod
   
 =item * &copyrightids()   =item * &copyrightids() 
   
 returns list of all copyrights  returns list of all copyrights
Line 3370  sub user_lang { Line 3950  sub user_lang {
 =over 4  =over 4
   
 =item * &get_previous_attempt($symb, $username, $domain, $course,  =item * &get_previous_attempt($symb, $username, $domain, $course,
     $getattempt, $regexp, $gradesub)      $getattempt, $regexp, $gradesub, $usec, $identifier)
   
 Return string with previous attempt on problem. Arguments:  Return string with previous attempt on problem. Arguments:
   
Line 3392  Return string with previous attempt on p Line 3972  Return string with previous attempt on p
   
 =item * $gradesub: routine that processes the string if it matches $regexp  =item * $gradesub: routine that processes the string if it matches $regexp
   
   =item * $usec: section of the desired student
   
   =item * $identifier: counter for student (multiple students one problem) or
       problem (one student; whole sequence).
   
 =back  =back
   
 The output string is a table containing all desired attempts, if any.  The output string is a table containing all desired attempts, if any.
Line 3399  The output string is a table containing Line 3984  The output string is a table containing
 =cut  =cut
   
 sub get_previous_attempt {  sub get_previous_attempt {
   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;    my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
   my $prevattempts='';    my $prevattempts='';
   no strict 'refs';    no strict 'refs';
   if ($symb) {    if ($symb) {
Line 3409  sub get_previous_attempt { Line 3994  sub get_previous_attempt {
       my %lasthash=();        my %lasthash=();
       my $version;        my $version;
       for ($version=1;$version<=$returnhash{'version'};$version++) {        for ($version=1;$version<=$returnhash{'version'};$version++) {
         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {          foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
   $lasthash{$key}=$returnhash{$version.':'.$key};              if ($key =~ /\.rawrndseed$/) {
                   my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
               } else {
                   $lasthash{$key}=$returnhash{$version.':'.$key};
               }
         }          }
       }        }
       $prevattempts=&start_data_table().&start_data_table_header_row();        $prevattempts=&start_data_table().&start_data_table_header_row();
       $prevattempts.='<th>'.&mt('History').'</th>';        $prevattempts.='<th>'.&mt('History').'</th>';
       my (%typeparts,%lasthidden);        my (%typeparts,%lasthidden,%regraded,%hidestatus);
       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});        my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
       foreach my $key (sort(keys(%lasthash))) {        foreach my $key (sort(keys(%lasthash))) {
  my ($ign,@parts) = split(/\./,$key);   my ($ign,@parts) = split(/\./,$key);
Line 3423  sub get_previous_attempt { Line 4013  sub get_previous_attempt {
   my $data=$parts[-1];    my $data=$parts[-1];
           next if ($data eq 'foilorder');            next if ($data eq 'foilorder');
   pop(@parts);    pop(@parts);
             $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
           if ($data eq 'type') {            if ($data eq 'type') {
               unless ($showsurv) {                unless ($showsurv) {
                   my $id = join(',',@parts);                    my $id = join(',',@parts);
Line 3431  sub get_previous_attempt { Line 4022  sub get_previous_attempt {
                       $lasthidden{$ign.'.'.$id} = 1;                        $lasthidden{$ign.'.'.$id} = 1;
                   }                    }
               }                }
               delete($lasthash{$key});                if ($identifier ne '') {
           } else {                    my $id = join(',',@parts);
       $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';                    if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
           }                                                 $domain,$username,$usec,undef,$course) =~ /^no/) {
                         $hidestatus{$ign.'.'.$id} = 1;
                     }
                 }
             } elsif ($data eq 'regrader') {
                 if (($identifier ne '') && (@parts)) {
                     my $id = join(',',@parts);
                     $regraded{$ign.'.'.$id} = 1;
                 }
             } 
  } else {   } else {
   if ($#parts == 0) {    if ($#parts == 0) {
     $prevattempts.='<th>'.$parts[0].'</th>';      $prevattempts.='<th>'.$parts[0].'</th>';
Line 3445  sub get_previous_attempt { Line 4045  sub get_previous_attempt {
       }        }
       $prevattempts.=&end_data_table_header_row();        $prevattempts.=&end_data_table_header_row();
       if ($getattempt eq '') {        if ($getattempt eq '') {
           my (%solved,%resets,%probstatus);
           if (($identifier ne '') && (keys(%regraded) > 0)) {
               for ($version=1;$version<=$returnhash{'version'};$version++) {
                   foreach my $id (keys(%regraded)) {
                       if (($returnhash{$version.':'.$id.'.regrader'}) &&
                           ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                           ($returnhash{$version.':'.$id.'.award'} eq '')) {
                           push(@{$resets{$id}},$version);
                       }
                   }
               }
           }
  for ($version=1;$version<=$returnhash{'version'};$version++) {   for ($version=1;$version<=$returnhash{'version'};$version++) {
             my @hidden;              my (@hidden,@unsolved);
             if (%typeparts) {              if (%typeparts) {
                 foreach my $id (keys(%typeparts)) {                  foreach my $id (keys(%typeparts)) {
                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {                      if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
                           ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                         push(@hidden,$id);                          push(@hidden,$id);
                       } elsif ($identifier ne '') {
                           unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                                   ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                                   ($hidestatus{$id})) {
                               next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
                               if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                                   push(@{$solved{$id}},$version);
                               } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                                        (ref($solved{$id}) eq 'ARRAY')) {
                                   my $skip;
                                   if (ref($resets{$id}) eq 'ARRAY') {
                                       foreach my $reset (@{$resets{$id}}) {
                                           if ($reset > $solved{$id}[-1]) {
                                               $skip=1;
                                               last;
                                           }
                                       }
                                   }
                                   unless ($skip) {
                                       my ($ign,$partslist) = split(/\./,$id,2);
                                       push(@unsolved,$partslist);
                                   }
                               }
                           }
                     }                      }
                 }                  }
             }              }
             $prevattempts.=&start_data_table_row().              $prevattempts.=&start_data_table_row().
                            '<td>'.&mt('Transaction [_1]',$version).'</td>';                             '<td>'.&mt('Transaction [_1]',$version);
               if (@unsolved) {
                   $prevattempts .= '<span class="LC_nobreak"><label>'.
                                    '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                                    &mt('Hide').'</label></span>';
               }
               $prevattempts .= '</td>';
             if (@hidden) {              if (@hidden) {
                 foreach my $key (sort(keys(%lasthash))) {                  foreach my $key (sort(keys(%lasthash))) {
                     next if ($key =~ /\.foilorder$/);                      next if ($key =~ /\.foilorder$/);
Line 3477  sub get_previous_attempt { Line 4120  sub get_previous_attempt {
                         }                          }
                     } else {                      } else {
                         if ($key =~ /\./) {                          if ($key =~ /\./) {
                             my $value = &format_previous_attempt_value($key,                              my $value = $returnhash{$version.':'.$key};
                                               $returnhash{$version.':'.$key});                              if ($key =~ /\.rndseed$/) {
                             $prevattempts.='<td>'.$value.'&nbsp;</td>';                                  my ($id) = ($key =~ /^(.+)\.rndseed$/);
                                   if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                                       $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                                   }
                               }
                               $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                                              '&nbsp;</td>';
                         } else {                          } else {
                             $prevattempts.='<td>&nbsp;</td>';                              $prevattempts.='<td>&nbsp;</td>';
                         }                          }
Line 3488  sub get_previous_attempt { Line 4137  sub get_previous_attempt {
             } else {              } else {
         foreach my $key (sort(keys(%lasthash))) {          foreach my $key (sort(keys(%lasthash))) {
                     next if ($key =~ /\.foilorder$/);                      next if ($key =~ /\.foilorder$/);
     my $value = &format_previous_attempt_value($key,                      my $value = $returnhash{$version.':'.$key};
             $returnhash{$version.':'.$key});                      if ($key =~ /\.rndseed$/) {
     $prevattempts.='<td>'.$value.'&nbsp;</td>';                          my ($id) = ($key =~ /^(.+)\.rndseed$/);
                           if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                               $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                           }
                       }
                       $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                                      '&nbsp;</td>';
         }          }
             }              }
     $prevattempts.=&end_data_table_row();      $prevattempts.=&end_data_table_row();
Line 3551  sub get_previous_attempt { Line 4206  sub get_previous_attempt {
   
 sub format_previous_attempt_value {  sub format_previous_attempt_value {
     my ($key,$value) = @_;      my ($key,$value) = @_;
     if ($key =~ /timestamp/) {      if (($key =~ /timestamp/) || ($key=~/duedate/)) {
  $value = &Apache::lonlocal::locallocaltime($value);   $value = &Apache::lonlocal::locallocaltime($value);
     } elsif (ref($value) eq 'ARRAY') {      } elsif (ref($value) eq 'ARRAY') {
  $value = '('.join(', ', @{ $value }).')';   $value = '('.join(', ', @{ $value }).')';
Line 3560  sub format_previous_attempt_value { Line 4215  sub format_previous_attempt_value {
         my @anskeys = sort(keys(%answers));          my @anskeys = sort(keys(%answers));
         if (@anskeys == 1) {          if (@anskeys == 1) {
             my $answer = $answers{$anskeys[0]};              my $answer = $answers{$anskeys[0]};
             if ($answer =~ m{\Q\0\E}) {              if ($answer =~ m{\0}) {
                 $answer =~ s{\Q\0\E}{, }g;                  $answer =~ s{\0}{,}g;
             }              }
             my $tag_internal_answer_name = 'INTERNAL';              my $tag_internal_answer_name = 'INTERNAL';
             if ($anskeys[0] eq $tag_internal_answer_name) {              if ($anskeys[0] eq $tag_internal_answer_name) {
Line 3572  sub format_previous_attempt_value { Line 4227  sub format_previous_attempt_value {
         } else {          } else {
             foreach my $ans (@anskeys) {              foreach my $ans (@anskeys) {
                 my $answer = $answers{$ans};                  my $answer = $answers{$ans};
                 if ($answer =~ m{\Q\0\E}) {                  if ($answer =~ m{\0}) {
                     $answer =~ s{\Q\0\E}{, }g;                      $answer =~ s{\0}{,}g;
                 }                  }
                 $value .=  $ans.'='.$answer.'<br />';;                  $value .=  $ans.'='.$answer.'<br />';;
             }               } 
Line 3856  sub findallcourses { Line 4511  sub findallcourses {
         $udom = $env{'user.domain'};          $udom = $env{'user.domain'};
     }      }
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {      if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
         my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});          my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,  
                                               $extra);  
         if (!%roles) {          if (!%roles) {
             %roles = (              %roles = (
                        cc => 1,                         cc => 1,
Line 3883  sub findallcourses { Line 4536  sub findallcourses {
             if ($tstart) {              if ($tstart) {
                 next if ($tstart > $now);                  next if ($tstart > $now);
             }              }
             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);              my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);              (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
               my $value = $trole.'/'.$cdom.'/';
             if ($secpart eq '') {              if ($secpart eq '') {
                 ($cnum,$role) = split(/_/,$cnumpart);                   ($cnum,$role) = split(/_/,$cnumpart); 
                 $sec = 'none';                  $sec = 'none';
                 $realsec = '';                  $value .= $cnum.'/';
             } else {              } else {
                 $cnum = $cnumpart;                  $cnum = $cnumpart;
                 ($sec,$role) = split(/_/,$secpart);                  ($sec,$role) = split(/_/,$secpart);
                 $realsec = $sec;                  $value .= $cnum.'/'.$sec;
               }
               if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                       push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   }
               } else {
                   @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
             }              }
             $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;  
         }          }
     } else {      } else {
         foreach my $key (keys(%env)) {          foreach my $key (keys(%env)) {
Line 3912  sub findallcourses { Line 4572  sub findallcourses {
                     if ($now>$endtime) { $active=0; }                      if ($now>$endtime) { $active=0; }
                 }                  }
                 if ($active) {                  if ($active) {
                       my $value = $role.'/'.$cdom.'/'.$cnum.'/';
                     if ($sec eq '') {                      if ($sec eq '') {
                         $sec = 'none';                          $sec = 'none';
                       } else {
                           $value .= $sec;
                       }
                       if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                           unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                               push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                           }
                       } else {
                           @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
                     }                      }
                     $courses{$cdom.'_'.$cnum}{$sec} =   
                                      $role.'/'.$cdom.'/'.$cnum.'/'.$sec;  
                 }                  }
             }              }
         }          }
Line 3927  sub findallcourses { Line 4595  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$uname,$udom) = @_;      my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
   
     if (!defined($udom)) {      if (defined($udom) && defined($uname)) {
           # If uname and udom are for a course, check for blocks in the course.
           if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
               my ($startblock,$endblock,$triggerblock) =
                   &get_blocks($setters,$activity,$udom,$uname,$url);
               return ($startblock,$endblock,$triggerblock);
           }
       } else {
         $udom = $env{'user.domain'};          $udom = $env{'user.domain'};
     }  
     if (!defined($uname)) {  
         $uname = $env{'user.name'};          $uname = $env{'user.name'};
     }      }
   
     # If uname and udom are for a course, check for blocks in the course.  
   
     if (&Apache::lonnet::is_course($udom,$uname)) {  
         my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);  
         my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);  
         return ($startblock,$endblock);  
     }  
   
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
       my $triggerblock = '';
     my %live_courses = &findallcourses(undef,$uname,$udom);      my %live_courses = &findallcourses(undef,$uname,$udom);
   
     # If uname is for a user, and activity is course-specific, i.e.,      # If uname is for a user, and activity is course-specific, i.e.,
     # 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') && ($env{'request.course.id'})) {           $activity eq 'groups' || $activity eq 'printout') &&
           ($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'}) {
                 delete($live_courses{$key});                  delete($live_courses{$key});
Line 4009  sub blockcheck { Line 4676  sub blockcheck {
             if ($otheruser) {              if ($otheruser) {
                 # Resource belongs to user other than current user.                  # Resource belongs to user other than current user.
                 # Assemble privs for that user, and check for 'evb' priv.                  # Assemble privs for that user, and check for 'evb' priv.
                 my ($trole,$tdom,$tnum,$tsec);                  my (%allroles,%userroles);
                 my $entry = $live_courses{$course}{$sec};                  if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                 if ($entry =~ /^cr/) {                      foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                     ($trole,$tdom,$tnum,$tsec) =                           my ($trole,$tdom,$tnum,$tsec);
                       ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);                          if ($entry =~ /^cr/) {
                 } else {                              ($trole,$tdom,$tnum,$tsec) = 
                     ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);                                  ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                 }                          } else {
                 my ($spec,$area,$trest,%allroles,%userroles);                             ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                 $area = '/'.$tdom.'/'.$tnum;                          }
                 $trest = $tnum;                          my ($spec,$area,$trest);
                 if ($tsec ne '') {                          $area = '/'.$tdom.'/'.$tnum;
                     $area .= '/'.$tsec;                          $trest = $tnum;
                     $trest .= '/'.$tsec;                          if ($tsec ne '') {
                 }                              $area .= '/'.$tsec;
                 $spec = $trole.'.'.$area;                              $trest .= '/'.$tsec;
                 if ($trole =~ /^cr/) {                          }
                     &Apache::lonnet::custom_roleprivs(\%allroles,$trole,                          $spec = $trole.'.'.$area;
                                                       $tdom,$spec,$trest,$area);                          if ($trole =~ /^cr/) {
                 } else {                              &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                     &Apache::lonnet::standard_roleprivs(\%allroles,$trole,                                                                $tdom,$spec,$trest,$area);
                                                        $tdom,$spec,$trest,$area);                          } else {
                 }                              &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                 my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);                                                                  $tdom,$spec,$trest,$area);
                 if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {                          }
                     if ($1) {                      }
                         $no_userblock = 1;                      my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                         last;                      if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                           if ($1) {
                               $no_userblock = 1;
                               last;
                           }
                     }                      }
                 }                  }
             } else {              } else {
Line 4053  sub blockcheck { Line 4724  sub blockcheck {
                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));                   ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
         next if ($no_userblock);          next if ($no_userblock);
   
         # Retrieve blocking times and identity of locker for course          # Retrieve blocking times and identity of blocker for course
         # of specified user, unless user has 'evb' privilege.          # of specified user, unless user has 'evb' privilege.
                   
         my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);          my ($start,$end,$trigger) = 
               &get_blocks($setters,$activity,$cdom,$cnum,$url);
         if (($start != 0) &&           if (($start != 0) && 
             (($startblock == 0) || ($startblock > $start))) {              (($startblock == 0) || ($startblock > $start))) {
             $startblock = $start;              $startblock = $start;
               if ($trigger ne '') {
                   $triggerblock = $trigger;
               }
         }          }
         if (($end != 0)  &&          if (($end != 0)  &&
             (($endblock == 0) || ($endblock < $end))) {              (($endblock == 0) || ($endblock < $end))) {
             $endblock = $end;              $endblock = $end;
               if ($trigger ne '') {
                   $triggerblock = $trigger;
               }
         }          }
     }      }
     return ($startblock,$endblock);      return ($startblock,$endblock,$triggerblock);
 }  }
   
 sub get_blocks {  sub get_blocks {
     my ($setters,$activity,$cdom,$cnum) = @_;      my ($setters,$activity,$cdom,$cnum,$url) = @_;
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
       my $triggerblock = '';
     my $course = $cdom.'_'.$cnum;      my $course = $cdom.'_'.$cnum;
     $setters->{$course} = {};      $setters->{$course} = {};
     $setters->{$course}{'staff'} = [];      $setters->{$course}{'staff'} = [];
     $setters->{$course}{'times'} = [];      $setters->{$course}{'times'} = [];
     my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);      $setters->{$course}{'triggers'} = [];
     foreach my $record (keys(%records)) {      my (@blockers,%triggered);
         my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);      my $now = time;
         if ($start <= time && $end >= time) {      my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
             my ($staff_name,$staff_dom,$title,$blocks) =      if ($activity eq 'docs') {
                 &parse_block_record($records{$record});          @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
             if ($blocks->{$activity} eq 'on') {          foreach my $block (@blockers) {
                 push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);              if ($block =~ /^firstaccess____(.+)$/) {
                 push(@{$$setters{$course}{'times'}}, [$start,$end]);                  my $item = $1;
                 if ( ($startblock == 0) || ($startblock > $start) ) {                  my $type = 'map';
                     $startblock = $start;                  my $timersymb = $item;
                   if ($item eq 'course') {
                       $type = 'course';
                   } elsif ($item =~ /___\d+___/) {
                       $type = 'resource';
                   } else {
                       $timersymb = &Apache::lonnet::symbread($item);
                   }
                   my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   $triggered{$block} = {
                                          start => $start,
                                          end   => $end,
                                          type  => $type,
                                        };
               }
           }
       } else {
           foreach my $block (keys(%commblocks)) {
               if ($block =~ m/^(\d+)____(\d+)$/) { 
                   my ($start,$end) = ($1,$2);
                   if ($start <= time && $end >= time) {
                       if (ref($commblocks{$block}) eq 'HASH') {
                           if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                               if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                                   unless(grep(/^\Q$block\E$/,@blockers)) {
                                       push(@blockers,$block);
                                   }
                               }
                           }
                       }
                   }
               } elsif ($block =~ /^firstaccess____(.+)$/) {
                   my $item = $1;
                   my $timersymb = $item; 
                   my $type = 'map';
                   if ($item eq 'course') {
                       $type = 'course';
                   } elsif ($item =~ /___\d+___/) {
                       $type = 'resource';
                   } else {
                       $timersymb = &Apache::lonnet::symbread($item);
                 }                  }
                 if ( ($endblock == 0) || ($endblock < $end) ) {                  my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                     $endblock = $end;                  my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   if ($start && $end) {
                       if (($start <= time) && ($end >= time)) {
                           unless (grep(/^\Q$block\E$/,@blockers)) {
                               push(@blockers,$block);
                               $triggered{$block} = {
                                                      start => $start,
                                                      end   => $end,
                                                      type  => $type,
                                                    };
                           }
                       }
                 }                  }
             }              }
         }          }
     }      }
     return ($startblock,$endblock);      foreach my $blocker (@blockers) {
           my ($staff_name,$staff_dom,$title,$blocks) =
               &parse_block_record($commblocks{$blocker});
           push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
           my ($start,$end,$triggertype);
           if ($blocker =~ m/^(\d+)____(\d+)$/) {
               ($start,$end) = ($1,$2);
           } elsif (ref($triggered{$blocker}) eq 'HASH') {
               $start = $triggered{$blocker}{'start'};
               $end = $triggered{$blocker}{'end'};
               $triggertype = $triggered{$blocker}{'type'};
           }
           if ($start) {
               push(@{$$setters{$course}{'times'}}, [$start,$end]);
               if ($triggertype) {
                   push(@{$$setters{$course}{'triggers'}},$triggertype);
               } else {
                   push(@{$$setters{$course}{'triggers'}},0);
               }
               if ( ($startblock == 0) || ($startblock > $start) ) {
                   $startblock = $start;
                   if ($triggertype) {
                       $triggerblock = $blocker;
                   }
               }
               if ( ($endblock == 0) || ($endblock < $end) ) {
                  $endblock = $end;
                  if ($triggertype) {
                      $triggerblock = $blocker;
                  }
               }
           }
       }
       return ($startblock,$endblock,$triggerblock);
 }  }
   
 sub parse_block_record {  sub parse_block_record {
Line 4119  sub parse_block_record { Line 4883  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
   my ($activity,$uname,$udom) = @_;      my ($activity,$uname,$udom,$url,$is_course) = @_;
   my %setters;      my %setters;
   
   # check for active blocking  
   my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);  
   
   my $blocked = $startblock && $endblock ? 1 : 0;  # check for active blocking
       my ($startblock,$endblock,$triggerblock) = 
   # caller just wants to know whether a block is active          &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
   if (!wantarray) { return $blocked; }      my $blocked = 0;
       if ($startblock && $endblock) {
   # build a link to a popup window containing the details          $blocked = 1;
   my $querystring  = "?activity=$activity";      }
   # $uname and $udom decide whose portfolio the user is trying to look at  
      $querystring .= "&amp;udom=$udom"      if $udom;  # caller just wants to know whether a block is active
      $querystring .= "&amp;uname=$uname"    if $uname;      if (!wantarray) { return $blocked; }
   
   my $output .= <<'END_MYBLOCK';  # build a link to a popup window containing the details
     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {      my $querystring  = "?activity=$activity";
         var options = "width=" + w + ",height=" + h + ",";  # $uname and $udom decide whose portfolio the user is trying to look at
         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";      if (($activity eq 'port') || ($activity eq 'passwd')) {
         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";          $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);
         var newWin = window.open(url, wdwName, options);          $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
         newWin.focus();      } elsif ($activity eq 'docs') {
     }          $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
       }
   
       my $output .= <<'END_MYBLOCK';
   function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
       var options = "width=" + w + ",height=" + h + ",";
       options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
       options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
       var newWin = window.open(url, wdwName, options);
       newWin.focus();
   }
 END_MYBLOCK  END_MYBLOCK
   
   $output = Apache::lonhtmlcommon::scripttag($output);      $output = Apache::lonhtmlcommon::scripttag($output);
       
   my $popupUrl = "/adm/blockingstatus/$querystring";      my $popupUrl = "/adm/blockingstatus/$querystring";
   my $text = mt('Communication Blocked');      my $text = &mt('Communication Blocked');
       my $class = 'LC_comblock';
   $output .= <<"END_BLOCK";      if ($activity eq 'docs') {
 <div class='LC_comblock'>          $text = &mt('Content Access Blocked');
           $class = '';
       } elsif ($activity eq 'printout') {
           $text = &mt('Printing Blocked');
       } elsif ($activity eq 'passwd') {
           $text = &mt('Password Changing Blocked');
       }
       $output .= <<"END_BLOCK";
   <div class='$class'>
   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'    <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
   title='$text'>    title='$text'>
   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>    <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
Line 4162  END_MYBLOCK Line 4941  END_MYBLOCK
   
 END_BLOCK  END_BLOCK
   
   return ($blocked, $output);      return ($blocked, $output);
 }  }
   
 ###############################################  ###############################################
   
 sub check_ip_acc {  sub check_ip_acc {
     my ($acc)=@_;      my ($acc,$clientip)=@_;
     &Apache::lonxml::debug("acc is $acc");      &Apache::lonxml::debug("acc is $acc");
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed=0;      my $allowed=0;
     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};      my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
   
     my $name;      my $name;
     foreach my $pattern (split(',',$acc)) {      foreach my $pattern (split(',',$acc)) {
Line 4270  sub get_domainconf { Line 5049  sub get_domainconf {
             if (keys(%{$domconfig{'login'}})) {              if (keys(%{$domconfig{'login'}})) {
                 foreach my $key (keys(%{$domconfig{'login'}})) {                  foreach my $key (keys(%{$domconfig{'login'}})) {
                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {                      if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                         if ($key eq 'loginvia') {                          if (($key eq 'loginvia') || ($key eq 'headtag')) {
                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {                              if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                                 my @ids = &Apache::lonnet::current_machine_ids();                                  foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                                 foreach my $hostname (@ids) {                                      if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {                                          if ($key eq 'loginvia') {
                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {                                              if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};                                                  my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                                             $designhash{$udom.'.login.loginvia'} = $server;                                                  $designhash{$udom.'.login.loginvia'} = $server;
                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {                                                  if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                                                       $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};                                                  } else {
                                             } else {                                                      $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                                                  $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};                                                  }
                                             }                                              }
                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {                                          } elsif ($key eq 'headtag') {
                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};                                              if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                                                   $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
                                             }                                              }
                                         }                                          }
                                           if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                                               $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                                           }
                                     }                                      }
                                 }                                  }
                             }                              }
Line 4355  sub get_legacy_domconf { Line 5138  sub get_legacy_domconf {
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     my $designfile =  $designdir.'/'.$udom.'.tab';      my $designfile =  $designdir.'/'.$udom.'.tab';
     if (-e $designfile) {      if (-e $designfile) {
         if ( open (my $fh,"<$designfile") ) {          if ( open (my $fh,'<',$designfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line =~ /^\#/);                  next if ($line =~ /^\#/);
                 chomp($line);                  chomp($line);
Line 4365  sub get_legacy_domconf { Line 5148  sub get_legacy_domconf {
             close($fh);              close($fh);
         }          }
     }      }
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {      if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";          $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
     }      }
     return %legacyhash;      return %legacyhash;
Line 4423  sub designparm { Line 5206  sub designparm {
         return $env{'environment.color.'.$which};          return $env{'environment.color.'.$which};
     }      }
     $domain=&determinedomain($domain);      $domain=&determinedomain($domain);
     my %domdesign = &get_domainconf($domain);      my %domdesign;
       unless ($domain eq 'public') {
           %domdesign = &get_domainconf($domain);
       }
     my $output;      my $output;
     if ($domdesign{$domain.'.'.$which} ne '') {      if ($domdesign{$domain.'.'.$which} ne '') {
         $output = $domdesign{$domain.'.'.$which};          $output = $domdesign{$domain.'.'.$which};
Line 4448  sub designparm { Line 5234  sub designparm {
   
 =item * &authorspace()  =item * &authorspace()
   
 Inputs: ./.  Inputs: $url (usually will be undef).
   
 Returns: Path to the Construction Space of the current user's  Returns: Path to Authoring Space containing the resource or 
          accessed author space           directory being viewed (or for which action is being taken). 
          The author space will be that of the current user           If $url is provided, and begins /priv/<domain>/<uname>
          when accessing the own author space           the path will be that portion of the $context argument.
          and that of the co-author/assistent co-author           Otherwise the path will be for the author space of the current
          when accessing the co-author's/assistent co-author's           user when the current role is author, or for that of the 
          space           co-author/assistant co-author space when the current role 
            is co-author or assistant co-author.
   
 =cut  =cut
   
 sub authorspace {  sub authorspace {
       my ($url) = @_;
       if ($url ne '') {
           if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
              return $1;
           }
       }
     my $caname = '';      my $caname = '';
     if ($env{'request.role'} =~ /^ca|^aa/) {      my $cadom = '';
         (undef,$caname) =      if ($env{'request.role'} =~ /^(?:ca|aa)/) {
           ($cadom,$caname) =
             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);              ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
     } else {      } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
         $caname = $env{'user.name'};          $caname = $env{'user.name'};
           $cadom = $env{'user.domain'};
     }      }
     return '/priv/'.$caname.'/';      if (($caname ne '') && ($cadom ne '')) {
           return "/priv/$cadom/$caname/";
       }
       return;
 }  }
   
 ##############################################  ##############################################
Line 4486  Returns: HTML div with $content Line 5284  Returns: HTML div with $content
 sub head_subbox {  sub head_subbox {
     my ($content)=@_;      my ($content)=@_;
     my $output =      my $output =
         '<div id="LC_head_subbox">'          '<div class="LC_head_subbox">'
        .$content         .$content
        .'</div>'         .'</div>'
 }  }
Line 4496  sub head_subbox { Line 5294  sub head_subbox {
   
 =item * &CSTR_pageheader()  =item * &CSTR_pageheader()
   
 Inputs: ./.  Input: (optional) filename from which breadcrumb trail is built.
          In most cases no input as needed, as $env{'request.filename'}
          is appropriate for use in building the breadcrumb trail.
   
 Returns: HTML div with CSTR path and recent box  Returns: HTML div with CSTR path and recent box
          To be included on Construction Space pages           To be included on Authoring Space pages
   
 =cut  =cut
   
 sub CSTR_pageheader {  sub CSTR_pageheader {
     # this is for resources; directories have customtitle, and crumbs      my ($trailfile) = @_;
             # and select recent are created in lonpubdir.pm        if ($trailfile eq '') {
     my ($uname,$thisdisfn)=          $trailfile = $env{'request.filename'};
         ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);      }
     my $formaction='/priv/'.$uname.'/'.$thisdisfn;  
     $formaction=~s/\/+/\//g;  # this is for resources; directories have customtitle, and crumbs
   # and select recent are created in lonpubdir.pm
   
       my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
       my ($udom,$uname,$thisdisfn)=
           ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
       my $formaction = "/priv/$udom/$uname/$thisdisfn";
       $formaction =~ s{/+}{/}g;
   
     my $parentpath = '';      my $parentpath = '';
     my $lastitem = '';      my $lastitem = '';
Line 4523  sub CSTR_pageheader { Line 5330  sub CSTR_pageheader {
     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('Construction Space:').'</b> '          .'<b>'.&mt('Authoring Space:').'</b> '
         .'<form name="dirs" method="post" action="'.$formaction          .'<form name="dirs" method="post" action="'.$formaction
         .'" target="_top">' #FIXME lonpubdir: target="_parent"          .'" target="_top">' #FIXME lonpubdir: target="_parent"
         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv',undef,undef);          .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
   
     if ($lastitem) {      if ($lastitem) {
         $output .=          $output .=
Line 4582  Inputs: Line 5389  Inputs:
   
 =item * $bgcolor, used to override the bgcolor on a webpage to a specific value  =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
   
   =item * $no_inline_link, if true and in remote mode, don't show the
            'Switch To Inline Menu' link
   
 =item * $args, optional argument valid values are  =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg              no_auto_mt_title -> prevents &mt()ing the title arg
             inherit_jsmath -> when creating popup window in a page,              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
               inlineremote items to be added in "Functions" menu below
               breadcrumbs.
   
 =back  =back
   
Line 4599  other decorations will be returned. Line 5414  other decorations will be returned.
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
         $no_nav_bar,$bgcolor,$args)=@_;          $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
   
     my $public;      my $public;
     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))      if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
Line 4607  sub bodytag { Line 5422  sub bodytag {
         $public = 1;          $public = 1;
     }      }
     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }      if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
       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 4622  sub bodytag { Line 5439  sub bodytag {
     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};       @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
   
  # role and realm   # role and realm
     my ($role,$realm) = split(/\./,$env{'request.role'},2);      my ($role,$realm) = split(m{\./},$env{'request.role'},2);
       if ($realm) {
           $realm = '/'.$realm;
       }
     if ($role  eq 'ca') {      if ($role  eq 'ca') {
         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});          my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
         $realm = &plainname($rname,$rdom);          $realm = &plainname($rname,$rdom);
Line 4631  sub bodytag { Line 5451  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 4646  sub bodytag { Line 5474  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']);
   
     if ($bodyonly) {      if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
         return $bodytag;          return $bodytag;
     }       }
   
     my $name = &plainname($env{'user.name'},$env{'user.domain'});  
     if ($public) {      if ($public) {
  undef($role);   undef($role);
     } else {  
  $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});  
     }      }
           
     my $titleinfo = '<h1>'.$title.'</h1>';      my $titleinfo = '<h1>'.$title.'</h1>';
Line 4671  sub bodytag { Line 5498  sub bodytag {
         $dc_info =~ s/\s+$//;          $dc_info =~ s/\s+$//;
     }      }
   
     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;      $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);  
   
         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') {       if ($env{'request.state'} eq 'construct') { $forcereg=1; }
             return $bodytag;   
         }   
   
         if ($env{'request.state'} eq 'construct') { $forcereg=1; }  
   
       my $funclist;
       if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
           $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
                       Apache::lonmenu::serverform();
           my $forbodytag;
           &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                               $forcereg,$args->{'group'},
                                               $args->{'bread_crumbs'},
                                               $advtoolsref,'','',\$forbodytag);
           unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
               $funclist = $forbodytag;
           }
       } else {
   
         #    if ($env{'request.state'} eq 'construct') {          #    if ($env{'request.state'} eq 'construct') {
         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls          #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
         #    }          #    }
   
           $bodytag .= Apache::lonhtmlcommon::scripttag(
               Apache::lonmenu::utilityfunctions($httphost), 'start');
   
           my ($left,$right) = Apache::lonmenu::primary_menu();
   
         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {          if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
              if ($dc_info) {              if ($dc_info) {
                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;                   $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
              }              }
              $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
                 <em>$realm</em> $dc_info</div>|;                             <em>$realm</em> $dc_info</div>|;
             return $bodytag;              return $bodytag;
         }          }
   
         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {          unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;              $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
         }          }
   
         $bodytag .= Apache::lonhtmlcommon::scripttag(          $bodytag .= $right;
             Apache::lonmenu::utilityfunctions(), 'start');  
   
         $bodytag .= Apache::lonmenu::primary_menu();  
   
         if ($dc_info) {          if ($dc_info) {
             $dc_info = &dc_courseid_toggle($dc_info);              $dc_info = &dc_courseid_toggle($dc_info);
         }          }
         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;          $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
   
           #if directed to not display the secondary menu, don't.
           if ($args->{'no_secondary_menu'}) {
               return $bodytag;
           }
         #don't show menus for public users          #don't show menus for public users
         if (!$public){          if (!$public){
             $bodytag .= Apache::lonmenu::secondary_menu();              $bodytag .= Apache::lonmenu::secondary_menu($httphost);
             $bodytag .= Apache::lonmenu::serverform();              $bodytag .= Apache::lonmenu::serverform();
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');              $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {              if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,
                                 $args->{'bread_crumbs'});                                  $args->{'bread_crumbs'},'','',$hostname);
             } elsif ($forcereg) {               } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                               $args->{'group'},
                                                               $args->{'hide_buttons',
                                                               $hostname});
               } else {
                   my $forbodytag;
                   &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                                       $forcereg,$args->{'group'},
                                                       $args->{'bread_crumbs'},
                                                       $advtoolsref,'',$hostname,
                                                       \$forbodytag);
                   unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                       $bodytag .= $forbodytag;
                   }
             }              }
         }else{          }else{
             # this is to seperate menu from content when there's no secondary              # this is to seperate menu from content when there's no secondary
Line 4728  sub bodytag { Line 5583  sub bodytag {
         }          }
   
         return $bodytag;          return $bodytag;
       }
   
   #
   # Top frame rendering, Remote is up
   #
   
       my $imgsrc = $img;
       if ($img =~ /^\/adm/) {
           $imgsrc = &lonhttpdurl($img);
       }
       my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
   
       my $help=($no_inline_link?''
                 :&Apache::loncommon::top_nav_help('Help'));
   
       # Explicit link to get inline menu
       my $menu= ($no_inline_link?''
                  :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
   
       if ($dc_info) {
           $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
       }
   
       my $name = &plainname($env{'user.name'},$env{'user.domain'});
       unless ($public) {
           $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                                   undef,'LC_menubuttons_link');
       }
   
       unless ($env{'form.inhibitmenu'}) {
           $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
                          <ol class="LC_primary_menu LC_floatright LC_right">
                          <li>$help</li>
                          <li>$menu</li>
                          </ol><div id="LC_realm"> $realm $dc_info</div>|;
       }
       if ($env{'request.state'} eq 'construct') {
           if (!$public){
               if ($env{'request.state'} eq 'construct') {
                   $funclist = &Apache::lonhtmlcommon::scripttag(
                                   &Apache::lonmenu::utilityfunctions($httphost), 'start').
                               &Apache::lonhtmlcommon::scripttag('','end').
                               &Apache::lonmenu::innerregister($forcereg,
                                                               $args->{'bread_crumbs'});
               }
           }
       }
       return $bodytag."\n".$funclist;
 }  }
   
 sub dc_courseid_toggle {  sub dc_courseid_toggle {
     my ($dc_info) = @_;      my ($dc_info) = @_;
     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.      return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
            '<a href="javascript:showCourseID();">'.             '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
            &mt('(More ...)').'</a></span>'.             &mt('(More ...)').'</a></span>'.
            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';             '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
 }  }
Line 4759  sub make_attr_string { Line 5662  sub make_attr_string {
  delete($attr_ref->{$key});   delete($attr_ref->{$key});
     }      }
  }   }
  $attr_ref->{'onload'}  = $on_load;          if ($env{'environment.remote'} eq 'on') {
  $attr_ref->{'onunload'}= $on_unload;              $attr_ref->{'onload'}  =
                   &Apache::lonmenu::loadevents().  $on_load;
               $attr_ref->{'onunload'}=
                   &Apache::lonmenu::unloadevents().$on_unload;
           } else {  
       $attr_ref->{'onload'}  = $on_load;
       $attr_ref->{'onunload'}= $on_unload;
           }
     }      }
   
     my $attr_string;      my $attr_string;
     foreach my $attr (keys(%$attr_ref)) {      foreach my $attr (sort(keys(%$attr_ref))) {
  $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';   $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
     }      }
     return $attr_string;      return $attr_string;
Line 4790  i.e., $env{'internal.head.redirect'} exi Line 5700  i.e., $env{'internal.head.redirect'} exi
   
 sub endbodytag {  sub endbodytag {
     my ($args) = @_;      my ($args) = @_;
     my $endbodytag='</body>';      my $endbodytag;
     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;      unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
           $endbodytag='</body>';
       }
     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 4838  sub standard_css { Line 5750  sub standard_css {
     my $mono                 = 'monospace';      my $mono                 = 'monospace';
     my $data_table_head      = $sidebg;      my $data_table_head      = $sidebg;
     my $data_table_light     = '#FAFAFA';      my $data_table_light     = '#FAFAFA';
     my $data_table_dark      = '#F0F0F0';      my $data_table_dark      = '#E0E0E0';
     my $data_table_darker    = '#CCCCCC';      my $data_table_darker    = '#CCCCCC';
     my $data_table_highlight = '#FFFF00';      my $data_table_highlight = '#FFFF00';
     my $mail_new             = '#FFBB77';      my $mail_new             = '#FFBB77';
Line 4878  body { Line 5790  body {
 a:focus,  a:focus,
 a:focus img {  a:focus img {
   color: red;    color: red;
   background: yellow;  
 }  }
   
 form, .inline {  form, .inline {
Line 4893  form, .inline { Line 5804  form, .inline {
   vertical-align:middle;    vertical-align:middle;
 }  }
   
   .LC_floatleft {
     float: left;
   }
   
   .LC_floatright {
     float: right;
   }
   
 .LC_400Box {  .LC_400Box {
   width:400px;    width:400px;
 }  }
Line 4925  form, .inline { Line 5844  form, .inline {
   text-decoration:none;    text-decoration:none;
 }  }
   
   .LC_setting {
     text-decoration:underline;
   }
   
 .LC_error {  .LC_error {
   color: red;    color: red;
   font-size: larger;  
 }  }
   
 .LC_warning,  .LC_warning {
     color: darkorange;
   }
   
 .LC_diff_removed {  .LC_diff_removed {
   color: red;    color: red;
 }  }
Line 4953  div.LC_confirm_box .LC_success img { Line 5878  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 4969  div.LC_confirm_box .LC_success img { Line 5905  div.LC_confirm_box .LC_success img {
 }  }
   
 .LC_discussion {  .LC_discussion {
   background: $tabbg;    background: $data_table_dark;
   border: 1px solid black;    border: 1px solid black;
   margin: 2px;    margin: 2px;
 }  }
   
 .LC_disc_action_links_bar {  
   background: $tabbg;  
   border: none;  
   margin: 4px;  
 }  
   
 .LC_disc_action_left {  .LC_disc_action_left {
     background: $sidebg;
   text-align: left;    text-align: left;
     padding: 4px;
     margin: 2px;
 }  }
   
 .LC_disc_action_right {  .LC_disc_action_right {
     background: $sidebg;
   text-align: right;    text-align: right;
     padding: 4px;
     margin: 2px;
 }  }
   
 .LC_disc_new_item {  .LC_disc_new_item {
   background: white;    background: white;
   border: 2px solid red;    border: 2px solid red;
   margin: 2px;    margin: 4px;
     padding: 4px;
 }  }
   
 .LC_disc_old_item {  .LC_disc_old_item {
   background: white;    background: white;
   border: 1px solid black;    margin: 4px;
   margin: 2px;    padding: 4px;
 }  }
   
 table.LC_pastsubmission {  table.LC_pastsubmission {
Line 5073  table#LC_menubuttons img { Line 6010  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 5089  td.LC_table_cell_checkbox { Line 6030  td.LC_table_cell_checkbox {
   overflow: hidden;    overflow: hidden;
   margin: 0;    margin: 0;
   padding: 0;    padding: 0;
     text-align: left;
 }  }
   
 #LC_head_subbox {  .LC_head_subbox, .LC_actionbox {
   clear:both;    clear:both;
   background: #F8F8F8; /* $sidebg; */    background: #F8F8F8; /* $sidebg; */
   border: 1px solid $sidebg;    border: 1px solid $sidebg;
   margin: 0 0 10px 0;          margin: 0 0 10px 0;
   padding: 3px;    padding: 3px;
     text-align: left;
 }  }
   
 .LC_fontsize_medium {  .LC_fontsize_medium {
Line 5117  td.LC_table_cell_checkbox { Line 6060  td.LC_table_cell_checkbox {
   vertical-align: middle;    vertical-align: middle;
 }  }
   
 li.LC_menubuttons_inline_text img,a {  li.LC_menubuttons_inline_text img {
   cursor:pointer;    cursor:pointer;
     text-decoration: none;
 }  }
   
 .LC_menubuttons_link {  .LC_menubuttons_link {
Line 5140  td.LC_menubuttons_text { Line 6084  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 5166  table.LC_nested { Line 6115  table.LC_nested {
   width: 100%;    width: 100%;
 }  }
   
 .ui-accordion,  
 .ui-accordion table.LC_data_table,  
 .ui-accordion table.LC_nested_outer{  
   border: 0px;  
   border-spacing: 0px;  
   margin: 3px;  
 }  
   
 table.LC_data_table tr th,  table.LC_data_table tr th,
 table.LC_calendar tr th,  table.LC_calendar tr th,
 table.LC_prior_tries tr th,  table.LC_prior_tries tr th,
Line 5234  table.LC_nested tr.LC_empty_row td { Line 6175  table.LC_nested tr.LC_empty_row td {
   padding: 8px;    padding: 8px;
 }  }
   
 table.LC_data_table tr.LC_empty_row td {  table.LC_data_table tr.LC_empty_row td,
   table.LC_data_table tr.LC_footer_row td {
   background-color: $sidebg;    background-color: $sidebg;
 }  }
   
Line 5289  table.LC_nested tr td.LC_right_item { Line 6231  table.LC_nested tr td.LC_right_item {
   text-align: right;    text-align: right;
 }  }
   
 .ui-accordion table.LC_nested tr.LC_odd_row td.LC_left_item,  
 .ui-accordion table.LC_nested tr.LC_even_row td.LC_left_item {  
   text-align: right;  
   width: 40%;  
   padding-right:10px;  
   vertical-align: top;  
   padding: 5px;  
 }  
   
 .ui-accordion table.LC_nested tr.LC_odd_row td.LC_right_item,  
 .ui-accordion table.LC_nested tr.LC_even_row td.LC_right_item {  
   text-align: left;  
   width: 60%;  
   padding: 2px 4px;  
 }  
   
 table.LC_nested tr.LC_odd_row td {  table.LC_nested tr.LC_odd_row td {
   background-color: #EEEEEE;    background-color: #EEEEEE;
 }  }
Line 5436  span.LC_current_location { Line 6362  span.LC_current_location {
   background: $pgbg;    background: $pgbg;
 }  }
   
   span.LC_current_nav_location {
     font-weight:bold;
     background: $sidebg;
   }
   
 span.LC_parm_menu_item {  span.LC_parm_menu_item {
   font-size: larger;    font-size: larger;
 }  }
Line 5807  div.LC_docs_entry_move { Line 6738  div.LC_docs_entry_move {
   
 table.LC_data_table tr > td.LC_docs_entry_commands,  table.LC_data_table tr > td.LC_docs_entry_commands,
 table.LC_data_table tr > td.LC_docs_entry_parameter {  table.LC_data_table tr > td.LC_docs_entry_parameter {
   background: #DDDDDD;  
   font-size: x-small;    font-size: x-small;
 }  }
   
Line 5831  table.LC_data_table tr > td.LC_docs_entr Line 6761  table.LC_data_table tr > td.LC_docs_entr
   color: #990000;    color: #990000;
 }  }
   
   .LC_domprefs_email,
 .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 5937  div.LC_edit_problem_footer { Line 6868  div.LC_edit_problem_footer {
   font-weight: normal;    font-weight: normal;
   font-size:  medium;    font-size:  medium;
   margin: 2px;    margin: 2px;
     background-color: $sidebg;
 }  }
   
 div.LC_edit_problem_header,  div.LC_edit_problem_header,
Line 5945  div.LC_edit_problem_footer, Line 6877  div.LC_edit_problem_footer,
 div.LC_edit_problem_footer div,  div.LC_edit_problem_footer div,
 div.LC_edit_problem_editxml_header,  div.LC_edit_problem_editxml_header,
 div.LC_edit_problem_editxml_header div {  div.LC_edit_problem_editxml_header div {
   margin-top: 5px;    z-index: 100;
 }  }
   
 div.LC_edit_problem_header_title {  div.LC_edit_problem_header_title {
Line 5953  div.LC_edit_problem_header_title { Line 6885  div.LC_edit_problem_header_title {
   font-size: larger;    font-size: larger;
   background: $tabbg;    background: $tabbg;
   padding: 3px;    padding: 3px;
     margin: 0 0 5px 0;
 }  }
   
 table.LC_edit_problem_header_title {  table.LC_edit_problem_header_title {
Line 5960  table.LC_edit_problem_header_title { Line 6893  table.LC_edit_problem_header_title {
   background: $tabbg;    background: $tabbg;
 }  }
   
 div.LC_edit_problem_discards {  div.LC_edit_actionbar {
   float: left;      background-color: $sidebg;
   padding-bottom: 5px;      margin: 0;
       padding: 0;
       line-height: 200%;
 }  }
   
 div.LC_edit_problem_saves {  div.LC_edit_actionbar div{
   float: right;      padding: 0;
   padding-bottom: 5px;      margin: 0;
       display: inline-block;
   }
   
   .LC_edit_opt {
     padding-left: 1em;
     white-space: nowrap;
   }
   
   .LC_edit_problem_latexhelper{
       text-align: right;
   }
   
   #LC_edit_problem_colorful div{
       margin-left: 40px;
   }
   
   #LC_edit_problem_codemirror div{
       margin-left: 0px;
 }  }
   
 img.stift {  img.stift {
Line 5984  div.LC_createcourse { Line 6937  div.LC_createcourse {
 }  }
   
 .LC_dccid {  .LC_dccid {
     float: right;
   margin: 0.2em 0 0 0;    margin: 0.2em 0 0 0;
   padding: 0;    padding: 0;
   font-size: 90%;    font-size: 90%;
   display:none;    display:none;
 }  }
   
 a:hover,  
 ol.LC_primary_menu a:hover,  ol.LC_primary_menu a:hover,
 ol#LC_MenuBreadcrumbs a:hover,  ol#LC_MenuBreadcrumbs a:hover,
 ol#LC_PathBreadcrumbs a:hover,  ol#LC_PathBreadcrumbs a:hover,
Line 6057  fieldset { Line 7010  fieldset {
   /* overflow: hidden; */    /* overflow: hidden; */
 }  }
   
   article.geogebraweb div {
       margin: 0;
   }
   
 fieldset > legend {  fieldset > legend {
   font-weight: bold;    font-weight: bold;
   padding: 0 5px 0 5px;    padding: 0 5px 0 5px;
Line 6064  fieldset > legend { Line 7021  fieldset > legend {
   
 #LC_nav_bar {  #LC_nav_bar {
   float: left;    float: left;
     background-color: $pgbg_or_bgcolor;
   margin: 0 0 2px 0;    margin: 0 0 2px 0;
 }  }
   
Line 6072  fieldset > legend { Line 7030  fieldset > legend {
   padding: 0;    padding: 0;
   font-weight: bold;    font-weight: bold;
   text-align: center;    text-align: center;
     background-color: $pgbg_or_bgcolor;
 }  }
   
 #LC_nav_bar em {  #LC_nav_bar em {
Line 6080  fieldset > legend { Line 7039  fieldset > legend {
 }  }
   
 ol.LC_primary_menu {  ol.LC_primary_menu {
   float: right;  
   margin: 0;    margin: 0;
     padding: 0;
 }  }
   
 ol#LC_PathBreadcrumbs {  ol#LC_PathBreadcrumbs {
Line 6089  ol#LC_PathBreadcrumbs { Line 7048  ol#LC_PathBreadcrumbs {
 }  }
   
 ol.LC_primary_menu li {  ol.LC_primary_menu li {
   display: inline;    color: RGB(80, 80, 80);
   padding: 5px 5px 0 10px;    vertical-align: middle;
     text-align: left;
     list-style: none;
     position: relative;
     float: left;
     z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
     line-height: 1.5em;
   }
   
   ol.LC_primary_menu li a, 
   ol.LC_primary_menu li p {
     display: block;
     margin: 0;
     padding: 0 5px 0 10px;
     text-decoration: none;
   }
   
   ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
     display: inline-block;
     width: 95%;
     text-align: left;
   }
   
   ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
     display: inline-block;
     width: 5%;
     float: right;
     text-align: right;
     font-size: 70%;
   }
   
   ol.LC_primary_menu ul {
     display: none;
     width: 15em;
     background-color: $data_table_light;
     position: absolute;
     top: 100%;
   }
   
   ol.LC_primary_menu ul ul {
     left: 100%;
     top: 0;
   }
   
   ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
     display: block;
     position: absolute;
     margin: 0;
     padding: 0;
     z-index: 2;
   }
   
   ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
   /* First Submenu -> size should be smaller than the menu title of the whole menu */
     font-size: 90%;
   vertical-align: top;    vertical-align: top;
     float: none;
     border-left: 1px solid black;
     border-right: 1px solid black;
   /* A dark bottom border to visualize different menu options;
   overwritten in the create_submenu routine for the last border-bottom of the menu */
     border-bottom: 1px solid $data_table_dark;
   }
   
   ol.LC_primary_menu li li p:hover {
     color:$button_hover;
     text-decoration:none;
     background-color:$data_table_dark;
   }
   
   ol.LC_primary_menu li li a:hover {
      color:$button_hover;
      background-color:$data_table_dark;
   }
   
   /* Font-size equal to the size of the predecessors*/
   ol.LC_primary_menu li:hover li li {
     font-size: 100%;
 }  }
   
 ol.LC_primary_menu li img {  ol.LC_primary_menu li img {
   vertical-align: bottom;    vertical-align: bottom;
   height: 1.1em;    height: 1.1em;
     margin: 0.2em 0 0 0;
 }  }
   
 ol.LC_primary_menu a {  ol.LC_primary_menu a {
Line 6134  ol.LC_docs_parameters li.LC_docs_paramet Line 7170  ol.LC_docs_parameters li.LC_docs_paramet
 }  }
   
 ul#LC_secondary_menu {  ul#LC_secondary_menu {
   clear: both;    clear: right;
   color: $fontmenu;    color: $fontmenu;
   background: $tabbg;    background: $tabbg;
   list-style: none;    list-style: none;
   padding: 0;    padding: 0;
   margin: 0;    margin: 0;
   width: 100%;    width: 100%;
     text-align: left;
     float: left;
 }  }
   
 ul#LC_secondary_menu li {  ul#LC_secondary_menu li {
   font-weight: bold;    font-weight: bold;
   line-height: 1.8em;    line-height: 1.8em;
     border-right: 1px solid black;
     float: left;
   }
   
   ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
     background-color: $data_table_light;
   }
   
   ul#LC_secondary_menu li a {
   padding: 0 0.8em;    padding: 0 0.8em;
   }
   
   ul#LC_secondary_menu li ul {
     display: none;
   }
   
   ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
     display: block;
     position: absolute;
     margin: 0;
     padding: 0;
     list-style:none;
     float: none;
     background-color: $data_table_light;
     z-index: 2;
     margin-left: -1px;
   }
   
   ul#LC_secondary_menu li ul li {
     font-size: 90%;
     vertical-align: top;
     border-left: 1px solid black;
   border-right: 1px solid black;    border-right: 1px solid black;
   display: inline;    background-color: $data_table_light;
   vertical-align: middle;    list-style:none;
     float: none;
   }
   
   ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
     background-color: $data_table_dark;
 }  }
   
 ul.LC_TabContent {  ul.LC_TabContent {
Line 6157  ul.LC_TabContent { Line 7231  ul.LC_TabContent {
   background: $sidebg;    background: $sidebg;
   border-bottom: solid 1px $lg_border_color;    border-bottom: solid 1px $lg_border_color;
   list-style:none;    list-style:none;
   margin: 0 -10px;    margin: -1px -10px 0 -10px;
   padding: 0;    padding: 0;
 }  }
   
Line 6180  ul.LC_TabContent li { Line 7254  ul.LC_TabContent li {
   padding: 0 16px 0 10px;    padding: 0 16px 0 10px;
   background-color:$tabbg;    background-color:$tabbg;
   border-bottom:solid 1px $lg_border_color;    border-bottom:solid 1px $lg_border_color;
   border-right: solid 1px $font;    border-left: solid 1px $font;
 }  }
   
 ul.LC_TabContent .right {  ul.LC_TabContent .right {
Line 6220  ul.LC_TabContent li.active a { Line 7294  ul.LC_TabContent li.active a {
   background:#FFFFFF;    background:#FFFFFF;
   outline: none;    outline: none;
 }  }
   
   ul.LC_TabContent li.goback {
     float: left;
     border-left: none;
   }
   
 #maincoursedoc {  #maincoursedoc {
   clear:both;    clear:both;
 }  }
Line 6274  ul.LC_TabContentBigger li.active b { Line 7354  ul.LC_TabContentBigger li.active b {
   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;    background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
   color:$font;    color:$font;
   border: 0;    border: 0;
   cursor:default;  
 }  }
   
   
 ul.LC_CourseBreadcrumbs {  ul.LC_CourseBreadcrumbs {
   background: $sidebg;    background: $sidebg;
   line-height: 32px;    height: 2em;
   padding-left: 10px;    padding-left: 10px;
   margin: 0 0 10px 0;    margin: 0;
   list-style-position: inside;    list-style-position: inside;
   
 }  }
   
 ol#LC_MenuBreadcrumbs,  ol#LC_MenuBreadcrumbs,
Line 6326  ol#LC_PathBreadcrumbs li a { Line 7404  ol#LC_PathBreadcrumbs li a {
   padding: 0 10px 10px 10px;    padding: 0 10px 10px 10px;
 }  }
   
   .LC_DocsBox {
     border: solid 1px $lg_border_color;
     padding: 0 0 10px 10px;
   }
   
 .LC_AboutMe_Image {  .LC_AboutMe_Image {
   float:left;    float:left;
   margin-right:10px;    margin-right:10px;
Line 6466  a#LC_content_toolbar_changefolder_toggle Line 7549  a#LC_content_toolbar_changefolder_toggle
   background-image:url(/res/adm/pages/open-all-folders.gif);    background-image:url(/res/adm/pages/open-all-folders.gif);
 }  }
   
   a#LC_content_toolbar_edittoplevel {
     background-image:url(/res/adm/pages/edittoplevel.gif);
   }
   
 ul#LC_toolbar li a:hover {  ul#LC_toolbar li a:hover {
   background-position: bottom center;    background-position: bottom center;
 }  }
Line 6476  ul#LC_toolbar { Line 7563  ul#LC_toolbar {
   list-style:none;    list-style:none;
   position:relative;    position:relative;
   background-color:white;    background-color:white;
     overflow: auto;
 }  }
   
 ul#LC_toolbar li {  ul#LC_toolbar li {
Line 6485  ul#LC_toolbar li { Line 7573  ul#LC_toolbar li {
   float: left;    float: left;
   display:inline;    display:inline;
   vertical-align:middle;    vertical-align:middle;
     white-space: nowrap;
 }  }
   
   
Line 6530  ul.LC_funclist li { Line 7619  ul.LC_funclist li {
   line-height: 150%;    line-height: 150%;
 }  }
   
 .ui-accordion .LC_advanced_toggle {  
   float: right;  
   font-size: 90%;  
   padding: 0px 4px  
 }  
   
 .LC_hidden {  .LC_hidden {
   display: none;    display: none;
 }  }
   
   .LCmodal-overlay {
    position:fixed;
    top:0;
    right:0;
    bottom:0;
    left:0;
    height:100%;
    width:100%;
    margin:0;
    padding:0;
    background:#999;
    opacity:.75;
    filter: alpha(opacity=75);
    -moz-opacity: 0.75;
    z-index:101;
   }
   
   * html .LCmodal-overlay {   
    position: absolute;
    height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
   }
   
   .LCmodal-window {
    position:fixed;
    top:50%;
    left:50%;
    margin:0;
    padding:0;
    z-index:102;
    }
   
   * html .LCmodal-window {
    position:absolute;
   }
   
   .LCclose-window {
    position:absolute;
    width:32px;
    height:32px;
    right:8px;
    top:8px;
    background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
    text-indent:-99999px;
    overflow:hidden;
    cursor:pointer;
   }
   
   /*
     styles used by TTH when "Default set of options to pass to tth/m
     when converting TeX" in course settings has been set
   
     option passed: -t
   
   */
   
   td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
   td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
   td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
   td div.norm {line-height:normal;}
   
   /*
     option passed -y3
   */
   
   span.roman {font-family: serif; font-style: normal; font-weight: normal;}
   span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
   span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
   
   #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 6576  sub headtag { Line 7760  sub headtag {
     my $function = $args->{'function'} || &get_users_function();      my $function = $args->{'function'} || &get_users_function();
     my $domain   = $args->{'domain'}   || &determinedomain();      my $domain   = $args->{'domain'}   || &determinedomain();
     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);      my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
       my $httphost = $args->{'use_absolute'};
     my $url = join(':',$env{'user.name'},$env{'user.domain'},      my $url = join(':',$env{'user.name'},$env{'user.domain'},
    $Apache::lonnet::perlvar{'lonVersion'},     $Apache::lonnet::perlvar{'lonVersion'},
    #time(),     #time(),
Line 6586  sub headtag { Line 7771  sub headtag {
   
     my $result =      my $result =
  '<head>'.   '<head>'.
  &font_settings();   &font_settings($args);
   
       my $inhibitprint;
       if ($args->{'print_suppress'}) {
           $inhibitprint = &print_suppression();
       }
   
     if (!$args->{'frameset'}) {      if (!$args->{'frameset'}) {
  $result .= &Apache::lonhtmlcommon::htmlareaheaders();   $result .= &Apache::lonhtmlcommon::htmlareaheaders();
     }      }
     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {      if ($args->{'force_register'}) {
         $result .= Apache::lonxml::display_title();          $result .= &Apache::lonmenu::registerurl(1);
     }      }
     if (!$args->{'no_nav_bar'}       if (!$args->{'no_nav_bar'} 
  && !$args->{'only_body'}   && !$args->{'only_body'}
  && !$args->{'frameset'}) {   && !$args->{'frameset'}) {
  $result .= &help_menu_js();   $result .= &help_menu_js($httphost);
           $result.=&modal_window();
           $result.=&togglebox_script();
           $result.=&wishlist_window();
           $result.=&LCprogressbarUpdate_script();
       } else {
           if ($args->{'add_modal'}) {
              $result.=&modal_window();
           }
           if ($args->{'add_wishlist'}) {
              $result.=&wishlist_window();
           }
           if ($args->{'add_togglebox'}) {
              $result.=&togglebox_script();
           }
           if ($args->{'add_progressbar'}) {
              $result.=&LCprogressbarUpdate_script();
           }
     }      }
   
     if (ref($args->{'redirect'})) {      if (ref($args->{'redirect'})) {
  my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};   my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
  $url = &Apache::lonenc::check_encrypt($url);   $url = &Apache::lonenc::check_encrypt($url);
Line 6610  sub headtag { Line 7816  sub headtag {
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 <meta http-equiv="Refresh" content="$time; url=$url" />  <meta http-equiv="Refresh" content="$time; url=$url" />
 ADDMETA  ADDMETA
       } else {
           unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
               my $requrl = $env{'request.uri'};
               if ($requrl eq '') {
                   $requrl = $ENV{'REQUEST_URI'};
                   $requrl =~ s/\?.+$//;
               }
               unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                       (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                        ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                       my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                       if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                           my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                           if ($domdefs{'offloadnow'}{$lonhost}) {
                               my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                               if (($newserver) && ($newserver ne $lonhost)) {
                                   my $numsec = 5;
                                   my $timeout = $numsec * 1000;
                                   my ($newurl,$locknum,%locks,$msg);
                                   if ($env{'request.role.adv'}) {
                                       ($locknum,%locks) = &Apache::lonnet::get_locks();
                                   }
                                   my $disable_submit = 0;
                                   if ($requrl =~ /$LONCAPA::assess_re/) {
                                       $disable_submit = 1;
                                   }
                                   if ($locknum) {
                                       my @lockinfo = sort(values(%locks));
                                       $msg = &mt('Once the following tasks are complete: ')."\\n".
                                              join(", ",sort(values(%locks)))."\\n".
                                              &mt('your session will be transferred to a different server, after you click "Roles".');
                                   } else {
                                       if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                                           $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                                       }
                                       $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                                       $newurl = '/adm/switchserver?otherserver='.$newserver;
                                       if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                                           $newurl .= '&role='.$env{'request.role'};
                                       }
                                       if ($env{'request.symb'}) {
                                           $newurl .= '&symb='.$env{'request.symb'};
                                       } else {
                                           $newurl .= '&origurl='.$requrl;
                                       }
                                   }
                                   &js_escape(\$msg);
                                   $result.=<<OFFLOAD
   <meta http-equiv="pragma" content="no-cache" />
   <script type="text/javascript">
   // <![CDATA[
   function LC_Offload_Now() {
       var dest = "$newurl";
       if (dest != '') {
           window.location.href="$newurl";
       }
   }
   \$(document).ready(function () {
       window.alert('$msg');
       if ($disable_submit) {
           \$(".LC_hwk_submit").prop("disabled", true);
           \$( ".LC_textline" ).prop( "readonly", "readonly");
       }
       setTimeout('LC_Offload_Now()', $timeout);
   });
   // ]]>
   </script>
   OFFLOAD
                               }
                           }
                       }
                   }
               }
           }
     }      }
     if (!defined($title)) {      if (!defined($title)) {
  $title = 'The LearningOnline Network with CAPA';   $title = 'The LearningOnline Network with CAPA';
     }      }
     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }      if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
     $result .= '<title> LON-CAPA '.$title.'</title>'      $result .= '<title> LON-CAPA '.$title.'</title>'
  .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'   .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
       if (!$args->{'frameset'}) {
           $result .= ' /';
       }
       $result .= '>'
           .$inhibitprint
  .$head_extra;   .$head_extra;
       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 .= '
   <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" />';
       }
       $result .= '<meta name="google" content="notranslate" />'."\n";
     return $result.'</head>';      return $result.'</head>';
 }  }
   
Line 6627  ADDMETA Line 7926  ADDMETA
   
 Returns neccessary <meta> to set the proper encoding  Returns neccessary <meta> to set the proper encoding
   
 Inputs: none  Inputs: optional reference to HASH -- $args passed to &headtag()
   
 =cut  =cut
   
 sub font_settings {  sub font_settings {
       my ($args) = @_;
     my $headerstring='';      my $headerstring='';
     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {      if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
           ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
  $headerstring.=   $headerstring.=
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';      '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
           if (!$args->{'frameset'}) {
               $headerstring.= ' /';
           }
           $headerstring .= '>'."\n";
     }      }
     return $headerstring;      return $headerstring;
 }  }
   
 =pod  =pod
   
   =item * &print_suppression()
   
   In course context returns css which causes the body to be blank when media="print",
   if printout generation is unavailable for the current resource.
   
   This could be because:
   
   (a) printstartdate is in the future
   
   (b) printenddate is in the past
   
   (c) there is an active exam block with "printout"
   functionality blocked
   
   Users with pav, pfo or evb privileges are exempt.
   
   Inputs: none
   
   =cut
   
   
   sub print_suppression {
       my $noprint;
       if ($env{'request.course.id'}) {
           my $scope = $env{'request.course.id'};
           if ((&Apache::lonnet::allowed('pav',$scope)) ||
               (&Apache::lonnet::allowed('pfo',$scope))) {
               return;
           }
           if ($env{'request.course.sec'} ne '') {
               $scope .= "/$env{'request.course.sec'}";
               if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   (&Apache::lonnet::allowed('pfo',$scope))) {
                   return;
               }
           }
           my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
           my $blocked = &blocking_status('printout',$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})) {
                   $noprint = 1;
               }
           }
           unless ($noprint) {
               my $symb = &Apache::lonnet::symbread();
               if ($symb ne '') {
                   my $navmap = Apache::lonnavmaps::navmap->new();
                   if (ref($navmap)) {
                       my $res = $navmap->getBySymb($symb);
                       if (ref($res)) {
                           if (!$res->resprintable()) {
                               $noprint = 1;
                           }
                       }
                   }
               }
           }
           if ($noprint) {
               return <<"ENDSTYLE";
   <style type="text/css" media="print">
       body { display:none }
   </style>
   ENDSTYLE
           }
       }
       return;
   }
   
   =pod
   
 =item * &xml_begin()  =item * &xml_begin()
   
 Returns the needed doctype and <html>  Returns the needed doctype and <html>
Line 6651  Inputs: none Line 8032  Inputs: none
 =cut  =cut
   
 sub xml_begin {  sub xml_begin {
       my ($is_frameset) = @_;
     my $output='';      my $output='';
   
     if ($env{'browser.mathml'}) {      if ($env{'browser.mathml'}) {
Line 6662  sub xml_begin { Line 8044  sub xml_begin {
     .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'      .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '               .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
     .'xmlns="http://www.w3.org/1999/xhtml">';      .'xmlns="http://www.w3.org/1999/xhtml">';
       } elsif ($is_frameset) {
           $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   '<html>'."\n";
     } else {      } else {
  $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'   $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';                  '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
     }      }
     return $output;      return $output;
 }  }
Line 6708  $args - additional optional args support Line 8093  $args - additional optional args support
              skip_phases    -> hash ref of                skip_phases    -> hash ref of 
                                     head -> skip the <html><head> generation                                      head -> skip the <html><head> generation
                                     body -> skip all <body> generation                                      body -> skip all <body> generation
                no_inline_link -> if true and in remote mode, don't show the
                                       'Switch To Inline Menu' link
              no_auto_mt_title -> prevent &mt()ing the title arg               no_auto_mt_title -> prevent &mt()ing the title arg
              inherit_jsmath -> when creating popup window in a page,  
                                     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
                                  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 6724  $args - additional optional args support Line 8116  $args - additional optional args support
 sub start_page {  sub start_page {
     my ($title,$head_extra,$args) = @_;      my ($title,$head_extra,$args) = @_;
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));      #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
 #SD  
 #I don't see why we copy certain elements of %$args to %head_args  
 #head args is passed to headtag() and this routine only reads those  
 #keys that are needed. There doesn't happen any writes or any processing  
 #of other keys.  
 #proposal: just pass $args to headtag instead of \%head_args and delete   
 #marked lines  
 #<- MARK  
     my %head_args;  
     foreach my $arg ('redirect','force_register','domain','function',  
      'bgcolor','frameset','no_nav_bar','only_body',  
      'no_auto_mt_title') {  
  if (defined($args->{$arg})) {  
     $head_args{$arg} = $args->{$arg};  
  }  
     }  
 #MARK ->  
   
     $env{'internal.start_page'}++;      $env{'internal.start_page'}++;
     my $result;      my ($result,@advtools);
   
     if (! exists($args->{'skip_phases'}{'head'}) ) {      if (! exists($args->{'skip_phases'}{'head'}) ) {
         $result .=           $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
                   &xml_begin() . &headtag($title,$head_extra,\%head_args);  
 #replace prev line by  
 #                 &xml_begin() . &headtag($title, $head_extra, $args);  
     }      }
           
     if (! exists($args->{'skip_phases'}{'body'}) ) {      if (! exists($args->{'skip_phases'}{'body'}) ) {
Line 6763  sub start_page { Line 8135  sub start_page {
                          $args->{'function'},       $args->{'add_entries'},                           $args->{'function'},       $args->{'add_entries'},
                          $args->{'only_body'},      $args->{'domain'},                           $args->{'only_body'},      $args->{'domain'},
                          $args->{'force_register'}, $args->{'no_nav_bar'},                           $args->{'force_register'}, $args->{'no_nav_bar'},
                          $args->{'bgcolor'},        $args);                           $args->{'bgcolor'},        $args->{'no_inline_link'},
                            $args,                     \@advtools);
         }          }
     }      }
   
Line 6792  sub start_page { Line 8165  sub start_page {
  &Apache::lonhtmlcommon::add_breadcrumb($crumb);   &Apache::lonhtmlcommon::add_breadcrumb($crumb);
  }   }
  }   }
                   # if @advtools array contains items add then to the breadcrumbs
                   if (@advtools > 0) {
                       &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'})) {
                       $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);
  }   }
       } elsif (($env{'environment.remote'} eq 'on') &&
                ($env{'form.inhibitmenu'} ne 'yes') &&
                ($env{'request.noversionuri'} =~ m{^/res/}) &&
                ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
           $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
     }      }
     return $result;      return $result;
 }  }
Line 6815  sub end_page { Line 8203  sub end_page {
  }   }
  $result .= &Apache::lonxml::xmlend($target,$parser);   $result .= &Apache::lonxml::xmlend($target,$parser);
     }      }
   
     if ($args->{'frameset'}) {      if ($args->{'frameset'}) {
  $result .= '</frameset>';   $result .= '</frameset>';
     } else {      } else {
  $result .= &endbodytag($args);   $result .= &endbodytag($args);
     }      }
     $result .= "\n</html>";      unless ($args->{'notbody'}) {
           $result .= "\n</html>";
       }
   
     if ($args->{'js_ready'}) {      if ($args->{'js_ready'}) {
  $result = &js_ready($result);   $result = &js_ready($result);
Line 6834  sub end_page { Line 8223  sub end_page {
     return $result;      return $result;
 }  }
   
   sub wishlist_window {
       return(<<'ENDWISHLIST');
   <script type="text/javascript">
   // <![CDATA[
   // <!-- BEGIN LON-CAPA Internal
   function set_wishlistlink(title, path) {
       if (!title) {
           title = document.title;
           title = title.replace(/^LON-CAPA /,'');
       }
       title = encodeURIComponent(title);
       title = title.replace("'","\\\'");
       if (!path) {
           path = location.pathname;
       }
       path = encodeURIComponent(path);
       path = path.replace("'","\\\'");
       Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                         'wishlistNewLink','width=560,height=350,scrollbars=0');
   }
   // END LON-CAPA Internal -->
   // ]]>
   </script>
   ENDWISHLIST
   }
   
   sub modal_window {
       return(<<'ENDMODAL');
   <script type="text/javascript">
   // <![CDATA[
   // <!-- BEGIN LON-CAPA Internal
   var modalWindow = {
    parent:"body",
    windowId:null,
    content:null,
    width:null,
    height:null,
    close:function()
    {
           $(".LCmodal-window").remove();
           $(".LCmodal-overlay").remove();
    },
    open:function()
    {
    var modal = "";
    modal += "<div class=\"LCmodal-overlay\"></div>";
    modal += "<div id=\"" + this.windowId + "\" class=\"LCmodal-window\" style=\"width:" + this.width + "px; height:" + this.height + "px; margin-top:-" + (this.height / 2) + "px; margin-left:-" + (this.width / 2) + "px;\">";
    modal += this.content;
    modal += "</div>";
   
    $(this.parent).append(modal);
   
    $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
    $(".LCclose-window").click(function(){modalWindow.close();});
    $(".LCmodal-overlay").click(function(){modalWindow.close();});
    }
   };
    var openMyModal = function(source,width,height,scrolling,transparency,style)
    {
                   source = source.replace(/'/g,"&#39;");
    modalWindow.windowId = "myModal";
    modalWindow.width = width;
    modalWindow.height = height;
    modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
    modalWindow.open();
    };
   // END LON-CAPA Internal -->
   // ]]>
   </script>
   ENDMODAL
   }
   
   sub modal_link {
       my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
       unless ($width) { $width=480; }
       unless ($height) { $height=400; }
       unless ($scrolling) { $scrolling='yes'; }
       unless ($transparency) { $transparency='true'; }
   
       my $target_attr;
       if (defined($target)) {
           $target_attr = 'target="'.$target.'"';
       }
       return <<"ENDLINK";
   <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
              $linktext</a>
   ENDLINK
   }
   
   sub modal_adhoc_script {
       my ($funcname,$width,$height,$content)=@_;
       return (<<ENDADHOC);
   <script type="text/javascript">
   // <![CDATA[
           var $funcname = function()
           {
                   modalWindow.windowId = "myModal";
                   modalWindow.width = $width;
                   modalWindow.height = $height;
                   modalWindow.content = '$content';
                   modalWindow.open();
           };  
   // ]]>
   </script>
   ENDADHOC
   }
   
   sub modal_adhoc_inner {
       my ($funcname,$width,$height,$content)=@_;
       my $innerwidth=$width-20;
       $content=&js_ready(
                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                    &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                    $content.
                    &end_scrollbox().
                    &end_page()
                );
       return &modal_adhoc_script($funcname,$width,$height,$content);
   }
   
   sub modal_adhoc_window {
       my ($funcname,$width,$height,$content,$linktext)=@_;
       return &modal_adhoc_inner($funcname,$width,$height,$content).
              "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
   }
   
   sub modal_adhoc_launch {
       my ($funcname,$width,$height,$content)=@_;
       return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
   <script type="text/javascript">
   // <![CDATA[
   $funcname();
   // ]]>
   </script>
   ENDLAUNCH
   }
   
   sub modal_adhoc_close {
       return (<<ENDCLOSE);
   <script type="text/javascript">
   // <![CDATA[
   modalWindow.close();
   // ]]>
   </script>
   ENDCLOSE
   }
   
   sub togglebox_script {
      return(<<ENDTOGGLE);
   <script type="text/javascript"> 
   // <![CDATA[
   function LCtoggleDisplay(id,hidetext,showtext) {
      link = document.getElementById(id + "link").childNodes[0];
      with (document.getElementById(id).style) {
         if (display == "none" ) {
             display = "inline";
             link.nodeValue = hidetext;
           } else {
             display = "none";
             link.nodeValue = showtext;
          }
      }
   }
   // ]]>
   </script>
   ENDTOGGLE
   }
   
   sub start_togglebox {
       my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
       unless ($heading) { $heading=''; } else { $heading.=' '; }
       unless ($showtext) { $showtext=&mt('show'); }
       unless ($hidetext) { $hidetext=&mt('hide'); }
       unless ($headerbg) { $headerbg='#FFFFFF'; }
       return &start_data_table().
              &start_data_table_header_row().
              '<td bgcolor="'.$headerbg.'">'.$heading.
              '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
              $showtext.'\')">'.$showtext.'</a>]</td>'.
              &end_data_table_header_row().
              '<tr id="'.$id.'" style="display:none""><td>';
   }
   
   sub end_togglebox {
       return '</td></tr>'.&end_data_table();
   }
   
   sub LCprogressbar_script {
      my ($id,$number_to_do)=@_;
      if ($number_to_do) {
          return(<<ENDPROGRESS);
   <script type="text/javascript">
   // <![CDATA[
   \$('#progressbar$id').progressbar({
     value: 0,
     change: function(event, ui) {
       var newVal = \$(this).progressbar('option', 'value');
       \$('.pblabel', this).text(LCprogressTxt);
     }
   });
   // ]]>
   </script>
   ENDPROGRESS
      } else {
          return(<<ENDPROGRESS);
   <script type="text/javascript">
   // <![CDATA[
   \$('#progressbar$id').progressbar({
     value: false,
     create: function(event, ui) {
       \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
       \$('.ui-progressbar-overlay', this).css({'margin':'0'});
     }
   });
   // ]]>
   </script>
   ENDPROGRESS
      }
   }
   
   sub LCprogressbarUpdate_script {
      return(<<ENDPROGRESSUPDATE);
   <style type="text/css">
   .ui-progressbar { position:relative; }
   .progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
   .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
   </style>
   <script type="text/javascript">
   // <![CDATA[
   var LCprogressTxt='---';
   
   function LCupdateProgress(percent,progresstext,id,maxnum) {
      LCprogressTxt=progresstext;
      if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
          \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
      } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
          \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
      } else {
          \$('#progressbar'+id).progressbar('value',percent);
      }
   }
   // ]]>
   </script>
   ENDPROGRESSUPDATE
   }
   
   my $LClastpercent;
   my $LCidcnt;
   my $LCcurrentid;
   
   sub LCprogressbar {
       my ($r,$number_to_do,$preamble)=@_;
       $LClastpercent=0;
       $LCidcnt++;
       $LCcurrentid=$$.'_'.$LCidcnt;
       my ($starting,$content);
       if ($number_to_do) {
           $starting=&mt('Starting');
           $content=(<<ENDPROGBAR);
   $preamble
     <div id="progressbar$LCcurrentid">
       <span class="pblabel">$starting</span>
     </div>
   ENDPROGBAR
       } else {
           $starting=&mt('Loading...');
           $LClastpercent='false';
           $content=(<<ENDPROGBAR);
   $preamble
     <div id="progressbar$LCcurrentid">
         <div class="progress-label">$starting</div>
     </div>
   ENDPROGBAR
       }
       &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
   }
   
   sub LCprogressbarUpdate {
       my ($r,$val,$text,$number_to_do)=@_;
       if ($number_to_do) {
           unless ($val) { 
               if ($LClastpercent) {
                   $val=$LClastpercent;
               } else {
                   $val=0;
               }
           }
           if ($val<0) { $val=0; }
           if ($val>100) { $val=0; }
           $LClastpercent=$val;
           unless ($text) { $text=$val.'%'; }
       } else {
           $val = 'false';
       }
       $text=&js_ready($text);
       &r_print($r,<<ENDUPDATE);
   <script type="text/javascript">
   // <![CDATA[
   LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
   // ]]>
   </script>
   ENDUPDATE
   }
   
   sub LCprogressbarClose {
       my ($r)=@_;
       $LClastpercent=0;
       &r_print($r,<<ENDCLOSE);
   <script type="text/javascript">
   // <![CDATA[
   \$("#progressbar$LCcurrentid").hide('slow'); 
   // ]]>
   </script>
   ENDCLOSE
   }
   
   sub r_print {
       my ($r,$to_print)=@_;
       if ($r) {
         $r->print($to_print);
         $r->rflush();
       } else {
         print($to_print);
       }
   }
   
 sub html_encode {  sub html_encode {
     my ($result) = @_;      my ($result) = @_;
   
Line 6841  sub html_encode { Line 8556  sub html_encode {
           
     return $result;      return $result;
 }  }
   
 sub js_ready {  sub js_ready {
     my ($result) = @_;      my ($result) = @_;
   
Line 6877  sub validate_page { Line 8593  sub validate_page {
     }      }
 }  }
   
   
   sub start_scrollbox {
       my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
       unless ($outerwidth) { $outerwidth='520px'; }
       unless ($width) { $width='500px'; }
       unless ($height) { $height='200px'; }
       my ($table_id,$div_id,$tdcol);
       if ($id ne '') {
           $table_id = ' id="table_'.$id.'"';
           $div_id = ' id="div_'.$id.'"';
       }
       if ($bgcolor ne '') {
           $tdcol = "background-color: $bgcolor;";
       }
       my $nicescroll_js;
       if ($env{'browser.mobile'}) {
           $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
       }
       return <<"END";
   $nicescroll_js
   
   <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
   <div style="overflow:auto; width:$width; height:$height;"$div_id>
   END
   }
   
   sub end_scrollbox {
       return '</div></td></tr></table>';
   }
   
   sub nicescroll_javascript {
       my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
       my %options;
       if (ref($cursor) eq 'HASH') {
           %options = %{$cursor};
       }
       unless ($options{'railalign'} =~ /^left|right$/) {
           $options{'railalign'} = 'left';
       }
       unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
           my $function  = &get_users_function();
           $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
           unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
               $options{'cursorcolor'} = '#00F';
           }
       }
       if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
           unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
               $options{'cursoropacity'}='1.0';
           }
       } else {
           $options{'cursoropacity'}='1.0';
       }
       if ($options{'cursorfixedheight'} eq 'none') {
           delete($options{'cursorfixedheight'});
       } else {
           unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
       }
       unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
           delete($options{'railoffset'});
       }
       my @niceoptions;
       while (my($key,$value) = each(%options)) {
           if ($value =~ /^\{.+\}$/) {
               push(@niceoptions,$key.':'.$value);
           } else {
               push(@niceoptions,$key.':"'.$value.'"');
           }
       }
       my $nicescroll_js = '
   $(document).ready(
         function() {
             $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
         }
   );
   ';
       if ($framecheck) {
           $nicescroll_js .= '
   function expand_div(caller) {
       if (top === self) {
           document.getElementById("'.$id.'").style.width = "auto";
           document.getElementById("'.$id.'").style.height = "auto";
       } else {
           try {
               if (parent.frames) {
                   if (parent.frames.length > 1) {
                       var framesrc = parent.frames[1].location.href;
                       var currsrc = framesrc.replace(/\#.*$/,"");
                       if ((caller == "search") || (currsrc == "'.$location.'")) {
                           document.getElementById("'.$id.'").style.width = "auto";
                           document.getElementById("'.$id.'").style.height = "auto";
                       }
                   }
               }
           } catch (e) {
               return;
           }
       }
       return;
   }
   ';
       }
       if ($needjsready) {
           $nicescroll_js = '
   <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
       } else {
           $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
       }
       return $nicescroll_js;
   }
   
 sub simple_error_page {  sub simple_error_page {
     my ($r,$title,$msg) = @_;      my ($r,$title,$msg,$args) = @_;
       if (ref($args) eq 'HASH') {
           if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
       } else {
           $msg = &mt($msg);
       }
   
     my $page =      my $page =
  &Apache::loncommon::start_page($title).   &Apache::loncommon::start_page($title).
  &mt($msg).   '<p class="LC_error">'.$msg.'</p>'.
  &Apache::loncommon::end_page();   &Apache::loncommon::end_page();
     if (ref($r)) {      if (ref($r)) {
  $r->print($page);   $r->print($page);
Line 6904  sub simple_error_page { Line 8737  sub simple_error_page {
     }      }
   
     sub start_data_table {      sub start_data_table {
  my ($add_class) = @_;   my ($add_class,$id) = @_;
  my $css_class = (join(' ','LC_data_table',$add_class));   my $css_class = (join(' ','LC_data_table',$add_class));
           my $table_id;
           if (defined($id)) {
               $table_id = ' id="'.$id.'"';
           }
  &start_data_table_count();   &start_data_table_count();
  return '<table class="'.$css_class.'">'."\n";   return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
     }      }
   
     sub end_data_table {      sub end_data_table {
Line 7034  sub get_users_function { Line 8871  sub get_users_function {
         $function='admin';          $function='admin';
     }      }
     if (($env{'request.role'}=~/^(au|ca|aa)/) ||      if (($env{'request.role'}=~/^(au|ca|aa)/) ||
         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {          ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
         $function='author';          $function='author';
     }      }
     return $function;      return $function;
Line 7092  role status: active, previous or future. Line 8929  role status: active, previous or future.
   
 sub check_user_status {  sub check_user_status {
     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;      my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
     my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});      my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);      my @uroles = keys(%userinfo);
     my @uroles = keys %userinfo;  
     my $srchstr;      my $srchstr;
     my $active_chk = 'none';      my $active_chk = 'none';
     my $now = time;      my $now = time;
Line 7171  sub get_sections { Line 9007  sub get_sections {
     my %sectioncount;      my %sectioncount;
     my $now = time;      my $now = time;
   
     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {      my $check_students = 1;
       my $only_students = 0;
       if (ref($possible_roles) eq 'ARRAY') {
           if (grep(/^st$/,@{$possible_roles})) {
               if (@{$possible_roles} == 1) {
                   $only_students = 1;
               }
           } else {
               $check_students = 0;
           }
       }
   
       if ($check_students) {
  my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);   my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
  my $sec_index = &Apache::loncoursedata::CL_SECTION();   my $sec_index = &Apache::loncoursedata::CL_SECTION();
  my $status_index = &Apache::loncoursedata::CL_STATUS();   my $status_index = &Apache::loncoursedata::CL_STATUS();
Line 7198  sub get_sections { Line 9046  sub get_sections {
     }      }
  }   }
     }      }
       if ($only_students) {
           return %sectioncount;
       }
     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);      my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
     foreach my $user (sort(keys(%courseroles))) {      foreach my $user (sort(keys(%courseroles))) {
  if ($user !~ /^(\w{2})/) { next; }   if ($user !~ /^(\w{2})/) { next; }
Line 7345  sub get_course_users { Line 9196  sub get_course_users {
                               active   => 'Active',                                active   => 'Active',
                               future   => 'Future',                                future   => 'Future',
                             );                              );
         my %nothide;          my (%nothide,@possdoms);
         if ($hidepriv) {          if ($hidepriv) {
             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);              my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {              foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
Line 7355  sub get_course_users { Line 9206  sub get_course_users {
                     $nothide{$user} = 1;                      $nothide{$user} = 1;
                 }                  }
             }              }
               my @possdoms = ($cdom);
               if ($coursehash{'checkforpriv'}) {
                   push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
               }
         }          }
         foreach my $person (sort(keys(%coursepersonnel))) {          foreach my $person (sort(keys(%coursepersonnel))) {
             my $match = 0;              my $match = 0;
Line 7390  sub get_course_users { Line 9245  sub get_course_users {
                 }                  }
                 if ($uname ne '' && $udom ne '') {                  if ($uname ne '' && $udom ne '') {
                     if ($hidepriv) {                      if ($hidepriv) {
                         if ((&Apache::lonnet::privileged($uname,$udom)) &&                          if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
                             (!$nothide{$uname.':'.$udom})) {                              (!$nothide{$uname.':'.$udom})) {
                             next;                              next;
                         }                          }
Line 7478  sub get_user_info { Line 9333  sub get_user_info {
   
 =item * &get_user_quota()  =item * &get_user_quota()
   
 Retrieves quota assigned for storage of portfolio files for a user    Retrieves quota assigned for storage of user files.
   Default is to report quota for portfolio files.
   
 Incoming parameters:  Incoming parameters:
 1. user's username  1. user's username
 2. user's domain  2. user's domain
   3. quota name - portfolio, author, or course
      (if no quota name provided, defaults to portfolio).
   4. crstype - official, unofficial, textbook or community, if quota name is
      course
   
 Returns:  Returns:
 1. Disk quota (in Mb) assigned to student.  1. Disk quota (in MB) assigned to student.
 2. (Optional) Type of setting: custom or default  2. (Optional) Type of setting: custom or default
    (individually assigned or default for user's      (individually assigned or default for user's 
    institutional status).     institutional status).
Line 7496  Returns: Line 9356  Returns:
   
 If a value has been stored in the user's environment,   If a value has been stored in the user's environment, 
 it will return that, otherwise it returns the maximal default  it will return that, otherwise it returns the maximal default
 defined for the user's instituional status(es) in the domain.  defined for the user's institutional status(es) in the domain.
   
 =cut  =cut
   
Line 7504  defined for the user's instituional stat Line 9364  defined for the user's instituional stat
   
   
 sub get_user_quota {  sub get_user_quota {
     my ($uname,$udom) = @_;      my ($uname,$udom,$quotaname,$crstype) = @_;
     my ($quota,$quotatype,$settingstatus,$defquota);      my ($quota,$quotatype,$settingstatus,$defquota);
     if (!defined($udom)) {      if (!defined($udom)) {
         $udom = $env{'user.domain'};          $udom = $env{'user.domain'};
Line 7519  sub get_user_quota { Line 9379  sub get_user_quota {
         $defquota = 0;           $defquota = 0; 
     } else {      } else {
         my $inststatus;          my $inststatus;
         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {          if ($quotaname eq 'course') {
             $quota = $env{'environment.portfolioquota'};              if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
             $inststatus = $env{'environment.inststatus'};                  ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
         } else {                  $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
             my %userenv =               } else {
                 &Apache::lonnet::get('environment',['portfolioquota',                  my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                                      'inststatus'],$udom,$uname);                  $quota = $cenv{'internal.uploadquota'};
             my ($tmp) = keys(%userenv);              }
             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {  
                 $quota = $userenv{'portfolioquota'};  
                 $inststatus = $userenv{'inststatus'};  
             } else {  
                 undef(%userenv);  
             }  
         }  
         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);  
         if ($quota eq '') {  
             $quota = $defquota;  
             $quotatype = 'default';  
         } else {          } else {
             $quotatype = 'custom';              if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   if ($quotaname eq 'author') {
                       $quota = $env{'environment.authorquota'};
                   } else {
                       $quota = $env{'environment.portfolioquota'};
                   }
                   $inststatus = $env{'environment.inststatus'};
               } else {
                   my %userenv = 
                       &Apache::lonnet::get('environment',['portfolioquota',
                                            'authorquota','inststatus'],$udom,$uname);
                   my ($tmp) = keys(%userenv);
                   if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                       if ($quotaname eq 'author') {
                           $quota = $userenv{'authorquota'};
                       } else {
                           $quota = $userenv{'portfolioquota'};
                       }
                       $inststatus = $userenv{'inststatus'};
                   } else {
                       undef(%userenv);
                   }
               }
           }
           if ($quota eq '' || wantarray) {
               if ($quotaname eq 'course') {
                   my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
                   if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                       ($crstype eq 'community') || ($crstype eq 'textbook')) {
                       $defquota = $domdefs{$crstype.'quota'};
                   }
                   if ($defquota eq '') {
                       $defquota = 500;
                   }
               } else {
                   ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
               }
               if ($quota eq '') {
                   $quota = $defquota;
                   $quotatype = 'default';
               } else {
                   $quotatype = 'custom';
               }
         }          }
     }      }
     if (wantarray) {      if (wantarray) {
Line 7559  Retrieves default quota assigned for sto Line 9450  Retrieves default quota assigned for sto
 given an (optional) user's institutional status.  given an (optional) user's institutional status.
   
 Incoming parameters:  Incoming parameters:
   
 1. domain  1. domain
 2. (Optional) institutional status(es).  This is a : separated list of   2. (Optional) institutional status(es).  This is a : separated list of 
    status types (e.g., faculty, staff, student etc.)     status types (e.g., faculty, staff, student etc.)
    which apply to the user for whom the default is being retrieved.     which apply to the user for whom the default is being retrieved.
    If the institutional status string in undefined, the domain     If the institutional status string in undefined, the domain
    default quota will be returned.      default quota will be returned.
   3.  quota name - portfolio, author, or course
      (if no quota name provided, defaults to portfolio).
   
 Returns:  Returns:
 1. Default disk quota (in Mb) for user portfolios in the domain.  
   1. Default disk quota (in MB) for user portfolios in the domain.
 2. (Optional) institutional type which determined the value of the  2. (Optional) institutional type which determined the value of the
    default quota.     default quota.
   
 If a value has been stored in the domain's configuration db,  If a value has been stored in the domain's configuration db,
 it will return that, otherwise it returns 20 (for backwards   it will return that, otherwise it returns 20 (for backwards 
 compatibility with domains which have not set up a configuration  compatibility with domains which have not set up a configuration
 db file; the original statically defined portfolio quota was 20 Mb).   db file; the original statically defined portfolio quota was 20 MB). 
   
 If the user's status includes multiple types (e.g., staff and student),  If the user's status includes multiple types (e.g., staff and student),
 the largest default quota which applies to the user determines the  the largest default quota which applies to the user determines the
 default quota returned.  default quota returned.
   
 =back  
   
 =cut  =cut
   
 ###############################################  ###############################################
   
   
 sub default_quota {  sub default_quota {
     my ($udom,$inststatus) = @_;      my ($udom,$inststatus,$quotaname) = @_;
     my ($defquota,$settingstatus);      my ($defquota,$settingstatus);
     my %quotahash = &Apache::lonnet::get_dom('configuration',      my %quotahash = &Apache::lonnet::get_dom('configuration',
                                             ['quotas'],$udom);                                              ['quotas'],$udom);
       my $key = 'defaultquota';
       if ($quotaname eq 'author') {
           $key = 'authorquota';
       }
     if (ref($quotahash{'quotas'}) eq 'HASH') {      if (ref($quotahash{'quotas'}) eq 'HASH') {
         if ($inststatus ne '') {          if ($inststatus ne '') {
             my @statuses = map { &unescape($_); } split(/:/,$inststatus);              my @statuses = map { &unescape($_); } split(/:/,$inststatus);
             foreach my $item (@statuses) {              foreach my $item (@statuses) {
                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {                  if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {                      if ($quotahash{'quotas'}{$key}{$item} ne '') {
                         if ($defquota eq '') {                          if ($defquota eq '') {
                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};                              $defquota = $quotahash{'quotas'}{$key}{$item};
                             $settingstatus = $item;                              $settingstatus = $item;
                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {                          } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};                              $defquota = $quotahash{'quotas'}{$key}{$item};
                             $settingstatus = $item;                              $settingstatus = $item;
                         }                          }
                     }                      }
                 } else {                  } elsif ($key eq 'defaultquota') {
                     if ($quotahash{'quotas'}{$item} ne '') {                      if ($quotahash{'quotas'}{$item} ne '') {
                         if ($defquota eq '') {                          if ($defquota eq '') {
                             $defquota = $quotahash{'quotas'}{$item};                              $defquota = $quotahash{'quotas'}{$item};
Line 7620  sub default_quota { Line 9517  sub default_quota {
             }              }
         }          }
         if ($defquota eq '') {          if ($defquota eq '') {
             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {              if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};                  $defquota = $quotahash{'quotas'}{$key}{'default'};
             } else {              } elsif ($key eq 'defaultquota') {
                 $defquota = $quotahash{'quotas'}{'default'};                  $defquota = $quotahash{'quotas'}{'default'};
             }              }
             $settingstatus = 'default';              $settingstatus = 'default';
               if ($defquota eq '') {
                   if ($quotaname eq 'author') {
                       $defquota = 500;
                   }
               }
         }          }
     } else {      } else {
         $settingstatus = 'default';          $settingstatus = 'default';
         $defquota = 20;          if ($quotaname eq 'author') {
               $defquota = 500;
           } else {
               $defquota = 20;
           }
     }      }
     if (wantarray) {      if (wantarray) {
         return ($defquota,$settingstatus);          return ($defquota,$settingstatus);
Line 7638  sub default_quota { Line 9544  sub default_quota {
     }      }
 }  }
   
   ###############################################
   
   =pod
   
   =item * &excess_filesize_warning()
   
   Returns warning message if upload of file to authoring space, or copying
   of existing file within authoring space will cause quota for the authoring
   space to be exceeded.
   
   Same, if upload of a file directly to a course/community via Course Editor
   will cause quota for uploaded content for the course to be exceeded.
   
   Inputs: 7 
   1. username or coursenum
   2. domain
   3. context ('author' or 'course')
   4. filename of file for which action is being requested
   5. filesize (kB) of file
   6. action being taken: copy or upload.
   7. quotatype (in course context -- official, unofficial, community or textbook).
   
   Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
            otherwise return null.
   
   =back
   
   =cut
   
   sub excess_filesize_warning {
       my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
       my $current_disk_usage = 0;
       my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
       if ($context eq 'author') {
           my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
           $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
       } else {
           foreach my $subdir ('docs','supplemental') {
               $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
           }
       }
       $disk_quota = int($disk_quota * 1000);
       if (($current_disk_usage + $filesize) > $disk_quota) {
           return '<p class="LC_warning">'.
                   &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
                       '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                  '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                               $disk_quota,$current_disk_usage).
                  '</p>';
       }
       return;
   }
   
   ###############################################
   
   
 sub get_secgrprole_info {  sub get_secgrprole_info {
     my ($cdom,$cnum,$needroles,$type)  = @_;      my ($cdom,$cnum,$needroles,$type)  = @_;
     my %sections_count = &get_sections($cdom,$cnum);      my %sections_count = &get_sections($cdom,$cnum);
Line 7676  sub get_secgrprole_info { Line 9638  sub get_secgrprole_info {
 }  }
   
 sub user_picker {  sub user_picker {
     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;      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 7698  sub user_picker { Line 9676  sub user_picker {
         }          }
         $srchterm = $srch->{'srchterm'};          $srchterm = $srch->{'srchterm'};
     }      }
     my %lt=&Apache::lonlocal::texthash(      my %html_lt=&Apache::lonlocal::texthash(
                     'usr'       => 'Search criteria',                      'usr'       => 'Search criteria',
                     'doma'      => 'Domain/institution to search',                      'doma'      => 'Domain/institution to search',
                     'uname'     => 'username',                      'uname'     => 'username',
Line 7711  sub user_picker { Line 9689  sub user_picker {
                     'exact'     => 'is',                      'exact'     => 'is',
                     'contains'  => 'contains',                      'contains'  => 'contains',
                     'begins'    => 'begins with',                      'begins'    => 'begins with',
                                          );
       my %js_lt=&Apache::lonlocal::texthash(
                     'youm'      => "You must include some text to search for.",                      'youm'      => "You must include some text to search for.",
                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",                      'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",                      'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
Line 7720  sub user_picker { Line 9700  sub user_picker {
                     'whse'      => "When searching by last,first you must include at least one character in the first name.",                      'whse'      => "When searching by last,first you must include at least one character in the first name.",
                      'thfo'     => "The following need to be corrected before the search can be run:",                       'thfo'     => "The following need to be corrected before the search can be run:",
                                        );                                         );
     my $domform = &select_dom_form($currdom,'srchdomain',1,1);      &html_escape(\%html_lt);
       &js_escape(\%js_lt);
       my $domform;
       my $allow_blank = 1;
       if ($fixeddom) {
           $allow_blank = 0;
           $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
       } else {
           $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
       }
     my $srchinsel = ' <select name="srchin">';      my $srchinsel = ' <select name="srchin">';
   
     my @srchins = ('crs','dom','alc','instd');      my @srchins = ('crs','dom','alc','instd');
Line 7732  sub user_picker { Line 9721  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">'.$lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
         } else {          } else {
             $srchinsel .= '              $srchinsel .= '
    <option value="'.$option.'">'.$lt{$option}.'</option>';     <option value="'.$option.'">'.$html_lt{$option}.'</option>';
         }          }
     }      }
     $srchinsel .= "\n  </select>\n";      $srchinsel .= "\n  </select>\n";
Line 7746  sub user_picker { Line 9736  sub user_picker {
     foreach my $option ('lastname','lastfirst','uname') {      foreach my $option ('lastname','lastfirst','uname') {
         if ($curr_selected{'srchby'} eq $option) {          if ($curr_selected{'srchby'} eq $option) {
             $srchbysel .= '              $srchbysel .= '
    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
         } else {          } else {
             $srchbysel .= '              $srchbysel .= '
    <option value="'.$option.'">'.$lt{$option}.'</option>';     <option value="'.$option.'">'.$html_lt{$option}.'</option>';
          }           }
     }      }
     $srchbysel .= "\n  </select>\n";      $srchbysel .= "\n  </select>\n";
Line 7758  sub user_picker { Line 9748  sub user_picker {
     foreach my $option ('begins','contains','exact') {      foreach my $option ('begins','contains','exact') {
         if ($curr_selected{'srchtype'} eq $option) {          if ($curr_selected{'srchtype'} eq $option) {
             $srchtypesel .= '              $srchtypesel .= '
    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
         } else {          } else {
             $srchtypesel .= '              $srchtypesel .= '
    <option value="'.$option.'">'.$lt{$option}.'</option>';     <option value="'.$option.'">'.$html_lt{$option}.'</option>';
         }          }
     }      }
     $srchtypesel .= "\n  </select>\n";      $srchtypesel .= "\n  </select>\n";
   
     my ($newuserscript,$new_user_create);      my ($newuserscript,$new_user_create);
       my $context_dom = $env{'request.role.domain'};
       if ($context eq 'requestcrs') {
           if ($env{'form.coursedom'} ne '') { 
               $context_dom = $env{'form.coursedom'};
           }
       }
     if ($forcenewuser) {      if ($forcenewuser) {
         if (ref($srch) eq 'HASH') {          if (ref($srch) eq 'HASH') {
             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {              if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
                 if ($cancreate) {                  if ($cancreate) {
                     $new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';                      $new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';
                 } else {                  } else {
Line 7809  function setSearch(createnew,callingForm Line 9804  function setSearch(createnew,callingForm
             }              }
         }          }
         for (var i=0; i<callingForm.srchdomain.length; i++) {          for (var i=0; i<callingForm.srchdomain.length; i++) {
             if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {              if (callingForm.srchdomain.options[i].value == '$context_dom') {
                 callingForm.srchdomain.selectedIndex = i;                  callingForm.srchdomain.selectedIndex = i;
             }              }
         }          }
Line 7841  function validateEntry(callingForm) { Line 9836  function validateEntry(callingForm) {
   
     if (srchterm == "") {      if (srchterm == "") {
         checkok = 0;          checkok = 0;
         msg += "$lt{'youm'}\\n";          msg += "$js_lt{'youm'}\\n";
     }      }
   
     if (srchtype== 'begins') {      if (srchtype== 'begins') {
         if (srchterm.length < 2) {          if (srchterm.length < 2) {
             checkok = 0;              checkok = 0;
             msg += "$lt{'thte'}\\n";              msg += "$js_lt{'thte'}\\n";
         }          }
     }      }
   
     if (srchtype== 'contains') {      if (srchtype== 'contains') {
         if (srchterm.length < 3) {          if (srchterm.length < 3) {
             checkok = 0;              checkok = 0;
             msg += "$lt{'thet'}\\n";              msg += "$js_lt{'thet'}\\n";
         }          }
     }      }
     if (srchin == 'instd') {      if (srchin == 'instd') {
         if (srchdomain == '') {          if (srchdomain == '') {
             checkok = 0;              checkok = 0;
             msg += "$lt{'yomc'}\\n";              msg += "$js_lt{'yomc'}\\n";
         }          }
     }      }
     if (srchin == 'dom') {      if (srchin == 'dom') {
         if (srchdomain == '') {          if (srchdomain == '') {
             checkok = 0;              checkok = 0;
             msg += "$lt{'ymcd'}\\n";              msg += "$js_lt{'ymcd'}\\n";
         }          }
     }      }
     if (srchby == 'lastfirst') {      if (srchby == 'lastfirst') {
         if (srchterm.indexOf(",") == -1) {          if (srchterm.indexOf(",") == -1) {
             checkok = 0;              checkok = 0;
             msg += "$lt{'whus'}\\n";              msg += "$js_lt{'whus'}\\n";
         }          }
         if (srchterm.indexOf(",") == srchterm.length -1) {          if (srchterm.indexOf(",") == srchterm.length -1) {
             checkok = 0;              checkok = 0;
             msg += "$lt{'whse'}\\n";              msg += "$js_lt{'whse'}\\n";
         }          }
     }      }
     if (checkok == 0) {      if (checkok == 0) {
         alert("$lt{'thfo'}\\n"+msg);          alert("$js_lt{'thfo'}\\n"+msg);
         return;          return;
     }      }
     if (checkok == 1) {      if (checkok == 1) {
Line 7898  $new_user_create Line 9893  $new_user_create
 END_BLOCK  END_BLOCK
   
     $output .= &Apache::lonhtmlcommon::start_pick_box().      $output .= &Apache::lonhtmlcommon::start_pick_box().
                &Apache::lonhtmlcommon::row_title($lt{'doma'}).                 &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
                $domform.                 $domform.
                &Apache::lonhtmlcommon::row_closure().                 &Apache::lonhtmlcommon::row_closure().
                &Apache::lonhtmlcommon::row_title($lt{'usr'}).                 &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
                $srchbysel.                 $srchbysel.
                $srchtypesel.                  $srchtypesel. 
                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.                 '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
Line 7909  END_BLOCK Line 9904  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 {
     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;      my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
     my $response;      my ($response,%inst_response);
     if (ref($usershash) eq 'HASH') {      if (ref($usershash) eq 'HASH') {
         foreach my $user (keys(%{$usershash})) {          if (keys(%{$usershash}) > 1) {
             my ($uname,$udom) = split(/:/,$user);              my (%by_username,%by_id,%userdoms);
             next if ($udom eq '' || $uname eq '');              my $checkid;
             my ($id,$newuser);  
             if (ref($usershash->{$user}) eq 'HASH') {  
                 $newuser = $usershash->{$user}->{'newuser'};  
                 $id = $usershash->{$user}->{'id'};  
             }  
             my $inst_response;  
             if (ref($checks) eq 'HASH') {              if (ref($checks) eq 'HASH') {
                 if (defined($checks->{'username'})) {                  if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                     ($inst_response,%{$inst_results->{$user}}) =                       $checkid = 1;
                         &Apache::lonnet::get_instuser($udom,$uname);                  }
                 } elsif (defined($checks->{'id'})) {              }
                     ($inst_response,%{$inst_results->{$user}}) =              foreach my $user (keys(%{$usershash})) {
                         &Apache::lonnet::get_instuser($udom,undef,$id);                  my ($uname,$udom) = split(/:/,$user);
                   if ($checkid) {
                       if (ref($usershash->{$user}) eq 'HASH') {
                           if ($usershash->{$user}->{'id'} ne '') {
                               $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
                               $userdoms{$udom} = 1;
                               if (ref($inst_results) eq 'HASH') {
                                   $inst_results->{$uname.':'.$udom} = {};
                               }
                           }
                       }
                   } else {
                       $by_username{$udom}{$uname} = 1;
                       $userdoms{$udom} = 1;
                       if (ref($inst_results) eq 'HASH') {
                           $inst_results->{$uname.':'.$udom} = {};
                       }
                   }
               }
               foreach my $udom (keys(%userdoms)) {
                   if (!$got_rules->{$udom}) {
                       my %domconfig = &Apache::lonnet::get_dom('configuration',
                                                                ['usercreation'],$udom);
                       if (ref($domconfig{'usercreation'}) eq 'HASH') {
                           foreach my $item ('username','id') {
                               if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                                   $$curr_rules{$udom}{$item} =
                                       $domconfig{'usercreation'}{$item.'_rule'};
                               }
                           }
                       }
                       $got_rules->{$udom} = 1;
                   }
               }
               if ($checkid) {
                   foreach my $udom (keys(%by_id)) {
                       my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                       if ($outcome eq 'ok') {
                           foreach my $id (keys(%{$by_id{$udom}})) {
                               my $uname = $by_id{$udom}{$id};
                               $inst_response{$uname.':'.$udom} = $outcome;
                           }
                           if (ref($results) eq 'HASH') {
                               foreach my $uname (keys(%{$results})) {
                                   if (exists($inst_response{$uname.':'.$udom})) {
                                       $inst_response{$uname.':'.$udom} = $outcome;
                                       $inst_results->{$uname.':'.$udom} = $results->{$uname};
                                   }
                               }
                           }
                       }
                 }                  }
             } else {              } else {
                 ($inst_response,%{$inst_results->{$user}}) =                  foreach my $udom (keys(%by_username)) {
                     &Apache::lonnet::get_instuser($udom,$uname);                      my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                 return;                      if ($outcome eq 'ok') {
                           foreach my $uname (keys(%{$by_username{$udom}})) {
                               $inst_response{$uname.':'.$udom} = $outcome;
                           }
                           if (ref($results) eq 'HASH') {
                               foreach my $uname (keys(%{$results})) {
                                   $inst_results->{$uname.':'.$udom} = $results->{$uname};
                               }
                           }
                       }
                   }
             }              }
             if (!$got_rules->{$udom}) {          } elsif (keys(%{$usershash}) == 1) {
                 my %domconfig = &Apache::lonnet::get_dom('configuration',              my $user = (keys(%{$usershash}))[0];
                                                   ['usercreation'],$udom);              my ($uname,$udom) = split(/:/,$user);
                 if (ref($domconfig{'usercreation'}) eq 'HASH') {              if (($udom ne '') && ($uname ne '')) {
                     foreach my $item ('username','id') {                  if (ref($usershash->{$user}) eq 'HASH') {
                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {                      if (ref($checks) eq 'HASH') {
                             $$curr_rules{$udom}{$item} =                           if (defined($checks->{'username'})) {
                                 $domconfig{'usercreation'}{$item.'_rule'};                              ($inst_response{$user},%{$inst_results->{$user}}) =
                                   &Apache::lonnet::get_instuser($udom,$uname);
                           } elsif (defined($checks->{'id'})) {
                               if ($usershash->{$user}->{'id'} ne '') {
                                   ($inst_response{$user},%{$inst_results->{$user}}) =
                                       &Apache::lonnet::get_instuser($udom,undef,
                                                                     $usershash->{$user}->{'id'});
                               } else {
                                   ($inst_response{$user},%{$inst_results->{$user}}) =
                                       &Apache::lonnet::get_instuser($udom,$uname);
                               }
                         }                          }
                       } else {
                          ($inst_response{$user},%{$inst_results->{$user}}) =
                               &Apache::lonnet::get_instuser($udom,$uname);
                          return;
                       }
                       if (!$got_rules->{$udom}) {
                           my %domconfig = &Apache::lonnet::get_dom('configuration',
                                                                    ['usercreation'],$udom);
                           if (ref($domconfig{'usercreation'}) eq 'HASH') {
                               foreach my $item ('username','id') {
                                   if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                                      $$curr_rules{$udom}{$item} =
                                          $domconfig{'usercreation'}{$item.'_rule'};
                                   }
                               }
                           }
                           $got_rules->{$udom} = 1;
                     }                      }
                 }                  }
                 $got_rules->{$udom} = 1;                } else {
                   return;
               }
           } else {
               return;
           }
           foreach my $user (keys(%{$usershash})) {
               my ($uname,$udom) = split(/:/,$user);
               next if (($udom eq '') || ($uname eq ''));
               my $id;
               if (ref($inst_results) eq 'HASH') {
                   if (ref($inst_results->{$user}) eq 'HASH') {
                       $id = $inst_results->{$user}->{'id'};
                   }
               }
               if ($id eq '') {
                   if (ref($usershash->{$user})) {
                       $id = $usershash->{$user}->{'id'};
                   }
             }              }
             foreach my $item (keys(%{$checks})) {              foreach my $item (keys(%{$checks})) {
                 if (ref($$curr_rules{$udom}) eq 'HASH') {                  if (ref($$curr_rules{$udom}) eq 'HASH') {
                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {                      if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                         if (@{$$curr_rules{$udom}{$item}} > 0) {                          if (@{$$curr_rules{$udom}{$item}} > 0) {
                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});                              my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                                                                                $$curr_rules{$udom}{$item});
                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {                              foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                                 if ($rule_check{$rule}) {                                  if ($rule_check{$rule}) {
                                     $$rulematch{$user}{$item} = $rule;                                      $$rulematch{$user}{$item} = $rule;
                                     if ($inst_response eq 'ok') {                                      if ($inst_response{$user} eq 'ok') {
                                         if (ref($inst_results) eq 'HASH') {                                          if (ref($inst_results) eq 'HASH') {
                                             if (ref($inst_results->{$user}) eq 'HASH') {                                              if (ref($inst_results->{$user}) eq 'HASH') {
                                                 if (keys(%{$inst_results->{$user}}) == 0) {                                                  if (keys(%{$inst_results->{$user}}) == 0) {
                                                     $$alerts{$item}{$udom}{$uname} = 1;                                                      $$alerts{$item}{$udom}{$uname} = 1;
                                                   } elsif ($item eq 'id') {
                                                       if ($inst_results->{$user}->{'id'} eq '') {
                                                           $$alerts{$item}{$udom}{$uname} = 1;
                                                       }
                                                 }                                                  }
                                             }                                              }
                                         }                                          }
Line 7990  sub user_rule_formats { Line 10089  sub user_rule_formats {
     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);      my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {      if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
         if (@{$ruleorder} > 0) {          if (@{$ruleorder} > 0) {
             $output = '<br />'.&mt("$text{$check} with the following format(s) may <span class=\"LC_cusr_emph\">only</span> be used for verified users at [_1]:",$domdesc).' <ul>';              $output = '<br />'.
                         &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                             '<span class="LC_cusr_emph">','</span>',$domdesc).
                         ' <ul>';
             foreach my $rule (@{$ruleorder}) {              foreach my $rule (@{$ruleorder}) {
                 if (ref($curr_rules) eq 'ARRAY') {                  if (ref($curr_rules) eq 'ARRAY') {
                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {                      if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
Line 8071  sub personal_data_fieldtitles { Line 10173  sub personal_data_fieldtitles {
   
 sub sorted_inst_types {  sub sorted_inst_types {
     my ($dom) = @_;      my ($dom) = @_;
     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);      my ($usertypes,$order);
       my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
       if (ref($domdefaults{'inststatus'}) eq 'HASH') {
           $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
           $order = $domdefaults{'inststatus'}{'inststatusorder'};
       } else {
           ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
       }
     my $othertitle = &mt('All users');      my $othertitle = &mt('All users');
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         $othertitle  = &mt('Any users');          $othertitle  = &mt('Any users');
Line 8110  sub get_institutional_codes { Line 10219  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 8123  sub get_institutional_codes { Line 10232  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 8144  sub get_standard_codeitems { Line 10253  sub get_standard_codeitems {
   
 =item * sorted_slots()  =item * sorted_slots()
   
 Sorts an array of slot names in order of slot start time (earliest first).   Sorts an array of slot names in order of an optional sort key,
   default sort is by slot start time (earliest first). 
   
 Inputs:  Inputs:
   
Line 8154  slotsarr  - Reference to array of unsort Line 10264  slotsarr  - Reference to array of unsort
   
 slots     - Reference to hash of hash, where outer hash keys are slot names.  slots     - Reference to hash of hash, where outer hash keys are slot names.
   
   sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
   
 =back  =back
   
 Returns:  Returns:
   
 =over 4  =over 4
   
 sorted   - An array of slot names sorted by the start time of the slot.  sorted   - An array of slot names sorted by a specified sort key 
              (default sort key is start time of the slot).
 =back  
   
 =back  =back
   
Line 8170  sorted   - An array of slot names sorted Line 10281  sorted   - An array of slot names sorted
   
   
 sub sorted_slots {  sub sorted_slots {
     my ($slotsarr,$slots) = @_;      my ($slotsarr,$slots,$sortkey) = @_;
       if ($sortkey eq '') {
           $sortkey = 'starttime';
       }
     my @sorted;      my @sorted;
     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {      if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
         @sorted =          @sorted =
             sort {              sort {
                      if (ref($slots->{$a}) && ref($slots->{$b})) {                       if (ref($slots->{$a}) && ref($slots->{$b})) {
                          return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}                           return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
                      }                       }
                      if (ref($slots->{$a})) { return -1;}                       if (ref($slots->{$a})) { return -1;}
                      if (ref($slots->{$b})) { return 1;}                       if (ref($slots->{$b})) { return 1;}
Line 8186  sub sorted_slots { Line 10300  sub sorted_slots {
     return @sorted;      return @sorted;
 }  }
   
   =pod
   
   =item * get_future_slots()
   
   Inputs:
   
   =over 4
   
   cnum - course number
   
   cdom - course domain
   
   now - current UNIX time
   
   symb - optional symb
   
   =back
   
   Returns:
   
   =over 4
   
   sorted_reservable - ref to array of student_schedulable slots currently 
                       reservable, ordered by end date of reservation period.
   
   reservable_now - ref to hash of student_schedulable slots currently
                    reservable.
   
       Keys in inner hash are:
       (a) symb: either blank or symb to which slot use is restricted.
       (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
                   the future, ordered by start date of reservation period.
   
   future_reservable - ref to hash of student_schedulable slots reservable
                       in the future.
   
       Keys in inner hash are:
       (a) symb: either blank or symb to which slot use is restricted.
       (b) startreserve:  start date of reservation period.
       (c) uniqueperiod: start,end dates when slot is to be uniquely
           selected.
   
   =back
   
   =cut
   
   sub get_future_slots {
       my ($cnum,$cdom,$now,$symb) = @_;
       my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
       my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
       foreach my $slot (keys(%slots)) {
           next unless($slots{$slot}->{'type'} eq 'schedulable_student');
           if ($symb) {
               next if (($slots{$slot}->{'symb'} ne '') && 
                        ($slots{$slot}->{'symb'} ne $symb));
           }
           if (($slots{$slot}->{'starttime'} > $now) &&
               ($slots{$slot}->{'endtime'} > $now)) {
               if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   my $userallowed = 0;
                   if ($slots{$slot}->{'allowedsections'}) {
                       my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                       if (!defined($env{'request.role.sec'})
                           && grep(/^No section assigned$/,@allowed_sec)) {
                           $userallowed=1;
                       } else {
                           if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                               $userallowed=1;
                           }
                       }
                       unless ($userallowed) {
                           if (defined($env{'request.course.groups'})) {
                               my @groups = split(/:/,$env{'request.course.groups'});
                               foreach my $group (@groups) {
                                   if (grep(/^\Q$group\E$/,@allowed_sec)) {
                                       $userallowed=1;
                                       last;
                                   }
                               }
                           }
                       }
                   }
                   if ($slots{$slot}->{'allowedusers'}) {
                       my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                       my $user = $env{'user.name'}.':'.$env{'user.domain'};
                       if (grep(/^\Q$user\E$/,@allowed_users)) {
                           $userallowed = 1;
                       }
                   }
                   next unless($userallowed);
               }
               my $startreserve = $slots{$slot}->{'startreserve'};
               my $endreserve = $slots{$slot}->{'endreserve'};
               my $symb = $slots{$slot}->{'symb'};
               my $uniqueperiod;
               if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
               }
               if (($startreserve < $now) &&
                   (!$endreserve || $endreserve > $now)) {
                   my $lastres = $endreserve;
                   if (!$lastres) {
                       $lastres = $slots{$slot}->{'starttime'};
                   }
                   $reservable_now{$slot} = {
                                              symb       => $symb,
                                              endreserve => $lastres,
                                              uniqueperiod => $uniqueperiod,   
                                            };
               } elsif (($startreserve > $now) &&
                        (!$endreserve || $endreserve > $startreserve)) {
                   $future_reservable{$slot} = {
                                                 symb         => $symb,
                                                 startreserve => $startreserve,
                                                 uniqueperiod => $uniqueperiod,
                                               };
               }
           }
       }
       my @unsorted_reservable = keys(%reservable_now);
       if (@unsorted_reservable > 0) {
           @sorted_reservable = 
               &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
       }
       my @unsorted_future = keys(%future_reservable);
       if (@unsorted_future > 0) {
           @sorted_future =
               &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
       }
       return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
   }
   
 =pod  =pod
   
   =back
   
 =head1 HTTP Helpers  =head1 HTTP Helpers
   
 =over 4  =over 4
Line 8327  sub get_env_multiple { Line 10578  sub get_env_multiple {
   
 sub ask_for_embedded_content {  sub ask_for_embedded_content {
     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;      my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);      my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
     my $num = 0;          %currsubfile,%unused,$rem);
       my $counter = 0;
       my $numnew = 0;
     my $numremref = 0;      my $numremref = 0;
     my $numinvalid = 0;      my $numinvalid = 0;
     my $numpathchg = 0;      my $numpathchg = 0;
     my $numexisting = 0;      my $numexisting = 0;
     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);      my $numunused = 0;
     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {      my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
           $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
       my $heading = &mt('Upload embedded files');
       my $buttontext = &mt('Upload');
   
       if ($env{'request.course.id'}) {
           if ($actionurl eq '/adm/dependencies') {
               $navmap = Apache::lonnavmaps::navmap->new();
           }
           $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       }
       if (($actionurl eq '/adm/portfolio') ||
           ($actionurl eq '/adm/coursegrp_portfolio')) {
         my $current_path='/';          my $current_path='/';
         if ($env{'form.currentpath'}) {          if ($env{'form.currentpath'}) {
             $current_path = $env{'form.currentpath'};              $current_path = $env{'form.currentpath'};
         }          }
         if ($actionurl eq '/adm/coursegrp_portfolio') {          if ($actionurl eq '/adm/coursegrp_portfolio') {
             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};              $udom = $cdom;
             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};              $uname = $cnum;
             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';              $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
         } else {          } else {
             $udom = $env{'user.domain'};              $udom = $env{'user.domain'};
Line 8353  sub ask_for_embedded_content { Line 10619  sub ask_for_embedded_content {
         $getpropath = 1;          $getpropath = 1;
     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||      } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
              ($actionurl eq '/adm/imsimport')) {                ($actionurl eq '/adm/imsimport')) { 
         ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$});          my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
         $url = '/home/'.$uname.'/public_html/';          $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
         $toplevel = $url;          $toplevel = $url;
         if ($rest ne '') {          if ($rest ne '') {
             $url .= $rest;              $url .= $rest;
         }          }
     } elsif ($actionurl eq '/adm/coursedocs') {      } elsif ($actionurl eq '/adm/coursedocs') {
         if (ref($args) eq 'HASH') {          if (ref($args) eq 'HASH') {
            $url = $args->{'docs_url'};              $url = $args->{'docs_url'};
            $toplevel = $url;              $toplevel = $url;
               if ($args->{'context'} eq 'paste') {
                   ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   ($path) =
                       ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   $fileloc =~ s{^/}{};
               }
           }
       } elsif ($actionurl eq '/adm/dependencies') {
           if ($env{'request.course.id'} ne '') {
               if (ref($args) eq 'HASH') {
                   $url = $args->{'docs_url'};
                   $title = $args->{'docs_title'};
                   $toplevel = $url;
                   unless ($toplevel =~ m{^/}) {
                       $toplevel = "/$url";
                   }
                   ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
                   if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                       $path = $1;
                   } else {
                       ($path) =
                           ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   }
                   if ($toplevel=~/^\/*(uploaded|editupload)/) {
                       $fileloc = $toplevel;
                       $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                       my ($udom,$uname,$fname) =
                           ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                       $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   } else {
                       $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   }
                   $fileloc =~ s{^/}{};
                   ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
               }
         }          }
     }      } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
     my $now = time();          $udom = $cdom;
     foreach my $embed_file (keys(%{$allfiles})) {          $uname = $cnum;
         my $absolutepath;          $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
           $toplevel = $url;
           $path = $url;
           $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
           $fileloc =~ s{^/}{};
       }
       foreach my $file (keys(%{$allfiles})) {
           my $embed_file;
           if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
               $embed_file = $1;
           } else {
               $embed_file = $file;
           }
           my ($absolutepath,$cleaned_file);
         if ($embed_file =~ m{^\w+://}) {          if ($embed_file =~ m{^\w+://}) {
             $newfiles{$embed_file} = 1;              $cleaned_file = $embed_file;
             $mapping{$embed_file} = $embed_file;              $newfiles{$cleaned_file} = 1;
               $mapping{$cleaned_file} = $embed_file;
         } else {          } else {
               $cleaned_file = &clean_path($embed_file);
             if ($embed_file =~ m{^/}) {              if ($embed_file =~ m{^/}) {
                 $absolutepath = $embed_file;                  $absolutepath = $embed_file;
                 $embed_file =~ s{^(/+)}{};  
             }              }
             if ($embed_file =~ m{/}) {              if ($cleaned_file =~ m{/}) {
                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});                  my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
                 $path = &check_for_traversal($path,$url,$toplevel);                  $path = &check_for_traversal($path,$url,$toplevel);
                 my $item = $fname;                  my $item = $fname;
                 if ($path ne '') {                  if ($path ne '') {
Line 8394  sub ask_for_embedded_content { Line 10711  sub ask_for_embedded_content {
             } else {              } else {
                 $dependencies{$embed_file} = 1;                  $dependencies{$embed_file} = 1;
                 if ($absolutepath) {                  if ($absolutepath) {
                     $mapping{$embed_file} = $absolutepath;                      $mapping{$cleaned_file} = $absolutepath;
                 } else {                  } else {
                     $mapping{$embed_file} = $embed_file;                      $mapping{$cleaned_file} = $embed_file;
                 }                  }
             }              }
         }          }
     }      }
       my $dirptr = 16384;
     foreach my $path (keys(%subdependencies)) {      foreach my $path (keys(%subdependencies)) {
         my %currsubfile;          $currsubfile{$path} = {};
         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {           if (($actionurl eq '/adm/portfolio') ||
             my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);              ($actionurl eq '/adm/coursegrp_portfolio')) { 
             foreach my $line (@subdir_list) {              my ($sublistref,$listerror) =
                 my ($file_name,$rest) = split(/\&/,$line,2);                  &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                 $currsubfile{$file_name} = 1;              if (ref($sublistref) eq 'ARRAY') {
                   foreach my $line (@{$sublistref}) {
                       my ($file_name,$rest) = split(/\&/,$line,2);
                       $currsubfile{$path}{$file_name} = 1;
                   }
             }              }
         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {          } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
             if (opendir(my $dir,$url.'/'.$path)) {              if (opendir(my $dir,$url.'/'.$path)) {
                 my @subdir_list = grep(!/^\./,readdir($dir));                  my @subdir_list = grep(!/^\./,readdir($dir));
                 map {$currsubfile{$_} = 1;} @subdir_list;                  map {$currsubfile{$path}{$_} = 1;} @subdir_list;
               }
           } elsif (($actionurl eq '/adm/dependencies') ||
                    (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                     ($args->{'context'} eq 'paste')) ||
                    ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
               if ($env{'request.course.id'} ne '') {
                   my $dir;
                   if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                       $dir = $fileloc;
                   } else {
                       ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   }
                   if ($dir ne '') {
                       my ($sublistref,$listerror) =
                           &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                       if (ref($sublistref) eq 'ARRAY') {
                           foreach my $line (@{$sublistref}) {
                               my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                                   undef,$mtime)=split(/\&/,$line,12);
                               unless (($testdir&$dirptr) ||
                                       ($file_name =~ /^\.\.?$/)) {
                                   $currsubfile{$path}{$file_name} = [$size,$mtime];
                               }
                           }
                       }
                   }
             }              }
         }          }
         foreach my $file (keys(%{$subdependencies{$path}})) {          foreach my $file (keys(%{$subdependencies{$path}})) {
             if ($currsubfile{$file}) {              if (exists($currsubfile{$path}{$file})) {
                 my $item = $path.'/'.$file;                  my $item = $path.'/'.$file;
                 unless ($mapping{$item} eq $item) {                  unless ($mapping{$item} eq $item) {
                     $pathchanges{$item} = 1;                      $pathchanges{$item} = 1;
Line 8427  sub ask_for_embedded_content { Line 10775  sub ask_for_embedded_content {
                 $newfiles{$path.'/'.$file} = 1;                  $newfiles{$path.'/'.$file} = 1;
             }              }
         }          }
           if ($actionurl eq '/adm/dependencies') {
               foreach my $path (keys(%currsubfile)) {
                   if (ref($currsubfile{$path}) eq 'HASH') {
                       foreach my $file (keys(%{$currsubfile{$path}})) {
                            unless ($subdependencies{$path}{$file}) {
                                next if (($rem ne '') &&
                                         (($env{"httpref.$rem"."$path/$file"} ne '') ||
                                          (ref($navmap) &&
                                          (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                                           (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                                            ($navmap->getResourceByUrl($rem."$path/$1")))))));
                                $unused{$path.'/'.$file} = 1; 
                            }
                       }
                   }
               }
           }
     }      }
     my %currfile;      my %currfile;
     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {      if (($actionurl eq '/adm/portfolio') ||
         my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);          ($actionurl eq '/adm/coursegrp_portfolio')) {
         foreach my $line (@dir_list) {          my ($dirlistref,$listerror) =
             my ($file_name,$rest) = split(/\&/,$line,2);              &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
             $currfile{$file_name} = 1;          if (ref($dirlistref) eq 'ARRAY') {
               foreach my $line (@{$dirlistref}) {
                   my ($file_name,$rest) = split(/\&/,$line,2);
                   $currfile{$file_name} = 1;
               }
         }          }
     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {      } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
         if (opendir(my $dir,$url)) {          if (opendir(my $dir,$url)) {
             my @dir_list = grep(!/^\./,readdir($dir));              my @dir_list = grep(!/^\./,readdir($dir));
             map {$currfile{$_} = 1;} @dir_list;              map {$currfile{$_} = 1;} @dir_list;
         }          }
       } elsif (($actionurl eq '/adm/dependencies') ||
                (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                 ($args->{'context'} eq 'paste')) ||
                ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
           if ($env{'request.course.id'} ne '') {
               my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
               if ($dir ne '') {
                   my ($dirlistref,$listerror) =
                       &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   if (ref($dirlistref) eq 'ARRAY') {
                       foreach my $line (@{$dirlistref}) {
                           my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                               $size,undef,$mtime)=split(/\&/,$line,12);
                           unless (($testdir&$dirptr) ||
                                   ($file_name =~ /^\.\.?$/)) {
                               $currfile{$file_name} = [$size,$mtime];
                           }
                       }
                   }
               }
           }
     }      }
     foreach my $file (keys(%dependencies)) {      foreach my $file (keys(%dependencies)) {
         if ($currfile{$file}) {          if (exists($currfile{$file})) {
             unless ($mapping{$file} eq $file) {              unless ($mapping{$file} eq $file) {
                 $pathchanges{$file} = 1;                  $pathchanges{$file} = 1;
             }              }
Line 8452  sub ask_for_embedded_content { Line 10842  sub ask_for_embedded_content {
             $newfiles{$file} = 1;              $newfiles{$file} = 1;
         }          }
     }      }
       foreach my $file (keys(%currfile)) {
           unless (($file eq $filename) ||
                   ($file eq $filename.'.bak') ||
                   ($dependencies{$file})) {
               if ($actionurl eq '/adm/dependencies') {
                   unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                       next if (($rem ne '') &&
                                (($env{"httpref.$rem".$file} ne '') ||
                                 (ref($navmap) &&
                                 (($navmap->getResourceByUrl($rem.$file) ne '') ||
                                  (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                                   ($navmap->getResourceByUrl($rem.$1)))))));
                   }
               }
               $unused{$file} = 1;
           }
       }
       if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
           ($args->{'context'} eq 'paste')) {
           $counter = scalar(keys(%existing));
           $numpathchg = scalar(keys(%pathchanges));
           return ($output,$counter,$numpathchg,\%existing);
       } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
           $counter = scalar(keys(%existing));
           $numpathchg = scalar(keys(%pathchanges));
           return ($output,$counter,$numpathchg,\%existing,\%mapping);
       }
     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') {
               next if ($embed_file =~ m{^\w+://});
           }
         $upload_output .= &start_data_table_row().          $upload_output .= &start_data_table_row().
                           '<td><span class="LC_filename">'.$embed_file.'</span>';                            '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                             '<span class="LC_filename">'.$embed_file.'</span>';
         unless ($mapping{$embed_file} eq $embed_file) {          unless ($mapping{$embed_file} eq $embed_file) {
             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';              $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                                 &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
         }          }
         $upload_output .= '</td><td>';          $upload_output .= '</td>';
         if ($args->{'ignore_remote_references'}          if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
             && $embed_file =~ m{^\w+://}) {              $upload_output.='<td align="right">'.
             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';                              '<span class="LC_info LC_fontsize_medium">'.
                               &mt("URL points to web address").'</span>';
             $numremref++;              $numremref++;
         } elsif ($args->{'error_on_invalid_names'}          } elsif ($args->{'error_on_invalid_names'}
             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {              && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
               $upload_output.='<td align="right"><span class="LC_warning">'.
             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';                              &mt('Invalid characters').'</span>';
             $numinvalid++;              $numinvalid++;
         } else {          } else {
             $upload_output .= &embedded_file_element('upload_embedded',$num,              $upload_output .= '<td>'.
                                 &embedded_file_element('upload_embedded',$counter,
                                                      $embed_file,\%mapping,                                                       $embed_file,\%mapping,
                                                      $allfiles,$codebase);                                                       $allfiles,$codebase,'upload');
             $num++;              $counter ++;
               $numnew ++;
         }          }
         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";          $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
     }      }
     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {      foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
         $upload_output .= &start_data_table_row().          if ($actionurl eq '/adm/dependencies') {
                           '<td><span class="LC_filename">'.$embed_file.'</span></td>'.              my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                           '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.              $modify_output .= &start_data_table_row().
                           &Apache::loncommon::end_data_table_row()."\n";                                '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                                 '<img src="'.&icon($embed_file).'" border="0" />'.
                                 '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                                 '<td>'.$size.'</td>'.
                                 '<td>'.$mtime.'</td>'.
                                 '<td><label><input type="checkbox" name="mod_upload_dep" '.
                                 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                                 $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                                 '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                                 &embedded_file_element('upload_embedded',$counter,
                                                        $embed_file,\%mapping,
                                                        $allfiles,$codebase,'modify').
                                 '</div></td>'.
                                 &end_data_table_row()."\n";
               $counter ++;
           } else {
               $upload_output .= &start_data_table_row().
                                 '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                                 '<span class="LC_filename">'.$embed_file.'</span></td>'.
                                 '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
                                 &Apache::loncommon::end_data_table_row()."\n";
           }
       }
       my $delidx = $counter;
       foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
           my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
           $delete_output .= &start_data_table_row().
                             '<td><img src="'.&icon($oldfile).'" />'.
                             '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                             '<td>'.$size.'</td>'.
                             '<td>'.$mtime.'</td>'.
                             '<td><label><input type="checkbox" name="del_upload_dep" '.
                             ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                             &embedded_file_element('upload_embedded',$delidx,
                                                    $oldfile,\%mapping,$allfiles,
                                                    $codebase,'delete').'</td>'.
                             &end_data_table_row()."\n"; 
           $numunused ++;
           $delidx ++;
     }      }
     if ($upload_output) {      if ($upload_output) {
         $upload_output = &start_data_table().          $upload_output = &start_data_table().
                          $upload_output.                           $upload_output.
                          &end_data_table()."\n";                           &end_data_table()."\n";
     }      }
       if ($modify_output) {
           $modify_output = &start_data_table().
                            &start_data_table_header_row().
                            '<th>'.&mt('File').'</th>'.
                            '<th>'.&mt('Size (KB)').'</th>'.
                            '<th>'.&mt('Modified').'</th>'.
                            '<th>'.&mt('Upload replacement?').'</th>'.
                            &end_data_table_header_row().
                            $modify_output.
                            &end_data_table()."\n";
       }
       if ($delete_output) {
           $delete_output = &start_data_table().
                            &start_data_table_header_row().
                            '<th>'.&mt('File').'</th>'.
                            '<th>'.&mt('Size (KB)').'</th>'.
                            '<th>'.&mt('Modified').'</th>'.
                            '<th>'.&mt('Delete?').'</th>'.
                            &end_data_table_header_row().
                            $delete_output.
                            &end_data_table()."\n";
       }
     my $applies = 0;      my $applies = 0;
     if ($numremref) {      if ($numremref) {
         $applies ++;          $applies ++;
Line 8497  sub ask_for_embedded_content { Line 10983  sub ask_for_embedded_content {
     if ($numexisting) {      if ($numexisting) {
         $applies ++;          $applies ++;
     }      }
     if ($num) {      if ($counter || $numunused) {
         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.          $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   ' method="post" enctype="multipart/form-data">'."\n".                    ' method="post" enctype="multipart/form-data">'."\n".
                   $state.                    $state.'<h3>'.$heading.'</h3>'; 
                   '<h3>'.&mt('Upload embedded files').          if ($actionurl eq '/adm/dependencies') {
                   ':</h3>'.$upload_output.'<br />'."\n".              if ($numnew) {
                   '<input type ="hidden" name="number_embedded_items" value="'.                  $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   $num.'" />'."\n";                             '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
         if ($actionurl eq '') {                             $upload_output.'<br />'."\n";
               }
               if ($numexisting) {
                   $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                              '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                              $modify_output.'<br />'."\n";
                              $buttontext = &mt('Save changes');
               }
               if ($numunused) {
                   $output .= '<h4>'.&mt('Unused files').'</h4>'.
                              '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                              $delete_output.'<br />'."\n";
                              $buttontext = &mt('Save changes');
               }
           } else {
               $output .= $upload_output.'<br />'."\n";
           }
           $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                      $counter.'" />'."\n";
           if ($actionurl eq '/adm/dependencies') { 
               $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                          $numnew.'" />'."\n";
           } elsif ($actionurl eq '') {
             $output .=  '<input type="hidden" name="phase" value="three" />';              $output .=  '<input type="hidden" name="phase" value="three" />';
         }          }
     } elsif ($applies) {      } elsif ($applies) {
         $output = '<b>'.&mt('Referenced files').'</b>:<br />';          $output = '<b>'.&mt('Referenced files').'</b>:<br />';
         if ($applies > 1) {          if ($applies > 1) {
             $output .=                $output .=  
                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';                  &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
             if ($numremref) {              if ($numremref) {
                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";                  $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
             }              }
Line 8533  sub ask_for_embedded_content { Line 11041  sub ask_for_embedded_content {
         $output .= $upload_output.'<br />';          $output .= $upload_output.'<br />';
     }      }
     my ($pathchange_output,$chgcount);      my ($pathchange_output,$chgcount);
     $chgcount = $num;      $chgcount = $counter;
     if (keys(%pathchanges) > 0) {      if (keys(%pathchanges) > 0) {
         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {          foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
             if ($num) {              if ($counter) {
                 $output .= &embedded_file_element('pathchange',$chgcount,                  $output .= &embedded_file_element('pathchange',$chgcount,
                                                   $embed_file,\%mapping,                                                    $embed_file,\%mapping,
                                                   $allfiles,$codebase);                                                    $allfiles,$codebase,'change');
             } else {              } else {
                 $pathchange_output .=                   $pathchange_output .= 
                     &start_data_table_row().                      &start_data_table_row().
Line 8548  sub ask_for_embedded_content { Line 11056  sub ask_for_embedded_content {
                     '<td>'.$mapping{$embed_file}.'</td>'.                      '<td>'.$mapping{$embed_file}.'</td>'.
                     '<td>'.$embed_file.                      '<td>'.$embed_file.
                     &embedded_file_element('pathchange',$numpathchg,$embed_file,                      &embedded_file_element('pathchange',$numpathchg,$embed_file,
                                            \%mapping,$allfiles,$codebase).                                             \%mapping,$allfiles,$codebase,'change').
                     '</td>'.&end_data_table_row();                      '</td>'.&end_data_table_row();
             }              }
             $numpathchg ++;              $numpathchg ++;
             $chgcount ++;              $chgcount ++;
         }          }
     }      }
     if ($num) {      if (($counter) || ($numunused)) {
         if ($numpathchg) {          if ($numpathchg) {
             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.              $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                        $numpathchg.'" />'."\n";                         $numpathchg.'" />'."\n";
Line 8565  sub ask_for_embedded_content { Line 11073  sub ask_for_embedded_content {
             $output .= '<input type="hidden" name="phase" value="three" />'."\n";              $output .= '<input type="hidden" name="phase" value="three" />'."\n";
         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {          } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
             $output .= '<input type="hidden" name="action" value="upload_embedded" />';              $output .= '<input type="hidden" name="action" value="upload_embedded" />';
           } elsif ($actionurl eq '/adm/dependencies') {
               $output .= '<input type="hidden" name="action" value="process_changes" />';
         }          }
         $output .=  '<input type ="submit" value="'.&mt('Upload Listed Files').'" />'."\n".          $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
                     &mt('(only files for which a location has been provided will be uploaded)').'</form>'."\n";  
     } elsif ($numpathchg) {      } elsif ($numpathchg) {
         my %pathchange = ();          my %pathchange = ();
         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);          $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {          if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
             $output .= '<p>'.&mt('or').'</p>';               $output .= '<p>'.&mt('or').'</p>'; 
         }           }
       }
       return ($output,$counter,$numpathchg);
   }
   
   =pod
   
   =item * clean_path($name)
   
   Performs clean-up of directories, subdirectories and filename in an
   embedded object, referenced in an HTML file which is being uploaded
   to a course or portfolio, where
   "Upload embedded images/multimedia files if HTML file" checkbox was
   checked.
   
   Clean-up is similar to replacements in lonnet::clean_filename()
   except each / between sub-directory and next level is preserved.
   
   =cut
   
   sub clean_path {
       my ($embed_file) = @_;
       $embed_file =~s{^/+}{};
       my @contents;
       if ($embed_file =~ m{/}) {
           @contents = split(/\//,$embed_file);
       } else {
           @contents = ($embed_file);
       }
       my $lastidx = scalar(@contents)-1;
       for (my $i=0; $i<=$lastidx; $i++) {
           $contents[$i]=~s{\\}{/}g;
           $contents[$i]=~s/\s+/\_/g;
           $contents[$i]=~s{[^/\w\.\-]}{}g;
           if ($i == $lastidx) {
               $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
           }
       }
       if ($lastidx > 0) {
           return join('/',@contents);
       } else {
           return $contents[0];
     }      }
     return ($output,$num,$numpathchg);  
 }  }
   
 sub embedded_file_element {  sub embedded_file_element {
     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;      my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&      return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                    (ref($codebase) eq 'HASH'));                     (ref($codebase) eq 'HASH'));
     my $output;      my $output;
     if ($context eq 'upload_embedded') {      if (($context eq 'upload_embedded') && ($type ne 'delete')) {
        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";         $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
     }      }
     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.      $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
Line 8610  sub embedded_file_element { Line 11159  sub embedded_file_element {
     return $output;      return $output;
 }  }
   
   sub get_dependency_details {
       my ($currfile,$currsubfile,$embed_file) = @_;
       my ($size,$mtime,$showsize,$showmtime);
       if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
           if ($embed_file =~ m{/}) {
               my ($path,$fname) = split(/\//,$embed_file);
               if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
               }
           } else {
               if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   ($size,$mtime) = @{$currfile->{$embed_file}};
               }
           }
           $showsize = $size/1024.0;
           $showsize = sprintf("%.1f",$showsize);
           if ($mtime > 0) {
               $showmtime = &Apache::lonlocal::locallocaltime($mtime);
           }
       }
       return ($showsize,$showmtime);
   }
   
   sub ask_embedded_js {
       return <<"END";
   <script type="text/javascript"">
   // <![CDATA[
   function toggleBrowse(counter) {
       var chkboxid = document.getElementById('mod_upload_dep_'+counter);
       var fileid = document.getElementById('embedded_item_'+counter);
       var uploaddivid = document.getElementById('moduploaddep_'+counter);
       if (chkboxid.checked == true) {
           uploaddivid.style.display='block';
       } else {
           uploaddivid.style.display='none';
           fileid.value = '';
       }
   }
   // ]]>
   </script>
   
   END
   }
   
 sub upload_embedded {  sub upload_embedded {
     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,      my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
         $current_disk_usage,$hiddenstate,$actionurl) = @_;          $current_disk_usage,$hiddenstate,$actionurl) = @_;
Line 8658  sub upload_embedded { Line 11251  sub upload_embedded {
         # Check if extension is valid          # Check if extension is valid
         if (($fname =~ /\.(\w+)$/) &&          if (($fname =~ /\.(\w+)$/) &&
             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {              (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
             $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';              $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                         .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
             next;              next;
         } elsif (($fname =~ /\.(\w+)$/) &&          } elsif (($fname =~ /\.(\w+)$/) &&
                  (!defined(&Apache::loncommon::fileembstyle($1)))) {                   (!defined(&Apache::loncommon::fileembstyle($1)))) {
             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';              $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
             next;              next;
         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {          } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
             $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';              $output .= &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
             next;              next;
         }          }
   
         $env{'form.embedded_item_'.$i.'.filename'}=$fname;          $env{'form.embedded_item_'.$i.'.filename'}=$fname;
           my $subdir = $path;
           $subdir =~ s{/+$}{};
         if ($context eq 'portfolio') {          if ($context eq 'portfolio') {
             my $result;              my $result;
             if ($state eq 'existingfile') {              if ($state eq 'existingfile') {
                 $result=                  $result=
                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',                      &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
                                                     $dirpath.$env{'form.currentpath'}.$path);                                                      $dirpath.$env{'form.currentpath'}.$subdir);
             } else {              } else {
                 $result=                  $result=
                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',                      &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
                                                     $dirpath.                                                      $dirpath.
                                                     $env{'form.currentpath'}.$path);                                                      $env{'form.currentpath'}.$subdir);
                 if ($result !~ m|^/uploaded/|) {                  if ($result !~ m|^/uploaded/|) {
                     $output .= '<span class="LC_error">'                      $output .= '<span class="LC_error">'
                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'                                 .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
Line 8692  sub upload_embedded { Line 11287  sub upload_embedded {
                                $path.$fname.'</span>').'<br />';                                      $path.$fname.'</span>').'<br />';     
                 }                  }
             }              }
         } elsif ($context eq 'coursedoc') {          } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
               my $extendedsubdir = $dirpath.'/'.$subdir;
               $extendedsubdir =~ s{/+$}{};
             my $result =              my $result =
                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',                  &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
                                                 $dirpath.'/'.$path);  
             if ($result !~ m|^/uploaded/|) {              if ($result !~ m|^/uploaded/|) {
                 $output .= '<span class="LC_error">'                  $output .= '<span class="LC_error">'
                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'                             .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
Line 8705  sub upload_embedded { Line 11301  sub upload_embedded {
             } else {              } else {
                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.                  $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                            $path.$fname.'</span>').'<br />';                             $path.$fname.'</span>').'<br />';
                   if ($context eq 'syllabus') {
                       &Apache::lonnet::make_public_indefinitely($result);
                   }
             }              }
         } else {          } else {
 # Save the file  # Save the file
Line 8712  sub upload_embedded { Line 11311  sub upload_embedded {
             my $fullpath = $dir_root.$dirpath.'/'.$path;              my $fullpath = $dir_root.$dirpath.'/'.$path;
             my $dest = $fullpath.$fname;              my $dest = $fullpath.$fname;
             my $url = $url_root.$dirpath.'/'.$path.$fname;              my $url = $url_root.$dirpath.'/'.$path.$fname;
             my @parts=split(/\//,$fullpath);              my @parts=split(/\//,"$dirpath/$path");
             my $count;              my $count;
             my $filepath = $dir_root;              my $filepath = $dir_root;
             for ($count=4;$count<=$#parts;$count++) {              foreach my $subdir (@parts) {
                 $filepath .= "/$parts[$count]";                  $filepath .= "/$subdir";
                 if ((-e $filepath)!=1) {                  if (!-e $filepath) {
                     mkdir($filepath,0770);                      mkdir($filepath,0770);
                 }                  }
             }              }
Line 8725  sub upload_embedded { Line 11324  sub upload_embedded {
             if (!open($fh,'>'.$dest)) {              if (!open($fh,'>'.$dest)) {
                 &Apache::lonnet::logthis('Failed to create '.$dest);                  &Apache::lonnet::logthis('Failed to create '.$dest);
                 $output .= '<span class="LC_error">'.                  $output .= '<span class="LC_error">'.
                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).                             &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                                  $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                            '</span><br />';                             '</span><br />';
             } else {              } else {
                 if (!print $fh $env{'form.embedded_item_'.$i}) {                  if (!print $fh $env{'form.embedded_item_'.$i}) {
                     &Apache::lonnet::logthis('Failed to write to '.$dest);                      &Apache::lonnet::logthis('Failed to write to '.$dest);
                     $output .= '<span class="LC_error">'.                      $output .= '<span class="LC_error">'.
                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).                                &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                                     $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                               '</span><br />';                                '</span><br />';
                 } else {                  } else {
                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.                      $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
Line 8753  sub upload_embedded { Line 11354  sub upload_embedded {
     }      }
     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);      $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
     $returnflag = 'ok';      $returnflag = 'ok';
     if (keys(%pathchange) > 0) {      my $numpathchgs = scalar(keys(%pathchange));
       if ($numpathchgs > 0) {
         if ($context eq 'portfolio') {          if ($context eq 'portfolio') {
             $output .= '<p>'.&mt('or').'</p>';              $output .= '<p>'.&mt('or').'</p>';
         } elsif ($context eq 'testbank') {          } elsif ($context eq 'testbank') {
             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';              $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                                     '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
             $returnflag = 'modify_orightml';              $returnflag = 'modify_orightml';
         }          }
     }      }
     return ($output.$footer,$returnflag);      return ($output.$footer,$returnflag,$numpathchgs);
 }  }
   
 sub modify_html_form {  sub modify_html_form {
Line 8796  sub modify_html_form { Line 11399  sub modify_html_form {
                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.                      '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.                      &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                     &end_data_table_row();                      &end_data_table_row();
             }               }
         }          }
     } else {      } else {
         $modifyform = $pathchgtable;          $modifyform = $pathchgtable;
Line 8807  sub modify_html_form { Line 11410  sub modify_html_form {
         }          }
     }      }
     if ($modifyform) {      if ($modifyform) {
           if ($actionurl eq '/adm/dependencies') {
               $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
           }
         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".          return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                '<p>'.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'<ol>'."\n".                 '<p>'.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'<ol>'."\n".
                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".                 '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
Line 8829  sub modify_html_form { Line 11435  sub modify_html_form {
 }  }
   
 sub modify_html_refs {  sub modify_html_refs {
     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;      my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
     my $container;      my $container;
     if ($context eq 'portfolio') {      if ($context eq 'portfolio') {
         $container = $env{'form.container'};          $container = $env{'form.container'};
     } elsif ($context eq 'coursedoc') {      } elsif ($context eq 'coursedoc') {
         $container = $env{'form.primaryurl'};          $container = $env{'form.primaryurl'};
       } elsif ($context eq 'manage_dependencies') {
           (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
           $container = "/$container";
       } elsif ($context eq 'syllabus') {
           $container = $url;
     } else {      } else {
         $container = $env{'form.filename'};          $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
         $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2};  
     }      }
     my (%allfiles,%codebase,$output,$content);      my (%allfiles,%codebase,$output,$content);
     my @changes = &get_env_multiple('form.namechange');      my @changes = &get_env_multiple('form.namechange');
     return unless (@changes > 0);      unless ((@changes > 0)  || ($context eq 'syllabus')) {
     if (($context eq 'portfolio') || ($context eq 'coursedoc')) {          if (wantarray) {
         return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/});              return ('',0,0); 
           } else {
               return;
           }
       }
       if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
           ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
           unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
               if (wantarray) {
                   return ('',0,0);
               } else {
                   return;
               }
           } 
         $content = &Apache::lonnet::getfile($container);          $content = &Apache::lonnet::getfile($container);
         return if ($content eq '-1');          if ($content eq '-1') {
               if (wantarray) {
                   return ('',0,0);
               } else {
                   return;
               }
           }
     } else {      } else {
         return unless ($container =~ /^\Q$dir_root\E/);           unless ($container =~ /^\Q$dir_root\E/) {
         if (open(my $fh,"<$container")) {              if (wantarray) {
                   return ('',0,0);
               } else {
                   return;
               }
           } 
           if (open(my $fh,'<',$container)) {
             $content = join('', <$fh>);              $content = join('', <$fh>);
             close($fh);              close($fh);
         } else {          } else {
             return;              if (wantarray) {
                   return ('',0,0);
               } else {
                   return;
               }
         }          }
     }      }
     my ($count,$codebasecount) = (0,0);      my ($count,$codebasecount) = (0,0);
Line 8869  sub modify_html_refs { Line 11508  sub modify_html_refs {
                 if ($allfiles{$ref}) {                  if ($allfiles{$ref}) {
                     my $newname =  $orig;                      my $newname =  $orig;
                     my ($attrib_regexp,$codebase);                      my ($attrib_regexp,$codebase);
                     my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});                      $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
                     if ($attrib_regexp =~ /:/) {                      if ($attrib_regexp =~ /:/) {
                         $attrib_regexp =~ s/\:/|/g;                          $attrib_regexp =~ s/\:/|/g;
                     }                      }
                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {                      if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);                          my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                         $count += $numchg;                          $count += $numchg;
                           $allfiles{$newname} = $allfiles{$ref};
                           delete($allfiles{$ref});
                     }                      }
                     if ($env{'form.embedded_codebase_'.$i} ne '') {                      if ($env{'form.embedded_codebase_'.$i} ne '') {
                         my $codebase = &unescape($env{'form.embedded_codebase_'.$i});                          $codebase = &unescape($env{'form.embedded_codebase_'.$i});
                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs                          my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                         $codebasecount ++;                          $codebasecount ++;
                     }                      }
                 }                  }
             }              }
               my $skiprewrites;
             if ($count || $codebasecount) {              if ($count || $codebasecount) {
                 my $saveresult;                  my $saveresult;
                 if ($context eq 'portfolio' || $context eq 'coursedoc') {                  if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                       ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);                      my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                     if ($url eq $container) {                      if ($url eq $container) {
                         my ($fname) = ($container =~ m{/([^/]+)$});                          my ($fname) = ($container =~ m{/([^/]+)$});
                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',                          $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                                             $count,'<span class="LC_filename">'.                                              $count,'<span class="LC_filename">'.
                                             $fname.'</span>').'</p>';                                               $fname.'</span>').'</p>';
                     } else {                      } else {
                          $output = '<p class="LC_error">'.                           $output = '<p class="LC_error">'.
                                    &mt('Error: update failed for: [_1].',                                     &mt('Error: update failed for: [_1].',
                                    '<span class="LC_filename">'.                                     '<span class="LC_filename">'.
                                    $container.'</span>').'</p>';                                     $container.'</span>').'</p>';
                     }                      }
                       if ($context eq 'syllabus') {
                           unless ($saveresult eq 'ok') {
                               $skiprewrites = 1;
                           }
                       }
                 } else {                  } else {
                     if (open(my $fh,">$container")) {                      if (open(my $fh,'>',$container)) {
                         print $fh $content;                          print $fh $content;
                         close($fh);                          close($fh);
                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',                          $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
Line 8914  sub modify_html_refs { Line 11562  sub modify_html_refs {
                     }                      }
                 }                  }
             }              }
               if (($context eq 'syllabus') && (!$skiprewrites)) {
                   my ($actionurl,$state);
                   $actionurl = "/public/$udom/$uname/syllabus";
                   my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                       &ask_for_embedded_content($actionurl,$state,\%allfiles,
                                                 \%codebase,
                                                 {'context' => 'rewrites',
                                                  'ignore_remote_references' => 1,});
                   if (ref($mapping) eq 'HASH') {
                       my $rewrites = 0;
                       foreach my $key (keys(%{$mapping})) {
                           next if ($key =~ m{^https?://});
                           my $ref = $mapping->{$key};
                           my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                           my $attrib;
                           if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                               $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                           }
                           if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                               my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                               $rewrites += $numchg;
                           }
                       }
                       if ($rewrites) {
                           my $saveresult;
                           my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                           if ($url eq $container) {
                               my ($fname) = ($container =~ m{/([^/]+)$});
                               $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                                               $count,'<span class="LC_filename">'.
                                               $fname.'</span>').'</p>';
                           } else {
                               $output .= '<p class="LC_error">'.
                                          &mt('Error: could not update links in [_1].',
                                          '<span class="LC_filename">'.
                                          $container.'</span>').'</p>';
   
                           }
                       }
                   }
               }
         } else {          } else {
             &logthis('Failed to parse '.$container.              &logthis('Failed to parse '.$container.
                      ' to modify references: '.$parse_result);                       ' to modify references: '.$parse_result);
         }          }
     }      }
     return $output;      if (wantarray) {
           return ($output,$count,$codebasecount);
       } else {
           return $output;
       }
 }  }
   
 sub check_for_existing {  sub check_for_existing {
Line 8947  sub check_for_upload { Line 11640  sub check_for_upload {
                   &mt('Unable to upload [_1]. (size = [_2] bytes)',                     &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                       '<span class="LC_filename">'.$fname.'</span>',                        '<span class="LC_filename">'.$fname.'</span>',
                       $filesize).'<br />'.                        $filesize).'<br />'.
                   &mt('Either the file you uploaded was empty, or your web browser was unable to read its contents.').'<br />';                     &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
                   '</span>';                    '</span>';
         return ('zero_bytes',$msg);          return ('zero_bytes',$msg);
     }      }
     $filesize =  $filesize/1000; #express in k (1024?)      $filesize =  $filesize/1000; #express in k (1024?)
     my $getpropath = 1;      my $getpropath = 1;
     my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,      my ($dirlistref,$listerror) =
                                             $getpropath);           &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
     my $found_file = 0;      my $found_file = 0;
     my $locked_file = 0;      my $locked_file = 0;
     foreach my $line (@dir_list) {      my @lockers;
         my ($file_name,$rest)=split(/\&/,$line,2);      my $navmap;
         if ($file_name eq $fname){      if ($env{'request.course.id'}) {
             $file_name = $path.$file_name;          $navmap = Apache::lonnavmaps::navmap->new();
             if ($group ne '') {      }
                 $file_name = $group.$file_name;      if (ref($dirlistref) eq 'ARRAY') {
             }          foreach my $line (@{$dirlistref}) {
             $found_file = 1;              my ($file_name,$rest)=split(/\&/,$line,2);
             if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {              if ($file_name eq $fname){
                 $locked_file = 1;                  $file_name = $path.$file_name;
             } else {                  if ($group ne '') {
                 my @info = split(/\&/,$rest);                      $file_name = $group.$file_name;
                 my $currsize = $info[6]/1000;                  }
                 if ($currsize < $filesize) {                  $found_file = 1;
                     my $extra = $filesize - $currsize;                  if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                     if (($current_disk_usage + $extra) > $disk_quota) {                      foreach my $lock (@lockers) {
                         my $msg = '<span class="LC_error">'.                          if (ref($lock) eq 'ARRAY') {
                                   &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',                              my ($symb,$crsid) = @{$lock};
                                       '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.                              if ($crsid eq $env{'request.course.id'}) {
                                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',                                  if (ref($navmap)) {
                                                $disk_quota,$current_disk_usage);                                      my $res = $navmap->getBySymb($symb);
                         return ('will_exceed_quota',$msg);                                      foreach my $part (@{$res->parts()}) { 
                                           my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                                           unless (($slot_status == $res->RESERVED) ||
                                                   ($slot_status == $res->RESERVED_LOCATION)) {
                                               $locked_file = 1;
                                           }
                                       }
                                   } else {
                                       $locked_file = 1;
                                   }
                               } else {
                                   $locked_file = 1;
                               }
                           }
                      }
                   } else {
                       my @info = split(/\&/,$rest);
                       my $currsize = $info[6]/1000;
                       if ($currsize < $filesize) {
                           my $extra = $filesize - $currsize;
                           if (($current_disk_usage + $extra) > $disk_quota) {
                               my $msg = '<p class="LC_warning">'.
                                         &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
                                             '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                                         '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                                                      $disk_quota,$current_disk_usage).'</p>';
                               return ('will_exceed_quota',$msg);
                           }
                     }                      }
                 }                  }
             }              }
         }          }
     }      }
     if (($current_disk_usage + $filesize) > $disk_quota){      if (($current_disk_usage + $filesize) > $disk_quota){
         my $msg = '<span class="LC_error">'.          my $msg = '<p class="LC_warning">'.
                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.                  &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);                    '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
         return ('will_exceed_quota',$msg);          return ('will_exceed_quota',$msg);
     } elsif ($found_file) {      } elsif ($found_file) {
         if ($locked_file) {          if ($locked_file) {
             my $msg = '<span class="LC_error">';              my $msg = '<p class="LC_warning">';
             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');              $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
             $msg .= '</span><br />';              $msg .= '</p>';
             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');              $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
             return ('file_locked',$msg);              return ('file_locked',$msg);
         } else {          } else {
             my $msg = '<span class="LC_error">';              my $msg = '<p class="LC_error">';
             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});              $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
             $msg .= '</span>';              $msg .= '</p>';
             return ('existingfile',$msg);              return ('existingfile',$msg);
         }          }
     }      }
Line 9048  sub check_for_traversal { Line 11768  sub check_for_traversal {
     return $cleanpath;      return $cleanpath;
 }  }
   
   sub is_archive_file {
       my ($mimetype) = @_;
       if (($mimetype eq 'application/octet-stream') ||
           ($mimetype eq 'application/x-stuffit') ||
           ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
           return 1;
       }
       return;
   }
   
   sub decompress_form {
       my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
       my %lt = &Apache::lonlocal::texthash (
           this => 'This file is an archive file.',
           camt => 'This file is a Camtasia archive file.',
           itsc => 'Its contents are as follows:',
           youm => 'You may wish to extract its contents.',
           extr => 'Extract contents',
           auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
           proa => 'Process automatically?',
           yes  => 'Yes',
           no   => 'No',
           fold => 'Title for folder containing movie',
           movi => 'Title for page containing embedded movie', 
       );
       my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
       my ($is_camtasia,$topdir,%toplevel,@paths);
       my $info = &list_archive_contents($fileloc,\@paths);
       if (@paths) {
           foreach my $path (@paths) {
               $path =~ s{^/}{};
               if ($path =~ m{^([^/]+)/$}) {
                   $topdir = $1;
               }
               if ($path =~ m{^([^/]+)/}) {
                   $toplevel{$1} = $path;
               } else {
                   $toplevel{$path} = $path;
               }
           }
       }
       if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
           my @camtasia6 = ("$topdir/","$topdir/index.html",
                           "$topdir/media/",
                           "$topdir/media/$topdir.mp4",
                           "$topdir/media/FirstFrame.png",
                           "$topdir/media/player.swf",
                           "$topdir/media/swfobject.js",
                           "$topdir/media/expressInstall.swf");
           my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
                            "$topdir/$topdir.mp4",
                            "$topdir/$topdir\_config.xml",
                            "$topdir/$topdir\_controller.swf",
                            "$topdir/$topdir\_embed.css",
                            "$topdir/$topdir\_First_Frame.png",
                            "$topdir/$topdir\_player.html",
                            "$topdir/$topdir\_Thumbnails.png",
                            "$topdir/playerProductInstall.swf",
                            "$topdir/scripts/",
                            "$topdir/scripts/config_xml.js",
                            "$topdir/scripts/handlebars.js",
                            "$topdir/scripts/jquery-1.7.1.min.js",
                            "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                            "$topdir/scripts/modernizr.js",
                            "$topdir/scripts/player-min.js",
                            "$topdir/scripts/swfobject.js",
                            "$topdir/skins/",
                            "$topdir/skins/configuration_express.xml",
                            "$topdir/skins/express_show/",
                            "$topdir/skins/express_show/player-min.css",
                            "$topdir/skins/express_show/spritesheet.png");
           my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                            "$topdir/$topdir.mp4",
                            "$topdir/$topdir\_config.xml",
                            "$topdir/$topdir\_controller.swf",
                            "$topdir/$topdir\_embed.css",
                            "$topdir/$topdir\_First_Frame.png",
                            "$topdir/$topdir\_player.html",
                            "$topdir/$topdir\_Thumbnails.png",
                            "$topdir/playerProductInstall.swf",
                            "$topdir/scripts/",
                            "$topdir/scripts/config_xml.js",
                            "$topdir/scripts/techsmith-smart-player.min.js",
                            "$topdir/skins/",
                            "$topdir/skins/configuration_express.xml",
                            "$topdir/skins/express_show/",
                            "$topdir/skins/express_show/spritesheet.min.css",
                            "$topdir/skins/express_show/spritesheet.png",
                            "$topdir/skins/express_show/techsmith-smart-player.min.css");
           my @diffs = &compare_arrays(\@paths,\@camtasia6);
           if (@diffs == 0) {
               $is_camtasia = 6;
           } else {
               @diffs = &compare_arrays(\@paths,\@camtasia8_1);
               if (@diffs == 0) {
                   $is_camtasia = 8;
               } else {
                   @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   if (@diffs == 0) {
                       $is_camtasia = 8;
                   }
               }
           }
       }
       my $output;
       if ($is_camtasia) {
           $output = <<"ENDCAM";
   <script type="text/javascript" language="Javascript">
   // <![CDATA[
   
   function camtasiaToggle() {
       for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
           if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
               if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
                   document.getElementById('camtasia_titles').style.display='block';
               } else {
                   document.getElementById('camtasia_titles').style.display='none';
               }
           }
       }
       return;
   }
   
   // ]]>
   </script>
   <p>$lt{'camt'}</p>
   ENDCAM
       } else {
           $output = '<p>'.$lt{'this'};
           if ($info eq '') {
               $output .= ' '.$lt{'youm'}.'</p>'."\n";
           } else {
               $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                          '<div><pre>'.$info.'</pre></div>';
           }
       }
       $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
       my $duplicates;
       my $num = 0;
       if (ref($dirlist) eq 'ARRAY') {
           foreach my $item (@{$dirlist}) {
               if (ref($item) eq 'ARRAY') {
                   if (exists($toplevel{$item->[0]})) {
                       $duplicates .= 
                           &start_data_table_row().
                           '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                           'value="0" checked="checked" />'.&mt('No').'</label>'.
                           '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                           'value="1" />'.&mt('Yes').'</label>'.
                           '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                           '<td>'.$item->[0].'</td>';
                       if ($item->[2]) {
                           $duplicates .= '<td>'.&mt('Directory').'</td>';
                       } else {
                           $duplicates .= '<td>'.&mt('File').'</td>';
                       }
                       $duplicates .= '<td>'.$item->[3].'</td>'.
                                      '<td>'.
                                      &Apache::lonlocal::locallocaltime($item->[4]).
                                      '</td>'.
                                      &end_data_table_row();
                       $num ++;
                   }
               }
           }
       }
       my $itemcount;
       if (@paths > 0) {
           $itemcount = scalar(@paths);
       } else {
           $itemcount = 1;
       }
       if ($is_camtasia) {
           $output .= $lt{'auto'}.'<br />'.
                      '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                      '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                      $lt{'yes'}.'</label>&nbsp;<label>'.
                      '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                      $lt{'no'}.'</label></span><br />'.
                      '<div id="camtasia_titles" style="display:block">'.
                      &Apache::lonhtmlcommon::start_pick_box().
                      &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                      '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                      &Apache::lonhtmlcommon::row_closure().
                      &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                      '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                      &Apache::lonhtmlcommon::row_closure(1).
                      &Apache::lonhtmlcommon::end_pick_box().
                      '</div>';
       }
       $output .= 
           '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
           '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
           "\n";
       if ($duplicates ne '') {
           $output .= '<p><span class="LC_warning">'.
                      &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                      &start_data_table().
                      &start_data_table_header_row().
                      '<th>'.&mt('Overwrite?').'</th>'.
                      '<th>'.&mt('Name').'</th>'.
                      '<th>'.&mt('Type').'</th>'.
                      '<th>'.&mt('Size').'</th>'.
                      '<th>'.&mt('Last modified').'</th>'.
                      &end_data_table_header_row().
                      $duplicates.
                      &end_data_table().
                      '</p>';
       }
       $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
       if (ref($hiddenelements) eq 'HASH') {
           foreach my $hidden (sort(keys(%{$hiddenelements}))) {
               $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
           }
       }
       $output .= <<"END";
   <br />
   <input type="submit" name="decompress" value="$lt{'extr'}" />
   </form>
   $noextract
   END
       return $output;
   }
   
   sub decompression_utility {
       my ($program) = @_;
       my @utilities = ('tar','gunzip','bunzip2','unzip'); 
       my $location;
       if (grep(/^\Q$program\E$/,@utilities)) { 
           foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                            '/usr/sbin/') {
               if (-x $dir.$program) {
                   $location = $dir.$program;
                   last;
               }
           }
       }
       return $location;
   }
   
   sub list_archive_contents {
       my ($file,$pathsref) = @_;
       my (@cmd,$output);
       my $needsregexp;
       if ($file =~ /\.zip$/) {
           @cmd = (&decompression_utility('unzip'),"-l");
           $needsregexp = 1;
       } elsif (($file =~ m/\.tar\.gz$/) ||
                ($file =~ /\.tgz$/)) {
           @cmd = (&decompression_utility('tar'),"-ztf");
       } elsif ($file =~ /\.tar\.bz2$/) {
           @cmd = (&decompression_utility('tar'),"-jtf");
       } elsif ($file =~ m|\.tar$|) {
           @cmd = (&decompression_utility('tar'),"-tf");
       }
       if (@cmd) {
           undef($!);
           undef($@);
           if (open(my $fh,"-|", @cmd, $file)) {
               while (my $line = <$fh>) {
                   $output .= $line;
                   chomp($line);
                   my $item;
                   if ($needsregexp) {
                       ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   } else {
                       $item = $line;
                   }
                   if ($item ne '') {
                       unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                           push(@{$pathsref},$item);
                       } 
                   }
               }
               close($fh);
           }
       }
       return $output;
   }
   
   sub decompress_uploaded_file {
       my ($file,$dir) = @_;
       &Apache::lonnet::appenv({'cgi.file' => $file});
       &Apache::lonnet::appenv({'cgi.dir' => $dir});
       my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
       my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
       my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
       &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
       my $decompressed = $env{'cgi.decompressed'};
       &Apache::lonnet::delenv('cgi.file');
       &Apache::lonnet::delenv('cgi.dir');
       &Apache::lonnet::delenv('cgi.decompressed');
       return ($decompressed,$result);
   }
   
   sub process_decompression {
       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);
       if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
           $error = &mt('Filename not a supported archive file type.').
                    '<br />'.&mt('Filename should end with one of: [_1].',
                                 '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
       } else {
           my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
           if ($docuhome eq 'no_host') {
               $error = &mt('Could not determine home server for course.');
           } else {
               my @ids=&Apache::lonnet::current_machine_ids();
               my $currdir = "$dir_root/$destination";
               if (grep(/^\Q$docuhome\E$/,@ids)) {
                   $dir = &LONCAPA::propath($docudom,$docuname).
                          "$dir_root/$destination";
               } else {
                   $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                          "$dir_root/$docudom/$docuname/$destination";
                   unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                       $error = &mt('Archive file not found.');
                   }
               }
               my (@to_overwrite,@to_skip);
               if ($env{'form.archive_overwrite_total'} > 0) {
                   my $total = $env{'form.archive_overwrite_total'};
                   for (my $i=0; $i<$total; $i++) {
                       if ($env{'form.archive_overwrite_'.$i} == 1) {
                           push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                       } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                           push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                       }
                   }
               }
               my $numskip = scalar(@to_skip);
               my $numoverwrite = scalar(@to_overwrite);
               if (($numskip) && (!$numoverwrite)) {
                   $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
               } elsif ($dir eq '') {
                   $error = &mt('Directory containing archive file unavailable.');
               } elsif (!$error) {
                   my ($decompressed,$display);
                   if (($numskip) || ($numoverwrite)) {
                       my $tempdir = time.'_'.$$.int(rand(10000));
                       mkdir("$dir/$tempdir",0755);
                       if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
                           ($decompressed,$display) =
                               &decompress_uploaded_file($file,"$dir/$tempdir");
                           foreach my $item (@to_skip) {
                               if (($item ne '') && ($item !~ /\.\./)) {
                                   if (-f "$dir/$tempdir/$item") {
                                       unlink("$dir/$tempdir/$item");
                                   } elsif (-d "$dir/$tempdir/$item") {
                                       &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
                                   }
                               }
                           }
                           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::remove_tree("$dir/$item",{ safe => 1 });
                                       }
                                       &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
                                   }
                               }
                           }
                           if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
                               &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
                           }
                       }
                   } else {
                       ($decompressed,$display) = 
                           &decompress_uploaded_file($file,$dir);
                   }
                   if ($decompressed eq 'ok') {
                       $output = '<p class="LC_info">'.
                                 &mt('Files extracted successfully from archive.').
                                 '</p>'."\n";
                       my ($warning,$result,@contents);
                       my ($newdirlistref,$newlisterror) =
                           &Apache::lonnet::dirlist($currdir,$docudom,
                                                    $docuname,1);
                       my (%is_dir,%changes,@newitems);
                       my $dirptr = 16384;
                       if (ref($newdirlistref) eq 'ARRAY') {
                           foreach my $dir_line (@{$newdirlistref}) {
                               my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                               unless (($item =~ /^\.+$/) || ($item eq $file)) { 
                                   push(@newitems,$item);
                                   if ($dirptr&$testdir) {
                                       $is_dir{$item} = 1;
                                   }
                                   $changes{$item} = 1;
                               }
                           }
                       }
                       if (keys(%changes) > 0) {
                           foreach my $item (sort(@newitems)) {
                               if ($changes{$item}) {
                                   push(@contents,$item);
                               }
                           }
                       }
                       if (@contents > 0) {
                           my $wantform;
                           unless ($env{'form.autoextract_camtasia'}) {
                               $wantform = 1;
                           }
                           my (%children,%parent,%dirorder,%titles);
                           my ($count,$datatable) = &get_extracted($docudom,$docuname,
                                                                   $currdir,\%is_dir,
                                                                   \%children,\%parent,
                                                                   \@contents,\%dirorder,
                                                                   \%titles,$wantform);
                           if ($datatable ne '') {
                               $output .= &archive_options_form('decompressed',$datatable,
                                                                $count,$hiddenelem);
                               my $startcount = 6;
                               $output .= &archive_javascript($startcount,$count,
                                                              \%titles,\%children);
                           }
                           if ($env{'form.autoextract_camtasia'}) {
                               my $version = $env{'form.autoextract_camtasia'};
                               my %displayed;
                               my $total = 1;
                               $env{'form.archive_directory'} = [];
                               foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                                   my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                                   $path =~ s{/$}{};
                                   my $item;
                                   if ($path ne '') {
                                       $item = "$path/$titles{$i}";
                                   } else {
                                       $item = $titles{$i};
                                   }
                                   $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                                   if ($item eq $contents[0]) {
                                       push(@{$env{'form.archive_directory'}},$i);
                                       $env{'form.archive_'.$i} = 'display';
                                       $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                                       $displayed{'folder'} = $i;
                                   } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                                            (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
                                       $env{'form.archive_'.$i} = 'display';
                                       $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                                       $displayed{'web'} = $i;
                                   } else {
                                       if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                                           ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                                                ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
                                           push(@{$env{'form.archive_directory'}},$i);
                                       }
                                       $env{'form.archive_'.$i} = 'dependency';
                                   }
                                   $total ++;
                               }
                               for (my $i=1; $i<$total; $i++) {
                                   next if ($i == $displayed{'web'});
                                   next if ($i == $displayed{'folder'});
                                   $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                               }
                               $env{'form.phase'} = 'decompress_cleanup';
                               $env{'form.archivedelete'} = 1;
                               $env{'form.archive_count'} = $total-1;
                               $output .=
                                   &process_extracted_files('coursedocs',$docudom,
                                                            $docuname,$destination,
                                                            $dir_root,$hiddenelem);
                           }
                       } else {
                           $warning = &mt('No new items extracted from archive file.');
                       }
                   } else {
                       $output = $display;
                       $error = &mt('An error occurred during extraction from the archive file.');
                   }
               }
           }
       }
       if ($error) {
           $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                      $error.'</p>'."\n";
       }
       if ($warning) {
           $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
       }
       return $output;
   }
   
   sub get_extracted {
       my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
           $titles,$wantform) = @_;
       my $count = 0;
       my $depth = 0;
       my $datatable;
       my @hierarchy;
       return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
                      (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                      (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
       foreach my $item (@{$contents}) {
           $count ++;
           @{$dirorder->{$count}} = @hierarchy;
           $titles->{$count} = $item;
           &archive_hierarchy($depth,$count,$parent,$children);
           if ($wantform) {
               $datatable .= &archive_row($is_dir->{$item},$item,
                                          $currdir,$depth,$count);
           }
           if ($is_dir->{$item}) {
               $depth ++;
               push(@hierarchy,$count);
               $parent->{$depth} = $count;
               $datatable .=
                   &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
                                              \$depth,\$count,\@hierarchy,$dirorder,
                                              $children,$parent,$titles,$wantform);
               $depth --;
               pop(@hierarchy);
           }
       }
       return ($count,$datatable);
   }
   
   sub recurse_extracted_archive {
       my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
           $children,$parent,$titles,$wantform) = @_;
       my $result='';
       unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
               (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
               (ref($dirorder) eq 'HASH')) {
           return $result;
       }
       my $dirptr = 16384;
       my ($newdirlistref,$newlisterror) =
           &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
       if (ref($newdirlistref) eq 'ARRAY') {
           foreach my $dir_line (@{$newdirlistref}) {
               my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
               unless ($item =~ /^\.+$/) {
                   $$count ++;
                   @{$dirorder->{$$count}} = @{$hierarchy};
                   $titles->{$$count} = $item;
                   &archive_hierarchy($$depth,$$count,$parent,$children);
   
                   my $is_dir;
                   if ($dirptr&$testdir) {
                       $is_dir = 1;
                   }
                   if ($wantform) {
                       $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   }
                   if ($is_dir) {
                       $$depth ++;
                       push(@{$hierarchy},$$count);
                       $parent->{$$depth} = $$count;
                       $result .=
                           &recurse_extracted_archive("$currdir/$item",$docudom,
                                                      $docuname,$depth,$count,
                                                      $hierarchy,$dirorder,$children,
                                                      $parent,$titles,$wantform);
                       $$depth --;
                       pop(@{$hierarchy});
                   }
               }
           }
       }
       return $result;
   }
   
   sub archive_hierarchy {
       my ($depth,$count,$parent,$children) =@_;
       if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
           if (exists($parent->{$depth})) {
                $children->{$parent->{$depth}} .= $count.':';
           }
       }
       return;
   }
   
   sub archive_row {
       my ($is_dir,$item,$currdir,$depth,$count) = @_;
       my ($name) = ($item =~ m{([^/]+)$});
       my %choices = &Apache::lonlocal::texthash (
                                          'display'    => 'Add as file',
                                          'dependency' => 'Include as dependency',
                                          'discard'    => 'Discard',
                                         );
       if ($is_dir) {
           $choices{'display'} = &mt('Add as folder'); 
       }
       my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
       my $offset = 0;
       foreach my $action ('display','dependency','discard') {
           $offset ++;
           if ($action ne 'display') {
               $offset ++;
           }  
           $output .= '<td><span class="LC_nobreak">'.
                      '<label><input type="radio" name="archive_'.$count.
                      '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
           my $text = $choices{$action};
           if ($is_dir) {
               $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
               if ($action eq 'display') {
                   $text = &mt('Add as folder');
               }
           } else {
               $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
   
           }
           $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
           if ($action eq 'dependency') {
               $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                          &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                          'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                          '<option value=""></option>'."\n".
                          '</select>'."\n".
                          '</div>';
           } elsif ($action eq 'display') {
               $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                          &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                          '</div>';
           }
           $output .= '</td>';
       }
       $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                  &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
       for (my $i=0; $i<$depth; $i++) {
           $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
       }
       if ($is_dir) {
           $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                      '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
       } else {
           $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
       }
       $output .= '&nbsp;'.$name.'</td>'."\n".
                  &end_data_table_row();
       return $output;
   }
   
   sub archive_options_form {
       my ($form,$display,$count,$hiddenelem) = @_;
       my %lt = &Apache::lonlocal::texthash(
                  perm => 'Permanently remove archive file?',
                  hows => 'How should each extracted item be incorporated in the course?',
                  cont => 'Content actions for all',
                  addf => 'Add as folder/file',
                  incd => 'Include as dependency for a displayed file',
                  disc => 'Discard',
                  no   => 'No',
                  yes  => 'Yes',
                  save => 'Save',
       );
       my $output = <<"END";
   <form name="$form" method="post" action="">
   <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
   <label>
     <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
   </label>
   &nbsp;
   <label>
     <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
   </span>
   </p>
   <input type="hidden" name="phase" value="decompress_cleanup" />
   <br />$lt{'hows'}
   <div class="LC_columnSection">
     <fieldset>
       <legend>$lt{'cont'}</legend>
       <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
       &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
       &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
     </fieldset>
   </div>
   END
       return $output.
              &start_data_table()."\n".
              $display."\n".
              &end_data_table()."\n".
              '<input type="hidden" name="archive_count" value="'.$count.'" />'.
              $hiddenelem.
              '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
              '</form>';
   }
   
   sub archive_javascript {
       my ($startcount,$numitems,$titles,$children) = @_;
       return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
       my $maintitle = $env{'form.comment'};
       my $scripttag = <<START;
   <script type="text/javascript">
   // <![CDATA[
   
   function checkAll(form,prefix) {
       var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
       for (var i=0; i < form.elements.length; i++) {
           var id = form.elements[i].id;
           if ((id != '') && (id != undefined)) {
               if (idstr.test(id)) {
                   if (form.elements[i].type == 'radio') {
                       form.elements[i].checked = true;
                       var nostart = i-$startcount;
                       var offset = nostart%7;
                       var count = (nostart-offset)/7;    
                       dependencyCheck(form,count,offset);
                   }
               }
           }
       }
   }
   
   function propagateCheck(form,count) {
       if (count > 0) {
           var startelement = $startcount + ((count-1) * 7);
           for (var j=1; j<6; j++) {
               if ((j != 2) && (j != 4)) {
                   var item = startelement + j; 
                   if (form.elements[item].type == 'radio') {
                       if (form.elements[item].checked) {
                           containerCheck(form,count,j);
                           break;
                       }
                   }
               }
           }
       }
   }
   
   numitems = $numitems
   var titles = new Array(numitems);
   var parents = new Array(numitems);
   for (var i=0; i<numitems; i++) {
       parents[i] = new Array;
   }
   var maintitle = '$maintitle';
   
   START
   
       foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
           my @contents = split(/:/,$children->{$container});
           for (my $i=0; $i<@contents; $i ++) {
               $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
           }
       }
   
       foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
           $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
       }
   
       $scripttag .= <<END;
   
   function containerCheck(form,count,offset) {
       if (count > 0) {
           dependencyCheck(form,count,offset);
           var item = (offset+$startcount)+7*(count-1);
           form.elements[item].checked = true;
           if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
               if (parents[count].length > 0) {
                   for (var j=0; j<parents[count].length; j++) {
                       containerCheck(form,parents[count][j],offset);
                   }
               }
           }
       }
   }
   
   function dependencyCheck(form,count,offset) {
       if (count > 0) {
           var chosen = (offset+$startcount)+7*(count-1);
           var depitem = $startcount + ((count-1) * 7) + 4;
           var currtype = form.elements[depitem].type;
           if (form.elements[chosen].value == 'dependency') {
               document.getElementById('arc_depon_'+count).style.display='block'; 
               form.elements[depitem].options.length = 0;
               form.elements[depitem].options[0] = new Option('Select','',true,true);
               for (var i=1; i<=numitems; i++) {
                   if (i == count) {
                       continue;
                   }
                   var startelement = $startcount + (i-1) * 7;
                   for (var j=1; j<6; j++) {
                       if ((j != 2) && (j!= 4)) {
                           var item = startelement + j;
                           if (form.elements[item].type == 'radio') {
                               if (form.elements[item].checked) {
                                   if (form.elements[item].value == 'display') {
                                       var n = form.elements[depitem].options.length;
                                       form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                                   }
                               }
                           }
                       }
                   }
               }
           } else {
               document.getElementById('arc_depon_'+count).style.display='none';
               form.elements[depitem].options.length = 0;
               form.elements[depitem].options[0] = new Option('Select','',true,true);
           }
           titleCheck(form,count,offset);
       }
   }
   
   function propagateSelect(form,count,offset) {
       if (count > 0) {
           var item = (1+offset+$startcount)+7*(count-1);
           var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
           if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
               if (parents[count].length > 0) {
                   for (var j=0; j<parents[count].length; j++) {
                       containerSelect(form,parents[count][j],offset,picked);
                   }
               }
           }
       }
   }
   
   function containerSelect(form,count,offset,picked) {
       if (count > 0) {
           var item = (offset+$startcount)+7*(count-1);
           if (form.elements[item].type == 'radio') {
               if (form.elements[item].value == 'dependency') {
                   if (form.elements[item+1].type == 'select-one') {
                       for (var i=0; i<form.elements[item+1].options.length; i++) {
                           if (form.elements[item+1].options[i].value == picked) {
                               form.elements[item+1].selectedIndex = i;
                               break;
                           }
                       }
                   }
                   if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                       if (parents[count].length > 0) {
                           for (var j=0; j<parents[count].length; j++) {
                               containerSelect(form,parents[count][j],offset,picked);
                           }
                       }
                   }
               }
           }
       }
   }
   
   function titleCheck(form,count,offset) {
       if (count > 0) {
           var chosen = (offset+$startcount)+7*(count-1);
           var depitem = $startcount + ((count-1) * 7) + 2;
           var currtype = form.elements[depitem].type;
           if (form.elements[chosen].value == 'display') {
               document.getElementById('arc_title_'+count).style.display='block';
               if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   document.getElementById('archive_title_'+count).value=maintitle;
               }
           } else {
               document.getElementById('arc_title_'+count).style.display='none';
               if (currtype == 'text') { 
                   document.getElementById('archive_title_'+count).value='';
               }
           }
       }
       return;
   }
   
   // ]]>
   </script>
   END
       return $scripttag;
   }
   
   sub process_extracted_files {
       my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
       my $numitems = $env{'form.archive_count'};
       return if ((!$numitems) || ($numitems =~ /\D/));
       my @ids=&Apache::lonnet::current_machine_ids();
       my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
           %folders,%containers,%mapinner,%prompttofetch);
       my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
       if (grep(/^\Q$docuhome\E$/,@ids)) {
           $prefix = &LONCAPA::propath($docudom,$docuname);
           $pathtocheck = "$dir_root/$destination";
           $dir = $dir_root;
           $ishome = 1;
       } else {
           $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
           $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
           $dir = "$dir_root/$docudom/$docuname";
       }
       my $currdir = "$dir_root/$destination";
       (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
       if ($env{'form.folderpath'}) {
           my @items = split('&',$env{'form.folderpath'});
           $folders{'0'} = $items[-2];
           if ($env{'form.folderpath'} =~ /\:1$/) {
               $containers{'0'}='page';
           } else {
               $containers{'0'}='sequence';
           }
       }
       my @archdirs = &get_env_multiple('form.archive_directory');
       if ($numitems) {
           for (my $i=1; $i<=$numitems; $i++) {
               my $path = $env{'form.archive_content_'.$i};
               if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   my $item = $1;
                   $toplevelitems{$item} = $i;
                   if (grep(/^\Q$i\E$/,@archdirs)) {
                       $is_dir{$item} = 1;
                   }
               }
           }
       }
       my ($output,%children,%parent,%titles,%dirorder,$result);
       if (keys(%toplevelitems) > 0) {
           my @contents = sort(keys(%toplevelitems));
           (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                                              \%parent,\@contents,\%dirorder,\%titles);
       }
       my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
       if ($numitems) {
           for (my $i=1; $i<=$numitems; $i++) {
               next if ($env{'form.archive_'.$i} eq 'dependency');
               my $path = $env{'form.archive_content_'.$i};
               if ($path =~ /^\Q$pathtocheck\E/) {
                   if ($env{'form.archive_'.$i} eq 'discard') {
                       if ($prefix ne '' && $path ne '') {
                           if (-e $prefix.$path) {
                               if ((@archdirs > 0) && 
                                   (grep(/^\Q$i\E$/,@archdirs))) {
                                   $todeletedir{$prefix.$path} = 1;
                               } else {
                                   $todelete{$prefix.$path} = 1;
                               }
                           }
                       }
                   } elsif ($env{'form.archive_'.$i} eq 'display') {
                       my ($docstitle,$title,$url,$outer);
                       ($title) = ($path =~ m{/([^/]+)$});
                       $docstitle = $env{'form.archive_title_'.$i};
                       if ($docstitle eq '') {
                           $docstitle = $title;
                       }
                       $outer = 0;
                       if (ref($dirorder{$i}) eq 'ARRAY') {
                           if (@{$dirorder{$i}} > 0) {
                               foreach my $item (reverse(@{$dirorder{$i}})) {
                                   if ($env{'form.archive_'.$item} eq 'display') {
                                       $outer = $item;
                                       last;
                                   }
                               }
                           }
                       }
                       my ($errtext,$fatal) = 
                           &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                                                  '/'.$folders{$outer}.'.'.
                                                  $containers{$outer});
                       next if ($fatal);
                       if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                           if ($context eq 'coursedocs') {
                               $mapinner{$i} = time;
                               $folders{$i} = 'default_'.$mapinner{$i};
                               $containers{$i} = 'sequence';
                               my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                                         $folders{$i}.'.'.$containers{$i};
                               my $newidx = &LONCAPA::map::getresidx();
                               $LONCAPA::map::resources[$newidx]=
                                   $docstitle.':'.$url.':false:normal:res';
                               push(@LONCAPA::map::order,$newidx);
                               my ($outtext,$errtext) =
                                   &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                                                           $docuname.'/'.$folders{$outer}.
                                                           '.'.$containers{$outer},1,1);
                               $newseqid{$i} = $newidx;
                               unless ($errtext) {
                                   $result .=  '<li>'.&mt('Folder: [_1] added to course',
                                                          &HTML::Entities::encode($docstitle,'<>&"'))..
                                               '</li>'."\n";
                               }
                           }
                       } else {
                           if ($context eq 'coursedocs') {
                               my $newidx=&LONCAPA::map::getresidx();
                               my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                                         $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                                         $title;
                               if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
                                   if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                                       mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                                   }
                                   if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                                       mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                                   }
                                   if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                                       if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
                                           $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                                           unless ($ishome) {
                                               my $fetch = "$newdest{$i}/$title";
                                               $fetch =~ s/^\Q$prefix$dir\E//;
                                               $prompttofetch{$fetch} = 1;
                                           }
                                      }
                                   }
                                   $LONCAPA::map::resources[$newidx]=
                                       $docstitle.':'.$url.':false:normal:res';
                                   push(@LONCAPA::map::order, $newidx);
                                   my ($outtext,$errtext)=
                                       &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                                                               $docuname.'/'.$folders{$outer}.
                                                               '.'.$containers{$outer},1,1);
                                   unless ($errtext) {
                                       if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                                           $result .= '<li>'.&mt('File: [_1] added to course',
                                                                 &HTML::Entities::encode($docstitle,'<>&"')).
                                                      '</li>'."\n";
                                       }
                                   }
                               } else {
                                   $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                                                   &HTML::Entities::encode($path,'<>&"')).'<br />';
                               }
                           }
                       }
                   }
               } else {
                   $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                                   &HTML::Entities::encode($path,'<>&"')).'<br />';
               }
           }
           for (my $i=1; $i<=$numitems; $i++) {
               next unless ($env{'form.archive_'.$i} eq 'dependency');
               my $path = $env{'form.archive_content_'.$i};
               if ($path =~ /^\Q$pathtocheck\E/) {
                   my ($title) = ($path =~ m{/([^/]+)$});
                   $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                       if (ref($dirorder{$i}) eq 'ARRAY') {
                           my ($itemidx,$fullpath,$relpath);
                           if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                               my $container = $dirorder{$referrer{$i}}->[-1];
                               for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
                                   if ($dirorder{$i}->[$j] eq $container) {
                                       $itemidx = $j;
                                   }
                               }
                           }
                           if ($itemidx eq '') {
                               $itemidx =  0;
                           }
                           if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                               if ($mapinner{$referrer{$i}}) {
                                   $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                                   for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                                       if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                                           unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                                               $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                                               $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                                               if (!-e $fullpath) {
                                                   mkdir($fullpath,0755);
                                               }
                                           }
                                       } else {
                                           last;
                                       }
                                   }
                               }
                           } elsif ($newdest{$referrer{$i}}) {
                               $fullpath = $newdest{$referrer{$i}};
                               for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                                   if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                                       $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                                       last;
                                   } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                                       unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                                           $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                                           $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                                           if (!-e $fullpath) {
                                               mkdir($fullpath,0755);
                                           }
                                       }
                                   } else {
                                       last;
                                   }
                               }
                           }
                           if ($fullpath ne '') {
                               if (-e "$prefix$path") {
                                   unless (rename("$prefix$path","$fullpath/$title")) {
                                        $warning .= &mt('Failed to rename dependency').'<br />';
                                   }
                               }
                               if (-e "$fullpath/$title") {
                                   my $showpath;
                                   if ($relpath ne '') {
                                       $showpath = "$relpath/$title";
                                   } else {
                                       $showpath = "/$title";
                                   }
                                   $result .= '<li>'.&mt('[_1] included as a dependency',
                                                         &HTML::Entities::encode($showpath,'<>&"')).
                                              '</li>'."\n";
                                   unless ($ishome) {
                                       my $fetch = "$fullpath/$title";
                                       $fetch =~ s/^\Q$prefix$dir\E//;
                                       $prompttofetch{$fetch} = 1;
                                   }
                               }
                           }
                       }
                   } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                       $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                                       &HTML::Entities::encode($path,'<>&"'),
                                       &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
                                   '<br />';
                   }
               } else {
                   $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                                   &HTML::Entities::encode($path)).'<br />';
               }
           }
           if (keys(%todelete)) {
               foreach my $key (keys(%todelete)) {
                   unlink($key);
               }
           }
           if (keys(%todeletedir)) {
               foreach my $key (keys(%todeletedir)) {
                   rmdir($key);
               }
           }
           foreach my $dir (sort(keys(%is_dir))) {
               if (($pathtocheck ne '') && ($dir ne ''))  {
                   &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
               }
           }
           if ($result ne '') {
               $output .= '<ul>'."\n".
                          $result."\n".
                          '</ul>';
           }
           unless ($ishome) {
               my $replicationfail;
               foreach my $item (keys(%prompttofetch)) {
                   my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   unless ($fetchresult eq 'ok') {
                       $replicationfail .= '<li>'.$item.'</li>'."\n";
                   }
               }
               if ($replicationfail) {
                   $output .= '<p class="LC_error">'.
                              &mt('Course home server failed to retrieve:').'<ul>'.
                              $replicationfail.
                              '</ul></p>';
               }
           }
       } else {
           $warning = &mt('No items found in archive.');
       }
       if ($error) {
           $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                      $error.'</p>'."\n";
       }
       if ($warning) {
           $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
       }
       return $output;
   }
   
   sub cleanup_empty_dirs {
       my ($path) = @_;
       if (($path ne '') && (-d $path)) {
           if (opendir(my $dirh,$path)) {
               my @dircontents = grep(!/^\./,readdir($dirh));
               my $numitems = 0;
               foreach my $item (@dircontents) {
                   if (-d "$path/$item") {
                       &cleanup_empty_dirs("$path/$item");
                       if (-e "$path/$item") {
                           $numitems ++;
                       }
                   } else {
                       $numitems ++;
                   }
               }
               if ($numitems == 0) {
                   rmdir($path);
               }
               closedir($dirh);
           }
       }
       return;
   }
   
   =pod
   
   =item * &get_folder_hierarchy()
   
   Provides hierarchy of names of folders/sub-folders containing the current
   item,
   
   Inputs: 3
        - $navmap - navmaps object
   
        - $map - url for map (either the trigger itself, or map containing
                              the resource, which is the trigger).
   
        - $showitem - 1 => show title for map itself; 0 => do not show.
   
   Outputs: 1 @pathitems - array of folder/subfolder names.
   
   =cut
   
   sub get_folder_hierarchy {
       my ($navmap,$map,$showitem) = @_;
       my @pathitems;
       if (ref($navmap)) {
           my $mapres = $navmap->getResourceByUrl($map);
           if (ref($mapres)) {
               my $pcslist = $mapres->map_hierarchy();
               if ($pcslist ne '') {
                   my @pcs = split(/,/,$pcslist);
                   foreach my $pc (@pcs) {
                       if ($pc == 1) {
                           push(@pathitems,&mt('Main Content'));
                       } else {
                           my $res = $navmap->getByMapPc($pc);
                           if (ref($res)) {
                               my $title = $res->compTitle();
                               $title =~ s/\W+/_/g;
                               if ($title ne '') {
                                   push(@pathitems,$title);
                               }
                           }
                       }
                   }
               }
               if ($showitem) {
                   if ($mapres->{ID} eq '0.0') {
                       push(@pathitems,&mt('Main Content'));
                   } else {
                       my $maptitle = $mapres->compTitle();
                       $maptitle =~ s/\W+/_/g;
                       if ($maptitle ne '') {
                           push(@pathitems,$maptitle);
                       }
                   }
               }
           }
       }
       return @pathitems;
   }
   
   =pod
   
   =item * &get_turnedin_filepath()
   
   Determines path in a user's portfolio file for storage of files uploaded
   to a specific essayresponse or dropbox item.
   
   Inputs: 3 required + 1 optional.
   $symb is symb for resource, $uname and $udom are for current user (required).
   $caller is optional (can be "submission", if routine is called when storing
   an upoaded file when "Submit Answer" button was pressed).
   
   Returns array containing $path and $multiresp. 
   $path is path in portfolio.  $multiresp is 1 if this resource contains more
   than one file upload item.  Callers of routine should append partid as a 
   subdirectory to $path in cases where $multiresp is 1.
   
   Called by: homework/essayresponse.pm and homework/structuretags.pm
   
   =cut
   
   sub get_turnedin_filepath {
       my ($symb,$uname,$udom,$caller) = @_;
       my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
       my $turnindir;
       my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
       $turnindir = $userhash{'turnindir'};
       my ($path,$multiresp);
       if ($turnindir eq '') {
           if ($caller eq 'submission') {
               $turnindir = &mt('turned in');
               $turnindir =~ s/\W+/_/g;
               my %newhash = (
                               'turnindir' => $turnindir,
                             );
               &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
           }
       }
       if ($turnindir ne '') {
           $path = '/'.$turnindir.'/';
           my ($multipart,$turnin,@pathitems);
           my $navmap = Apache::lonnavmaps::navmap->new();
           if (defined($navmap)) {
               my $mapres = $navmap->getResourceByUrl($map);
               if (ref($mapres)) {
                   my $pcslist = $mapres->map_hierarchy();
                   if ($pcslist ne '') {
                       foreach my $pc (split(/,/,$pcslist)) {
                           my $res = $navmap->getByMapPc($pc);
                           if (ref($res)) {
                               my $title = $res->compTitle();
                               $title =~ s/\W+/_/g;
                               if ($title ne '') {
                                   if (($pc > 1) && (length($title) > 12)) {
                                       $title = substr($title,0,12);
                                   }
                                   push(@pathitems,$title);
                               }
                           }
                       }
                   }
                   my $maptitle = $mapres->compTitle();
                   $maptitle =~ s/\W+/_/g;
                   if ($maptitle ne '') {
                       if (length($maptitle) > 12) {
                           $maptitle = substr($maptitle,0,12);
                       }
                       push(@pathitems,$maptitle);
                   }
                   unless ($env{'request.state'} eq 'construct') {
                       my $res = $navmap->getBySymb($symb);
                       if (ref($res)) {
                           my $partlist = $res->parts();
                           my $totaluploads = 0;
                           if (ref($partlist) eq 'ARRAY') {
                               foreach my $part (@{$partlist}) {
                                   my @types = $res->responseType($part);
                                   my @ids = $res->responseIds($part);
                                   for (my $i=0; $i < scalar(@ids); $i++) {
                                       if ($types[$i] eq 'essay') {
                                           my $partid = $part.'_'.$ids[$i];
                                           if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                                               $totaluploads ++;
                                           }
                                       }
                                   }
                               }
                               if ($totaluploads > 1) {
                                   $multiresp = 1;
                               }
                           }
                       }
                   }
               } else {
                   return;
               }
           } else {
               return;
           }
           my $restitle=&Apache::lonnet::gettitle($symb);
           $restitle =~ s/\W+/_/g;
           if ($restitle eq '') {
               $restitle = ($resurl =~ m{/[^/]+$});
               if ($restitle eq '') {
                   $restitle = time;
               }
           }
           if (length($restitle) > 12) {
               $restitle = substr($restitle,0,12);
           }
           push(@pathitems,$restitle);
           $path .= join('/',@pathitems);
       }
       return ($path,$multiresp);
   }
   
 =pod  =pod
   
 =back  =back
Line 9071  sub upfile_store { Line 13169  sub upfile_store {
     $env{'form.upfile'}=~s/\n+/\n/gs;      $env{'form.upfile'}=~s/\n+/\n/gs;
     $env{'form.upfile'}=~s/\n+$//gs;      $env{'form.upfile'}=~s/\n+$//gs;
   
     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.      my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
  '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;                                       '_enroll_'.$env{'request.course.id'}.'_'.
                                        time.'_'.$$);
       return if ($datatoken eq '');
   
     {      {
         my $datafile = $r->dir_config('lonDaemons').          my $datafile = $r->dir_config('lonDaemons').
                            '/tmp/'.$datatoken.'.tmp';                             '/tmp/'.$datatoken.'.tmp';
         if ( open(my $fh,">$datafile") ) {          if ( open(my $fh,'>',$datafile) ) {
             print $fh $env{'form.upfile'};              print $fh $env{'form.upfile'};
             close($fh);              close($fh);
         }          }
Line 9086  sub upfile_store { Line 13187  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 9108  sub load_tmp_file { Line 13210  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 9548  sub DrawBarGraph { Line 13658  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 9979  sub restore_settings { Line 14089  sub restore_settings {
   
 =item * &build_recipient_list()  =item * &build_recipient_list()
   
 Build recipient lists for five types of e-mail:  Build recipient lists for following types of e-mail:
 (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors  (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
 (d) Help requests, (e) Course requests needing approval,  generated by  (d) Help requests, (e) Course requests needing approval, (f) loncapa
 lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and  module change checking, student/employee ID conflict checks, as
 loncoursequeueadmin.pm respectively.  generated by lonerrorhandler.pm, CHECKRPMS, loncron,
   lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
   
 Inputs:  Inputs:
 defmail (scalar - email address of default recipient),   defmail (scalar - email address of default recipient),
 mailing type (scalar - errormail, packagesmail, or helpdeskmail),   mailing type (scalar: errormail, packagesmail, helpdeskmail,
   requestsmail, updatesmail, or idconflictsmail).
   
 defdom (domain for which to retrieve configuration settings),  defdom (domain for which to retrieve configuration settings),
 origmail (scalar - email address of recipient from loncapa.conf,   
 i.e., predates configuration by DC via domainprefs.pm   origmail (scalar - email address of recipient from loncapa.conf,
   i.e., predates configuration by DC via domainprefs.pm
   
 Returns: comma separated list of addresses to which to send e-mail.  Returns: comma separated list of addresses to which to send e-mail.
   
Line 10003  Returns: comma separated list of address Line 14117  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 10017  sub build_recipient_list { Line 14131  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 'helpdeskmail') && ($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 10044  sub build_recipient_list { Line 14240  sub build_recipient_list {
             }              }
         }          }
     }      }
     my $recipientlist = join(',',@recipients);       if ($mailing eq 'helpdeskmail') {
     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 10136  jsarray (reference to array of categorie Line 14345  jsarray (reference to array of categorie
 subcats (reference to hash of arrays containing all subcategories within each   subcats (reference to hash of arrays containing all subcategories within each 
          category, -recursive)           category, -recursive)
   
   maxd (reference to hash used to hold max depth for all top-level categories).
   
 Returns: nothing  Returns: nothing
   
 Side effects: populates trails and allitems hash references.  Side effects: populates trails and allitems hash references.
Line 10143  Side effects: populates trails and allit Line 14354  Side effects: populates trails and allit
 =cut  =cut
   
 sub extract_categories {  sub extract_categories {
     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;      my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
     if (ref($categories) eq 'HASH') {      if (ref($categories) eq 'HASH') {
         &gather_categories($categories,$cats,$idx,$jsarray);          &gather_categories($categories,$cats,$idx,$jsarray);
         if (ref($cats->[0]) eq 'ARRAY') {          if (ref($cats->[0]) eq 'ARRAY') {
Line 10169  sub extract_categories { Line 14380  sub extract_categories {
                         if (ref($subcats) eq 'HASH') {                          if (ref($subcats) eq 'HASH') {
                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');                              push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                         }                          }
                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);                          &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
                     }                      }
                 } else {                  } else {
                     if (ref($subcats) eq 'HASH') {                      if (ref($subcats) eq 'HASH') {
                         $subcats->{$item} = [];                          $subcats->{$item} = [];
                     }                      }
                       if (ref($maxd) eq 'HASH') {
                           $maxd->{$name} = 1;
                       }
                 }                  }
             }              }
         }          }
Line 10184  sub extract_categories { Line 14398  sub extract_categories {
   
 =pod  =pod
   
 =item *&recurse_categories()  =item * &recurse_categories()
   
 Recursively used to generate breadcrumb trails for course categories.  Recursively used to generate breadcrumb trails for course categories.
   
Line 10212  Side effects: populates trails and allit Line 14426  Side effects: populates trails and allit
 =cut  =cut
   
 sub recurse_categories {  sub recurse_categories {
     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;      my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
     my $shallower = $depth - 1;      my $shallower = $depth - 1;
     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {      if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {          for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
Line 10239  sub recurse_categories { Line 14453  sub recurse_categories {
                 }                  }
             }              }
             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,              &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                                 $subcats);                                  $subcats,$maxd);
             pop(@{$parents});              pop(@{$parents});
         }          }
     } else {      } else {
         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;          my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
         my $trailstr = join(' -&gt; ',(@{$parents},$category));          my $trailstr = join(' &raquo; ',(@{$parents},$category));
         if ($allitems->{$item} eq '') {          if ($allitems->{$item} eq '') {
             push(@{$trails},$trailstr);              push(@{$trails},$trailstr);
             $allitems->{$item} = scalar(@{$trails})-1;              $allitems->{$item} = scalar(@{$trails})-1;
         }          }
           if (ref($maxd) eq 'HASH') {
               if ($depth > $maxd->{$parents->[0]}) {
                   $maxd->{$parents->[0]} = $depth;
               }
           }
     }      }
     return;      return;
 }  }
   
 =pod  =pod
   
 =item *&assign_categories_table()  =item * &assign_categories_table()
   
 Create a datatable for display of hierarchical categories in a domain,  Create a datatable for display of hierarchical categories in a domain,
 with checkboxes to allow a course to be categorized.   with checkboxes to allow a course to be categorized. 
Line 10269  currcat - scalar with an & separated lis Line 14488  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,%maxd,@path,$maxdepth);
         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);          &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
         $maxdepth = scalar(@cats);          $maxdepth = scalar(@cats);
         if (@cats > 0) {          if (@cats > 0) {
             my $itemcount = 0;              my $itemcount = 0;
Line 10310  sub assign_categories_table { Line 14532  sub assign_categories_table {
                     }                      }
                     $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 10332  sub assign_categories_table { Line 14554  sub assign_categories_table {
   
 =pod  =pod
   
 =item *&assign_category_rows()  =item * &assign_category_rows()
   
 Create a datatable row for display of nested categories in a domain,  Create a datatable row for display of nested categories in a domain,
 with checkboxes to allow a course to be categorized,called recursively.  with checkboxes to allow a course to be categorized,called recursively.
Line 10353  path - Array containing all categories b Line 14575  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 10366  sub assign_category_rows { Line 14591  sub assign_category_rows {
             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {              if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                 my $numchildren = @{$cats->[$depth]{$parent}};                  my $numchildren = @{$cats->[$depth]{$parent}};
                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';                  my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                 $text .= '<td><table class="LC_datatable">';                  $text .= '<td><table class="LC_data_table">';
                 for (my $j=0; $j<$numchildren; $j++) {                  for (my $j=0; $j<$numchildren; $j++) {
                     $name = $cats->[$depth]{$parent}[$j];                      $name = $cats->[$depth]{$parent}[$j];
                     $item = &escape($name).':'.&escape($parent).':'.$depth;                      $item = &escape($name).':'.&escape($parent).':'.$depth;
Line 10381  sub assign_category_rows { Line 14606  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 10398  sub assign_category_rows { Line 14623  sub assign_category_rows {
     return $text;      return $text;
 }  }
   
   =pod
   
   =back
   
   =cut
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
Line 10414  sub commit_customrole { Line 14645  sub commit_customrole {
 }  }
   
 sub commit_standardrole {  sub commit_standardrole {
     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;      my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
     my ($output,$logmsg,$linefeed);      my ($output,$logmsg,$linefeed);
     if ($context eq 'auto') {      if ($context eq 'auto') {
         $linefeed = "\n";          $linefeed = "\n";
Line 10423  sub commit_standardrole { Line 14654  sub commit_standardrole {
     }        }  
     if ($three eq 'st') {      if ($three eq 'st') {
         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,          my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                                          $one,$two,$sec,$context);                                           $one,$two,$sec,$context,$credits);
         if (($result =~ /^error/) || ($result eq 'not_in_class') ||           if (($result =~ /^error/) || ($result eq 'not_in_class') || 
             ($result eq 'unknown_course') || ($result eq 'refused')) {              ($result eq 'unknown_course') || ($result eq 'refused')) {
             $output = $logmsg.' '.&mt('Error: ').$result."\n";               $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
Line 10454  sub commit_standardrole { Line 14685  sub commit_standardrole {
 }  }
   
 sub commit_studentrole {  sub commit_studentrole {
     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;      my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
           $credits) = @_;
     my ($result,$linefeed,$oldsecurl,$newsecurl);      my ($result,$linefeed,$oldsecurl,$newsecurl);
     if ($context eq 'auto') {      if ($context eq 'auto') {
         $linefeed = "\n";          $linefeed = "\n";
Line 10501  sub commit_studentrole { Line 14733  sub commit_studentrole {
             }              }
         }          }
         if (($expire_role_result eq 'ok') || ($secchange == 0)) {          if (($expire_role_result eq 'ok') || ($secchange == 0)) {
             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);              $modify_section_result = 
                   &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                                                              undef,undef,undef,$sec,
                                                              $end,$start,'','',$cid,
                                                              '',$context,$credits);
             if ($modify_section_result =~ /^ok/) {              if ($modify_section_result =~ /^ok/) {
                 if ($secchange == 1) {                  if ($secchange == 1) {
                     if ($sec eq '') {                      if ($sec eq '') {
Line 10532  sub commit_studentrole { Line 14768  sub commit_studentrole {
             $result = $modify_section_result;              $result = $modify_section_result;
         } elsif ($secchange == 1) {          } elsif ($secchange == 1) {
             if ($oldsec eq '') {              if ($oldsec eq '') {
                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;                  $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_2] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
             } else {              } else {
                 $$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;                  $$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;
             }              }
Line 10558  sub commit_studentrole { Line 14794  sub commit_studentrole {
     return $result;      return $result;
 }  }
   
   sub show_role_extent {
       my ($scope,$context,$role) = @_;
       $scope =~ s{^/}{};
       my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
       push(@courseroles,'co');
       my @authorroles = &Apache::lonuserutils::roles_by_context('author');
       if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
           $scope =~ s{/}{_};
           return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
       } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
           my ($audom,$auname) = split(/\//,$scope);
           return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                      &Apache::loncommon::plainname($auname,$audom).'</span>');
       } else {
           $scope =~ s{/$}{};
           return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                      &Apache::lonnet::domain($scope,'description').'</span>');
       }
   }
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
Line 10586  sub check_clone { Line 14842  sub check_clone {
                 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 {
     my %clonehash = &Apache::lonnet::get('environment',['cloners'],      my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
  $args->{'clonedomain'},$args->{'clonecourse'});   $args->{'clonedomain'},$args->{'clonecourse'});
     my @cloners = split(/,/,$clonehash{'cloners'});              if ($clonehash{'cloners'} eq '') {
             if (grep(/^\*$/,@cloners)) {                  my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                 $can_clone = 1;                  if ($domdefs{'canclone'}) {
             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {                      unless ($domdefs{'canclone'} eq 'none') {
                 $can_clone = 1;                          if ($domdefs{'canclone'} eq 'domain') {
                               if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                                   $can_clone = 1;
                               }
                           } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                                    ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                               if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                                                                             $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                                   $can_clone = 1;
                               }
                           }
                       }
                   }
             } else {              } else {
           my @cloners = split(/,/,$clonehash{'cloners'});
                   if (grep(/^\*$/,@cloners)) {
                       $can_clone = 1;
                   } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                       $can_clone = 1;
                   } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                       $can_clone = 1;
                   }
                   unless ($can_clone) {
                       if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                           ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                           my (%gotdomdefaults,%gotcodedefaults);
                           foreach my $cloner (@cloners) {
                               if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                                   ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                                   my (%codedefaults,@code_order);
                                   if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                                       if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                                           %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                                       }
                                       if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                                           @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                                       }
                                   } else {
                                       &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                                                                               \%codedefaults,
                                                                               \@code_order);
                                       $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                                       $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                                   }
                                   if (@code_order > 0) {
                                       if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                                                                                   $cloner,$clonehash{'internal.coursecode'},
                                                                                   $args->{'crscode'})) {
                                           $can_clone = 1;
                                           last;
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
               unless ($can_clone) {
                 my $ccrole = 'cc';                  my $ccrole = 'cc';
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     $ccrole = 'co';                      $ccrole = 'co';
                 }                  }
         my %roleshash =                  my %roleshash =
     &Apache::lonnet::get_my_roles($args->{'ccuname'},                      &Apache::lonnet::get_my_roles($args->{'ccuname'},
  $args->{'ccdomain'},                                                    $args->{'ccdomain'},
                                          'userroles',['active'],[$ccrole],                                                    'userroles',['active'],[$ccrole],
  [$args->{'clonedomain'}]);                                                    [$args->{'clonedomain'}]);
         if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {                  if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                     $can_clone = 1;                      $can_clone = 1;
                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {                  } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                                                             $args->{'ccuname'},$args->{'ccdomain'})) {
                     $can_clone = 1;                      $can_clone = 1;
                   }
               }
               unless ($can_clone) {
                   if ($args->{'crstype'} eq 'Community') {
                       $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                 } else {                  } else {
                     if ($args->{'crstype'} eq 'Community') {                      $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                         $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});  
                     } else {  
                         $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});  
                     }  
         }          }
     }      }
         }          }
Line 10625  sub check_clone { Line 14939  sub check_clone {
 }  }
   
 sub construct_course {  sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;      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 10721  sub construct_course { Line 15036  sub construct_course {
                    'pch.users.denied',                     'pch.users.denied',
                    'plc.users.denied',                     'plc.users.denied',
                    'hidefromcat',                     'hidefromcat',
                    'categories'],                     'checkforpriv',
                      'categories',
                      'internal.uniquecode'],
                    $$crsudom,$$crsunum);                     $$crsudom,$$crsunum);
           if ($args->{'textbook'}) {
               $cenv{'internal.textbook'} = $args->{'textbook'};
           }
     }      }
   
 #  #
Line 10750  sub construct_course { Line 15070  sub construct_course {
     } else {      } else {
         $cenv{'internal.courseowner'} = $args->{'curruser'};          $cenv{'internal.courseowner'} = $args->{'curruser'};
     }      }
       if ($args->{'defaultcredits'}) {
           $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
       }
     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.      my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
     if ($args->{'crssections'}) {      if ($args->{'crssections'}) {
         $cenv{'internal.sectionnums'} = '';          $cenv{'internal.sectionnums'} = '';
Line 10765  sub construct_course { Line 15088  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 10774  sub construct_course { Line 15097  sub construct_course {
 # do not hide course coordinator from staff listing,   # do not hide course coordinator from staff listing, 
 # even if privileged  # even if privileged
     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};      $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
   # add course coordinator's domain to domains to check for privileged users
   # if different to course domain
       if ($$crsudom ne $args->{'ccdomain'}) {
           $cenv{'checkforpriv'} = $args->{'ccdomain'};
       }
 # add crosslistings  # add crosslistings
     if ($args->{'crsxlist'}) {      if ($args->{'crsxlist'}) {
         $cenv{'internal.crosslistings'}='';          $cenv{'internal.crosslistings'}='';
Line 10788  sub construct_course { Line 15116  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 10823  sub construct_course { Line 15151  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'}) {
         $args->{'endaccess'} = 0;          $args->{'endaccess'} = 0;
Line 10876  sub construct_course { Line 15205  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 10898  sub construct_course { Line 15230  sub construct_course {
  }   }
     }      }
   
   #
   #  generate and store uniquecode (available to course requester), if course should have one.
   #
       if ($args->{'uniquecode'}) {
           my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
           if ($code) {
               $cenv{'internal.uniquecode'} = $code;
               my %crsinfo =
                   &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
               if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
               }
               if (ref($coderef)) {
                   $$coderef = $code;
               }
           }
       }
   
     if ($args->{'disresdis'}) {      if ($args->{'disresdis'}) {
         $cenv{'pch.roles.denied'}='st';          $cenv{'pch.roles.denied'}='st';
     }      }
Line 10966  sub construct_course { Line 15317  sub construct_course {
     return (1,$outcome);      return (1,$outcome);
 }  }
   
   sub make_unique_code {
       my ($cdom,$cnum) = @_;
       # get lock on uniquecodes db
       my $lockhash = {
                         $cnum."\0".'uniquecodes' => $env{'user.name'}.
                                                     ':'.$env{'user.domain'},
                      };
       my $tries = 0;
       my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
       my ($code,$error);
   
       while (($gotlock ne 'ok') && ($tries<3)) {
           $tries ++;
           sleep 1;
           $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
       }
       if ($gotlock eq 'ok') {
           my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
           my $gotcode;
           my $attempts = 0;
           while ((!$gotcode) && ($attempts < 100)) {
               $code = &generate_code();
               if (!exists($currcodes{$code})) {
                   $gotcode = 1;
                   unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                       $error = 'nostore';
                   }
               }
               $attempts ++;
           }
           my @del_lock = ($cnum."\0".'uniquecodes');
           my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
       } else {
           $error = 'nolock';
       }
       return ($code,$error);
   }
   
   sub generate_code {
       my $code;
       my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
       for (my $i=0; $i<6; $i++) {
           my $lettnum = int (rand 2);
           my $item = '';
           if ($lettnum) {
               $item = $letts[int( rand(18) )];
           } else {
               $item = 1+int( rand(8) );
           }
           $code .= $item;
       }
       return $code;
   }
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
Line 10993  sub group_term { Line 15398  sub group_term {
 }  }
   
 sub course_types {  sub course_types {
     my @types = ('official','unofficial','community');      my @types = ('official','unofficial','community','textbook');
     my %typename = (      my %typename = (
                          official   => 'Official course',                           official   => 'Official course',
                          unofficial => 'Unofficial course',                           unofficial => 'Unofficial course',
                          community  => 'Community',                           community  => 'Community',
                            textbook   => 'Textbook course',
                    );                     );
     return (\@types,\%typename);      return (\@types,\%typename);
 }  }
Line 11058  sub escape_url { Line 15464  sub escape_url {
     my ($url)   = @_;      my ($url)   = @_;
     my @urlslices = split(/\//, $url,-1);      my @urlslices = split(/\//, $url,-1);
     my $lastitem = &escape(pop(@urlslices));      my $lastitem = &escape(pop(@urlslices));
     return join('/',@urlslices).'/'.$lastitem;      return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
 }  }
   
 sub compare_arrays {  sub compare_arrays {
Line 11086  sub init_user_environment { Line 15492  sub init_user_environment {
   
 # See if old ID present, if so, remove  # See if old ID present, if so, remove
   
     my ($filename,$cookie,$userroles);      my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
     my $now=time;      my $now=time;
   
     if ($public) {      if ($public) {
Line 11116  sub init_user_environment { Line 15522  sub init_user_environment {
  }   }
     }      }
     closedir(DIR);      closedir(DIR);
   # If there is a undeleted lockfile for the user's paste buffer remove it.
               my $namespace = 'nohist_courseeditor';
               my $lockingkey = 'paste'."\0".'locked_num';
               my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                                                   $domain,$username);
               if (exists($lockhash{$lockingkey})) {
                   my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   unless ($delresult eq 'ok') {
                       &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   }
               }
  }   }
 # Give them a new cookie  # Give them a new cookie
  my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}   my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
Line 11124  sub init_user_environment { Line 15541  sub init_user_environment {
           
 # Initialize roles  # Initialize roles
   
  $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);   ($userroles,$firstaccenv,$timerintenv) = 
               &Apache::lonnet::rolesinit($domain,$username,$authhost);
     }      }
 # ------------------------------------ Check browser type and MathML capability  # ------------------------------------ Check browser type and MathML capability
   
     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,      my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
         $clientunicode,$clientos) = &decode_user_agent($r);          $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
   
 # ------------------------------------------------------------- Get environment  # ------------------------------------------------------------- Get environment
   
Line 11160  sub init_user_environment { Line 15578  sub init_user_environment {
      "browser.mathml"     => $clientmathml,       "browser.mathml"     => $clientmathml,
      "browser.unicode"    => $clientunicode,       "browser.unicode"    => $clientunicode,
      "browser.os"         => $clientos,       "browser.os"         => $clientos,
                "browser.mobile"     => $clientmobile,
                "browser.info"       => $clientinfo,
                "browser.osversion"  => $clientosversion,
      "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},       "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
      "request.course.fn"  => '',       "request.course.fn"  => '',
      "request.course.uri" => '',       "request.course.uri" => '',
Line 11179  sub init_user_environment { Line 15600  sub init_user_environment {
     $env{'browser.interface'}=$form->{'interface'};      $env{'browser.interface'}=$form->{'interface'};
  }   }
   
         my %is_adv = ( is_adv => $env{'user.adv'} );          if ($form->{'iptoken'}) {
         my %domdef = &Apache::lonnet::get_domain_defaults($domain);              my $lonhost = $r->dir_config('lonHostID');
               $initial_env{"user.noloadbalance"} = $lonhost;
               $env{'user.noloadbalance'} = $lonhost;
           }
   
         foreach my $tool ('aboutme','blog','portfolio') {          if ($form->{'noloadbalance'}) {
             $userenv{'availabletools.'.$tool} =               my @hosts = &Apache::lonnet::current_machine_ids();
                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',              my $hosthere = $form->{'noloadbalance'};
                                                   undef,\%userenv,\%domdef,\%is_adv);              if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   $initial_env{"user.noloadbalance"} = $hosthere;
                   $env{'user.noloadbalance'} = $hosthere;
               }
         }          }
   
         foreach my $crstype ('official','unofficial','community') {          unless ($domain eq 'public') {
             $userenv{'canrequest.'.$crstype} =              my %is_adv = ( is_adv => $env{'user.adv'} );
                 &Apache::lonnet::usertools_access($username,$domain,$crstype,              my %domdef = &Apache::lonnet::get_domain_defaults($domain);
                                                   'reload','requestcourses',  
               foreach my $tool ('aboutme','blog','webdav','portfolio') {
                   $userenv{'availabletools.'.$tool} = 
                       &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                                                         undef,\%userenv,\%domdef,\%is_adv);
               }
   
               foreach my $crstype ('official','unofficial','community','textbook') {
                   $userenv{'canrequest.'.$crstype} =
                       &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                         'reload','requestcourses',
                                                         \%userenv,\%domdef,\%is_adv);
               }
   
               $userenv{'canrequest.author'} =
                   &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                                                     'reload','requestauthor',
                                                   \%userenv,\%domdef,\%is_adv);                                                    \%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'};
                   }
               }
         }          }
   
  $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",
  &GDBM_WRCREAT(),0640)) {   &GDBM_WRCREAT(),0640)) {
     &_add_to_env(\%disk_env,\%initial_env);      &_add_to_env(\%disk_env,\%initial_env);
     &_add_to_env(\%disk_env,\%userenv,'environment.');      &_add_to_env(\%disk_env,\%userenv,'environment.');
     &_add_to_env(\%disk_env,$userroles);      &_add_to_env(\%disk_env,$userroles);
               if (ref($firstaccenv) eq 'HASH') {
                   &_add_to_env(\%disk_env,$firstaccenv);
               }
               if (ref($timerintenv) eq 'HASH') {
                   &_add_to_env(\%disk_env,$timerintenv);
               }
     if (ref($args->{'extra_env'})) {      if (ref($args->{'extra_env'})) {
  &_add_to_env(\%disk_env,$args->{'extra_env'});   &_add_to_env(\%disk_env,$args->{'extra_env'});
     }      }
Line 11237  sub get_symb { Line 15695  sub get_symb {
     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));      my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
     if ($symb eq '') {      if ($symb eq '') {
         if (!$silent) {          if (!$silent) {
             $request->print("Unable to handle ambiguous references:$url:.");              if (ref($request)) { 
                   $request->print("Unable to handle ambiguous references:$url:.");
               }
             return ();              return ();
         }          }
     }      }
Line 11271  sub clean_symb { Line 15731  sub clean_symb {
     return ($symb,$enc);      return ($symb,$enc);
 }  }
   
   ############################################################
   ############################################################
   
   =pod
   
   =head1 Routines for building display used to search for courses
   
   
   =over 4
   
   =item * &build_filters()
   
   Create markup for a table used to set filters to use when selecting
   courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
   and quotacheck.pl
   
   
   Inputs:
   
   filterlist - anonymous array of fields to include as potential filters
   
   crstype - course type
   
   roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                 to pop-open a course selector (will contain "extra element").
   
   multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
   
   filter - anonymous hash of criteria and their values
   
   action - form action
   
   numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
   
   caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
   
   cloneruname - username of owner of new course who wants to clone
   
   clonerudom - domain of owner of new course who wants to clone
   
   typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
   
   codetitlesref - reference to array of titles of components in institutional codes (official courses)
   
   codedom - domain
   
   formname - value of form element named "form".
   
   fixeddom - domain, if fixed.
   
   prevphase - value to assign to form element named "phase" when going back to the previous screen
   
   cnameelement - name of form element in form on opener page which will receive title of selected course
   
   cnumelement - name of form element in form on opener page which will receive courseID  of selected course
   
   cdomelement - name of form element in form on opener page which will receive domain of selected course
   
   setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
   
   clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
   
   clonewarning - warning message about missing information for intended course owner when DC creates a course
   
   
   Returns: $output - HTML for display of search criteria, and hidden form elements.
   
   
   Side Effects: None
   
   =cut
   
   # ---------------------------------------------- search for courses based on last activity etc.
   
   sub build_filters {
       my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
           $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
           $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
           $cnameelement,$cnumelement,$cdomelement,$setroles,
           $clonetext,$clonewarning) = @_;
       my ($list,$jscript);
       my $onchange = 'javascript:updateFilters(this)';
       my ($domainselectform,$sincefilterform,$createdfilterform,
           $ownerdomselectform,$persondomselectform,$instcodeform,
           $typeselectform,$instcodetitle);
       if ($formname eq '') {
           $formname = $caller;
       }
       foreach my $item (@{$filterlist}) {
           unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
               if ($item eq 'domainfilter') {
                   $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
               } elsif ($item eq 'coursefilter') {
                   $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
               } elsif ($item eq 'ownerfilter') {
                   $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
               } elsif ($item eq 'ownerdomfilter') {
                   $filter->{'ownerdomfilter'} =
                       &LONCAPA::clean_domain($filter->{$item});
                   $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                                                          'ownerdomfilter',1);
               } elsif ($item eq 'personfilter') {
                   $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
               } elsif ($item eq 'persondomfilter') {
                   $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                                                           'persondomfilter',1);
               } else {
                   $filter->{$item} =~ s/\W//g;
               }
               if (!$filter->{$item}) {
                   $filter->{$item} = '';
               }
           }
           if ($item eq 'domainfilter') {
               my $allow_blank = 1;
               if ($formname eq 'portform') {
                   $allow_blank=0;
               } elsif ($formname eq 'studentform') {
                   $allow_blank=0;
               }
               if ($fixeddom) {
                   $domainselectform = '<input type="hidden" name="domainfilter"'.
                                       ' value="'.$codedom.'" />'.
                                       &Apache::lonnet::domain($codedom,'description');
               } else {
                   $domainselectform = &select_dom_form($filter->{$item},
                                                        'domainfilter',
                                                         $allow_blank,'',$onchange);
               }
           } else {
               $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
           }
       }
   
       # last course activity filter and selection
       $sincefilterform = &timebased_select_form('sincefilter',$filter);
   
       # course created filter and selection
       if (exists($filter->{'createdfilter'})) {
           $createdfilterform = &timebased_select_form('createdfilter',$filter);
       }
   
       my %lt = &Apache::lonlocal::texthash(
                   'cac' => "$crstype Activity",
                   'ccr' => "$crstype Created",
                   'cde' => "$crstype Title",
                   'cdo' => "$crstype Domain",
                   'ins' => 'Institutional Code',
                   'inc' => 'Institutional Categorization',
                   'cow' => "$crstype Owner/Co-owner",
                   'cop' => "$crstype Personnel Includes",
                   'cog' => 'Type',
                );
   
       if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
           my $typeval = 'Course';
           if ($crstype eq 'Community') {
               $typeval = 'Community';
           }
           $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
       } else {
           $typeselectform =  '<select name="type" size="1"';
           if ($onchange) {
               $typeselectform .= ' onchange="'.$onchange.'"';
           }
           $typeselectform .= '>'."\n";
           foreach my $posstype ('Course','Community') {
               $typeselectform.='<option value="'.$posstype.'"'.
                   ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
           }
           $typeselectform.="</select>";
       }
   
       my ($cloneableonlyform,$cloneabletitle);
       if (exists($filter->{'cloneableonly'})) {
           my $cloneableon = '';
           my $cloneableoff = ' checked="checked"';
           if ($filter->{'cloneableonly'}) {
               $cloneableon = $cloneableoff;
               $cloneableoff = '';
           }
           $cloneableonlyform = '<span class="LC_nobreak"><label><input type="radio" name="cloneableonly" value="1" '.$cloneableon.'/>&nbsp;'.&mt('Required').'</label>'.('&nbsp;'x3).'<label><input type="radio" name="cloneableonly" value="" '.$cloneableoff.' />&nbsp;'.&mt('No restriction').'</label></span>';
           if ($formname eq 'ccrs') {
               $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
           } else {
               $cloneabletitle = &mt('Cloneable by you');
           }
       }
       my $officialjs;
       if ($crstype eq 'Course') {
           if (exists($filter->{'instcodefilter'})) {
   #            if (($fixeddom) || ($formname eq 'requestcrs') ||
   #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
               if ($codedom) {
                   $officialjs = 1;
                   ($instcodeform,$jscript,$$numtitlesref) =
                       &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                                                                     $officialjs,$codetitlesref);
                   if ($jscript) {
                       $jscript = '<script type="text/javascript">'."\n".
                                  '// <![CDATA['."\n".
                                  $jscript."\n".
                                  '// ]]>'."\n".
                                  '</script>'."\n";
                   }
               }
               if ($instcodeform eq '') {
                   $instcodeform =
                       '<input type="text" name="instcodefilter" size="10" value="'.
                       $list->{'instcodefilter'}.'" />';
                   $instcodetitle = $lt{'ins'};
               } else {
                   $instcodetitle = $lt{'inc'};
               }
               if ($fixeddom) {
                   $instcodetitle .= '<br />('.$codedom.')';
               }
           }
       }
       my $output = qq|
   <form method="post" name="filterpicker" action="$action">
   <input type="hidden" name="form" value="$formname" />
   |;
       if ($formname eq 'modifycourse') {
           $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                      '<input type="hidden" name="prevphase" value="'.
                      $prevphase.'" />'."\n";
       } elsif ($formname eq 'quotacheck') {
           $output .= qq|
   <input type="hidden" name="sortby" value="" />
   <input type="hidden" name="sortorder" value="" />
   |;
       } else {
           my $name_input;
           if ($cnameelement ne '') {
               $name_input = '<input type="hidden" name="cnameelement" value="'.
                             $cnameelement.'" />';
           }
           $output .= qq|
   <input type="hidden" name="cnumelement" value="$cnumelement" />
   <input type="hidden" name="cdomelement" value="$cdomelement" />
   $name_input
   $roleelement
   $multelement
   $typeelement
   |;
           if ($formname eq 'portform') {
               $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
           }
       }
       if ($fixeddom) {
           $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
       }
       $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
       if ($sincefilterform) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                     .$sincefilterform
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if ($createdfilterform) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                     .$createdfilterform
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if ($domainselectform) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                     .$domainselectform
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if ($typeselectform) {
           if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
               $output .= $typeselectform;
           } else {
               $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                         .$typeselectform
                         .&Apache::lonhtmlcommon::row_closure();
           }
       }
       if ($instcodeform) {
           $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                     .$instcodeform
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if (exists($filter->{'ownerfilter'})) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                      '<table><tr><td>'.&mt('Username').'<br />'.
                      '<input type="text" name="ownerfilter" size="20" value="'.
                      $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                      $ownerdomselectform.'</td></tr></table>'.
                      &Apache::lonhtmlcommon::row_closure();
       }
       if (exists($filter->{'personfilter'})) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                      '<table><tr><td>'.&mt('Username').'<br />'.
                      '<input type="text" name="personfilter" size="20" value="'.
                      $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                      $persondomselectform.'</td></tr></table>'.
                      &Apache::lonhtmlcommon::row_closure();
       }
       if (exists($filter->{'coursefilter'})) {
           $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                     .'<input type="text" name="coursefilter" size="25" value="'
                     .$list->{'coursefilter'}.'" />'
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if ($cloneableonlyform) {
           $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                      $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
       }
       if (exists($filter->{'descriptfilter'})) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                     .'<input type="text" name="descriptfilter" size="40" value="'
                     .$list->{'descriptfilter'}.'" />'
                     .&Apache::lonhtmlcommon::row_closure(1);
       }
       $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                  '<input type="hidden" name="updater" value="" />'."\n".
                  '<input type="submit" name="gosearch" value="'.
                  &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
       return $jscript.$clonewarning.$output;
   }
   
   =pod
   
   =item * &timebased_select_form()
   
   Create markup for a dropdown list used to select a time-based
   filter e.g., Course Activity, Course Created, when searching for courses
   or communities
   
   Inputs:
   
   item - name of form element (sincefilter or createdfilter)
   
   filter - anonymous hash of criteria and their values
   
   Returns: HTML for a select box contained a blank, then six time selections,
            with value set in incoming form variables currently selected.
   
   Side Effects: None
   
   =cut
   
   sub timebased_select_form {
       my ($item,$filter) = @_;
       if (ref($filter) eq 'HASH') {
           $filter->{$item} =~ s/[^\d-]//g;
           if (!$filter->{$item}) { $filter->{$item}=-1; }
           return &select_form(
                               $filter->{$item},
                               $item,
                               {      '-1' => '',
                                   '86400' => &mt('today'),
                                  '604800' => &mt('last week'),
                                 '2592000' => &mt('last month'),
                                 '7776000' => &mt('last three months'),
                                '15552000' => &mt('last six months'),
                                '31104000' => &mt('last year'),
                       'select_form_order' =>
                              ['-1','86400','604800','2592000','7776000',
                               '15552000','31104000']});
       }
   }
   
   =pod
   
   =item * &js_changer()
   
   Create script tag containing Javascript used to submit course search form
   when course type or domain is changed, and also to hide 'Searching ...' on
   page load completion for page showing search result.
   
   Inputs: None
   
   Returns: markup containing updateFilters() and hideSearching() javascript functions.
   
   Side Effects: None
   
   =cut
   
   sub js_changer {
       return <<ENDJS;
   <script type="text/javascript">
   // <![CDATA[
   function updateFilters(caller) {
       if (typeof(caller) != "undefined") {
           document.filterpicker.updater.value = caller.name;
       }
       document.filterpicker.submit();
   }
   
   function hideSearching() {
       if (document.getElementById('searching')) {
           document.getElementById('searching').style.display = 'none';
       }
       return;
   }
   
   // ]]>
   </script>
   
   ENDJS
   }
   
   =pod
   
   =item * &search_courses()
   
   Process selected filters form course search form and pass to lonnet::courseiddump
   to retrieve a hash for which keys are courseIDs which match the selected filters.
   
   Inputs:
   
   dom - domain being searched
   
   type - course type ('Course' or 'Community' or '.' if any).
   
   filter - anonymous hash of criteria and their values
   
   numtitles - for institutional codes - number of categories
   
   cloneruname - optional username of new course owner
   
   clonerudom - optional domain of new course owner
   
   domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
               (used when DC is using course creation form)
   
   codetitles - reference to array of titles of components in institutional codes (official courses).
   
   cc_clone - escaped comma separated list of courses for which course cloner has active CC role
              (and so can clone automatically)
   
   reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
   
   reqinstcode - institutional code of new course, where search_courses is used to identify potential
                 courses to clone
   
   Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
   
   
   Side Effects: None
   
   =cut
   
   
   sub search_courses {
       my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
           $cc_clone,$reqcrsdom,$reqinstcode) = @_;
       my (%courses,%showcourses,$cloner);
       if (($filter->{'ownerfilter'} ne '') ||
           ($filter->{'ownerdomfilter'} ne '')) {
           $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                                          $filter->{'ownerdomfilter'};
       }
       foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
           if (!$filter->{$item}) {
               $filter->{$item}='.';
           }
       }
       my $now = time;
       my $timefilter =
          ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
       my ($createdbefore,$createdafter);
       if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
           $createdbefore = $now;
           $createdafter = $now-$filter->{'createdfilter'};
       }
       my ($instcodefilter,$regexpok);
       if ($numtitles) {
           if ($env{'form.official'} eq 'on') {
               $instcodefilter =
                   &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
               $regexpok = 1;
           } elsif ($env{'form.official'} eq 'off') {
               $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
               unless ($instcodefilter eq '') {
                   $regexpok = -1;
               }
           }
       } else {
           $instcodefilter = $filter->{'instcodefilter'};
       }
       if ($instcodefilter eq '') { $instcodefilter = '.'; }
       if ($type eq '') { $type = '.'; }
   
       if (($clonerudom ne '') && ($cloneruname ne '')) {
           $cloner = $cloneruname.':'.$clonerudom;
       }
       %courses = &Apache::lonnet::courseiddump($dom,
                                                $filter->{'descriptfilter'},
                                                $timefilter,
                                                $instcodefilter,
                                                $filter->{'combownerfilter'},
                                                $filter->{'coursefilter'},
                                                undef,undef,$type,$regexpok,undef,undef,
                                                undef,undef,$cloner,$cc_clone,
                                                $filter->{'cloneableonly'},
                                                $createdbefore,$createdafter,undef,
                                                $domcloner,undef,$reqcrsdom,$reqinstcode);
       if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
           my $ccrole;
           if ($type eq 'Community') {
               $ccrole = 'co';
           } else {
               $ccrole = 'cc';
           }
           my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                                                        $filter->{'persondomfilter'},
                                                        'userroles',undef,
                                                        [$ccrole,'in','ad','ep','ta','cr'],
                                                        $dom);
           foreach my $role (keys(%rolehash)) {
               my ($cnum,$cdom,$courserole) = split(':',$role);
               my $cid = $cdom.'_'.$cnum;
               if (exists($courses{$cid})) {
                   if (ref($courses{$cid}) eq 'HASH') {
                       if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                           if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                               push(@{$courses{$cid}{roles}},$courserole);
                           }
                       } else {
                           $courses{$cid}{roles} = [$courserole];
                       }
                       $showcourses{$cid} = $courses{$cid};
                   }
               }
           }
           %courses = %showcourses;
       }
       return %courses;
   }
   
   =pod
   
   =back
   
   =head1 Routines for version requirements for current course.
   
   =over 4
   
   =item * &check_release_required()
   
   Compares required LON-CAPA version with version on server, and
   if required version is newer looks for a server with the required version.
   
   Looks first at servers in user's owen domain; if none suitable, looks at
   servers in course's domain are permitted to host sessions for user's domain.
   
   Inputs:
   
   $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
   
   $courseid - Course ID of current course
   
   $rolecode - User's current role in course (for switchserver query string).
   
   $required - LON-CAPA version needed by course (format: Major.Minor).
   
   
   Returns:
   
   $switchserver - query string tp append to /adm/switchserver call (if
                   current server's LON-CAPA version is too old.
   
   $warning - Message is displayed if no suitable server could be found.
   
   =cut
   
   sub check_release_required {
       my ($loncaparev,$courseid,$rolecode,$required) = @_;
       my ($switchserver,$warning);
       if ($required ne '') {
           my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
           my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
           if ($reqdmajor ne '' && $reqdminor ne '') {
               my $otherserver;
               if (($major eq '' && $minor eq '') ||
                   (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   my $switchlcrev =
                       &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                                                              $userdomserver);
                   my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                       (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                       my $cdom = $env{'course.'.$courseid.'.domain'};
                       if ($cdom ne $env{'user.domain'}) {
                           my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                           my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                           my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                           my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                           my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                           my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                           my $canhost =
                               &Apache::lonnet::can_host_session($env{'user.domain'},
                                                                 $coursedomserver,
                                                                 $remoterev,
                                                                 $udomdefaults{'remotesessions'},
                                                                 $defdomdefaults{'hostedsessions'});
   
                           if ($canhost) {
                               $otherserver = $coursedomserver;
                           } else {
                               $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
                           }
                       } else {
                           $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
                       }
                   } else {
                       $otherserver = $userdomserver;
                   }
               }
               if ($otherserver ne '') {
                   $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
               }
           }
       }
       return ($switchserver,$warning);
   }
   
   =pod
   
   =item * &check_release_result()
   
   Inputs:
   
   $switchwarning - Warning message if no suitable server found to host session.
   
   $switchserver - query string to append to /adm/switchserver containing lonHostID
                   and current role.
   
   Returns: HTML to display with information about requirement to switch server.
            Either displaying warning with link to Roles/Courses screen or
            display link to switchserver.
   
   =cut
   
   sub check_release_result {
       my ($switchwarning,$switchserver) = @_;
       my $output = &start_page('Selected course unavailable on this server').
                    '<p class="LC_warning">';
       if ($switchwarning) {
           $output .= $switchwarning.'<br /><a href="/adm/roles">';
           if (&show_course()) {
               $output .= &mt('Display courses');
           } else {
               $output .= &mt('Display roles');
           }
           $output .= '</a>';
       } elsif ($switchserver) {
           $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                      '<br />'.
                      '<a href="/adm/switchserver?'.$switchserver.'">'.
                      &mt('Switch Server').
                      '</a>';
       }
       $output .= '</p>'.&end_page();
       return $output;
   }
   
 =pod  =pod
   
   =item * &needs_coursereinit()
   
   Determine if course contents stored for user's session needs to be
   refreshed, because content has changed since "Big Hash" last tied.
   
   Check for change is made if time last checked is more than 10 minutes ago
   (by default).
   
   Inputs:
   
   $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
   
   $interval (optional) - Time which may elapse (in s) between last check for content
                          change in current course. (default: 600 s).
   
   Returns: an array; first element is:
   
   =over 4
   
   'switch' - if content updates mean user's session
              needs to be switched to a server running a newer LON-CAPA version
   
   'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
              on current server hosting user's session
   
   ''       - if no action required.
   
   =back
   
   If first item element is 'switch':
   
   second item is $switchwarning - Warning message if no suitable server found to host session.
   
   third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                                 and current role.
   
   otherwise: no other elements returned.
   
 =back  =back
   
 =cut  =cut
   
   sub needs_coursereinit {
       my ($loncaparev,$interval) = @_;
       return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       my $now = time;
       if ($interval eq '') {
           $interval = 600;
       }
       if (($now-$env{'request.course.timechecked'})>$interval) {
           my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
           &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
           if ($lastchange > $env{'request.course.tied'}) {
               my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
               if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                       &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                                                $curr_reqd_hash{'internal.releaserequired'}});
                       my ($switchserver,$switchwarning) =
                           &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                                                   $curr_reqd_hash{'internal.releaserequired'});
                       if ($switchwarning ne '' || $switchserver ne '') {
                           return ('switch',$switchwarning,$switchserver);
                       }
                   }
               }
               return ('update');
           }
       }
       return ();
   }
   
   sub update_content_constraints {
       my ($cdom,$cnum,$chome,$cid) = @_;
       my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
       my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
       my %checkresponsetypes;
       foreach my $key (keys(%Apache::lonnet::needsrelease)) {
           my ($item,$name,$value) = split(/:/,$key);
           if ($item eq 'resourcetag') {
               if ($name eq 'responsetype') {
                   $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
               }
           }
       }
       my $navmap = Apache::lonnavmaps::navmap->new();
       if (defined($navmap)) {
           my %allresponses;
           foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
               my %responses = $res->responseTypes();
               foreach my $key (keys(%responses)) {
                   next unless(exists($checkresponsetypes{$key}));
                   $allresponses{$key} += $responses{$key};
               }
           }
           foreach my $key (keys(%allresponses)) {
               my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
               if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   ($reqdmajor,$reqdminor) = ($major,$minor);
               }
           }
           undef($navmap);
       }
       unless (($reqdmajor eq '') && ($reqdminor eq '')) {
           &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
       }
       return;
   }
   
   sub allmaps_incourse {
       my ($cdom,$cnum,$chome,$cid) = @_;
       if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
           $cid = $env{'request.course.id'};
           $cdom = $env{'course.'.$cid.'.domain'};
           $cnum = $env{'course.'.$cid.'.num'};
           $chome = $env{'course.'.$cid.'.home'};
       }
       my %allmaps = ();
       my $lastchange =
           &Apache::lonnet::get_coursechange($cdom,$cnum);
       if ($lastchange > $env{'request.course.tied'}) {
           my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
           unless ($ferr) {
               &update_content_constraints($cdom,$cnum,$chome,$cid);
           }
       }
       my $navmap = Apache::lonnavmaps::navmap->new();
       if (defined($navmap)) {
           foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
               $allmaps{$res->src()} = 1;
           }
       }
       return \%allmaps;
   }
   
   sub parse_supplemental_title {
       my ($title) = @_;
   
       my ($foldertitle,$renametitle);
       if ($title =~ /&amp;&amp;&amp;/) {
           $title = &HTML::Entites::decode($title);
       }
       if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
           $renametitle=$4;
           my ($time,$uname,$udom) = ($1,$2,$3);
           $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
           my $name =  &plainname($uname,$udom);
           $name = &HTML::Entities::encode($name,'"<>&\'');
           $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
           $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
               $name.': <br />'.$foldertitle;
       }
       if (wantarray) {
           return ($title,$foldertitle,$renametitle);
       }
       return $title;
   }
   
   sub recurse_supplemental {
       my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
       if ($suppmap) {
           my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
           if ($fatal) {
               $errors ++;
           } else {
               if ($#LONCAPA::map::resources > 0) {
                   foreach my $res (@LONCAPA::map::resources) {
                       my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                       if (($src ne '') && ($status eq 'res')) {
                           if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                               ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
                           } else {
                               $numfiles ++;
                           }
                       }
                   }
               }
           }
       }
       return ($numfiles,$errors);
   }
   
   sub symb_to_docspath {
       my ($symb,$navmapref) = @_;
       return unless ($symb && ref($navmapref));
       my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
       if ($resurl=~/\.(sequence|page)$/) {
           $mapurl=$resurl;
       } elsif ($resurl eq 'adm/navmaps') {
           $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
       }
       my $mapresobj;
       unless (ref($$navmapref)) {
           $$navmapref = Apache::lonnavmaps::navmap->new();
       }
       if (ref($$navmapref)) {
           $mapresobj = $$navmapref->getResourceByUrl($mapurl);
       }
       $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
       my $type=$2;
       my $path;
       if (ref($mapresobj)) {
           my $pcslist = $mapresobj->map_hierarchy();
           if ($pcslist ne '') {
               foreach my $pc (split(/,/,$pcslist)) {
                   next if ($pc <= 1);
                   my $res = $$navmapref->getByMapPc($pc);
                   if (ref($res)) {
                       my $thisurl = $res->src();
                       $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                       my $thistitle = $res->title();
                       $path .= '&'.
                                &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
                                &escape($thistitle).
                                ':'.$res->randompick().
                                ':'.$res->randomout().
                                ':'.$res->encrypted().
                                ':'.$res->randomorder().
                                ':'.$res->is_page();
                   }
               }
           }
           $path =~ s/^\&//;
           my $maptitle = $mapresobj->title();
           if ($mapurl eq 'default') {
               $maptitle = 'Main Content';
           }
           $path .= (($path ne '')? '&' : '').
                    &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                    &escape($maptitle).
                    ':'.$mapresobj->randompick().
                    ':'.$mapresobj->randomout().
                    ':'.$mapresobj->encrypted().
                    ':'.$mapresobj->randomorder().
                    ':'.$mapresobj->is_page();
       } else {
           my $maptitle = &Apache::lonnet::gettitle($mapurl);
           my $ispage = (($type eq 'page')? 1 : '');
           if ($mapurl eq 'default') {
               $maptitle = 'Main Content';
           }
           $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   &escape($maptitle).':::::'.$ispage;
       }
       unless ($mapurl eq 'default') {
           $path = 'default&'.
                   &escape('Main Content').
                   ':::::&'.$path;
       }
       return $path;
   }
   
   sub captcha_display {
       my ($context,$lonhost) = @_;
       my ($output,$error);
       my ($captcha,$pubkey,$privkey,$version) =
           &get_captcha_config($context,$lonhost);
       if ($captcha eq 'original') {
           $output = &create_captcha();
           unless ($output) {
               $error = 'captcha';
           }
       } elsif ($captcha eq 'recaptcha') {
           $output = &create_recaptcha($pubkey,$version);
           unless ($output) {
               $error = 'recaptcha';
           }
       }
       return ($output,$error,$captcha,$version);
   }
   
   sub captcha_response {
       my ($context,$lonhost) = @_;
       my ($captcha_chk,$captcha_error);
       my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
       if ($captcha eq 'original') {
           ($captcha_chk,$captcha_error) = &check_captcha();
       } elsif ($captcha eq 'recaptcha') {
           $captcha_chk = &check_recaptcha($privkey,$version);
       } else {
           $captcha_chk = 1;
       }
       return ($captcha_chk,$captcha_error);
   }
   
   sub get_captcha_config {
       my ($context,$lonhost) = @_;
       my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
       my $hostname = &Apache::lonnet::hostname($lonhost);
       my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
       my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
       if ($context eq 'usercreation') {
           my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
           if (ref($domconfig{$context}) eq 'HASH') {
               $hashtocheck = $domconfig{$context}{'cancreate'};
               if (ref($hashtocheck) eq 'HASH') {
                   if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                       if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                           $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                           $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                       }
                       if ($privkey && $pubkey) {
                           $captcha = 'recaptcha';
                           $version = $hashtocheck->{'recaptchaversion'};
                           if ($version ne '2') {
                               $version = 1;
                           }
                       } else {
                           $captcha = 'original';
                       }
                   } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                       $captcha = 'original';
                   }
               }
           } else {
               $captcha = 'captcha';
           }
       } elsif ($context eq 'login') {
           my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
           if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
               $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
               $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
               if ($privkey && $pubkey) {
                   $captcha = 'recaptcha';
                   $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   if ($version ne '2') {
                       $version = 1;
                   }
               } else {
                   $captcha = 'original';
               }
           } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
               $captcha = 'original';
           }
       }
       return ($captcha,$pubkey,$privkey,$version);
   }
   
   sub create_captcha {
       my %captcha_params = &captcha_settings();
       my ($output,$maxtries,$tries) = ('',10,0);
       while ($tries < $maxtries) {
           $tries ++;
           my $captcha = Authen::Captcha->new (
                                              output_folder => $captcha_params{'output_dir'},
                                              data_folder   => $captcha_params{'db_dir'},
                                             );
           my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
   
           if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
               $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                         &mt('Type in the letters/numbers shown below').'&nbsp;'.
                         '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                         '<br />'.
                         '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
               last;
           }
       }
       return $output;
   }
   
   sub captcha_settings {
       my %captcha_params = (
                              output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                              www_output_dir => "/captchaspool",
                              db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                              numchars       => '5',
                            );
       return %captcha_params;
   }
   
   sub check_captcha {
       my ($captcha_chk,$captcha_error);
       my $code = $env{'form.code'};
       my $md5sum = $env{'form.crypt'};
       my %captcha_params = &captcha_settings();
       my $captcha = Authen::Captcha->new(
                         output_folder => $captcha_params{'output_dir'},
                         data_folder   => $captcha_params{'db_dir'},
                     );
       $captcha_chk = $captcha->check_code($code,$md5sum);
       my %captcha_hash = (
                           0       => 'Code not checked (file error)',
                          -1      => 'Failed: code expired',
                          -2      => 'Failed: invalid code (not in database)',
                          -3      => 'Failed: invalid code (code does not match crypt)',
       );
       if ($captcha_chk != 1) {
           $captcha_error = $captcha_hash{$captcha_chk}
       }
       return ($captcha_chk,$captcha_error);
   }
   
   sub create_recaptcha {
       my ($pubkey,$version) = @_;
       if ($version >= 2) {
           return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
       } else {
           my $use_ssl;
           if ($ENV{'SERVER_PORT'} == 443) {
               $use_ssl = 1;
           }
           my $captcha = Captcha::reCAPTCHA->new;
           return $captcha->get_options_setter({theme => 'white'})."\n".
                  $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 {
       my ($privkey,$version) = @_;
       my $captcha_chk;
       if ($version >= 2) {
           my $ua = LWP::UserAgent->new;
           $ua->timeout(10);
           my %info = (
                        secret   => $privkey,
                        response => $env{'form.g-recaptcha-response'},
                        remoteip => $ENV{'REMOTE_ADDR'},
                      );
           my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
           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;
   }
   
   sub emailusername_info {
       my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
       my %titles = &Apache::lonlocal::texthash (
                        lastname      => 'Last Name',
                        firstname     => 'First Name',
                        institution   => 'School/college/university',
                        location      => "School's city, state/province, country",
                        web           => "School's web address",
                        officialemail => 'E-mail address at institution (if different)',
                        id            => 'Student/Employee ID',
                    );
       return (\@fields,\%titles);
   }
   
   sub cleanup_html {
       my ($incoming) = @_;
       my $outgoing;
       if ($incoming ne '') {
           $outgoing = $incoming;
           $outgoing =~ s/;/&#059;/g;
           $outgoing =~ s/\#/&#035;/g;
           $outgoing =~ s/\&/&#038;/g;
           $outgoing =~ s/</&#060;/g;
           $outgoing =~ s/>/&#062;/g;
           $outgoing =~ s/\(/&#040/g;
           $outgoing =~ s/\)/&#041;/g;
           $outgoing =~ s/"/&#034;/g;
           $outgoing =~ s/'/&#039;/g;
           $outgoing =~ s/\$/&#036;/g;
           $outgoing =~ s{/}{&#047;}g;
           $outgoing =~ s/=/&#061;/g;
           $outgoing =~ s/\\/&#092;/g
       }
       return $outgoing;
   }
   
   # Checks for critical messages and returns a redirect url if one exists.
   # $interval indicates how often to check for messages.
   sub critical_redirect {
       my ($interval) = @_;
       if ((time-$env{'user.criticalcheck.time'})>$interval) {
           my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                                           $env{'user.name'});
           &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
           my $redirecturl;
           if ($what[0]) {
               if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   $redirecturl='/adm/email?critical=display';
                   my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   return (1, $url);
               }
           }
       }
       return ();
   }
   
   # Use:
   #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
   #
   ##################################################
   #          password associated functions         #
   ##################################################
   sub des_keys {
       # Make a new key for DES encryption.
       # Each key has two parts which are returned separately.
       # Please note:  Each key must be passed through the &hex function
       # before it is output to the web browser.  The hex versions cannot
       # be used to decrypt.
       my @hexstr=('0','1','2','3','4','5','6','7',
                   '8','9','a','b','c','d','e','f');
       my $lkey='';
       for (0..7) {
           $lkey.=$hexstr[rand(15)];
       }
       my $ukey='';
       for (0..7) {
           $ukey.=$hexstr[rand(15)];
       }
       return ($lkey,$ukey);
   }
   
   sub des_decrypt {
       my ($key,$cyphertext) = @_;
       my $keybin=pack("H16",$key);
       my $cypher;
       if ($Crypt::DES::VERSION>=2.03) {
           $cypher=new Crypt::DES $keybin;
       } else {
           $cypher=new DES $keybin;
       }
       my $plaintext='';
       my $cypherlength = length($cyphertext);
       my $numchunks = int($cypherlength/32);
       for (my $j=0; $j<$numchunks; $j++) {
           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;
   }
   
 1;  1;
 __END__;  __END__;
   
Removed from v.1.989  
changed lines
  Added in v.1.1075.2.134

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