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

Diff for /loncom/interface/loncommon.pm between versions 1.1062 and 1.1075.2.95

version 1.1062, 2012/03/31 23:10:39 version 1.1075.2.95, 2015/05/22 17:33:11
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::Catalog;
   use Encode();
   use Authen::Captcha;
   use Captcha::reCAPTCHA;
   use Crypt::DES;
   use DynaLoader; # for Crypt::DES version
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);  use vars qw(%defaultdesign);
Line 524  ENDAUTHORBRW Line 532  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 574  sub coursebrowser_javascript { Line 583  sub coursebrowser_javascript {
         if (formname == 'ccrs') {          if (formname == 'ccrs') {
             var ownername = document.forms[formid].ccuname.value;              var ownername = document.forms[formid].ccuname.value;
             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;              var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
             url += '&cloner='+ownername+':'+ownerdom;              url += '&cloner='+ownername+':'+ownerdom+'&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 587  sub coursebrowser_javascript { Line 599  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 745  ENDUSERBRW Line 758  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 840  function setRole(crstype) { Line 853  function setRole(crstype) {
 }  }
 |;  |;
     }      }
       if ($credits_element) {
           $setsections .= qq|
   function setCredits(defaultcredits) {
       document.$formname.$credits_element.value = defaultcredits;
       return;
   }
   |;
       }
     return $setsections;      return $setsections;
 }  }
   
Line 885  sub check_uncheck_jscript { Line 906  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 959  sub select_datelocale { Line 984  sub select_datelocale {
                         $locale_names{$id} = '('.$en_terr.')';                          $locale_names{$id} = '('.$en_terr.')';
                     }                      }
                 }                  }
                   $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
                 push (@possibles,$id);                  push (@possibles,$id);
             }              }
         }          }
Line 970  sub select_datelocale { Line 996  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 990  sub select_language { Line 1016  sub select_language {
             $langchoices{$code} = &plainlanguagedescription($id);              $langchoices{$code} = &plainlanguagedescription($id);
         }          }
     }      }
       %langchoices = &Apache::lonlocal::texthash(%langchoices);
     return &select_form($selected,$name,\%langchoices);      return &select_form($selected,$name,\%langchoices);
 }  }
   
Line 1021  linked_select_forms takes the following Line 1048  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 1074  sub linked_select_forms { Line 1107  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 1130  function select1_changed() { Line 1165  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 1143  END Line 1178  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 1203  sub help_open_topic { Line 1242  sub help_open_topic {
     $topic=~s/\W/\_/g;      $topic=~s/\W/\_/g;
   
     if (!$stayOnPage) {      if (!$stayOnPage) {
  $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'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') {      } elsif ($stayOnPage eq 'popup') {
         $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";          $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
     } else {      } else {
Line 1254  sub helpLatexCheatsheet { Line 1297  sub helpLatexCheatsheet {
     unless ($not_author) {      unless ($not_author) {
         $out .= ' <span>'          $out .= ' <span>'
        .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)         .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
        .'</span>';         .'</span> <span>'
                  .&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 1317  sub help_open_menu { Line 1362  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 1374  function helpMenu(target) { Line 1427  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 1688  RESIZE Line 1742  RESIZE
   
 =head1 Excel and CSV file utility routines  =head1 Excel and CSV file utility routines
   
 =over 4  
   
 =cut  =cut
   
 ###############################################################  ###############################################################
Line 1697  RESIZE Line 1749  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 1981  sub select_form { Line 2035  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 2037  sub select_level_form { Line 2184  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)
   
 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 2050  If the $showdomdesc flag is set, the dom Line 2197  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. 
   
 =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) = @_;
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
     }      }
     my @domains;      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); }
       if (ref($excdoms) eq 'ARRAY') {
           map { $exclude{$_} = 1; } @{$excdoms};
       }
     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";      my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\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 2189  Outputs: Line 2342  Outputs:
   
 =item * $clientos  =item * $clientos
   
   =item * $clientmobile
   
   =item * $clientinfo
   
   =item * $clientosversion
   
 =back  =back
   
 =back   =back 
Line 2207  sub decode_user_agent { Line 2366  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 2218  sub decode_user_agent { Line 2379  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 2227  sub decode_user_agent { Line 2389  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 2382  END Line 2558  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 2391  sub authform_authorwarning{ Line 2567  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 2420  sub authform_kerberos { Line 2596  sub authform_kerberos {
               );                );
     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,      my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
         $autharg,$jscall);          $autharg,$jscall);
     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 {
Line 2470  sub authform_kerberos { Line 2646  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" />';
                 }                  }
             }              }
         }          }
Line 2482  sub authform_kerberos { Line 2658  sub authform_kerberos {
                     $krbcheck.' />';                      $krbcheck.' />';
     }      }
     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 2520  sub authform_kerberos { Line 2696  sub authform_kerberos {
     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);
     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     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 2556  sub authform_internal{ Line 2732  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" />';
                 }                  }
             }              }
         }          }
Line 2575  sub authform_internal{ Line 2751  sub authform_internal{
     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);
     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     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 2611  sub authform_local{ Line 2787  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" />';
                 }                  }
             }              }
         }          }
Line 2629  sub authform_local{ Line 2805  sub authform_local{
     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);
     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     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 2662  sub authform_filesystem{ Line 2838  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" />';
                 }                  }
             }              }
         }          }
Line 3090  sub screenname { Line 3266  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 3129  sub noteswrapper { Line 3305  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 3506  sub user_lang { Line 3682  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 3528  Return string with previous attempt on p Line 3704  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 3535  The output string is a table containing Line 3716  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 3545  sub get_previous_attempt { Line 3726  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 3568  sub get_previous_attempt { Line 3754  sub get_previous_attempt {
                       $lasthidden{$ign.'.'.$id} = 1;                        $lasthidden{$ign.'.'.$id} = 1;
                   }                    }
               }                }
                 if ($identifier ne '') {
                     my $id = join(',',@parts);
                     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) {
Line 3579  sub get_previous_attempt { Line 3777  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 3611  sub get_previous_attempt { Line 3852  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 3622  sub get_previous_attempt { Line 3869  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 3990  sub findallcourses { Line 4243  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 4076  sub findallcourses { Line 4327  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$uname,$udom,$url) = @_;      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 ($startblock,$endblock,$triggerblock) =   
             &get_blocks($setters,$activity,$udom,$uname,$url);  
         return ($startblock,$endblock,$triggerblock);  
     }  
   
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
     my $triggerblock = '';      my $triggerblock = '';
Line 4102  sub blockcheck { Line 4350  sub blockcheck {
     # boards, chat or groups, check for blocking in current course only.      # boards, chat or groups, check for blocking in current course only.
   
     if (($activity eq 'boards' || $activity eq 'chat' ||      if (($activity eq 'boards' || $activity eq 'chat' ||
          $activity eq 'groups') && ($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 4366  sub parse_block_record { Line 4615  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
     my ($activity,$uname,$udom,$url) = @_;      my ($activity,$uname,$udom,$url,$is_course) = @_;
     my %setters;      my %setters;
   
 # check for active blocking  # check for active blocking
     my ($startblock,$endblock,$triggerblock) =       my ($startblock,$endblock,$triggerblock) = 
         &blockcheck(\%setters,$activity,$uname,$udom,$url);          &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
     my $blocked = 0;      my $blocked = 0;
     if ($startblock && $endblock) {      if ($startblock && $endblock) {
         $blocked = 1;          $blocked = 1;
Line 4404  END_MYBLOCK Line 4653  END_MYBLOCK
       
     my $popupUrl = "/adm/blockingstatus/$querystring";      my $popupUrl = "/adm/blockingstatus/$querystring";
     my $text = &mt('Communication Blocked');      my $text = &mt('Communication Blocked');
       my $class = 'LC_comblock';
     if ($activity eq 'docs') {      if ($activity eq 'docs') {
         $text = &mt('Content Access Blocked');          $text = &mt('Content Access Blocked');
           $class = '';
       } elsif ($activity eq 'printout') {
           $text = &mt('Printing Blocked');
     }      }
   
     $output .= <<"END_BLOCK";      $output .= <<"END_BLOCK";
 <div class='LC_comblock'>  <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 4527  sub get_domainconf { Line 4779  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') {
                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {                                  foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {                                      if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {                                          if ($key eq 'loginvia') {
                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};                                              if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                                             $designhash{$udom.'.login.loginvia'} = $server;                                                  my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {                                                  $designhash{$udom.'.login.loginvia'} = $server;
                                                   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 4709  sub designparm { Line 4966  sub designparm {
   
 Inputs: $url (usually will be undef).  Inputs: $url (usually will be undef).
   
 Returns: Path to Construction Space containing the resource or   Returns: Path to Authoring Space containing the resource or 
          directory being viewed (or for which action is being taken).            directory being viewed (or for which action is being taken). 
          If $url is provided, and begins /priv/<domain>/<uname>           If $url is provided, and begins /priv/<domain>/<uname>
          the path will be that portion of the $context argument.           the path will be that portion of the $context argument.
Line 4772  Input: (optional) filename from which br Line 5029  Input: (optional) filename from which br
        is appropriate for use in building the breadcrumb trail.         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
   
Line 4787  sub CSTR_pageheader { Line 5044  sub CSTR_pageheader {
   
     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     my ($udom,$uname,$thisdisfn)=      my ($udom,$uname,$thisdisfn)=
         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});          ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
     my $formaction = "/priv/$udom/$uname/$thisdisfn";      my $formaction = "/priv/$udom/$uname/$thisdisfn";
     $formaction =~ s{/+}{/}g;      $formaction =~ s{/+}{/}g;
   
Line 4803  sub CSTR_pageheader { Line 5060  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/'.$udom,undef,undef);          .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
Line 4862  Inputs: Line 5119  Inputs:
   
 =item * $bgcolor, used to override the bgcolor on a webpage to a specific value  =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
   
   =item * $no_inline_link, if true and in remote mode, don't show the
            'Switch To Inline Menu' link
   
 =item * $args, optional argument valid values are  =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg              no_auto_mt_title -> prevents &mt()ing the title arg
             inherit_jsmath -> when creating popup window in a page,              inherit_jsmath -> when creating popup window in a page,
                               should it have jsmath forced on by the                                should it have jsmath forced on by the
                               current page                                current page
   
   =item * $advtoolsref, optional argument, ref to an array containing
               inlineremote items to be added in "Functions" menu below
               breadcrumbs.
   
 =back  =back
   
 Returns: A uniform header for LON-CAPA web pages.    Returns: A uniform header for LON-CAPA web pages.  
Line 4879  other decorations will be returned. Line 5143  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 4887  sub bodytag { Line 5151  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'};
   
     $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 4902  sub bodytag { Line 5167  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 4928  sub bodytag { Line 5196  sub bodytag {
     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($args->{'inherit_jsmath'});
   
     if ($bodyonly) {      &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
   
       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 4952  sub bodytag { Line 5219  sub bodytag {
     }      }
   
     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;      $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);  
   
         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'});
             } elsif ($forcereg) {               } elsif ($forcereg) { 
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                               $args->{'group'});
               } else {
                   my $forbodytag;
                   &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                                       $forcereg,$args->{'group'},
                                                       $args->{'bread_crumbs'},
                                                       $advtoolsref,'',\$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 5008  sub bodytag { Line 5300  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 5039  sub make_attr_string { Line 5379  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 5070  i.e., $env{'internal.head.redirect'} exi Line 5417  i.e., $env{'internal.head.redirect'} exi
   
 sub endbodytag {  sub endbodytag {
     my ($args) = @_;      my ($args) = @_;
     my $endbodytag='</body>';      my $endbodytag;
       unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
           $endbodytag='</body>';
       }
     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;      $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
     if ( exists( $env{'internal.head.redirect'} ) ) {      if ( exists( $env{'internal.head.redirect'} ) ) {
         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {          if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
Line 5172  form, .inline { Line 5522  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 5210  form, .inline { Line 5568  form, .inline {
   
 .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 5376  td.LC_table_cell_checkbox { Line 5736  td.LC_table_cell_checkbox {
   text-align: left;    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;    text-align: left;
 }  }
Line 5513  table.LC_nested tr.LC_empty_row td { Line 5873  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 6075  div.LC_docs_entry_move { Line 6436  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 6240  div.LC_edit_problem_saves { Line 6600  div.LC_edit_problem_saves {
   padding-bottom: 5px;    padding-bottom: 5px;
 }  }
   
   .LC_edit_opt {
     padding-left: 1em;
     white-space: nowrap;
   }
   
   .LC_edit_problem_latexhelper{
       text-align: right;
   }
   
   #LC_edit_problem_colorful div{
       margin-left: 40px;
   }
   
 img.stift {  img.stift {
   border-width: 0;    border-width: 0;
   vertical-align: middle;    vertical-align: middle;
Line 6254  div.LC_createcourse { Line 6627  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%;
Line 6326  fieldset { Line 6700  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 6351  fieldset > legend { Line 6729  fieldset > legend {
 }  }
   
 ol.LC_primary_menu {  ol.LC_primary_menu {
   float: right;  
   margin: 0;    margin: 0;
     padding: 0;
   background-color: $pgbg_or_bgcolor;    background-color: $pgbg_or_bgcolor;
 }  }
   
Line 6361  ol#LC_PathBreadcrumbs { Line 6739  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;
     float: left;
   }
   
   ol.LC_primary_menu li a {
     display: block;
     margin: 0;
     padding: 0 5px 0 10px;
     text-decoration: none;
   }
   
   ol.LC_primary_menu li ul {
     display: none;
     width: 10em;
     background-color: $data_table_light;
   }
   
   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 {
     font-size: 90%;
   vertical-align: top;    vertical-align: top;
     float: none;
     border-left: 1px solid black;
     border-right: 1px solid black;
   }
   
   ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
     background-color:$data_table_light;
   }
   
   ol.LC_primary_menu li li a:hover {
      color:$button_hover;
      background-color:$data_table_dark;
 }  }
   
 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 6406  ol.LC_docs_parameters li.LC_docs_paramet Line 6825  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;
Line 6414  ul#LC_secondary_menu { Line 6833  ul#LC_secondary_menu {
   margin: 0;    margin: 0;
   width: 100%;    width: 100%;
   text-align: left;    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;
   padding: 0 0.8em;  
   border-right: 1px solid black;    border-right: 1px solid black;
   display: inline;  
   vertical-align: middle;    vertical-align: middle;
     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;
   }
   
   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;
     background-color: $data_table_light;
     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 6762  ul#LC_toolbar { Line 7219  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 6771  ul#LC_toolbar li { Line 7229  ul#LC_toolbar li {
   float: left;    float: left;
   display:inline;    display:inline;
   vertical-align:middle;    vertical-align:middle;
     white-space: nowrap;
 }  }
   
   
Line 6867  ul.LC_funclist li { Line 7326  ul.LC_funclist li {
  cursor:pointer;   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;}
   
 END  END
 }  }
   
Line 6903  sub headtag { Line 7383  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 6913  sub headtag { Line 7394  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.=&modal_window();
         $result.=&togglebox_script();          $result.=&togglebox_script();
         $result.=&wishlist_window();          $result.=&wishlist_window();
Line 6953  sub headtag { Line 7439  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;
                                       }
                                   }
                                   $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;
       if ($env{'browser.mobile'}) {
           $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" />';
       }
     return $result.'</head>';      return $result.'</head>';
 }  }
   
Line 6970  ADDMETA Line 7541  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 6994  Inputs: none Line 7647  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 7005  sub xml_begin { Line 7659  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 7051  $args - additional optional args support Line 7708  $args - additional optional args support
              skip_phases    -> hash ref of                skip_phases    -> hash ref of 
                                     head -> skip the <html><head> generation                                      head -> skip the <html><head> generation
                                     body -> skip all <body> generation                                      body -> skip all <body> generation
                no_inline_link -> if true and in remote mode, don't show the
                                       'Switch To Inline Menu' link
              no_auto_mt_title -> prevent &mt()ing the title arg               no_auto_mt_title -> prevent &mt()ing the title arg
              inherit_jsmath -> when creating popup window in a page,               inherit_jsmath -> when creating popup window in a page,
                                     should it have jsmath forced on by the                                      should it have jsmath forced on by the
                                     current page                                      current page
              bread_crumbs ->             Array containing breadcrumbs               bread_crumbs ->             Array containing breadcrumbs
              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs               bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
                group          -> includes the current group, if page is for a
                                  specific group
   
 =back  =back
   
Line 7069  sub start_page { Line 7730  sub start_page {
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));      #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
   
     $env{'internal.start_page'}++;      $env{'internal.start_page'}++;
     my $result;      my ($result,@advtools);
   
     if (! exists($args->{'skip_phases'}{'head'}) ) {      if (! exists($args->{'skip_phases'}{'head'}) ) {
         $result .= &xml_begin() . &headtag($title, $head_extra, $args);          $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
     }      }
           
     if (! exists($args->{'skip_phases'}{'body'}) ) {      if (! exists($args->{'skip_phases'}{'body'}) ) {
Line 7086  sub start_page { Line 7747  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 7115  sub start_page { Line 7777  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);
                   }
   
  #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'})){
Line 7122  sub start_page { Line 7788  sub start_page {
  }else{   }else{
  $result .= &Apache::lonhtmlcommon::breadcrumbs();   $result .= &Apache::lonhtmlcommon::breadcrumbs();
  }   }
       } 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 7143  sub end_page { Line 7814  sub end_page {
     } 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 7166  function set_wishlistlink(title, path) { Line 7839  function set_wishlistlink(title, path) {
         title = document.title;          title = document.title;
         title = title.replace(/^LON-CAPA /,'');          title = title.replace(/^LON-CAPA /,'');
     }      }
       title = encodeURIComponent(title);
       title = title.replace("'","\\\'");
     if (!path) {      if (!path) {
         path = location.pathname;          path = location.pathname;
     }      }
       path = encodeURIComponent(path);
       path = path.replace("'","\\\'");
     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,      Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                       'wishlistNewLink','width=560,height=350,scrollbars=0');                        'wishlistNewLink','width=560,height=350,scrollbars=0');
 }  }
Line 7209  var modalWindow = { Line 7886  var modalWindow = {
  $(".LCmodal-overlay").click(function(){modalWindow.close();});   $(".LCmodal-overlay").click(function(){modalWindow.close();});
  }   }
 };  };
  var openMyModal = function(source,width,height,scrolling)   var openMyModal = function(source,width,height,scrolling,transparency,style)
  {   {
                   source = source.replace("'","&#39;");
  modalWindow.windowId = "myModal";   modalWindow.windowId = "myModal";
  modalWindow.width = width;   modalWindow.width = width;
  modalWindow.height = height;   modalWindow.height = height;
  modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";   modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
  modalWindow.open();   modalWindow.open();
  };   };
 // END LON-CAPA Internal -->  // END LON-CAPA Internal -->
 // ]]>  // ]]>
 </script>  </script>
Line 7224  ENDMODAL Line 7902  ENDMODAL
 }  }
   
 sub modal_link {  sub modal_link {
     my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;      my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
     unless ($width) { $width=480; }      unless ($width) { $width=480; }
     unless ($height) { $height=400; }      unless ($height) { $height=400; }
     unless ($scrolling) { $scrolling='yes'; }      unless ($scrolling) { $scrolling='yes'; }
     return '<a href="'.$link.'" target="'.$target.'" title="'.$title.'" onclick="openMyModal(\''.$link.'\','.$width.','.$height.',\''.$scrolling.'\'); return false;">'.      unless ($transparency) { $transparency='true'; }
            $linktext.'</a>';  
       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 {  sub modal_adhoc_script {
Line 7255  sub modal_adhoc_inner { Line 7941  sub modal_adhoc_inner {
     my $innerwidth=$width-20;      my $innerwidth=$width-20;
     $content=&js_ready(      $content=&js_ready(
                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).                 &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').                   &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                     $content.                   $content.
                  &end_scrollbox().                   &end_scrollbox().
                &end_page()                   &end_page()
              );               );
     return &modal_adhoc_script($funcname,$width,$height,$content);      return &modal_adhoc_script($funcname,$width,$height,$content);
 }  }
Line 7377  sub LCprogressbar { Line 8063  sub LCprogressbar {
     $LCcurrentid=$$.'_'.$LCidcnt;      $LCcurrentid=$$.'_'.$LCidcnt;
     my $starting=&mt('Starting');      my $starting=&mt('Starting');
     my $content=(<<ENDPROGBAR);      my $content=(<<ENDPROGBAR);
 <p>  
   <div id="progressbar$LCcurrentid">    <div id="progressbar$LCcurrentid">
     <span class="pblabel">$starting</span>      <span class="pblabel">$starting</span>
   </div>    </div>
 </p>  
 ENDPROGBAR  ENDPROGBAR
     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));      &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
 }  }
Line 7477  sub validate_page { Line 8161  sub validate_page {
   
   
 sub start_scrollbox {  sub start_scrollbox {
     my ($outerwidth,$width,$height,$id)=@_;      my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
     unless ($outerwidth) { $outerwidth='520px'; }      unless ($outerwidth) { $outerwidth='520px'; }
     unless ($width) { $width='500px'; }      unless ($width) { $width='500px'; }
     unless ($height) { $height='200px'; }      unless ($height) { $height='200px'; }
     my ($table_id,$div_id);      my ($table_id,$div_id,$tdcol);
     if ($id ne '') {      if ($id ne '') {
         $table_id = " id='table_$id'";          $table_id = ' id="table_'.$id.'"';
         $div_id = " id='div_$id'";          $div_id = ' id="div_'.$id.'"';
       }
       if ($bgcolor ne '') {
           $tdcol = "background-color: $bgcolor;";
     }      }
     return "<table style='width: $outerwidth; border: 1px solid none;'$table_id><tr><td style='width: $width;' bgcolor='#FFFFFF'><div style='overflow:auto; width:$width; height: $height;'$div_id>";      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 {  sub end_scrollbox {
     return '</div></td></tr></table>';      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 7712  role status: active, previous or future. Line 8495  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 7791  sub get_sections { Line 8573  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 7818  sub get_sections { Line 8612  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 7965  sub get_course_users { Line 8762  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 7975  sub get_course_users { Line 8772  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 8010  sub get_course_users { Line 8811  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 8098  sub get_user_info { Line 8899  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 8116  Returns: Line 8922  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 8124  defined for the user's instituional stat Line 8930  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 8139  sub get_user_quota { Line 8945  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 8179  Retrieves default quota assigned for sto Line 9016  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 8240  sub default_quota { Line 9083  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 8258  sub default_quota { Line 9110  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 8615  sub user_rule_formats { Line 9523  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 8696  sub personal_data_fieldtitles { Line 9607  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 9084  sub get_env_multiple { Line 10002  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 9118  sub ask_for_embedded_content { Line 10051  sub ask_for_embedded_content {
         }          }
     } 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 9151  sub ask_for_embedded_content { Line 10135  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') ||
               ($actionurl eq '/adm/coursegrp_portfolio')) { 
             my ($sublistref,$listerror) =              my ($sublistref,$listerror) =
                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);                  &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
             if (ref($sublistref) eq 'ARRAY') {              if (ref($sublistref) eq 'ARRAY') {
                 foreach my $line (@{$sublistref}) {                  foreach my $line (@{$sublistref}) {
                     my ($file_name,$rest) = split(/\&/,$line,2);                      my ($file_name,$rest) = split(/\&/,$line,2);
                     $currsubfile{$file_name} = 1;                      $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 9187  sub ask_for_embedded_content { Line 10199  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') ||
           ($actionurl eq '/adm/coursegrp_portfolio')) {
         my ($dirlistref,$listerror) =          my ($dirlistref,$listerror) =
             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);              &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
         if (ref($dirlistref) eq 'ARRAY') {          if (ref($dirlistref) eq 'ARRAY') {
Line 9203  sub ask_for_embedded_content { Line 10233  sub ask_for_embedded_content {
             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 9215  sub ask_for_embedded_content { Line 10266  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 9260  sub ask_for_embedded_content { Line 10407  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 9296  sub ask_for_embedded_content { Line 10465  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 9311  sub ask_for_embedded_content { Line 10480  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 9328  sub ask_for_embedded_content { Line 10497  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 9373  sub embedded_file_element { Line 10583  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 9421  sub upload_embedded { Line 10675  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 9455  sub upload_embedded { Line 10711  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 9468  sub upload_embedded { Line 10725  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 9488  sub upload_embedded { Line 10748  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 9516  sub upload_embedded { Line 10778  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 9559  sub modify_html_form { Line 10823  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 9570  sub modify_html_form { Line 10834  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 9592  sub modify_html_form { Line 10859  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 = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};          $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
     }      }
     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 (wantarray) {
                   return ('',0,0);
               } else {
                   return;
               }
           } 
         if (open(my $fh,"<$container")) {          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 9638  sub modify_html_refs { Line 10939  sub modify_html_refs {
                     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 '') {
                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});                          $codebase = &unescape($env{'form.embedded_codebase_'.$i});
Line 9646  sub modify_html_refs { Line 10949  sub modify_html_refs {
                     }                      }
                 }                  }
             }              }
               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;
Line 9676  sub modify_html_refs { Line 10986  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 9761  sub check_for_upload { Line 11116  sub check_for_upload {
                     if ($currsize < $filesize) {                      if ($currsize < $filesize) {
                         my $extra = $filesize - $currsize;                          my $extra = $filesize - $currsize;
                         if (($current_disk_usage + $extra) > $disk_quota) {                          if (($current_disk_usage + $extra) > $disk_quota) {
                             my $msg = '<span class="LC_error">'.                              my $msg = '<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.',                                        &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.                                            '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',                                        '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                                                    $disk_quota,$current_disk_usage);                                                     $disk_quota,$current_disk_usage).'</p>';
                             return ('will_exceed_quota',$msg);                              return ('will_exceed_quota',$msg);
                         }                          }
                     }                      }
Line 9774  sub check_for_upload { Line 11129  sub check_for_upload {
         }          }
     }      }
     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 9848  sub is_archive_file { Line 11203  sub is_archive_file {
 }  }
   
 sub decompress_form {  sub decompress_form {
     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements) = @_;      my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
     my %lt = &Apache::lonlocal::texthash (      my %lt = &Apache::lonlocal::texthash (
         this => 'This file is an archive file.',          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.',          youm => 'You may wish to extract its contents.',
         camt => 'Extraction of contents is recommended for Camtasia zip files.',  
         perm => 'Permanently remove archive file after extraction of contents?',  
         extr => 'Extract 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',          yes  => 'Yes',
         no   => 'No',          no   => 'No',
           fold => 'Title for folder containing movie',
           movi => 'Title for page containing embedded movie', 
     );      );
     my $output = '<p>'.$lt{'this'}.' '.$lt{'youm'}.'<br />';      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)}) {      if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
         $output .= $lt{'camt'};          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;
                   }
               }
           }
     }      }
     $output .= '</p>';      my $output;
     $output .= <<"START";      if ($is_camtasia) {
 <div id="uploadfileresult">          $output = <<"ENDCAM";
   <form name="uploaded_decompress" action="$action" method="post">  <script type="text/javascript" language="Javascript">
   <input type="hidden" name="archiveurl" value="$archiveurl" />  // <![CDATA[
 START  
   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') {      if (ref($hiddenelements) eq 'HASH') {
         foreach my $hidden (sort(keys(%{$hiddenelements}))) {          foreach my $hidden (sort(keys(%{$hiddenelements}))) {
             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";              $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
         }          }
     }      }
     $output .= <<"END";      $output .= <<"END";
 <span class="LC_nobreak">$lt{'perm'}&nbsp;  <br />
 <label><input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}</label>&nbsp;&nbsp;  
 <label><input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label></span><br />  
 <input type="submit" name="decompress" value="$lt{'extr'}" />  <input type="submit" name="decompress" value="$lt{'extr'}" />
 </form>  </form>
 $noextract  $noextract
 </div>  
 END  END
     return $output;      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 {  sub decompress_uploaded_file {
     my ($file,$dir) = @_;      my ($file,$dir) = @_;
     &Apache::lonnet::appenv({'cgi.file' => $file});      &Apache::lonnet::appenv({'cgi.file' => $file});
Line 9903  sub decompress_uploaded_file { Line 11490  sub decompress_uploaded_file {
 sub process_decompression {  sub process_decompression {
     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;      my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
     my ($dir,$error,$warning,$output);      my ($dir,$error,$warning,$output);
     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {      if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
         $error = &mt('File name not a supported archive file type.').          $error = &mt('Filename not a supported archive file type.').
                  '<br />'.&mt('File name should end with one of: [_1].',                   '<br />'.&mt('Filename should end with one of: [_1].',
                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');                                '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
     } else {      } else {
         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);          my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
Line 9914  sub process_decompression { Line 11501  sub process_decompression {
         } else {          } else {
             my @ids=&Apache::lonnet::current_machine_ids();              my @ids=&Apache::lonnet::current_machine_ids();
             my $currdir = "$dir_root/$destination";              my $currdir = "$dir_root/$destination";
             my ($currdirlistref,$currlisterror) =  
                 &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);  
             if (grep(/^\Q$docuhome\E$/,@ids)) {              if (grep(/^\Q$docuhome\E$/,@ids)) {
                 $dir = &LONCAPA::propath($docudom,$docuname).                  $dir = &LONCAPA::propath($docudom,$docuname).
                        "$dir_root/$destination";                         "$dir_root/$destination";
Line 9926  sub process_decompression { Line 11511  sub process_decompression {
                     $error = &mt('Archive file not found.');                      $error = &mt('Archive file not found.');
                 }                  }
             }              }
             if ($dir eq '') {              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);
               if (($numskip > 0) && 
                   ($numskip == $env{'form.archive_itemcount'})) {
                   $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.');                  $error = &mt('Directory containing archive file unavailable.');
             } elsif (!$error) {              } elsif (!$error) {
                 my ($decompressed,$display) = &decompress_uploaded_file($file,$dir);                  my ($decompressed,$display);
                   if ($numskip > 0) {
                       my $tempdir = time.'_'.$$.int(rand(10000));
                       mkdir("$dir/$tempdir",0755);
                       system("mv $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") {
                                   system("rm -rf $dir/$tempdir/$item");
                               }
                           }
                       }
                       system("mv $dir/$tempdir/* $dir");
                       rmdir("$dir/$tempdir");   
                   } else {
                       ($decompressed,$display) = 
                           &decompress_uploaded_file($file,$dir);
                   }
                 if ($decompressed eq 'ok') {                  if ($decompressed eq 'ok') {
                     $output = &mt('Files extracted successfully from archive.').'<br />';                      $output = '<p class="LC_info">'.
                                 &mt('Files extracted successfully from archive.').
                                 '</p>'."\n";
                     my ($warning,$result,@contents);                      my ($warning,$result,@contents);
                     my ($newdirlistref,$newlisterror) =                      my ($newdirlistref,$newlisterror) =
                         &Apache::lonnet::dirlist($currdir,$docudom,                          &Apache::lonnet::dirlist($currdir,$docudom,
                                                  $docuname,1);                                                   $docuname,1);
                     my (%is_dir,%changes,@newitems);                      my (%is_dir,%changes,@newitems);
                     my $dirptr = 16384;                      my $dirptr = 16384;
                     if (ref($currdirlistref) eq 'ARRAY') {                      if (ref($newdirlistref) eq 'ARRAY') {
                         my @curritems;  
                         foreach my $dir_line (@{$currdirlistref}) {  
                             my ($item,$rest)=split(/\&/,$dir_line,2);  
                             unless ($item =~ /\.+$/) {  
                                 push(@curritems,$item);  
                             }  
                         }  
                         if (ref($newdirlistref) eq 'ARRAY') {  
                             foreach my $dir_line (@{$newdirlistref}) {  
                                 my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,4);  
                                 unless ($item =~ /^\.+$/) {  
                                     if ($dirptr&$testdir) {  
                                         $is_dir{$item} = 1;  
                                     }  
                                     push(@newitems,$item);  
                                 }  
                             }  
                             my @diffs = &compare_arrays(\@curritems,\@newitems);  
                             if (@diffs > 0) {  
                                foreach my $item (@diffs) {  
                                    $changes{$item} = 1;  
                                }  
                             }  
                         }  
                     } elsif (ref($newdirlistref) eq 'ARRAY') {  
                         foreach my $dir_line (@{$newdirlistref}) {                          foreach my $dir_line (@{$newdirlistref}) {
                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);                              my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                             unless ($item =~ /\.+$/) {                              unless (($item =~ /^\.+$/) || ($item eq $file) || 
                                       ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
                                 push(@newitems,$item);                                  push(@newitems,$item);
                                 if ($dirptr&$testdir) {                                  if ($dirptr&$testdir) {
                                     $is_dir{$item} = 1;                                      $is_dir{$item} = 1;
Line 9983  sub process_decompression { Line 11582  sub process_decompression {
                         }                          }
                     }                      }
                     if (@contents > 0) {                      if (@contents > 0) {
                           my $wantform;
                           unless ($env{'form.autoextract_camtasia'}) {
                               $wantform = 1;
                           }
                         my (%children,%parent,%dirorder,%titles);                          my (%children,%parent,%dirorder,%titles);
                         my $wantform = 1;  
                         my ($count,$datatable) = &get_extracted($docudom,$docuname,                          my ($count,$datatable) = &get_extracted($docudom,$docuname,
                                                                 $currdir,\%is_dir,                                                                  $currdir,\%is_dir,
                                                                 \%children,\%parent,                                                                  \%children,\%parent,
Line 9993  sub process_decompression { Line 11595  sub process_decompression {
                         if ($datatable ne '') {                          if ($datatable ne '') {
                             $output .= &archive_options_form('decompressed',$datatable,                              $output .= &archive_options_form('decompressed',$datatable,
                                                              $count,$hiddenelem);                                                               $count,$hiddenelem);
                             my $startcount = 4;                              my $startcount = 6;
                             $output .= &archive_javascript($startcount,$count,                              $output .= &archive_javascript($startcount,$count,
                                                            \%titles,\%children);                                                             \%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 {                      } else {
                         $warning = &mt('No new items extracted from archive file.');                          $warning = &mt('No new items extracted from archive file.');
                     }                      }
Line 10122  sub archive_row { Line 11772  sub archive_row {
     my $offset = 0;      my $offset = 0;
     foreach my $action ('display','dependency','discard') {      foreach my $action ('display','dependency','discard') {
         $offset ++;          $offset ++;
           if ($action ne 'display') {
               $offset ++;
           }  
         $output .= '<td><span class="LC_nobreak">'.          $output .= '<td><span class="LC_nobreak">'.
                    '<label><input type="radio" name="archive_'.$count.                     '<label><input type="radio" name="archive_'.$count.
                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';                     '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
Line 10167  sub archive_row { Line 11820  sub archive_row {
 }  }
   
 sub archive_options_form {  sub archive_options_form {
     my ($form,$output,$count,$hiddenelem) = @_;      my ($form,$display,$count,$hiddenelem) = @_;
     return '<form name="'.$form.'" method="post" action="">'."\n".      my %lt = &Apache::lonlocal::texthash(
            '<input type="hidden" name="phase" value="decompress_cleanup" />'."\n".                 perm => 'Permanently remove archive file?',
                     '<p>'.                 hows => 'How should each extracted item be incorporated in the course?',
                     &mt('How should each item be incorporated in the course?').                 cont => 'Content actions for all',
                     '</p>'.                 addf => 'Add as folder/file',
                     '<div class="LC_columnSection"><fieldset>'.                 incd => 'Include as dependency for a displayed file',
                     '<legend>'.&mt('Content actions for all').'</legend>'.                 disc => 'Discard',
                     '<input type="button" value="'.&mt('Add as folder/file').'" '.                 no   => 'No',
                     'onclick="javascript:checkAll(document.'.$form.",'display'".')" />'.                 yes  => 'Yes',
                     '&nbsp;&nbsp;<input type="button" value="'.&mt('Include as dependency for a displayed file').'"'.                 save => 'Save',
                     ' onclick="javascript:checkAll(document.'.$form.",'dependency'".')" />'.      );
                     '&nbsp;&nbsp;<input type="button" value="'.&mt('Discard').'"'.      my $output = <<"END";
                     ' onclick="javascript:checkAll(document.'.$form.",'discard'".')" />'.  <form name="$form" method="post" action="">
                      '</fieldset></div>'.  <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".             &start_data_table()."\n".
            $output."\n".             $display."\n".
            &end_data_table()."\n".             &end_data_table()."\n".
            '<input type="hidden" name="archive_count" value="'.$count.'" />'.             '<input type="hidden" name="archive_count" value="'.$count.'" />'.
            $hiddenelem.             $hiddenelem.
            '<br /><input type="submit" name="archive_submit" value="'.&mt('Save').'" />'.             '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
            '</form>';             '</form>';
 }  }
   
Line 10281  function dependencyCheck(form,count,offs Line 11954  function dependencyCheck(form,count,offs
             document.getElementById('arc_depon_'+count).style.display='block';               document.getElementById('arc_depon_'+count).style.display='block'; 
             form.elements[depitem].options.length = 0;              form.elements[depitem].options.length = 0;
             form.elements[depitem].options[0] = new Option('Select','',true,true);              form.elements[depitem].options[0] = new Option('Select','',true,true);
             for (var i=1; i<count; i++) {              for (var i=1; i<=numitems; i++) {
                   if (i == count) {
                       continue;
                   }
                 var startelement = $startcount + (i-1) * 7;                  var startelement = $startcount + (i-1) * 7;
                 for (var j=1; j<6; j++) {                  for (var j=1; j<6; j++) {
                     if ((j != 2) && (j!= 4)) {                      if ((j != 2) && (j!= 4)) {
Line 10308  function dependencyCheck(form,count,offs Line 11984  function dependencyCheck(form,count,offs
   
 function propagateSelect(form,count,offset) {  function propagateSelect(form,count,offset) {
     if (count > 0) {      if (count > 0) {
         var item = (2+offset+$startcount)+7*(count-1);          var item = (1+offset+$startcount)+7*(count-1);
         var picked = form.elements[item].options[form.elements[item].selectedIndex].value;           var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {          if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
             if (parents[count].length > 0) {              if (parents[count].length > 0) {
Line 10322  function propagateSelect(form,count,offs Line 11998  function propagateSelect(form,count,offs
   
 function containerSelect(form,count,offset,picked) {  function containerSelect(form,count,offset,picked) {
     if (count > 0) {      if (count > 0) {
         var item = (1+offset+$startcount)+7*(count-1);          var item = (offset+$startcount)+7*(count-1);
         if (form.elements[item].type == 'radio') {          if (form.elements[item].type == 'radio') {
             if (form.elements[item].value == 'dependency') {              if (form.elements[item].value == 'dependency') {
                 if (form.elements[item+1].type == 'select-one') {                  if (form.elements[item+1].type == 'select-one') {
Line 10377  sub process_extracted_files { Line 12053  sub process_extracted_files {
     return unless ($numitems);      return unless ($numitems);
     my @ids=&Apache::lonnet::current_machine_ids();      my @ids=&Apache::lonnet::current_machine_ids();
     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,      my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
         %folders,%containers,%mapinner);          %folders,%containers,%mapinner,%prompttofetch);
     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);      my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
     if (grep(/^\Q$docuhome\E$/,@ids)) {      if (grep(/^\Q$docuhome\E$/,@ids)) {
         $prefix = &LONCAPA::propath($docudom,$docuname);          $prefix = &LONCAPA::propath($docudom,$docuname);
Line 10394  sub process_extracted_files { Line 12070  sub process_extracted_files {
     if ($env{'form.folderpath'}) {      if ($env{'form.folderpath'}) {
         my @items = split('&',$env{'form.folderpath'});          my @items = split('&',$env{'form.folderpath'});
         $folders{'0'} = $items[-2];          $folders{'0'} = $items[-2];
         $containers{'0'}='sequence';          if ($env{'form.folderpath'} =~ /\:1$/) {
     } elsif ($env{'form.pagepath'}) {              $containers{'0'}='page';
         my @items = split('&',$env{'form.pagepath'});          } else {
         $folders{'0'} = $items[-2];              $containers{'0'}='sequence';
         $containers{'0'}='page';          }
     }      }
     my @archdirs = &get_env_multiple('form.archive_directory');      my @archdirs = &get_env_multiple('form.archive_directory');
     if ($numitems) {      if ($numitems) {
Line 10413  sub process_extracted_files { Line 12089  sub process_extracted_files {
             }              }
         }          }
     }      }
     my ($output,%children,%parent,%titles,%dirorder);      my ($output,%children,%parent,%titles,%dirorder,$result);
     if (keys(%toplevelitems) > 0) {      if (keys(%toplevelitems) > 0) {
         my @contents = sort(keys(%toplevelitems));          my @contents = sort(keys(%toplevelitems));
         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,          (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                                            \%parent,\@contents,\%dirorder,\%titles);                                             \%parent,\@contents,\%dirorder,\%titles);
     }      }
     my (%referrer,%orphaned,%todelete,%newdest,%newseqid);      my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
     if ($numitems) {      if ($numitems) {
         for (my $i=1; $i<=$numitems; $i++) {          for (my $i=1; $i<=$numitems; $i++) {
               next if ($env{'form.archive_'.$i} eq 'dependency');
             my $path = $env{'form.archive_content_'.$i};              my $path = $env{'form.archive_content_'.$i};
             if ($path =~ /^\Q$pathtocheck\E/) {              if ($path =~ /^\Q$pathtocheck\E/) {
                 if ($env{'form.archive_'.$i} eq 'discard') {                  if ($env{'form.archive_'.$i} eq 'discard') {
                     if ($prefix ne '' && $path ne '') {                      if ($prefix ne '' && $path ne '') {
                         if (-e $prefix.$path) {                          if (-e $prefix.$path) {
                             $todelete{$prefix.$path} = 1;                              if ((@archdirs > 0) && 
                                   (grep(/^\Q$i\E$/,@archdirs))) {
                                   $todeletedir{$prefix.$path} = 1;
                               } else {
                                   $todelete{$prefix.$path} = 1;
                               }
                         }                          }
                     }                      }
                 } elsif ($env{'form.archive_'.$i} eq 'display') {                  } elsif ($env{'form.archive_'.$i} eq 'display') {
Line 10467  sub process_extracted_files { Line 12149  sub process_extracted_files {
                             my ($outtext,$errtext) =                              my ($outtext,$errtext) =
                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.                                  &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                                                         $docuname.'/'.$folders{$outer}.                                                          $docuname.'/'.$folders{$outer}.
                                                         '.'.$containers{$outer},1);                                                          '.'.$containers{$outer},1,1);
                             $newseqid{$i} = $newidx;                              $newseqid{$i} = $newidx;
                               unless ($errtext) {
                                   $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                               }
                         }                          }
                     } else {                      } else {
                         if ($context eq 'coursedocs') {                          if ($context eq 'coursedocs') {
Line 10485  sub process_extracted_files { Line 12170  sub process_extracted_files {
                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {                              if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");                                  system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";                                  $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                                   unless ($ishome) {
                                       my $fetch = "$newdest{$i}/$title";
                                       $fetch =~ s/^\Q$prefix$dir\E//;
                                       $prompttofetch{$fetch} = 1;
                                   }
                             }                              }
                             $LONCAPA::map::resources[$newidx]=                              $LONCAPA::map::resources[$newidx]=
                                 $docstitle.':'.$url.':false:normal:res';                                  $docstitle.':'.$url.':false:normal:res';
Line 10492  sub process_extracted_files { Line 12182  sub process_extracted_files {
                             my ($outtext,$errtext)=                              my ($outtext,$errtext)=
                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.                                  &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                                                         $docuname.'/'.$folders{$outer}.                                                          $docuname.'/'.$folders{$outer}.
                                                         '.'.$containers{$outer},1);                                                          '.'.$containers{$outer},1,1);
                               unless ($errtext) {
                                   if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                                       $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                                   }
                               }
                         }                          }
                     }                      }
                 } elsif ($env{'form.archive_'.$i} eq 'dependency') {                  }
                     my ($title) = ($path =~ m{/([^/]+)$});              } else {
                     $referrer{$i} = $env{'form.archive_dependent_on_'.$i};                  $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                     if ($env{'form.archive_'.$referrer{$i}} eq 'display') {              }
                         if (ref($dirorder{$i}) eq 'ARRAY') {          }
                             my ($itemidx,$fullpath);          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++) {                              for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
                                 if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {                                  if ($dirorder{$i}->[$j] eq $container) {
                                     my $container = $dirorder{$referrer{$i}}->[-1];                                      $itemidx = $j;
                                     for (my $j=0; $j<@{$dirorder{$i}}; $j++) {  
                                         if ($dirorder{$i}->[$j] eq $container) {  
                                             $itemidx = $j;  
                                         }  
                                     }  
                                 }                                  }
                             }                              }
                             if ($itemidx ne '') {                          }
                                 if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {                          if ($itemidx eq '') {
                                     if ($mapinner{$referrer{$i}}) {                              $itemidx =  0;
                                         $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";                          }
                                         for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {                          if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                                             if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {                              if ($mapinner{$referrer{$i}}) {
                                                 unless (defined($newseqid{$dirorder{$i}->[$j]})) {                                  $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                                                     $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};                                  for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                                                     if (!-e $fullpath) {                                      if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                                                         mkdir($fullpath,0755);                                          unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                                                     }                                              $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                                                 }                                              $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                                             } else {                                              if (!-e $fullpath) {
                                                 last;                                                  mkdir($fullpath,0755);
                                             }                                              }
                                         }                                          }
                                       } else {
                                           last;
                                     }                                      }
                                 } elsif ($newdest{$referrer{$i}}) {                                  }
                                     $fullpath = $newdest{$referrer{$i}};                              }
                                     for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {                          } elsif ($newdest{$referrer{$i}}) {
                                         if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {                              $fullpath = $newdest{$referrer{$i}};
                                             $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};                              for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                                             last;                                  if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                                         } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {                                      $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                                             unless (defined($newseqid{$dirorder{$i}->[$j]})) {                                      last;
                                                 $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};                                  } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                                                 if (!-e $fullpath) {                                      unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                                                     mkdir($fullpath,0755);                                          $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                                                 }                                          $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                                             }                                          if (!-e $fullpath) {
                                         } else {                                              mkdir($fullpath,0755);
                                             last;  
                                         }                                          }
                                     }                                      }
                                   } else {
                                       last;
                                 }                                  }
                                 if ($fullpath ne '') {                              }
                                     system("mv $prefix$path $fullpath/$title");                          }
                           if ($fullpath ne '') {
                               if (-e "$prefix$path") {
                                   system("mv $prefix$path $fullpath/$title");
                               }
                               if (-e "$fullpath/$title") {
                                   my $showpath;
                                   if ($relpath ne '') {
                                       $showpath = "$relpath/$title";
                                   } else {
                                       $showpath = "/$title";
                                 }                                  }
                                   $result .= '<li>'.&mt('[_1] included as a dependency',$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.',  
                                         $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';  
                     }                      }
                   } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                       $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                                       $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
                 }                  }
             } else {              } else {
                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';                   $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
             }              }
         }          }
         if (keys(%todelete)) {          if (keys(%todelete)) {
             foreach my $key (keys(%todelete)) {              foreach my $key (keys(%todelete)) {
                 unlink($key);                  unlink($key);
                 unless ($ishome) {              }
                     #FIXME Need to notify homeserver to delete files.          }
                 }          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 {      } else {
Line 10581  sub process_extracted_files { Line 12327  sub process_extracted_files {
     return $output;      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  =pod
   
 =item * &get_turnedin_filepath()  =item * &get_turnedin_filepath()
Line 10634  sub get_turnedin_filepath { Line 12464  sub get_turnedin_filepath {
                             my $title = $res->compTitle();                              my $title = $res->compTitle();
                             $title =~ s/\W+/_/g;                              $title =~ s/\W+/_/g;
                             if ($title ne '') {                              if ($title ne '') {
                                   if (($pc > 1) && (length($title) > 12)) {
                                       $title = substr($title,0,12);
                                   }
                                 push(@pathitems,$title);                                  push(@pathitems,$title);
                             }                              }
                         }                          }
Line 10642  sub get_turnedin_filepath { Line 12475  sub get_turnedin_filepath {
                 my $maptitle = $mapres->compTitle();                  my $maptitle = $mapres->compTitle();
                 $maptitle =~ s/\W+/_/g;                  $maptitle =~ s/\W+/_/g;
                 if ($maptitle ne '') {                  if ($maptitle ne '') {
                       if (length($maptitle) > 12) {
                           $maptitle = substr($maptitle,0,12);
                       }
                     push(@pathitems,$maptitle);                      push(@pathitems,$maptitle);
                 }                  }
                 unless ($env{'request.state'} eq 'construct') {                  unless ($env{'request.state'} eq 'construct') {
Line 10682  sub get_turnedin_filepath { Line 12518  sub get_turnedin_filepath {
                 $restitle = time;                  $restitle = time;
             }              }
         }          }
           if (length($restitle) > 12) {
               $restitle = substr($restitle,0,12);
           }
         push(@pathitems,$restitle);          push(@pathitems,$restitle);
         $path .= join('/',@pathitems);          $path .= join('/',@pathitems);
     }      }
Line 11619  sub restore_settings { Line 13458  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 11824  sub extract_categories { Line 13667  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 11895  sub recurse_categories { Line 13738  sub recurse_categories {
   
 =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 11972  sub assign_categories_table { Line 13815  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 12006  sub assign_category_rows { Line 13849  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 12038  sub assign_category_rows { Line 13881  sub assign_category_rows {
     return $text;      return $text;
 }  }
   
   =pod
   
   =back
   
   =cut
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
Line 12054  sub commit_customrole { Line 13903  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 12063  sub commit_standardrole { Line 13912  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 12094  sub commit_standardrole { Line 13943  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 12141  sub commit_studentrole { Line 13991  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 12172  sub commit_studentrole { Line 14026  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 12198  sub commit_studentrole { Line 14052  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 12230  sub check_clone { Line 14104  sub check_clone {
             (&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') {
             } else {                              if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                 my $ccrole = 'cc';                                  $can_clone = 1;
                 if ($args->{'crstype'} eq 'Community') {                              }
                     $ccrole = 'co';                          } 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;
                               }
                           }
                       }
                 }                  }
         my %roleshash =              } else {
     &Apache::lonnet::get_my_roles($args->{'ccuname'},          my @cloners = split(/,/,$clonehash{'cloners'});
  $args->{'ccdomain'},                  if (grep(/^\*$/,@cloners)) {
                                          'userroles',['active'],[$ccrole],  
  [$args->{'clonedomain'}]);  
         if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {  
                     $can_clone = 1;                      $can_clone = 1;
                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {                  } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                     $can_clone = 1;                      $can_clone = 1;
                 } else {                  }
                     if ($args->{'crstype'} eq 'Community') {                  unless ($can_clone) {
                         $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                     } else {                          my (%gotdomdefaults,%gotcodedefaults);
                         $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'});                          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';
                           if ($args->{'crstype'} eq 'Community') {
                               $ccrole = 'co';
                           }
                           my %roleshash =
                               &Apache::lonnet::get_my_roles($args->{'ccuname'},
                                                             $args->{'ccdomain'},
                                                             'userroles',['active'],[$ccrole],
                                                             [$args->{'clonedomain'}]);
                           if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) ||
                               (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
                               $can_clone = 1;
                           } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                                                                     $args->{'ccuname'},$args->{'ccdomain'})) {
                               $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 {
                       $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 12265  sub check_clone { Line 14195  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 12361  sub construct_course { Line 14291  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 12390  sub construct_course { Line 14325  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 12414  sub construct_course { Line 14352  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 12538  sub construct_course { Line 14481  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 12606  sub construct_course { Line 14568  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 12633  sub group_term { Line 14649  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 12698  sub escape_url { Line 14715  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 12756  sub init_user_environment { Line 14773  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 12769  sub init_user_environment { Line 14797  sub init_user_environment {
     }      }
 # ------------------------------------ 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 12801  sub init_user_environment { Line 14829  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 12820  sub init_user_environment { Line 14851  sub init_user_environment {
     $env{'browser.interface'}=$form->{'interface'};      $env{'browser.interface'}=$form->{'interface'};
  }   }
   
           if ($form->{'iptoken'}) {
               my $lonhost = $r->dir_config('lonHostID');
               $initial_env{"user.noloadbalance"} = $lonhost;
               $env{'user.noloadbalance'} = $lonhost;
           }
   
         my %is_adv = ( is_adv => $env{'user.adv'} );          my %is_adv = ( is_adv => $env{'user.adv'} );
         my %domdef;          my %domdef;
         unless ($domain eq 'public') {          unless ($domain eq 'public') {
             %domdef = &Apache::lonnet::get_domain_defaults($domain);              %domdef = &Apache::lonnet::get_domain_defaults($domain);
         }          }
   
         foreach my $tool ('aboutme','blog','portfolio') {          foreach my $tool ('aboutme','blog','webdav','portfolio') {
             $userenv{'availabletools.'.$tool} =               $userenv{'availabletools.'.$tool} = 
                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',                  &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                                                   undef,\%userenv,\%domdef,\%is_adv);                                                    undef,\%userenv,\%domdef,\%is_adv);
         }          }
   
         foreach my $crstype ('official','unofficial','community') {          foreach my $crstype ('official','unofficial','community','textbook') {
             $userenv{'canrequest.'.$crstype} =              $userenv{'canrequest.'.$crstype} =
                 &Apache::lonnet::usertools_access($username,$domain,$crstype,                  &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                   'reload','requestcourses',                                                    'reload','requestcourses',
                                                   \%userenv,\%domdef,\%is_adv);                                                    \%userenv,\%domdef,\%is_adv);
         }          }
   
           $userenv{'canrequest.author'} =
               &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                                           'reload','requestauthor',
                                           \%userenv,\%domdef,\%is_adv);
           my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                                                $domain,$username);
           my $reqstatus = $reqauthor{'author_status'};
           if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
               if (ref($reqauthor{'author'}) eq 'HASH') {
                   $userenv{'requestauthorqueued'} = $reqstatus.':'.
                                                     $reqauthor{'author'}{'timestamp'};
               }
           }
   
  $env{'user.environment'} = "$lonids/$cookie.id";   $env{'user.environment'} = "$lonids/$cookie.id";
   
  if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",   if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
Line 12887  sub get_symb { Line 14938  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 12921  sub clean_symb { Line 14974  sub clean_symb {
     return ($symb,$enc);      return ($symb,$enc);
 }  }
   
 sub build_release_hashes {  ############################################################
     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;  ############################################################
     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&  
                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&  =pod
                   (ref($randomizetry) eq 'HASH'));  
     foreach my $key (keys(%Apache::lonnet::needsrelease)) {  =head1 Routines for building display used to search for courses
         my ($item,$name,$value) = split(/:/,$key);  
         if ($item eq 'parameter') {  
             if (ref($checkparms->{$name}) eq 'ARRAY') {  =over 4
                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {  
                     push(@{$checkparms->{$name}},$value);  =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 {              } else {
                 push(@{$checkparms->{$name}},$value);                  $filter->{$item} =~ s/\W//g;
             }              }
         } elsif ($item eq 'resourcetag') {              if (!$filter->{$item}) {
             if ($name eq 'responsetype') {                  $filter->{$item} = '';
                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}  
             }              }
         } elsif ($item eq 'course') {          }
             if ($name eq 'crstype') {          if ($item eq 'domainfilter') {
                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};              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.')';
             }              }
         }          }
     }      }
     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});      my $output = qq|
     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});  <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;      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  =pod
   
 =back  =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  =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
   
   =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
   
   =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) = @_;
       return unless ($symb);
       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;
       my $navmap = Apache::lonnavmaps::navmap->new();
       if (ref($navmap)) {
           $mapresobj = $navmap->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 = $navmap->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) = &get_captcha_config($context,$lonhost);
       if ($captcha eq 'original') {
           $output = &create_captcha();
           unless ($output) {
               $error = 'captcha';
           }
       } elsif ($captcha eq 'recaptcha') {
           $output = &create_recaptcha($pubkey);
           unless ($output) {
               $error = 'recaptcha';
           }
       }
       return ($output,$error,$captcha);
   }
   
   sub captcha_response {
       my ($context,$lonhost) = @_;
       my ($captcha_chk,$captcha_error);
       my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
       if ($captcha eq 'original') {
           ($captcha_chk,$captcha_error) = &check_captcha();
       } elsif ($captcha eq 'recaptcha') {
           $captcha_chk = &check_recaptcha($privkey);
       } else {
           $captcha_chk = 1;
       }
       return ($captcha_chk,$captcha_error);
   }
   
   sub get_captcha_config {
       my ($context,$lonhost) = @_;
       my ($captcha,$pubkey,$privkey,$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';
                       } 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';
               } else {
                   $captcha = 'original';
               }
           } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
               $captcha = 'original';
           }
       }
       return ($captcha,$pubkey,$privkey);
   }
   
   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) = @_;
       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) = @_;
       my $captcha_chk;
       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');
       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)',
                    );
       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=
           $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
       $plaintext.=
           $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
       $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
       return $plaintext;
   }
   
 1;  1;
 __END__;  __END__;
   
Removed from v.1.1062  
changed lines
  Added in v.1.1075.2.95

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