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

Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.144 and 1.1150

version 1.1075.2.144, 2020/03/05 21:54:44 version 1.1150, 2013/08/20 14:33:42
Line 69  use Apache::lontexconvert(); Line 69  use Apache::lontexconvert();
 use Apache::lonclonecourse();  use Apache::lonclonecourse();
 use Apache::lonuserutils();  use Apache::lonuserutils();
 use Apache::lonuserstate();  use Apache::lonuserstate();
 use Apache::courseclassifier();  
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use HTTP::Request;  
 use DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale;  use DateTime::Locale::Catalog;
 use Encode();  use Text::Aspell;
 use Authen::Captcha;  use Authen::Captcha;
 use Captcha::reCAPTCHA;  use Captcha::reCAPTCHA;
 use JSON::DWIW;  
 use LWP::UserAgent;  
 use Crypt::DES;  
 use DynaLoader; # for Crypt::DES version  
 use File::Copy();  
 use File::Path();  
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);  use vars qw(%defaultdesign);
Line 167  sub ssi_with_retries { Line 159  sub ssi_with_retries {
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
 my %supported_language;  my %supported_language;
   my %supported_codes;
 my %latex_language; # For choosing hyphenation in <transl..>  my %latex_language; # For choosing hyphenation in <transl..>
 my %latex_language_bykey; # for choosing hyphenation from metadata  my %latex_language_bykey; # for choosing hyphenation from metadata
 my %cprtag;  my %cprtag;
Line 197  BEGIN { Line 190  BEGIN {
     {      {
         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                                    '/language.tab';                                     '/language.tab';
         if ( open(my $fh,'<',$langtabfile) ) {          if ( open(my $fh,"<$langtabfile") ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line=~/^\#/);                  next if ($line=~/^\#/);
                 chomp($line);                  chomp($line);
                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));                  my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
                 $language{$key}=$val.' - '.$enc;                  $language{$key}=$val.' - '.$enc;
                 if ($sup) {                  if ($sup) {
                     $supported_language{$key}=$sup;                      $supported_language{$key}=$sup;
       $supported_codes{$key}   = $code;
                 }                  }
  if ($latex) {   if ($latex) {
     $latex_language_bykey{$key} = $latex;      $latex_language_bykey{$key} = $latex;
     $latex_language{$two} = $latex;      $latex_language{$code} = $latex;
  }   }
             }              }
             close($fh);              close($fh);
Line 218  BEGIN { Line 212  BEGIN {
     {      {
         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.          my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/copyright.tab';                                    '/copyright.tab';
         if ( open (my $fh,'<',$copyrightfile) ) {          if ( open (my $fh,"<$copyrightfile") ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line=~/^\#/);                  next if ($line=~/^\#/);
                 chomp($line);                  chomp($line);
Line 232  BEGIN { Line 226  BEGIN {
     {      {
         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.          my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/source_copyright.tab';                                    '/source_copyright.tab';
         if ( open (my $fh,'<',$sourcecopyrightfile) ) {          if ( open (my $fh,"<$sourcecopyrightfile") ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line =~ /^\#/);                  next if ($line =~ /^\#/);
                 chomp($line);                  chomp($line);
Line 246  BEGIN { Line 240  BEGIN {
 # -------------------------------------------------------------- default domain designs  # -------------------------------------------------------------- default domain designs
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     my $designfile = $designdir.'/default.tab';      my $designfile = $designdir.'/default.tab';
     if ( open (my $fh,'<',$designfile) ) {      if ( open (my $fh,"<$designfile") ) {
         while (my $line = <$fh>) {          while (my $line = <$fh>) {
             next if ($line =~ /^\#/);              next if ($line =~ /^\#/);
             chomp($line);              chomp($line);
Line 260  BEGIN { Line 254  BEGIN {
     {      {
         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                                   '/filecategories.tab';                                    '/filecategories.tab';
         if ( open (my $fh,'<',$categoryfile) ) {          if ( open (my $fh,"<$categoryfile") ) {
     while (my $line = <$fh>) {      while (my $line = <$fh>) {
  next if ($line =~ /^\#/);   next if ($line =~ /^\#/);
  chomp($line);   chomp($line);
                 my ($extension,$category)=(split(/\s+/,$line,2));                  my ($extension,$category)=(split(/\s+/,$line,2));
                 push(@{$category_extensions{lc($category)}},$extension);                  push @{$category_extensions{lc($category)}},$extension;
             }              }
             close($fh);              close($fh);
         }          }
Line 275  BEGIN { Line 269  BEGIN {
     {      {
         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                '/filetypes.tab';                 '/filetypes.tab';
         if ( open (my $fh,'<',$typesfile) ) {          if ( open (my $fh,"<$typesfile") ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
  next if ($line =~ /^\#/);   next if ($line =~ /^\#/);
  chomp($line);   chomp($line);
Line 428  sub studentbrowser_javascript { Line 422  sub studentbrowser_javascript {
 <script type="text/javascript" language="Javascript">  <script type="text/javascript" language="Javascript">
 // <![CDATA[  // <![CDATA[
     var stdeditbrowser;      var stdeditbrowser;
     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {      function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
         var url = '/adm/pickstudent?';          var url = '/adm/pickstudent?';
         var filter;          var filter;
  if (!ignorefilter) {   if (!ignorefilter) {
Line 443  sub studentbrowser_javascript { Line 437  sub studentbrowser_javascript {
                                     '&udomelement='+udom+                                      '&udomelement='+udom+
                                     '&clicker='+clicker;                                      '&clicker='+clicker;
  if (roleflag) { url+="&roles=1"; }   if (roleflag) { url+="&roles=1"; }
         if (courseadv == 'condition') {          if (courseadvonly) { url+="&courseadvonly=1"; }
             if (document.getElementById('courseadv')) {  
                 courseadv = document.getElementById('courseadv').value;  
             }  
         }  
         if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }  
         var title = 'Student_Browser';          var title = 'Student_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=600';
Line 480  ENDRESBRW Line 469  ENDRESBRW
 }  }
   
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;     my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".     my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".                        &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";                        &Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 491  sub selectstudent_link { Line 480  sub selectstudent_link {
    return '';     return '';
        }         }
        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";         $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
        if ($courseadv eq 'only') {         if ($courseadvonly)  {
            $callargs .= ",'',1,'$courseadv'";             $callargs .= ",'',1,1";
        } elsif ($courseadv eq 'none') {  
            $callargs .= ",'','','$courseadv'";  
        } elsif ($courseadv eq 'condition') {  
            $callargs .= ",'','','$courseadv'";  
        }         }
        return '<span class="LC_nobreak">'.         return '<span class="LC_nobreak">'.
               '<a href="javascript:openstdbrowser('.$callargs.');">'.                '<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 547  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) = @_;          $credits_element) = @_;
     my $wintitle = 'Course_Browser';      my $wintitle = 'Course_Browser';
     if ($crstype eq 'Community') {      if ($crstype eq 'Community') {
         $wintitle = 'Community_Browser';          $wintitle = 'Community_Browser';
Line 598  sub coursebrowser_javascript { Line 583  sub coursebrowser_javascript {
             var ownername = document.forms[formid].ccuname.value;              var ownername = document.forms[formid].ccuname.value;
             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;              var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
             url += '&cloner='+ownername+':'+ownerdom;              url += '&cloner='+ownername+':'+ownerdom;
             if (type == 'Course') {  
                 url += '&crscode='+document.forms[formid].crscode.value;  
             }  
         }  
         if (formname == 'requestcrs') {  
             url += '&crsdom=$domainfilter&crscode=$instcode';  
         }          }
         if (multflag !=null && multflag != '') {          if (multflag !=null && multflag != '') {
             url += '&multiple='+multflag;              url += '&multiple='+multflag;
Line 687  if (!Array.prototype.indexOf) { Line 666  if (!Array.prototype.indexOf) {
         var n = 0;          var n = 0;
         if (arguments.length > 0) {          if (arguments.length > 0) {
             n = Number(arguments[1]);              n = Number(arguments[1]);
             if (n !== n) { // shortcut for verifying if it's NaN              if (n !== n) { // shortcut for verifying if it is NaN
                 n = 0;                  n = 0;
             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {              } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                 n = (n > 0 || -1) * Math.floor(Math.abs(n));                  n = (n > 0 || -1) * Math.floor(Math.abs(n));
Line 923  sub check_uncheck_jscript { Line 902  sub check_uncheck_jscript {
 function checkAll(field) {  function checkAll(field) {
     if (field.length > 0) {      if (field.length > 0) {
         for (i = 0; i < field.length; i++) {          for (i = 0; i < field.length; i++) {
             if (!field[i].disabled) {              if (!field[i].disabled) { 
                 field[i].checked = true;                  field[i].checked = true;
             }              }
         }          }
     } else {      } else {
         if (!field.disabled) {          if (!field.disabled) { 
             field.checked = true;              field.checked = true;
         }          }
     }      }
Line 948  ENDSCRT Line 927  ENDSCRT
 }  }
   
 sub select_timezone {  sub select_timezone {
    my ($name,$selected,$onchange,$includeempty,$disabled)=@_;     my ($name,$selected,$onchange,$includeempty)=@_;
    my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
    if ($includeempty) {     if ($includeempty) {
        $output .= '<option value=""';         $output .= '<option value=""';
        if (($selected eq '') || ($selected eq 'local')) {         if (($selected eq '') || ($selected eq 'local')) {
Line 970  sub select_timezone { Line 949  sub select_timezone {
 }  }
   
 sub select_datelocale {  sub select_datelocale {
     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;      my ($name,$selected,$onchange,$includeempty)=@_;
     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";      my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
     if ($includeempty) {      if ($includeempty) {
         $output .= '<option value=""';          $output .= '<option value=""';
         if ($selected eq '') {          if ($selected eq '') {
Line 979  sub select_datelocale { Line 958  sub select_datelocale {
         }          }
         $output .= '> </option>';          $output .= '> </option>';
     }      }
     my @languages = &Apache::lonlocal::preferred_languages();  
     my (@possibles,%locale_names);      my (@possibles,%locale_names);
     my @locales = DateTime::Locale->ids();      my @locales = DateTime::Locale::Catalog::Locales;
     foreach my $id (@locales) {      foreach my $locale (@locales) {
         if ($id ne '') {          if (ref($locale) eq 'HASH') {
             my ($en_terr,$native_terr);              my $id = $locale->{'id'};
             my $loc = DateTime::Locale->load($id);              if ($id ne '') {
             if (ref($loc)) {                  my $en_terr = $locale->{'en_territory'};
                 $en_terr = $loc->name();                  my $native_terr = $locale->{'native_territory'};
                 $native_terr = $loc->native_name();                  my @languages = &Apache::lonlocal::preferred_languages();
                 if (grep(/^en$/,@languages) || !@languages) {                  if (grep(/^en$/,@languages) || !@languages) {
                     if ($en_terr ne '') {                      if ($en_terr ne '') {
                         $locale_names{$id} = '('.$en_terr.')';                          $locale_names{$id} = '('.$en_terr.')';
Line 1002  sub select_datelocale { Line 980  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 1014  sub select_datelocale { Line 991  sub select_datelocale {
         }          }
         $output.=">$item";          $output.=">$item";
         if ($locale_names{$item} ne '') {          if ($locale_names{$item} ne '') {
             $output.='  '.$locale_names{$item};              $output.="  $locale_names{$item}</option>\n";
         }          }
         $output.="</option>\n";          $output.="</option>\n";
     }      }
Line 1023  sub select_datelocale { Line 1000  sub select_datelocale {
 }  }
   
 sub select_language {  sub select_language {
     my ($name,$selected,$includeempty,$noedit) = @_;      my ($name,$selected,$includeempty) = @_;
     my %langchoices;      my %langchoices;
     if ($includeempty) {      if ($includeempty) {
         %langchoices = ('' => 'No language preference');          %langchoices = ('' => 'No language preference');
Line 1035  sub select_language { Line 1012  sub select_language {
         }          }
     }      }
     %langchoices = &Apache::lonlocal::texthash(%langchoices);      %langchoices = &Apache::lonlocal::texthash(%langchoices);
     return &select_form($selected,$name,\%langchoices,undef,$noedit);      return &select_form($selected,$name,\%langchoices);
   }
   
   =pod
   
   
   =item * &list_languages()
   
   Returns an array reference that is suitable for use in language prompters.
   Each array element is itself a two element array.  The first element
   is the language code.  The second element a descsriptiuon of the 
   language itself.  This is suitable for use in e.g.
   &Apache::edit::select_arg (once dereferenced that is).
   
   =cut 
   
   sub list_languages {
       my @lang_choices;
   
       foreach my $id (&languageids()) {
    my $code = &supportedlanguagecode($id);
    if ($code) {
       my $selector    = $supported_codes{$id};
       my $description = &plainlanguagedescription($id);
       push (@lang_choices, [$selector, $description]);
    }
       }
       return \@lang_choices;
 }  }
   
 =pod  =pod
Line 1150  sub linked_select_forms { Line 1154  sub linked_select_forms {
         $result.="select2data.d_$s1.texts = new Array(";                  $result.="select2data.d_$s1.texts = new Array(";        
         my @s2texts;          my @s2texts;
         foreach my $value (@s2values) {          foreach my $value (@s2values) {
             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});              push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
         }          }
         $result.="\"@s2texts\");\n";          $result.="\"@s2texts\");\n";
     }      }
Line 1260  sub help_open_topic { Line 1264  sub help_open_topic {
     $topic=~s/\W/\_/g;      $topic=~s/\W/\_/g;
   
     if (!$stayOnPage) {      if (!$stayOnPage) {
         if ($env{'browser.mobile'}) {   $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
     $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";  
         } else {  
             $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";  
         }  
     } elsif ($stayOnPage eq 'popup') {      } elsif ($stayOnPage eq 'popup') {
         $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";          $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
     } else {      } else {
Line 1315  sub helpLatexCheatsheet { Line 1315  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 1380  sub help_open_menu { Line 1378  sub help_open_menu {
 sub top_nav_help {  sub top_nav_help {
     my ($text) = @_;      my ($text) = @_;
     $text = &mt($text);      $text = &mt($text);
     my $stay_on_page;      my $stay_on_page = 1;
     unless ($env{'environment.remote'} eq 'on') {  
         $stay_on_page = 1;      my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
     }                       : "javascript:helpMenu('open')";
     my ($link,$banner_link);      my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
     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 ($httphost) = @_;      my ($text) = @_;
     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 = $httphost.'/adm/help/'.$helptopic.'.hlp';      my $details_link = '/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 1445  function helpMenu(target) { Line 1435  function helpMenu(target) {
     return;      return;
 }  }
 function writeHelp(caller) {  function writeHelp(caller) {
     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');      caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" />\\n<frame name="bodyframe" src="$details_link" />\\n$end_page')
     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');      caller.document.close()
     caller.document.close();      caller.focus()
     caller.focus();  
 }  }
 // END LON-CAPA Internal -->  // END LON-CAPA Internal -->
 // ]]>  // ]]>
Line 1756  RESIZE Line 1745  RESIZE
   
 }  }
   
 sub colorfuleditor_js {  
     return <<"COLORFULEDIT"  
 <script type="text/javascript">  
 // <![CDATA[>  
     function fold_box(curDepth, lastresource){  
   
     // we need a list because there can be several blocks you need to fold in one tag  
         var block = document.getElementsByName('foldblock_'+curDepth);  
     // but there is only one folding button per tag  
         var foldbutton = document.getElementById('folding_btn_'+curDepth);  
   
         if(block.item(0).style.display == 'none'){  
   
             foldbutton.value = '@{[&mt("Hide")]}';  
             for (i = 0; i < block.length; i++){  
                 block.item(i).style.display = '';  
             }  
         }else{  
   
             foldbutton.value = '@{[&mt("Show")]}';  
             for (i = 0; i < block.length; i++){  
                 // block.item(i).style.visibility = 'collapse';  
                 block.item(i).style.display = 'none';  
             }  
         };  
         saveState(lastresource);  
     }  
   
     function saveState (lastresource) {  
   
         var tag_list = getTagList();  
         if(tag_list != null){  
             var timestamp = new Date().getTime();  
             var key = lastresource;  
   
             // the value pattern is: 'time;key1,value1;key2,value2; ... '  
             // starting with timestamp  
             var value = timestamp+';';  
   
             // building the list of key-value pairs  
             for(var i = 0; i < tag_list.length; i++){  
                 value += tag_list[i]+',';  
                 value += document.getElementsByName(tag_list[i])[0].style.display+';';  
             }  
   
             // only iterate whole storage if nothing to override  
             if(localStorage.getItem(key) == null){  
   
                 // prevent storage from growing large  
                 if(localStorage.length > 50){  
                     var regex_getTimestamp = /^(?:\d)+;/;  
                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));  
                     var oldest_key;  
   
                     for(var i = 1; i < localStorage.length; i++){  
                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {  
                             oldest_key = localStorage.key(i);  
                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);  
                         }  
                     }  
                     localStorage.removeItem(oldest_key);  
                 }  
             }  
             localStorage.setItem(key,value);  
         }  
     }  
   
     // restore folding status of blocks (on page load)  
     function restoreState (lastresource) {  
         if(localStorage.getItem(lastresource) != null){  
             var key = lastresource;  
             var value = localStorage.getItem(key);  
             var regex_delTimestamp = /^\d+;/;  
   
             value.replace(regex_delTimestamp, '');  
   
             var valueArr = value.split(';');  
             var pairs;  
             var elements;  
             for (var i = 0; i < valueArr.length; i++){  
                 pairs = valueArr[i].split(',');  
                 elements = document.getElementsByName(pairs[0]);  
   
                 for (var j = 0; j < elements.length; j++){  
                     elements[j].style.display = pairs[1];  
                     if (pairs[1] == "none"){  
                         var regex_id = /([_\\d]+)\$/;  
                         regex_id.exec(pairs[0]);  
                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";  
                     }  
                 }  
             }  
         }  
     }  
   
     function getTagList () {  
   
         var stringToSearch = document.lonhomework.innerHTML;  
   
         var ret = new Array();  
         var regex_findBlock = /(foldblock_.*?)"/g;  
         var tag_list = stringToSearch.match(regex_findBlock);  
   
         if(tag_list != null){  
             for(var i = 0; i < tag_list.length; i++){  
                 ret.push(tag_list[i].replace(/"/, ''));  
             }  
         }  
         return ret;  
     }  
   
     function saveScrollPosition (resource) {  
         var tag_list = getTagList();  
   
         // we dont always want to jump to the first block  
         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this  
         if(\$(window).scrollTop() > 170){  
             if(tag_list != null){  
                 var result;  
                 for(var i = 0; i < tag_list.length; i++){  
                     if(isElementInViewport(tag_list[i])){  
                         result += tag_list[i]+';';  
                     }  
                 }  
                 sessionStorage.setItem('anchor_'+resource, result);  
             }  
         } else {  
             // we dont need to save zero, just delete the item to leave everything tidy  
             sessionStorage.removeItem('anchor_'+resource);  
         }  
     }  
   
     function restoreScrollPosition(resource){  
   
         var elem = sessionStorage.getItem('anchor_'+resource);  
         if(elem != null){  
             var tag_list = elem.split(';');  
             var elem_list;  
   
             for(var i = 0; i < tag_list.length; i++){  
                 elem_list = document.getElementsByName(tag_list[i]);  
   
                 if(elem_list.length > 0){  
                     elem = elem_list[0];  
                     break;  
                 }  
             }  
             elem.scrollIntoView();  
         }  
     }  
   
     function isElementInViewport(el) {  
   
         // change to last element instead of first  
         var elem = document.getElementsByName(el);  
         var rect = elem[0].getBoundingClientRect();  
   
         return (  
             rect.top >= 0 &&  
             rect.left >= 0 &&  
             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */  
             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */  
         );  
     }  
   
     function autosize(depth){  
         var cmInst = window['cm'+depth];  
         var fitsizeButton = document.getElementById('fitsize'+depth);  
   
         // is fixed size, switching to dynamic  
         if (sessionStorage.getItem("autosized_"+depth) == null) {  
             cmInst.setSize("","auto");  
             fitsizeButton.value = "@{[&mt('Fixed size')]}";  
             sessionStorage.setItem("autosized_"+depth, "yes");  
   
         // is dynamic size, switching to fixed  
         } else {  
             cmInst.setSize("","300px");  
             fitsizeButton.value = "@{[&mt('Dynamic size')]}";  
             sessionStorage.removeItem("autosized_"+depth);  
         }  
     }  
   
   
   
 // ]]>  
 </script>  
 COLORFULEDIT  
 }  
   
 sub xmleditor_js {  
     return <<XMLEDIT  
 <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>  
 <script type="text/javascript">  
 // <![CDATA[>  
   
     function saveScrollPosition (resource) {  
   
         var scrollPos = \$(window).scrollTop();  
         sessionStorage.setItem(resource,scrollPos);  
     }  
   
     function restoreScrollPosition(resource){  
   
         var scrollPos = sessionStorage.getItem(resource);  
         \$(window).scrollTop(scrollPos);  
     }  
   
     // unless internet explorer  
     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){  
   
         \$(document).ready(function() {  
              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});  
         });  
     }  
   
     // inserts text at cursor position into codemirror (xml editor only)  
     function insertText(text){  
         cm.focus();  
         var curPos = cm.getCursor();  
         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});  
     }  
 // ]]>  
 </script>  
 XMLEDIT  
 }  
   
 sub insert_folding_button {  
     my $curDepth = $Apache::lonxml::curdepth;  
     my $lastresource = $env{'request.ambiguous'};  
   
     return "<input type=\"button\" id=\"folding_btn_$curDepth\"  
             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";  
 }  
   
   
 =pod  =pod
   
 =head1 Excel and CSV file utility routines  =head1 Excel and CSV file utility routines
   
   =over 4
   
 =cut  =cut
   
 ###############################################################  ###############################################################
Line 2003  sub insert_folding_button { Line 1758  sub insert_folding_button {
   
 =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 2251  sub multiple_select_form { Line 2004  sub multiple_select_form {
   
 =pod  =pod
   
 =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)  =item * &select_form($defdom,$name,$hashref,$onchange)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select options from a ref to a hash containing:  allow a user to select options from a ref to a hash containing:
 option_name => displayed text. An optional $onchange can include  option_name => displayed text. An optional $onchange can include
 a javascript onchange item, e.g., onchange="this.form.submit();".  a javascript onchange item, e.g., onchange="this.form.submit();"  
 An optional arg -- $readonly -- if true will cause the select form  
 to be disabled, e.g., for the case where an instructor has a section-  
 specific role, and is viewing/modifying parameters.    
   
 See lonrights.pm for an example invocation and use.  See lonrights.pm for an example invocation and use.
   
Line 2267  See lonrights.pm for an example invocati Line 2017  See lonrights.pm for an example invocati
   
 #-------------------------------------------  #-------------------------------------------
 sub select_form {  sub select_form {
     my ($def,$name,$hashref,$onchange,$readonly) = @_;      my ($def,$name,$hashref,$onchange) = @_;
     return unless (ref($hashref) eq 'HASH');      return unless (ref($hashref) eq 'HASH');
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
     }      }
     my $disabled;      my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
     if ($readonly) {  
         $disabled = ' disabled="disabled"';  
     }  
     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";  
     my @keys;      my @keys;
     if (exists($hashref->{'select_form_order'})) {      if (exists($hashref->{'select_form_order'})) {
  @keys=@{$hashref->{'select_form_order'}};   @keys=@{$hashref->{'select_form_order'}};
Line 2445  sub select_level_form { Line 2191  sub select_level_form {
   
 =pod  =pod
   
 =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)  =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 2462  The optional $incdoms is a reference to Line 2208  The optional $incdoms is a reference to
   
 The optional $excdoms is a reference to an array of domains which will be excluded from the available options.  The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
   
 The optional $disabled argument, if true, adds the disabled attribute to the select tag.   
   
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
 sub select_dom_form {  sub select_dom_form {
     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;      my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
     }      }
     if ($disabled) {  
         $disabled = ' disabled="disabled"';  
     }  
     my (@domains,%exclude);      my (@domains,%exclude);
     if (ref($incdoms) eq 'ARRAY') {      if (ref($incdoms) eq 'ARRAY') {
         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});          @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
Line 2483  sub select_dom_form { Line 2224  sub select_dom_form {
     }      }
     if ($includeempty) { @domains=('',@domains); }      if ($includeempty) { @domains=('',@domains); }
     if (ref($excdoms) eq 'ARRAY') {      if (ref($excdoms) eq 'ARRAY') {
         map { $exclude{$_} = 1; } @{$excdoms};          map { $exclude{$_} = 1; } @{$excdoms}; 
     }      }
     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";      my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
     foreach my $dom (@domains) {      foreach my $dom (@domains) {
         next if ($exclude{$dom});          next if ($exclude{$dom});
         $selectdomain.="<option value=\"$dom\" ".          $selectdomain.="<option value=\"$dom\" ".
Line 2612  Outputs: Line 2353  Outputs:
   
 =item * $clientinfo  =item * $clientinfo
   
 =item * $clientosversion  
   
 =back  =back
   
 =back   =back 
Line 2633  sub decode_user_agent { Line 2372  sub decode_user_agent {
     my $clientmathml='';      my $clientmathml='';
     my $clientunicode='0';      my $clientunicode='0';
     my $clientmobile=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 2655  sub decode_user_agent { Line 2393  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) {      if ($httpbrowser=~/win/i) { $clientos='win'; }
         $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) {      if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
         $clientmobile=lc($1);          $clientmobile=lc($1);
Line 2671  sub decode_user_agent { Line 2404  sub decode_user_agent {
         $clientinfo = 'chromeframe-'.$1;          $clientinfo = 'chromeframe-'.$1;
     }      }
     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,      return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
             $clientunicode,$clientos,$clientmobile,$clientinfo,              $clientunicode,$clientos,$clientmobile,$clientinfo);
             $clientosversion);  
 }  }
   
 ###############################################################  ###############################################################
Line 2839  sub authform_nochange { Line 2571  sub authform_nochange {
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
           );            );
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});       my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     my $result;      my $result;
     if (!$authnum) {      if (!$authnum) {
         $result = &mt('Under your current role you are not permitted to change login settings for this user');          $result = &mt('Under your current role you are not permitted to change login settings for this user');
Line 2861  sub authform_kerberos { Line 2593  sub authform_kerberos {
               @_,                @_,
               );                );
     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,      my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
         $autharg,$jscall,$disabled);          $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 {
        $check4 = ' checked="checked"';         $check4 = ' checked="checked"';
     }      }
     if ($in{'readonly'}) {  
         $disabled = ' disabled="disabled"';  
     }  
     $krbarg = $in{'kerb_def_dom'};      $krbarg = $in{'kerb_def_dom'};
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'krb') {          if ($in{'curr_authtype'} eq 'krb') {
Line 2915  sub authform_kerberos { Line 2644  sub authform_kerberos {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';                      $authtype = '<input type="radio" name="login" value="krb" />';
                 }                  }
             }              }
         }          }
Line 2924  sub authform_kerberos { Line 2653  sub authform_kerberos {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="krb" '.          $authtype = '<input type="radio" name="login" value="krb" '.
                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.                      'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                     $krbcheck.$disabled.' />';                      $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'} &&
Line 2937  sub authform_kerberos { Line 2666  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'"'.$disabled.' />',               'onchange="'.$jscall.'" />',
          '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',           '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
          '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',           '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
  '</label>');   '</label>');
     } elsif ($can_assign{'krb4'}) {      } elsif ($can_assign{'krb4'}) {
         $result .= &mt          $result .= &mt
Line 2948  sub authform_kerberos { Line 2677  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'"'.$disabled.' />',               'onchange="'.$jscall.'" />',
          '<label><input type="hidden" name="krbver" value="4" />',           '<label><input type="hidden" name="krbver" value="4" />',
          '</label>');           '</label>');
     } elsif ($can_assign{'krb5'}) {      } elsif ($can_assign{'krb5'}) {
Line 2958  sub authform_kerberos { Line 2687  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'"'.$disabled.' />',               'onchange="'.$jscall.'" />',
          '<label><input type="hidden" name="krbver" value="5" />',           '<label><input type="hidden" name="krbver" value="5" />',
          '</label>');           '</label>');
     }      }
Line 2971  sub authform_internal { Line 2700  sub authform_internal {
                 kerb_def_dom => 'MSU.EDU',                  kerb_def_dom => 'MSU.EDU',
                 @_,                  @_,
                 );                  );
     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);      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 ($in{'readonly'}) {  
         $disabled = ' disabled="disabled"';  
     }  
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'int') {          if ($in{'curr_authtype'} eq 'int') {
             if ($can_assign{'int'}) {              if ($can_assign{'int'}) {
Line 3004  sub authform_internal { Line 2730  sub authform_internal {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';                      $authtype = '<input type="radio" name="login" value="int" />';
                 }                  }
             }              }
         }          }
Line 3012  sub authform_internal { Line 2738  sub authform_internal {
     $jscall = "javascript:changed_radio('int',$in{'formname'});";      $jscall = "javascript:changed_radio('int',$in{'formname'});";
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.          $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                     ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';                      ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
     }      }
     $autharg = '<input type="password" size="10" name="intarg" value="'.      $autharg = '<input type="password" size="10" name="intarg" value="'.
                $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';                 $intarg.'" onchange="'.$jscall.'" />';
     $result = &mt      $result = &mt
         ('[_1] Internally authenticated (with initial password [_2])',          ('[_1] Internally authenticated (with initial password [_2])',
          '<label>'.$authtype,'</label>'.$autharg);           '<label>'.$authtype,'</label>'.$autharg);
     $result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';      $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
     return $result;      return $result;
 }  }
   
Line 3029  sub authform_local { Line 2755  sub authform_local {
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);      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 ($in{'readonly'}) {  
         $disabled = ' disabled="disabled"';  
     }  
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'loc') {          if ($in{'curr_authtype'} eq 'loc') {
             if ($can_assign{'loc'}) {              if ($can_assign{'loc'}) {
Line 3062  sub authform_local { Line 2785  sub authform_local {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';                      $authtype = '<input type="radio" name="login" value="loc" />';
                 }                  }
             }              }
         }          }
Line 3071  sub authform_local { Line 2794  sub authform_local {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="loc" '.          $authtype = '<input type="radio" name="login" value="loc" '.
                     $loccheck.' onchange="'.$jscall.'" onclick="'.                      $loccheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'"'.$disabled.' />';                      $jscall.'" />';
     }      }
     $autharg = '<input type="text" size="10" name="locarg" value="'.      $autharg = '<input type="text" size="10" name="locarg" value="'.
                $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';                 $locarg.'" onchange="'.$jscall.'" />';
     $result = &mt('[_1] Local Authentication with argument [_2]',      $result = &mt('[_1] Local Authentication with argument [_2]',
                   '<label>'.$authtype,'</label>'.$autharg);                    '<label>'.$authtype,'</label>'.$autharg);
     return $result;      return $result;
Line 3086  sub authform_filesystem { Line 2809  sub authform_filesystem {
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);      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 ($in{'readonly'}) {  
         $disabled = ' disabled="disabled"';  
     }  
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'fsys') {          if ($in{'curr_authtype'} eq 'fsys') {
             if ($can_assign{'fsys'}) {              if ($can_assign{'fsys'}) {
Line 3116  sub authform_filesystem { Line 2836  sub authform_filesystem {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';                      $authtype = '<input type="radio" name="login" value="fsys" />';
                 }                  }
             }              }
         }          }
Line 3125  sub authform_filesystem { Line 2845  sub authform_filesystem {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="fsys" '.          $authtype = '<input type="radio" name="login" value="fsys" '.
                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.                      $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'"'.$disabled.' />';                      $jscall.'" />';
     }      }
     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.      $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                ' onchange="'.$jscall.'"'.$disabled.' />';                 ' onchange="'.$jscall.'" />';
     $result = &mt      $result = &mt
         ('[_1] Filesystem Authenticated (with initial password [_2])',          ('[_1] Filesystem Authenticated (with initial password [_2])',
          '<label><input type="radio" name="login" value="fsys" '.           '<label><input type="radio" name="login" value="fsys" '.
          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',           $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
          '</label><input type="password" size="10" name="fsysarg" value="" '.           '</label><input type="password" size="10" name="fsysarg" value="" '.
                   'onchange="'.$jscall.'"'.$disabled.' />');                    'onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
   
Line 3156  sub get_assignable_auth { Line 2876  sub get_assignable_auth {
             my $context;              my $context;
             if ($env{'request.role'} =~ /^au/) {              if ($env{'request.role'} =~ /^au/) {
                 $context = 'author';                  $context = 'author';
             } elsif ($env{'request.role'} =~ /^(dc|dh)/) {              } elsif ($env{'request.role'} =~ /^dc/) {
                 $context = 'domain';                  $context = 'domain';
             } elsif ($env{'request.course.id'}) {              } elsif ($env{'request.course.id'}) {
                 $context = 'course';                  $context = 'course';
Line 3180  sub get_assignable_auth { Line 2900  sub get_assignable_auth {
     return ($authnum,%can_assign);      return ($authnum,%can_assign);
 }  }
   
 sub check_passwd_rules {  
     my ($domain,$plainpass) = @_;  
     my %passwdconf = &Apache::lonnet::get_passwdconf($domain);  
     my ($min,$max,@chars,@brokerule,$warning);  
     $min = $Apache::lonnet::passwdmin;  
     if (ref($passwdconf{'chars'}) eq 'ARRAY') {  
         if ($passwdconf{'min'} =~ /^\d+$/) {  
             if ($passwdconf{'min'} > $min) {  
                 $min = $passwdconf{'min'};  
             }  
         }  
         if ($passwdconf{'max'} =~ /^\d+$/) {  
             $max = $passwdconf{'max'};  
         }  
         @chars = @{$passwdconf{'chars'}};  
     }  
     if (($min) && (length($plainpass) < $min)) {  
         push(@brokerule,'min');  
     }  
     if (($max) && (length($plainpass) > $max)) {  
         push(@brokerule,'max');  
     }  
     if (@chars) {  
         my %rules;  
         map { $rules{$_} = 1; } @chars;  
         if ($rules{'uc'}) {  
             unless ($plainpass =~ /[A-Z]/) {  
                 push(@brokerule,'uc');  
             }  
         }  
         if ($rules{'lc'}) {  
             unless ($plainpass =~ /[a-z]/) {  
                 push(@brokerule,'lc');  
             }  
         }  
         if ($rules{'num'}) {  
             unless ($plainpass =~ /\d/) {  
                 push(@brokerule,'num');  
             }  
         }  
         if ($rules{'spec'}) {  
             unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {  
                 push(@brokerule,'spec');  
             }  
         }  
     }  
     if (@brokerule) {  
         my %rulenames = &Apache::lonlocal::texthash(  
             uc   => 'At least one upper case letter',  
             lc   => 'At least one lower case letter',  
             num  => 'At least one number',  
             spec => 'At least one non-alphanumeric',  
         );  
         $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';  
         $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';  
         $rulenames{'num'} .= ': 0123456789';  
         $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';  
         $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);  
         $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);  
         $warning = &mt('Password did not satisfy the following:').'<ul>';  
         foreach my $rule ('min','max','uc','lc','num','spec') {  
             if (grep(/^$rule$/,@brokerule)) {  
                 $warning .= '<li>'.$rulenames{$rule}.'</li>';  
             }  
         }  
         $warning .= '</ul>';  
     }  
     if (wantarray) {  
         return @brokerule;  
     }  
     return $warning;  
 }  
   
 ###############################################################  ###############################################################
 ##    Get Kerberos Defaults for Domain                 ##  ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################  ###############################################################
Line 3420  sub get_related_words { Line 3067  sub get_related_words {
     untie %thesaurus_db;      untie %thesaurus_db;
     return @Words;      return @Words;
 }  }
   ###############################################################
   #
   #  Spell checking
   #
   
 =pod  =pod
   
 =back  =back
   
   =head1 Spell checking
   
   =over 4
   
   =item * &check_spelling($wordlist $language)
   
   Takes a string containing words and feeds it to an external
   spellcheck program via a pipeline. Returns a string containing
   them mis-spelled words.
   
   Parameters:
   
   =over 4
   
   =item - $wordlist
   
   String that will be fed into the spellcheck program.
   
   =item - $language
   
   Language string that specifies the language for which the spell
   check will be performed.
   
   =back
   
   =back
   
   Note: This sub assumes that aspell is installed.
   
   
 =cut  =cut
   
   
   sub check_spelling {
       my ($wordlist, $language) = @_;
       my @misspellings;
       
       # Generate the speller and set the langauge.
       # if explicitly selected:
   
       my $speller = Text::Aspell->new;
       if ($language) {
    $speller->set_option('lang', $language);
       }
   
       # Turn the word list into an array of words by splittingon whitespace
   
       my @words = split(/\s+/, $wordlist);
   
       foreach my $word (@words) {
    if(! $speller->check($word)) {
       push(@misspellings, $word);
    }
       }
       return join(' ', @misspellings);
       
   }
   
 # -------------------------------------------------------------- Plaintext name  # -------------------------------------------------------------- Plaintext name
 =pod  =pod
   
Line 4033  sub user_lang { Line 3740  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, $usec, $identifier)      $getattempt, $regexp, $gradesub)
   
 Return string with previous attempt on problem. Arguments:  Return string with previous attempt on problem. Arguments:
   
Line 4055  Return string with previous attempt on p Line 3762  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 4067  The output string is a table containing Line 3769  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,$usec,$identifier)=@_;    my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
   my $prevattempts='';    my $prevattempts='';
   no strict 'refs';    no strict 'refs';
   if ($symb) {    if ($symb) {
Line 4077  sub get_previous_attempt { Line 3779  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 (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {          foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
             if ($key =~ /\.rawrndseed$/) {    $lasthash{$key}=$returnhash{$version.':'.$key};
                 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,%regraded,%hidestatus);        my (%typeparts,%lasthidden);
       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 4105  sub get_previous_attempt { Line 3802  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 4128  sub get_previous_attempt { Line 3813  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,@unsolved);              my @hidden;
             if (%typeparts) {              if (%typeparts) {
                 foreach my $id (keys(%typeparts)) {                  foreach my $id (keys(%typeparts)) {
                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||                      if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {  
                         push(@hidden,$id);                          push(@hidden,$id);
                     } elsif ($identifier ne '') {  
                         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>'.&mt('Transaction [_1]',$version).'</td>';
             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 4203  sub get_previous_attempt { Line 3845  sub get_previous_attempt {
                         }                          }
                     } else {                      } else {
                         if ($key =~ /\./) {                          if ($key =~ /\./) {
                             my $value = $returnhash{$version.':'.$key};                              my $value = &format_previous_attempt_value($key,
                             if ($key =~ /\.rndseed$/) {                                                $returnhash{$version.':'.$key});
                                 my ($id) = ($key =~ /^(.+)\.rndseed$/);                              $prevattempts.='<td>'.$value.'&nbsp;</td>';
                                 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 4220  sub get_previous_attempt { Line 3856  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 = $returnhash{$version.':'.$key};      my $value = &format_previous_attempt_value($key,
                     if ($key =~ /\.rndseed$/) {              $returnhash{$version.':'.$key});
                         my ($id) = ($key =~ /^(.+)\.rndseed$/);      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                         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 4678  sub findallcourses { Line 4308  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;      my ($setters,$activity,$uname,$udom,$url) = @_;
   
     if (defined($udom) && defined($uname)) {      if (!defined($udom)) {
         # 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 4701  sub blockcheck { Line 4334  sub blockcheck {
     # boards, chat or groups, check for blocking in current course only.      # boards, chat or groups, check for blocking in current course only.
   
     if (($activity eq 'boards' || $activity eq 'chat' ||      if (($activity eq 'boards' || $activity eq 'chat' ||
          $activity eq 'groups' || $activity eq 'printout') &&           $activity eq 'groups') && ($env{'request.course.id'})) {
         ($env{'request.course.id'})) {  
         foreach my $key (keys(%live_courses)) {          foreach my $key (keys(%live_courses)) {
             if ($key ne $env{'request.course.id'}) {              if ($key ne $env{'request.course.id'}) {
                 delete($live_courses{$key});                  delete($live_courses{$key});
Line 4785  sub blockcheck { Line 4417  sub blockcheck {
                                                                 $tdom,$spec,$trest,$area);                                                                  $tdom,$spec,$trest,$area);
                         }                          }
                     }                      }
                     my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);                      my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {                      if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                         if ($1) {                          if ($1) {
                             $no_userblock = 1;                              $no_userblock = 1;
Line 4807  sub blockcheck { Line 4439  sub blockcheck {
                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));                   ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
         next if ($no_userblock);          next if ($no_userblock);
   
         # Retrieve blocking times and identity of blocker for course          # Retrieve blocking times and identity of locker for course
         # of specified user, unless user has 'evb' privilege.          # of specified user, unless user has 'evb' privilege.
                   
         my ($start,$end,$trigger) =           my ($start,$end,$trigger) = 
Line 4966  sub parse_block_record { Line 4598  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
     my ($activity,$uname,$udom,$url,$is_course) = @_;      my ($activity,$uname,$udom,$url) = @_;
     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,$is_course);          &blockcheck(\%setters,$activity,$uname,$udom,$url);
     my $blocked = 0;      my $blocked = 0;
     if ($startblock && $endblock) {      if ($startblock && $endblock) {
         $blocked = 1;          $blocked = 1;
Line 4983  sub blocking_status { Line 4615  sub blocking_status {
 # build a link to a popup window containing the details  # build a link to a popup window containing the details
     my $querystring  = "?activity=$activity";      my $querystring  = "?activity=$activity";
 # $uname and $udom decide whose portfolio the user is trying to look at  # $uname and $udom decide whose portfolio the user is trying to look at
     if (($activity eq 'port') || ($activity eq 'passwd')) {      if ($activity eq 'port') {
         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);          $querystring .= "&amp;udom=$udom"      if $udom;
         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);          $querystring .= "&amp;uname=$uname"    if $uname;
     } elsif ($activity eq 'docs') {      } elsif ($activity eq 'docs') {
         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');          $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
     }      }
Line 5004  END_MYBLOCK Line 4636  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') {      } elsif ($activity eq 'printout') {
         $text = &mt('Printing Blocked');          $text = &mt('Printing Blocked');
     } elsif ($activity eq 'passwd') {  
         $text = &mt('Password Changing Blocked');  
     }      }
     $output .= <<"END_BLOCK";      $output .= <<"END_BLOCK";
 <div class='$class'>  <div class='LC_comblock'>
   <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 5030  END_BLOCK Line 4658  END_BLOCK
 ###############################################  ###############################################
   
 sub check_ip_acc {  sub check_ip_acc {
     my ($acc,$clientip)=@_;      my ($acc)=@_;
     &Apache::lonxml::debug("acc is $acc");      &Apache::lonxml::debug("acc is $acc");
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed=0;      my $allowed=0;
     my $ip;      my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
     if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||  
         ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {  
         $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;  
     } else {  
         $ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip;  
     }  
   
     my $name;      my $name;
     foreach my $pattern (split(',',$acc)) {      foreach my $pattern (split(',',$acc)) {
Line 5138  sub get_domainconf { Line 4760  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') || ($key eq 'headtag')) {                          if ($key eq 'loginvia') {
                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {                              if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {                                  foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {                                      if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                                         if ($key eq 'loginvia') {                                          if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {                                              my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};                                              $designhash{$udom.'.login.loginvia'} = $server;
                                                 $designhash{$udom.'.login.loginvia'} = $server;                                              if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {  
                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};                                                  $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                                                 } else {                                              } else {
                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};                                                  $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                                                 }  
                                             }                                              }
                                         } elsif ($key eq 'headtag') {                                              if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {                                                  $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                                                 $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 5227  sub get_legacy_domconf { Line 4844  sub get_legacy_domconf {
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     my $designfile =  $designdir.'/'.$udom.'.tab';      my $designfile =  $designdir.'/'.$udom.'.tab';
     if (-e $designfile) {      if (-e $designfile) {
         if ( open (my $fh,'<',$designfile) ) {          if ( open (my $fh,"<$designfile") ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line =~ /^\#/);                  next if ($line =~ /^\#/);
                 chomp($line);                  chomp($line);
Line 5478  Inputs: Line 5095  Inputs:
   
 =item * $bgcolor, used to override the bgcolor on a webpage to a specific value  =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
   
 =item * $no_inline_link, if true and in remote mode, don't show the  
          'Switch To Inline Menu' link  
   
 =item * $args, optional argument valid values are  =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg              no_auto_mt_title -> prevents &mt()ing the title arg
             use_absolute     -> for external resource or syllabus, this will              inherit_jsmath -> when creating popup window in a page,
                                 contain https://<hostname> if server uses                                should it have jsmath forced on by the
                                 https (as per hosts.tab), but request is for http                                current page
             hostname         -> hostname, from $r->hostname().  
   
 =item * $advtoolsref, optional argument, ref to an array containing  =item * $advtoolsref, optional argument, ref to an array containing
             inlineremote items to be added in "Functions" menu below              inlineremote items to be added in "Functions" menu below
Line 5503  other decorations will be returned. Line 5116  other decorations will be returned.
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;          $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
   
     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 5511  sub bodytag { Line 5124  sub bodytag {
         $public = 1;          $public = 1;
     }      }
     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }      if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
     my $httphost = $args->{'use_absolute'};  
     my $hostname = $args->{'hostname'};  
   
     $function = &get_users_function() if (!$function);      $function = &get_users_function() if (!$function);
     my $img =    &designparm($function.'.img',$domain);      my $img =    &designparm($function.'.img',$domain);
Line 5528  sub bodytag { Line 5139  sub bodytag {
     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};       @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
   
  # role and realm   # role and realm
     my ($role,$realm) = split(m{\./},$env{'request.role'},2);      my ($role,$realm) = split(/\./,$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 5540  sub bodytag { Line 5148  sub bodytag {
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         if ($env{'request.role'} !~ /^cr/) {          if ($env{'request.role'} !~ /^cr/) {
             $role = &Apache::lonnet::plaintext($role,&course_type());              $role = &Apache::lonnet::plaintext($role,&course_type());
         } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {  
             if ($env{'request.role.desc'}) {  
                 $role = $env{'request.role.desc'};  
             } else {  
                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);  
             }  
         } else {  
             $role = (split(/\//,$role,4))[-1];  
         }          }
         if ($env{'request.course.sec'}) {          if ($env{'request.course.sec'}) {
             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};              $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
Line 5563  sub bodytag { Line 5163  sub bodytag {
   
 # construct main body tag  # construct main body tag
     my $bodytag = "<body $extra_body_attr>".      my $bodytag = "<body $extra_body_attr>".
  &Apache::lontexconvert::init_math_support();   &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
   
     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);      &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
   
Line 5587  sub bodytag { Line 5187  sub bodytag {
         $dc_info =~ s/\s+$//;          $dc_info =~ s/\s+$//;
     }      }
   
     $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});      $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
   
     if ($env{'request.state'} eq 'construct') { $forcereg=1; }          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(          $bodytag .= Apache::lonhtmlcommon::scripttag(
             Apache::lonmenu::utilityfunctions($httphost), 'start');              Apache::lonmenu::utilityfunctions(), 'start');
   
         my ($left,$right) = Apache::lonmenu::primary_menu();          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">$left $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;
         }          }
   
Line 5636  sub bodytag { Line 5220  sub bodytag {
         }          }
         $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($httphost);              $bodytag .= Apache::lonmenu::secondary_menu();
             $bodytag .= Apache::lonmenu::serverform();              $bodytag .= Apache::lonmenu::serverform();
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');              $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {              if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,
                                 $args->{'bread_crumbs'},'','',$hostname);                                  $args->{'bread_crumbs'});
             } elsif ($forcereg) {              } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                             $args->{'group'},                                                              $args->{'group'});
                                                             $args->{'hide_buttons',  
                                                             $hostname});  
             } else {              } else {
                 my $forbodytag;                  $bodytag .= 
                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},                      &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                                     $forcereg,$args->{'group'},                                                          $forcereg,$args->{'group'},
                                                     $args->{'bread_crumbs'},                                                          $args->{'bread_crumbs'},
                                                     $advtoolsref,'',$hostname,                                                          $advtoolsref);
                                                     \$forbodytag);  
                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {  
                     $bodytag .= $forbodytag;  
                 }  
             }              }
         }else{          }else{
             # this is to seperate menu from content when there's no secondary              # this is to seperate menu from content when there's no secondary
Line 5672  sub bodytag { Line 5246  sub bodytag {
         }          }
   
         return $bodytag;          return $bodytag;
     }  
   
 #  
 # Top frame rendering, Remote is up  
 #  
   
     my $imgsrc = $img;  
     if ($img =~ /^\/adm/) {  
         $imgsrc = &lonhttpdurl($img);  
     }  
     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';  
   
     my $help=($no_inline_link?''  
               :&Apache::loncommon::top_nav_help('Help'));  
   
     # Explicit link to get inline menu  
     my $menu= ($no_inline_link?''  
                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');  
   
     if ($dc_info) {  
         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;  
     }  
   
     my $name = &plainname($env{'user.name'},$env{'user.domain'});  
     unless ($public) {  
         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},  
                                 undef,'LC_menubuttons_link');  
     }  
   
     unless ($env{'form.inhibitmenu'}) {  
         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>  
                        <ol class="LC_primary_menu LC_floatright LC_right">  
                        <li>$help</li>  
                        <li>$menu</li>  
                        </ol><div id="LC_realm"> $realm $dc_info</div>|;  
     }  
     if ($env{'request.state'} eq 'construct') {  
         if (!$public){  
             if ($env{'request.state'} eq 'construct') {  
                 $funclist = &Apache::lonhtmlcommon::scripttag(  
                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').  
                             &Apache::lonhtmlcommon::scripttag('','end').  
                             &Apache::lonmenu::innerregister($forcereg,  
                                                             $args->{'bread_crumbs'});  
             }  
         }  
     }  
     return $bodytag."\n".$funclist;  
 }  }
   
 sub dc_courseid_toggle {  sub dc_courseid_toggle {
Line 5751  sub make_attr_string { Line 5277  sub make_attr_string {
  delete($attr_ref->{$key});   delete($attr_ref->{$key});
     }      }
  }   }
         if ($env{'environment.remote'} eq 'on') {   $attr_ref->{'onload'}  = $on_load;
             $attr_ref->{'onload'}  =   $attr_ref->{'onunload'}= $on_unload;
                 &Apache::lonmenu::loadevents().  $on_load;  
             $attr_ref->{'onunload'}=  
                 &Apache::lonmenu::unloadevents().$on_unload;  
         } else {    
     $attr_ref->{'onload'}  = $on_load;  
     $attr_ref->{'onunload'}= $on_unload;  
         }  
     }      }
   
     my $attr_string;      my $attr_string;
     foreach my $attr (sort(keys(%$attr_ref))) {      foreach my $attr (keys(%$attr_ref)) {
  $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';   $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
     }      }
     return $attr_string;      return $attr_string;
Line 5793  sub endbodytag { Line 5312  sub endbodytag {
     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {      unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
         $endbodytag='</body>';          $endbodytag='</body>';
     }      }
       $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
     if ( exists( $env{'internal.head.redirect'} ) ) {      if ( exists( $env{'internal.head.redirect'} ) ) {
         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {          if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
     $endbodytag=      $endbodytag=
Line 5967  div.LC_confirm_box .LC_success img { Line 5487  div.LC_confirm_box .LC_success img {
   vertical-align: middle;    vertical-align: middle;
 }  }
   
 .LC_maxwidth {  
   max-width: 100%;  
   height: auto;  
 }  
   
 .LC_textsize_mobile {  
   \@media only screen and (max-device-width: 480px) {  
       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;  
   }  
 }  
   
 .LC_icon {  .LC_icon {
   border: none;    border: none;
   vertical-align: middle;    vertical-align: middle;
Line 6099  table#LC_menubuttons img { Line 5608  table#LC_menubuttons img {
   vertical-align: middle;    vertical-align: middle;
 }  }
   
 .LC_breadcrumbs_hoverable {  
   background: $sidebg;  
 }  
   
 td.LC_table_cell_checkbox {  td.LC_table_cell_checkbox {
   text-align: center;    text-align: center;
 }  }
Line 6173  td.LC_menubuttons_text { Line 5678  td.LC_menubuttons_text {
   background: $tabbg;    background: $tabbg;
 }  }
   
 td.LC_zero_height {  
   line-height: 0;  
   cellpadding: 0;  
 }  
   
 table.LC_data_table {  table.LC_data_table {
   border: 1px solid #000000;    border: 1px solid #000000;
   border-collapse: separate;    border-collapse: separate;
Line 6768  table.LC_prior_tries td { Line 6268  table.LC_prior_tries td {
   padding: 6px;    padding: 6px;
 }  }
   
 .LC_answer_unknown,  .LC_answer_unknown {
 .LC_answer_warning {  
   background: orange;    background: orange;
   color: black;    color: black;
   padding: 6px;    padding: 6px;
Line 6851  table.LC_data_table tr > td.LC_docs_entr Line 6350  table.LC_data_table tr > td.LC_docs_entr
   color: #990000;    color: #990000;
 }  }
   
 .LC_domprefs_email,  
 .LC_docs_reinit_warn,  .LC_docs_reinit_warn,
 .LC_docs_ext_edit {  .LC_docs_ext_edit {
   font-size: x-small;    font-size: x-small;
Line 6967  div.LC_edit_problem_footer, Line 6465  div.LC_edit_problem_footer,
 div.LC_edit_problem_footer div,  div.LC_edit_problem_footer div,
 div.LC_edit_problem_editxml_header,  div.LC_edit_problem_editxml_header,
 div.LC_edit_problem_editxml_header div {  div.LC_edit_problem_editxml_header div {
   z-index: 100;    margin-top: 5px;
 }  }
   
 div.LC_edit_problem_header_title {  div.LC_edit_problem_header_title {
Line 6983  table.LC_edit_problem_header_title { Line 6481  table.LC_edit_problem_header_title {
   background: $tabbg;    background: $tabbg;
 }  }
   
 div.LC_edit_actionbar {  div.LC_edit_problem_discards {
     background-color: $sidebg;    float: left;
     margin: 0;    padding-bottom: 5px;
     padding: 0;  
     line-height: 200%;  
 }  }
   
 div.LC_edit_actionbar div{  div.LC_edit_problem_saves {
     padding: 0;    float: right;
     margin: 0;    padding-bottom: 5px;
     display: inline-block;  
 }  }
   
 .LC_edit_opt {  .LC_edit_opt {
Line 7001  div.LC_edit_actionbar div{ Line 6496  div.LC_edit_actionbar div{
   white-space: nowrap;    white-space: nowrap;
 }  }
   
 .LC_edit_problem_latexhelper{  
     text-align: right;  
 }  
   
 #LC_edit_problem_colorful div{  
     margin-left: 40px;  
 }  
   
 #LC_edit_problem_codemirror div{  
     margin-left: 0px;  
 }  
   
 img.stift {  img.stift {
   border-width: 0;    border-width: 0;
   vertical-align: middle;    vertical-align: middle;
Line 7100  fieldset { Line 6583  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 7131  fieldset > legend { Line 6610  fieldset > legend {
 ol.LC_primary_menu {  ol.LC_primary_menu {
   margin: 0;    margin: 0;
   padding: 0;    padding: 0;
     background-color: $pgbg_or_bgcolor;
 }  }
   
 ol#LC_PathBreadcrumbs {  ol#LC_PathBreadcrumbs {
Line 7142  ol.LC_primary_menu li { Line 6622  ol.LC_primary_menu li {
   vertical-align: middle;    vertical-align: middle;
   text-align: left;    text-align: left;
   list-style: none;    list-style: none;
   position: relative;  
   float: left;    float: left;
   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */  
   line-height: 1.5em;  
 }  }
   
 ol.LC_primary_menu li a,   ol.LC_primary_menu li a {
 ol.LC_primary_menu li p {  
   display: block;    display: block;
   margin: 0;    margin: 0;
   padding: 0 5px 0 10px;    padding: 0 5px 0 10px;
   text-decoration: none;    text-decoration: none;
 }  }
   
 ol.LC_primary_menu li p span.LC_primary_menu_innertitle {  ol.LC_primary_menu li ul {
   display: inline-block;  
   width: 95%;  
   text-align: left;  
 }  
   
 ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {  
   display: inline-block;  
   width: 5%;  
   float: right;  
   text-align: right;  
   font-size: 70%;  
 }  
   
 ol.LC_primary_menu ul {  
   display: none;    display: none;
   width: 15em;    width: 10em;
   background-color: $data_table_light;    background-color: $data_table_light;
   position: absolute;  
   top: 100%;  
 }  
   
 ol.LC_primary_menu ul ul {  
   left: 100%;  
   top: 0;  
 }  }
   
 ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {  ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
   display: block;    display: block;
   position: absolute;    position: absolute;
   margin: 0;    margin: 0;
Line 7192  ol.LC_primary_menu li:hover > ul, ol.LC_ Line 6647  ol.LC_primary_menu li:hover > ul, ol.LC_
 }  }
   
 ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {  ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
 /* First Submenu -> size should be smaller than the menu title of the whole menu */  
   font-size: 90%;    font-size: 90%;
   vertical-align: top;    vertical-align: top;
   float: none;    float: none;
   border-left: 1px solid black;    border-left: 1px solid black;
   border-right: 1px solid black;    border-right: 1px solid black;
 /* A dark bottom border to visualize different menu options;  
 overwritten in the create_submenu routine for the last border-bottom of the menu */  
   border-bottom: 1px solid $data_table_dark;  
 }  }
   
 ol.LC_primary_menu li li p:hover {  ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
   color:$button_hover;    background-color:$data_table_light;
   text-decoration:none;  
   background-color:$data_table_dark;  
 }  }
   
 ol.LC_primary_menu li li a:hover {  ol.LC_primary_menu li li a:hover {
Line 7214  ol.LC_primary_menu li li a:hover { Line 6663  ol.LC_primary_menu li li a:hover {
    background-color:$data_table_dark;     background-color:$data_table_dark;
 }  }
   
 /* Font-size equal to the size of the predecessors*/  
 ol.LC_primary_menu li:hover li li {  
   font-size: 100%;  
 }  
   
 ol.LC_primary_menu li img {  ol.LC_primary_menu li img {
   vertical-align: bottom;    vertical-align: bottom;
   height: 1.1em;    height: 1.1em;
Line 7760  ul.LC_funclist li { Line 7204  ul.LC_funclist li {
  cursor:pointer;   cursor:pointer;
 }  }
   
 pre.LC_wordwrap {  
   white-space: pre-wrap;  
   white-space: -moz-pre-wrap;  
   white-space: -pre-wrap;  
   white-space: -o-pre-wrap;  
   word-wrap: break-word;  
 }  
   
 /*  /*
   styles used by TTH when "Default set of options to pass to tth/m    styles used by TTH when "Default set of options to pass to tth/m
   when converting TeX" in course settings has been set    when converting TeX" in course settings has been set
Line 7789  span.roman {font-family: serif; font-sty Line 7225  span.roman {font-family: serif; font-sty
 span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}  span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
 span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}  span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
   
 #LC_minitab_header {  
   float:left;  
   width:100%;  
   background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;  
   font-size:93%;  
   line-height:normal;  
   margin: 0.5em 0 0.5em 0;  
 }  
 #LC_minitab_header ul {  
   margin:0;  
   padding:10px 10px 0;  
   list-style:none;  
 }  
 #LC_minitab_header li {  
   float:left;  
   background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;  
   margin:0;  
   padding:0 0 0 9px;  
 }  
 #LC_minitab_header a {  
   display:block;  
   background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;  
   padding:5px 15px 4px 6px;  
 }  
 #LC_minitab_header #LC_current_minitab {  
   background-image:url("/res/adm/pages/minitabmenu_left_on.gif");  
 }  
 #LC_minitab_header #LC_current_minitab a {  
   background-image:url("/res/adm/pages/minitabmenu_right_on.gif");  
   padding-bottom:5px;  
 }  
   
   
 END  END
 }  }
   
Line 7858  sub headtag { Line 7261  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 7869  sub headtag { Line 7271  sub headtag {
   
     my $result =      my $result =
  '<head>'.   '<head>'.
  &font_settings($args);   &font_settings();
   
     my $inhibitprint;      my $inhibitprint = &print_suppression();
     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'}) {      if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
         $result .= &Apache::lonmenu::registerurl(1);          $result .= Apache::lonxml::display_title();
     }      }
     if (!$args->{'no_nav_bar'}       if (!$args->{'no_nav_bar'} 
  && !$args->{'only_body'}   && !$args->{'only_body'}
  && !$args->{'frameset'}) {   && !$args->{'frameset'}) {
  $result .= &help_menu_js($httphost);   $result .= &help_menu_js();
         $result.=&modal_window();          $result.=&modal_window();
         $result.=&togglebox_script();          $result.=&togglebox_script();
         $result.=&wishlist_window();          $result.=&wishlist_window();
Line 7914  sub headtag { Line 7313  sub headtag {
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 <meta http-equiv="Refresh" content="$time; url=$url" />  <meta http-equiv="Refresh" content="$time; url=$url" />
 ADDMETA  ADDMETA
     } else {  
         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {  
             my $requrl = $env{'request.uri'};  
             if ($requrl eq '') {  
                 $requrl = $ENV{'REQUEST_URI'};  
                 $requrl =~ s/\?.+$//;  
             }  
             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||  
                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||  
                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {  
                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};  
                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {  
                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);  
                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {  
                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};  
                         if ($domdefs{'offloadnow'}{$lonhost}) {  
                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);  
                             if (($newserver) && ($newserver ne $lonhost)) {  
                                 my $numsec = 5;  
                                 my $timeout = $numsec * 1000;  
                                 my ($newurl,$locknum,%locks,$msg);  
                                 if ($env{'request.role.adv'}) {  
                                     ($locknum,%locks) = &Apache::lonnet::get_locks();  
                                 }  
                                 my $disable_submit = 0;  
                                 if ($requrl =~ /$LONCAPA::assess_re/) {  
                                     $disable_submit = 1;  
                                 }  
                                 if ($locknum) {  
                                     my @lockinfo = sort(values(%locks));  
                                     $msg = &mt('Once the following tasks are complete: ')."\\n".  
                                            join(", ",sort(values(%locks)))."\\n".  
                                            &mt('your session will be transferred to a different server, after you click "Roles".');  
                                 } else {  
                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {  
                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";  
                                     }  
                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);  
                                     $newurl = '/adm/switchserver?otherserver='.$newserver;  
                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {  
                                         $newurl .= '&role='.$env{'request.role'};  
                                     }  
                                     if ($env{'request.symb'}) {  
                                         $newurl .= '&symb='.$env{'request.symb'};  
                                     } else {  
                                         $newurl .= '&origurl='.$requrl;  
                                     }  
                                 }  
                                 &js_escape(\$msg);  
                                 $result.=<<OFFLOAD  
 <meta http-equiv="pragma" content="no-cache" />  
 <script type="text/javascript">  
 // <![CDATA[  
 function LC_Offload_Now() {  
     var dest = "$newurl";  
     if (dest != '') {  
         window.location.href="$newurl";  
     }  
 }  
 \$(document).ready(function () {  
     window.alert('$msg');  
     if ($disable_submit) {  
         \$(".LC_hwk_submit").prop("disabled", true);  
         \$( ".LC_textline" ).prop( "readonly", "readonly");  
     }  
     setTimeout('LC_Offload_Now()', $timeout);  
 });  
 // ]]>  
 </script>  
 OFFLOAD  
                             }  
                         }  
                     }  
                 }  
             }  
         }  
     }      }
     if (!defined($title)) {      if (!defined($title)) {
  $title = 'The LearningOnline Network with CAPA';   $title = 'The LearningOnline Network with CAPA';
     }      }
     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }      if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
     $result .= '<title> LON-CAPA '.$title.'</title>'      $result .= '<title> LON-CAPA '.$title.'</title>'
  .'<link rel="stylesheet" type="text/css" href="'.$url.'"';   .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
     if (!$args->{'frameset'}) {  
         $result .= ' /';  
     }  
     $result .= '>'  
         .$inhibitprint          .$inhibitprint
  .$head_extra;   .$head_extra;
     my $clientmobile;      if ($env{'browser.mobile'}) {
     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {  
         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();  
     } else {  
         $clientmobile = $env{'browser.mobile'};  
     }  
     if ($clientmobile) {  
         $result .= '          $result .= '
 <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">  <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
 <meta name="apple-mobile-web-app-capable" content="yes" />';  <meta name="apple-mobile-web-app-capable" content="yes" />';
     }      }
     $result .= '<meta name="google" content="notranslate" />'."\n";  
     return $result.'</head>';      return $result.'</head>';
 }  }
   
Line 8024  OFFLOAD Line 7336  OFFLOAD
   
 Returns neccessary <meta> to set the proper encoding  Returns neccessary <meta> to set the proper encoding
   
 Inputs: optional reference to HASH -- $args passed to &headtag()  Inputs: none
   
 =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;
 }  }
Line 8083  sub print_suppression { Line 7389  sub print_suppression {
         }          }
         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};          my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};          my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);          my $blocked = &blocking_status('printout',$cnum,$cdom);
         if ($blocked) {          if ($blocked) {
             my $checkrole = "cm./$cdom/$cnum";              my $checkrole = "cm./$cdom/$cnum";
             if ($env{'request.course.sec'} ne '') {              if ($env{'request.course.sec'} ne '') {
Line 8130  Inputs: none Line 7436  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 8142  sub xml_begin { Line 7447  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">'."\n".   $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";             .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
     }      }
     return $output;      return $output;
 }  }
Line 8191  $args - additional optional args support Line 7493  $args - additional optional args support
              skip_phases    -> hash ref of                skip_phases    -> hash ref of 
                                     head -> skip the <html><head> generation                                      head -> skip the <html><head> generation
                                     body -> skip all <body> generation                                      body -> skip all <body> generation
              no_inline_link -> if true and in remote mode, don't show the  
                                     'Switch To Inline Menu' link  
              no_auto_mt_title -> prevent &mt()ing the title arg               no_auto_mt_title -> prevent &mt()ing the title arg
                inherit_jsmath -> when creating popup window in a page,
                                       should it have jsmath forced on by the
                                       current page
              bread_crumbs ->             Array containing breadcrumbs               bread_crumbs ->             Array containing breadcrumbs
              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs               bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
              bread_crumbs_nomenu -> if true will pass false as the value of $menulink               group          -> includes the current group, if page is for a 
                                     to lonhtmlcommon::breadcrumbs                                 specific group  
              group          -> includes the current group, if page is for a  
                                specific group  
              use_absolute   -> for request for external resource or syllabus, this  
                                will contain https://<hostname> if server uses  
                                https (as per hosts.tab), but request is for http  
              hostname       -> hostname, originally from $r->hostname(), (optional).  
   
 =back  =back
   
Line 8219  sub start_page { Line 7516  sub start_page {
     my ($result,@advtools);      my ($result,@advtools);
   
     if (! exists($args->{'skip_phases'}{'head'}) ) {      if (! exists($args->{'skip_phases'}{'head'}) ) {
         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);          $result .= &xml_begin() . &headtag($title, $head_extra, $args);
     }      }
           
     if (! exists($args->{'skip_phases'}{'body'}) ) {      if (! exists($args->{'skip_phases'}{'body'}) ) {
Line 8233  sub start_page { Line 7530  sub start_page {
                          $args->{'function'},       $args->{'add_entries'},                           $args->{'function'},       $args->{'add_entries'},
                          $args->{'only_body'},      $args->{'domain'},                           $args->{'only_body'},      $args->{'domain'},
                          $args->{'force_register'}, $args->{'no_nav_bar'},                           $args->{'force_register'}, $args->{'no_nav_bar'},
                          $args->{'bgcolor'},        $args->{'no_inline_link'},                           $args->{'bgcolor'},        $args,
                          $args,                     \@advtools);                           \@advtools);
         }          }
     }      }
   
Line 8267  sub start_page { Line 7564  sub start_page {
                 if (@advtools > 0) {                  if (@advtools > 0) {
                     &Apache::lonmenu::advtools_crumbs(@advtools);                      &Apache::lonmenu::advtools_crumbs(@advtools);
                 }                  }
                 my $menulink;  
                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.  
                 if (exists($args->{'bread_crumbs_nomenu'})) {  
                     $menulink = 0;  
                 } else {  
                     undef($menulink);  
                 }  
  #if bread_crumbs_component exists show it as headline else show only the breadcrumbs   #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
  if(exists($args->{'bread_crumbs_component'})){   if(exists($args->{'bread_crumbs_component'})){
  $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);   $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
  }else{   }else{
  $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);   $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 8331  function set_wishlistlink(title, path) { Line 7617  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 8380  var modalWindow = { Line 7662  var modalWindow = {
 };  };
  var openMyModal = function(source,width,height,scrolling,transparency,style)   var openMyModal = function(source,width,height,scrolling,transparency,style)
  {   {
                 source = source.replace(/'/g,"&#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='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";   modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";
  modalWindow.open();   modalWindow.open();
  };   };
 // END LON-CAPA Internal -->  // END LON-CAPA Internal -->
 // ]]>  // ]]>
 </script>  </script>
Line 8405  sub modal_link { Line 7686  sub modal_link {
         $target_attr = 'target="'.$target.'"';          $target_attr = 'target="'.$target.'"';
     }      }
     return <<"ENDLINK";      return <<"ENDLINK";
 <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>  <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
              $linktext</a>
 ENDLINK  ENDLINK
 }  }
   
Line 8431  sub modal_adhoc_inner { Line 7713  sub modal_adhoc_inner {
     my ($funcname,$width,$height,$content)=@_;      my ($funcname,$width,$height,$content)=@_;
     my $innerwidth=$width-20;      my $innerwidth=$width-20;
     $content=&js_ready(      $content=&js_ready(
                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).                   &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).                   &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                  $content.                   $content.
                  &end_scrollbox().                   &end_scrollbox().
Line 8508  sub end_togglebox { Line 7790  sub end_togglebox {
 }  }
   
 sub LCprogressbar_script {  sub LCprogressbar_script {
    my ($id,$number_to_do)=@_;     my ($id)=@_;
    if ($number_to_do) {     return(<<ENDPROGRESS);
        return(<<ENDPROGRESS);  
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
 \$('#progressbar$id').progressbar({  \$('#progressbar$id').progressbar({
Line 8523  sub LCprogressbar_script { Line 7804  sub LCprogressbar_script {
 // ]]>  // ]]>
 </script>  </script>
 ENDPROGRESS  ENDPROGRESS
    } else {  
        return(<<ENDPROGRESS);  
 <script type="text/javascript">  
 // <![CDATA[  
 \$('#progressbar$id').progressbar({  
   value: false,  
   create: function(event, ui) {  
     \$('.ui-widget-header', this).css({'background':'#F0F0F0'});  
     \$('.ui-progressbar-overlay', this).css({'margin':'0'});  
   }  
 });  
 // ]]>  
 </script>  
 ENDPROGRESS  
    }  
 }  }
   
 sub LCprogressbarUpdate_script {  sub LCprogressbarUpdate_script {
    return(<<ENDPROGRESSUPDATE);     return(<<ENDPROGRESSUPDATE);
 <style type="text/css">  <style type="text/css">
 .ui-progressbar { position:relative; }  .ui-progressbar { position:relative; }
 .progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }  
 .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }  .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
 </style>  </style>
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
 var LCprogressTxt='---';  var LCprogressTxt='---';
   
 function LCupdateProgress(percent,progresstext,id,maxnum) {  function LCupdateProgress(percent,progresstext,id) {
    LCprogressTxt=progresstext;     LCprogressTxt=progresstext;
    if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {     \$('#progressbar'+id).progressbar('value',percent);
        \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);  
    } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {  
        \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);  
    } else {  
        \$('#progressbar'+id).progressbar('value',percent);  
    }  
 }  }
 // ]]>  // ]]>
 </script>  </script>
Line 8571  my $LCidcnt; Line 7830  my $LCidcnt;
 my $LCcurrentid;  my $LCcurrentid;
   
 sub LCprogressbar {  sub LCprogressbar {
     my ($r,$number_to_do,$preamble)=@_;      my ($r)=(@_);
     $LClastpercent=0;      $LClastpercent=0;
     $LCidcnt++;      $LCidcnt++;
     $LCcurrentid=$$.'_'.$LCidcnt;      $LCcurrentid=$$.'_'.$LCidcnt;
     my ($starting,$content);      my $starting=&mt('Starting');
     if ($number_to_do) {      my $content=(<<ENDPROGBAR);
         $starting=&mt('Starting');  
         $content=(<<ENDPROGBAR);  
 $preamble  
   <div id="progressbar$LCcurrentid">    <div id="progressbar$LCcurrentid">
     <span class="pblabel">$starting</span>      <span class="pblabel">$starting</span>
   </div>    </div>
 ENDPROGBAR  ENDPROGBAR
     } else {      &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
         $starting=&mt('Loading...');  
         $LClastpercent='false';  
         $content=(<<ENDPROGBAR);  
 $preamble  
   <div id="progressbar$LCcurrentid">  
       <div class="progress-label">$starting</div>  
   </div>  
 ENDPROGBAR  
     }  
     &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));  
 }  }
   
 sub LCprogressbarUpdate {  sub LCprogressbarUpdate {
     my ($r,$val,$text,$number_to_do)=@_;      my ($r,$val,$text)=@_;
     if ($number_to_do) {      unless ($val) { 
         unless ($val) {          if ($LClastpercent) {
             if ($LClastpercent) {             $val=$LClastpercent;
                 $val=$LClastpercent;         } else {
             } else {             $val=0;
                 $val=0;         }
             }  
         }  
         if ($val<0) { $val=0; }  
         if ($val>100) { $val=0; }  
         $LClastpercent=$val;  
         unless ($text) { $text=$val.'%'; }  
     } else {  
         $val = 'false';  
     }      }
       if ($val<0) { $val=0; }
       if ($val>100) { $val=0; }
       $LClastpercent=$val;
       unless ($text) { $text=$val.'%'; }
     $text=&js_ready($text);      $text=&js_ready($text);
     &r_print($r,<<ENDUPDATE);      &r_print($r,<<ENDUPDATE);
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
 LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');  LCupdateProgress($val,'$text','$LCcurrentid');
 // ]]>  // ]]>
 </script>  </script>
 ENDUPDATE  ENDUPDATE
Line 8803  function expand_div(caller) { Line 8045  function expand_div(caller) {
   
 sub simple_error_page {  sub simple_error_page {
     my ($r,$title,$msg,$args) = @_;      my ($r,$title,$msg,$args) = @_;
     if (ref($args) eq 'HASH') {      if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
         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).
Line 9027  role status: active, previous or future. Line 8265  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 %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);      my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
     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 9116  sub get_sections { Line 8354  sub get_sections {
         }          }
     }      }
   
     if ($check_students) {      if ($check_students) { 
  my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);   my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
  my $sec_index = &Apache::loncoursedata::CL_SECTION();   my $sec_index = &Apache::loncoursedata::CL_SECTION();
  my $status_index = &Apache::loncoursedata::CL_STATUS();   my $status_index = &Apache::loncoursedata::CL_STATUS();
Line 9438  Incoming parameters: Line 8676  Incoming parameters:
 2. user's domain  2. user's domain
 3. quota name - portfolio, author, or course  3. quota name - portfolio, author, or course
    (if no quota name provided, defaults to portfolio).     (if no quota name provided, defaults to portfolio).
 4. crstype - official, unofficial, textbook or community, if quota name is  4. crstype - official, unofficial or community, if quota name is
    course     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 9512  sub get_user_quota { Line 8750  sub get_user_quota {
         if ($quota eq '' || wantarray) {          if ($quota eq '' || wantarray) {
             if ($quotaname eq 'course') {              if ($quotaname eq 'course') {
                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);                  my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||                  if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) { 
                     ($crstype eq 'community') || ($crstype eq 'textbook')) {  
                     $defquota = $domdefs{$crstype.'quota'};                      $defquota = $domdefs{$crstype.'quota'};
                 }                  }
                 if ($defquota eq '') {                  if ($defquota eq '') {
Line 9559  Incoming parameters: Line 8796  Incoming parameters:
   
 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
Line 9654  space to be exceeded. Line 8891  space to be exceeded.
 Same, if upload of a file directly to a course/community via Course Editor  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.  will cause quota for uploaded content for the course to be exceeded.
   
 Inputs: 7   Inputs: 6
 1. username or coursenum  1. username or coursenum
 2. domain  2. domain
 3. context ('author' or 'course')  3. context ('author' or 'course')
 4. filename of file for which action is being requested  4. filename of file for which action is being requested
 5. filesize (kB) of file  5. filesize (kB) of file
 6. action being taken: copy or upload.  6. action being taken: copy or upload.
 7. quotatype (in course context -- official, unofficial, community or textbook).  
   
 Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,  Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
          otherwise return null.           otherwise return null.
Line 9671  Returns: 1 scalar: HTML to display conta Line 8907  Returns: 1 scalar: HTML to display conta
 =cut  =cut
   
 sub excess_filesize_warning {  sub excess_filesize_warning {
     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;      my ($uname,$udom,$context,$filename,$filesize,$action) = @_;
     my $current_disk_usage = 0;      my $current_disk_usage = 0;
     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB      my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB
     if ($context eq 'author') {      if ($context eq 'author') {
         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";          my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);          $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
Line 9684  sub excess_filesize_warning { Line 8920  sub excess_filesize_warning {
     }      }
     $disk_quota = int($disk_quota * 1000);      $disk_quota = int($disk_quota * 1000);
     if (($current_disk_usage + $filesize) > $disk_quota) {      if (($current_disk_usage + $filesize) > $disk_quota) {
         return '<p class="LC_warning">'.          return '<p><span class="LC_warning">'.
                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",                  &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.                      '<span class="LC_filename">'.$filename.'</span>',$filesize).'</span>'.
                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',                 '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                             $disk_quota,$current_disk_usage).                              $disk_quota,$current_disk_usage).
                '</p>';                 '</p>';
     }      }
Line 9697  sub excess_filesize_warning { Line 8933  sub excess_filesize_warning {
 ###############################################  ###############################################
   
   
   
   
 sub get_secgrprole_info {  sub get_secgrprole_info {
     my ($cdom,$cnum,$needroles,$type)  = @_;      my ($cdom,$cnum,$needroles,$type)  = @_;
     my %sections_count = &get_sections($cdom,$cnum);      my %sections_count = &get_sections($cdom,$cnum);
Line 9735  sub get_secgrprole_info { Line 8973  sub get_secgrprole_info {
 }  }
   
 sub user_picker {  sub user_picker {
     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;      my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
     my $currdom = $dom;      my $currdom = $dom;
     my @alldoms = &Apache::lonnet::all_domains();  
     if (@alldoms == 1) {  
         my %domsrch = &Apache::lonnet::get_dom('configuration',  
                                                ['directorysrch'],$alldoms[0]);  
         my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');  
         my $showdom = $domdesc;  
         if ($showdom eq '') {  
             $showdom = $dom;  
         }  
         if (ref($domsrch{'directorysrch'}) eq 'HASH') {  
             if ((!$domsrch{'directorysrch'}{'available'}) &&  
                 ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {  
                 return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);  
             }  
         }  
     }  
     my %curr_selected = (      my %curr_selected = (
                         srchin => 'dom',                          srchin => 'dom',
                         srchby => 'lastname',                          srchby => 'lastname',
Line 9773  sub user_picker { Line 8995  sub user_picker {
         }          }
         $srchterm = $srch->{'srchterm'};          $srchterm = $srch->{'srchterm'};
     }      }
     my %html_lt=&Apache::lonlocal::texthash(      my %lt=&Apache::lonlocal::texthash(
                     'usr'       => 'Search criteria',                      'usr'       => 'Search criteria',
                     'doma'      => 'Domain/institution to search',                      'doma'      => 'Domain/institution to search',
                     'uname'     => 'username',                      'uname'     => 'username',
Line 9786  sub user_picker { Line 9008  sub user_picker {
                     'exact'     => 'is',                      'exact'     => 'is',
                     'contains'  => 'contains',                      'contains'  => 'contains',
                     'begins'    => 'begins with',                      'begins'    => 'begins with',
                                        );  
     my %js_lt=&Apache::lonlocal::texthash(  
                     'youm'      => "You must include some text to search for.",                      'youm'      => "You must include some text to search for.",
                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",                      'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",                      'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
Line 9797  sub user_picker { Line 9017  sub user_picker {
                     'whse'      => "When searching by last,first you must include at least one character in the first name.",                      'whse'      => "When searching by last,first you must include at least one character in the first name.",
                      'thfo'     => "The following need to be corrected before the search can be run:",                       'thfo'     => "The following need to be corrected before the search can be run:",
                                        );                                         );
     &html_escape(\%html_lt);      my $domform = &select_dom_form($currdom,'srchdomain',1,1);
     &js_escape(\%js_lt);  
     my $domform;  
     my $allow_blank = 1;  
     if ($fixeddom) {  
         $allow_blank = 0;  
         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);  
     } else {  
         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);  
     }  
     my $srchinsel = ' <select name="srchin">';      my $srchinsel = ' <select name="srchin">';
   
     my @srchins = ('crs','dom','alc','instd');      my @srchins = ('crs','dom','alc','instd');
Line 9818  sub user_picker { Line 9029  sub user_picker {
         next if ($option eq 'alc');          next if ($option eq 'alc');
         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));            next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
         next if ($option eq 'crs' && !$env{'request.course.id'});          next if ($option eq 'crs' && !$env{'request.course.id'});
         next if (($option eq 'instd') && ($noinstd));  
         if ($curr_selected{'srchin'} eq $option) {          if ($curr_selected{'srchin'} eq $option) {
             $srchinsel .= '               $srchinsel .= ' 
    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
         } else {          } else {
             $srchinsel .= '              $srchinsel .= '
    <option value="'.$option.'">'.$html_lt{$option}.'</option>';     <option value="'.$option.'">'.$lt{$option}.'</option>';
         }          }
     }      }
     $srchinsel .= "\n  </select>\n";      $srchinsel .= "\n  </select>\n";
Line 9833  sub user_picker { Line 9043  sub user_picker {
     foreach my $option ('lastname','lastfirst','uname') {      foreach my $option ('lastname','lastfirst','uname') {
         if ($curr_selected{'srchby'} eq $option) {          if ($curr_selected{'srchby'} eq $option) {
             $srchbysel .= '              $srchbysel .= '
    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
         } else {          } else {
             $srchbysel .= '              $srchbysel .= '
    <option value="'.$option.'">'.$html_lt{$option}.'</option>';     <option value="'.$option.'">'.$lt{$option}.'</option>';
          }           }
     }      }
     $srchbysel .= "\n  </select>\n";      $srchbysel .= "\n  </select>\n";
Line 9845  sub user_picker { Line 9055  sub user_picker {
     foreach my $option ('begins','contains','exact') {      foreach my $option ('begins','contains','exact') {
         if ($curr_selected{'srchtype'} eq $option) {          if ($curr_selected{'srchtype'} eq $option) {
             $srchtypesel .= '              $srchtypesel .= '
    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
         } else {          } else {
             $srchtypesel .= '              $srchtypesel .= '
    <option value="'.$option.'">'.$html_lt{$option}.'</option>';     <option value="'.$option.'">'.$lt{$option}.'</option>';
         }          }
     }      }
     $srchtypesel .= "\n  </select>\n";      $srchtypesel .= "\n  </select>\n";
Line 9933  function validateEntry(callingForm) { Line 9143  function validateEntry(callingForm) {
   
     if (srchterm == "") {      if (srchterm == "") {
         checkok = 0;          checkok = 0;
         msg += "$js_lt{'youm'}\\n";          msg += "$lt{'youm'}\\n";
     }      }
   
     if (srchtype== 'begins') {      if (srchtype== 'begins') {
         if (srchterm.length < 2) {          if (srchterm.length < 2) {
             checkok = 0;              checkok = 0;
             msg += "$js_lt{'thte'}\\n";              msg += "$lt{'thte'}\\n";
         }          }
     }      }
   
     if (srchtype== 'contains') {      if (srchtype== 'contains') {
         if (srchterm.length < 3) {          if (srchterm.length < 3) {
             checkok = 0;              checkok = 0;
             msg += "$js_lt{'thet'}\\n";              msg += "$lt{'thet'}\\n";
         }          }
     }      }
     if (srchin == 'instd') {      if (srchin == 'instd') {
         if (srchdomain == '') {          if (srchdomain == '') {
             checkok = 0;              checkok = 0;
             msg += "$js_lt{'yomc'}\\n";              msg += "$lt{'yomc'}\\n";
         }          }
     }      }
     if (srchin == 'dom') {      if (srchin == 'dom') {
         if (srchdomain == '') {          if (srchdomain == '') {
             checkok = 0;              checkok = 0;
             msg += "$js_lt{'ymcd'}\\n";              msg += "$lt{'ymcd'}\\n";
         }          }
     }      }
     if (srchby == 'lastfirst') {      if (srchby == 'lastfirst') {
         if (srchterm.indexOf(",") == -1) {          if (srchterm.indexOf(",") == -1) {
             checkok = 0;              checkok = 0;
             msg += "$js_lt{'whus'}\\n";              msg += "$lt{'whus'}\\n";
         }          }
         if (srchterm.indexOf(",") == srchterm.length -1) {          if (srchterm.indexOf(",") == srchterm.length -1) {
             checkok = 0;              checkok = 0;
             msg += "$js_lt{'whse'}\\n";              msg += "$lt{'whse'}\\n";
         }          }
     }      }
     if (checkok == 0) {      if (checkok == 0) {
         alert("$js_lt{'thfo'}\\n"+msg);          alert("$lt{'thfo'}\\n"+msg);
         return;          return;
     }      }
     if (checkok == 1) {      if (checkok == 1) {
Line 9990  $new_user_create Line 9200  $new_user_create
 END_BLOCK  END_BLOCK
   
     $output .= &Apache::lonhtmlcommon::start_pick_box().      $output .= &Apache::lonhtmlcommon::start_pick_box().
                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).                 &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                $domform.                 $domform.
                &Apache::lonhtmlcommon::row_closure().                 &Apache::lonhtmlcommon::row_closure().
                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).                 &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                $srchbysel.                 $srchbysel.
                $srchtypesel.                  $srchtypesel. 
                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.                 '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
Line 10001  END_BLOCK Line 9211  END_BLOCK
                &Apache::lonhtmlcommon::row_closure(1).                  &Apache::lonhtmlcommon::row_closure(1). 
                &Apache::lonhtmlcommon::end_pick_box().                 &Apache::lonhtmlcommon::end_pick_box().
                '<br />';                 '<br />';
     return ($output,1);      return $output;
 }  }
   
 sub user_rule_check {  sub user_rule_check {
     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;      my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
     my ($response,%inst_response);      my $response;
     if (ref($usershash) eq 'HASH') {      if (ref($usershash) eq 'HASH') {
         if (keys(%{$usershash}) > 1) {          foreach my $user (keys(%{$usershash})) {
             my (%by_username,%by_id,%userdoms);              my ($uname,$udom) = split(/:/,$user);
             my $checkid;              next if ($udom eq '' || $uname eq '');
             if (ref($checks) eq 'HASH') {              my ($id,$newuser);
                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {              if (ref($usershash->{$user}) eq 'HASH') {
                     $checkid = 1;                  $newuser = $usershash->{$user}->{'newuser'};
                 }                  $id = $usershash->{$user}->{'id'};
             }  
             foreach my $user (keys(%{$usershash})) {  
                 my ($uname,$udom) = split(/:/,$user);  
                 if ($checkid) {  
                     if (ref($usershash->{$user}) eq 'HASH') {  
                         if ($usershash->{$user}->{'id'} ne '') {  
                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;  
                             $userdoms{$udom} = 1;  
                             if (ref($inst_results) eq 'HASH') {  
                                 $inst_results->{$uname.':'.$udom} = {};  
                             }  
                         }  
                     }  
                 } else {  
                     $by_username{$udom}{$uname} = 1;  
                     $userdoms{$udom} = 1;  
                     if (ref($inst_results) eq 'HASH') {  
                         $inst_results->{$uname.':'.$udom} = {};  
                     }  
                 }  
             }  
             foreach my $udom (keys(%userdoms)) {  
                 if (!$got_rules->{$udom}) {  
                     my %domconfig = &Apache::lonnet::get_dom('configuration',  
                                                              ['usercreation'],$udom);  
                     if (ref($domconfig{'usercreation'}) eq 'HASH') {  
                         foreach my $item ('username','id') {  
                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {  
                                 $$curr_rules{$udom}{$item} =  
                                     $domconfig{'usercreation'}{$item.'_rule'};  
                             }  
                         }  
                     }  
                     $got_rules->{$udom} = 1;  
                 }  
             }              }
             if ($checkid) {              my $inst_response;
                 foreach my $udom (keys(%by_id)) {              if (ref($checks) eq 'HASH') {
                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');                  if (defined($checks->{'username'})) {
                     if ($outcome eq 'ok') {                      ($inst_response,%{$inst_results->{$user}}) = 
                         foreach my $id (keys(%{$by_id{$udom}})) {                          &Apache::lonnet::get_instuser($udom,$uname);
                             my $uname = $by_id{$udom}{$id};                  } elsif (defined($checks->{'id'})) {
                             $inst_response{$uname.':'.$udom} = $outcome;                      ($inst_response,%{$inst_results->{$user}}) =
                         }                          &Apache::lonnet::get_instuser($udom,undef,$id);
                         if (ref($results) eq 'HASH') {  
                             foreach my $uname (keys(%{$results})) {  
                                 if (exists($inst_response{$uname.':'.$udom})) {  
                                     $inst_response{$uname.':'.$udom} = $outcome;  
                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};  
                                 }  
                             }  
                         }  
                     }  
                 }                  }
             } else {              } else {
                 foreach my $udom (keys(%by_username)) {                  ($inst_response,%{$inst_results->{$user}}) =
                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});                      &Apache::lonnet::get_instuser($udom,$uname);
                     if ($outcome eq 'ok') {                  return;
                         foreach my $uname (keys(%{$by_username{$udom}})) {  
                             $inst_response{$uname.':'.$udom} = $outcome;  
                         }  
                         if (ref($results) eq 'HASH') {  
                             foreach my $uname (keys(%{$results})) {  
                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};  
                             }  
                         }  
                     }  
                 }  
             }              }
         } elsif (keys(%{$usershash}) == 1) {              if (!$got_rules->{$udom}) {
             my $user = (keys(%{$usershash}))[0];                  my %domconfig = &Apache::lonnet::get_dom('configuration',
             my ($uname,$udom) = split(/:/,$user);                                                    ['usercreation'],$udom);
             if (($udom ne '') && ($uname ne '')) {                  if (ref($domconfig{'usercreation'}) eq 'HASH') {
                 if (ref($usershash->{$user}) eq 'HASH') {                      foreach my $item ('username','id') {
                     if (ref($checks) eq 'HASH') {                          if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                         if (defined($checks->{'username'})) {                              $$curr_rules{$udom}{$item} = 
                             ($inst_response{$user},%{$inst_results->{$user}}) =                                  $domconfig{'usercreation'}{$item.'_rule'};
                                 &Apache::lonnet::get_instuser($udom,$uname);  
                         } elsif (defined($checks->{'id'})) {  
                             if ($usershash->{$user}->{'id'} ne '') {  
                                 ($inst_response{$user},%{$inst_results->{$user}}) =  
                                     &Apache::lonnet::get_instuser($udom,undef,  
                                                                   $usershash->{$user}->{'id'});  
                             } else {  
                                 ($inst_response{$user},%{$inst_results->{$user}}) =  
                                     &Apache::lonnet::get_instuser($udom,$uname);  
                             }  
                         }  
                     } else {  
                        ($inst_response{$user},%{$inst_results->{$user}}) =  
                             &Apache::lonnet::get_instuser($udom,$uname);  
                        return;  
                     }  
                     if (!$got_rules->{$udom}) {  
                         my %domconfig = &Apache::lonnet::get_dom('configuration',  
                                                                  ['usercreation'],$udom);  
                         if (ref($domconfig{'usercreation'}) eq 'HASH') {  
                             foreach my $item ('username','id') {  
                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {  
                                    $$curr_rules{$udom}{$item} =  
                                        $domconfig{'usercreation'}{$item.'_rule'};  
                                 }  
                             }  
                         }                          }
                         $got_rules->{$udom} = 1;  
                     }                      }
                 }                  }
             } else {                  $got_rules->{$udom} = 1;  
                 return;  
             }  
         } else {  
             return;  
         }  
         foreach my $user (keys(%{$usershash})) {  
             my ($uname,$udom) = split(/:/,$user);  
             next if (($udom eq '') || ($uname eq ''));  
             my $id;  
             if (ref($inst_results) eq 'HASH') {  
                 if (ref($inst_results->{$user}) eq 'HASH') {  
                     $id = $inst_results->{$user}->{'id'};  
                 }  
             }  
             if ($id eq '') {  
                 if (ref($usershash->{$user})) {  
                     $id = $usershash->{$user}->{'id'};  
                 }  
             }              }
             foreach my $item (keys(%{$checks})) {              foreach my $item (keys(%{$checks})) {
                 if (ref($$curr_rules{$udom}) eq 'HASH') {                  if (ref($$curr_rules{$udom}) eq 'HASH') {
                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {                      if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                         if (@{$$curr_rules{$udom}{$item}} > 0) {                          if (@{$$curr_rules{$udom}{$item}} > 0) {
                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,                              my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                                                                              $$curr_rules{$udom}{$item});  
                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {                              foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                                 if ($rule_check{$rule}) {                                  if ($rule_check{$rule}) {
                                     $$rulematch{$user}{$item} = $rule;                                      $$rulematch{$user}{$item} = $rule;
                                     if ($inst_response{$user} eq 'ok') {                                      if ($inst_response eq 'ok') {
                                         if (ref($inst_results) eq 'HASH') {                                          if (ref($inst_results) eq 'HASH') {
                                             if (ref($inst_results->{$user}) eq 'HASH') {                                              if (ref($inst_results->{$user}) eq 'HASH') {
                                                 if (keys(%{$inst_results->{$user}}) == 0) {                                                  if (keys(%{$inst_results->{$user}}) == 0) {
                                                     $$alerts{$item}{$udom}{$uname} = 1;                                                      $$alerts{$item}{$udom}{$uname} = 1;
                                                 } elsif ($item eq 'id') {  
                                                     if ($inst_results->{$user}->{'id'} eq '') {  
                                                         $$alerts{$item}{$udom}{$uname} = 1;  
                                                     }  
                                                 }                                                  }
                                             }                                              }
                                         }                                          }
Line 10270  sub personal_data_fieldtitles { Line 9376  sub personal_data_fieldtitles {
   
 sub sorted_inst_types {  sub sorted_inst_types {
     my ($dom) = @_;      my ($dom) = @_;
     my ($usertypes,$order);      my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
     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 10316  sub get_institutional_codes { Line 9415  sub get_institutional_codes {
         foreach (@currxlists) {          foreach (@currxlists) {
             if (m/^([^:]+):(\w*)$/) {              if (m/^([^:]+):(\w*)$/) {
                 unless (grep/^$1$/,@{$allcourses}) {                  unless (grep/^$1$/,@{$allcourses}) {
                     push(@{$allcourses},$1);                      push @{$allcourses},$1;
                     $$LC_code{$1} = $2;                      $$LC_code{$1} = $2;
                 }                  }
             }              }
Line 10329  sub get_institutional_codes { Line 9428  sub get_institutional_codes {
                 my $sec = $coursecode.$1;                  my $sec = $coursecode.$1;
                 my $lc_sec = $2;                  my $lc_sec = $2;
                 unless (grep/^$sec$/,@{$allcourses}) {                  unless (grep/^$sec$/,@{$allcourses}) {
                     push(@{$allcourses},$sec);                      push @{$allcourses},$sec;
                     $$LC_code{$sec} = $lc_sec;                      $$LC_code{$sec} = $lc_sec;
                 }                  }
             }              }
Line 10427  reservable_now - ref to hash of student_ Line 9526  reservable_now - ref to hash of student_
   
     Keys in inner hash are:      Keys in inner hash are:
     (a) symb: either blank or symb to which slot use is restricted.      (a) symb: either blank or symb to which slot use is restricted.
     (b) endreserve: end date of reservation period.      (b) endreserve: end date of reservation period. 
     (c) uniqueperiod: start,end dates when slot is to be uniquely  
         selected.  
   
 sorted_future - ref to array of student_schedulable slots reservable in  sorted_future - ref to array of student_schedulable slots reservable in
                 the future, ordered by start date of reservation period.                  the future, ordered by start date of reservation period.
Line 10440  future_reservable - ref to hash of stude Line 9537  future_reservable - ref to hash of stude
     Keys in inner hash are:      Keys in inner hash are:
     (a) symb: either blank or symb to which slot use is restricted.      (a) symb: either blank or symb to which slot use is restricted.
     (b) startreserve:  start date of reservation period.      (b) startreserve:  start date of reservation period.
     (c) uniqueperiod: start,end dates when slot is to be uniquely  
         selected.  
   
 =back  =back
   
Line 10495  sub get_future_slots { Line 9590  sub get_future_slots {
             my $startreserve = $slots{$slot}->{'startreserve'};              my $startreserve = $slots{$slot}->{'startreserve'};
             my $endreserve = $slots{$slot}->{'endreserve'};              my $endreserve = $slots{$slot}->{'endreserve'};
             my $symb = $slots{$slot}->{'symb'};              my $symb = $slots{$slot}->{'symb'};
             my $uniqueperiod;  
             if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {  
                 $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});  
             }  
             if (($startreserve < $now) &&              if (($startreserve < $now) &&
                 (!$endreserve || $endreserve > $now)) {                  (!$endreserve || $endreserve > $now)) {
                 my $lastres = $endreserve;                  my $lastres = $endreserve;
Line 10507  sub get_future_slots { Line 9598  sub get_future_slots {
                 }                  }
                 $reservable_now{$slot} = {                  $reservable_now{$slot} = {
                                            symb       => $symb,                                             symb       => $symb,
                                            endreserve => $lastres,                                             endreserve => $lastres
                                            uniqueperiod => $uniqueperiod,     
                                          };                                           };
             } elsif (($startreserve > $now) &&              } elsif (($startreserve > $now) &&
                      (!$endreserve || $endreserve > $startreserve)) {                       (!$endreserve || $endreserve > $startreserve)) {
                 $future_reservable{$slot} = {                  $future_reservable{$slot} = {
                                               symb         => $symb,                                                symb         => $symb,
                                               startreserve => $startreserve,                                                startreserve => $startreserve
                                               uniqueperiod => $uniqueperiod,  
                                             };                                              };
             }              }
         }          }
Line 10685  sub ask_for_embedded_content { Line 9774  sub ask_for_embedded_content {
     my $numexisting = 0;      my $numexisting = 0;
     my $numunused = 0;      my $numunused = 0;
     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,      my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);          $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
     my $heading = &mt('Upload embedded files');      my $heading = &mt('Upload embedded files');
     my $buttontext = &mt('Upload');      my $buttontext = &mt('Upload');
   
       my ($navmap,$cdom,$cnum);
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         if ($actionurl eq '/adm/dependencies') {          if ($actionurl eq '/adm/dependencies') {
             $navmap = Apache::lonnavmaps::navmap->new();              $navmap = Apache::lonnavmaps::navmap->new();
Line 10696  sub ask_for_embedded_content { Line 9786  sub ask_for_embedded_content {
         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};          $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};          $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
     }      }
     if (($actionurl eq '/adm/portfolio') ||      if (($actionurl eq '/adm/portfolio') || 
         ($actionurl eq '/adm/coursegrp_portfolio')) {          ($actionurl eq '/adm/coursegrp_portfolio')) {
         my $current_path='/';          my $current_path='/';
         if ($env{'form.currentpath'}) {          if ($env{'form.currentpath'}) {
Line 10728  sub ask_for_embedded_content { Line 9818  sub ask_for_embedded_content {
             $toplevel = $url;              $toplevel = $url;
             if ($args->{'context'} eq 'paste') {              if ($args->{'context'} eq 'paste') {
                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});                  ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                 ($path) =                  ($path) = 
                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});                      ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);                  $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                 $fileloc =~ s{^/}{};                  $fileloc =~ s{^/}{};
             }              }
         }          }
     } elsif ($actionurl eq '/adm/dependencies') {      } elsif ($actionurl eq '/adm/dependencies')  {
         if ($env{'request.course.id'} ne '') {          if ($env{'request.course.id'} ne '') {
             if (ref($args) eq 'HASH') {              if (ref($args) eq 'HASH') {
                 $url = $args->{'docs_url'};                  $url = $args->{'docs_url'};
                 $title = $args->{'docs_title'};                  $title = $args->{'docs_title'};
                 $toplevel = $url;                  $toplevel = $url; 
                 unless ($toplevel =~ m{^/}) {                  unless ($toplevel =~ m{^/}) {
                     $toplevel = "/$url";                      $toplevel = "/$url";
                 }                  }
Line 10750  sub ask_for_embedded_content { Line 9840  sub ask_for_embedded_content {
                     ($path) =                      ($path) =
                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});                          ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                 }                  }
                 if ($toplevel=~/^\/*(uploaded|editupload)/) {                  $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                     $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{^/}{};                  $fileloc =~ s{^/}{};
                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});                  ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");                  $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
Line 10780  sub ask_for_embedded_content { Line 9862  sub ask_for_embedded_content {
         } else {          } else {
             $embed_file = $file;              $embed_file = $file;
         }          }
         my ($absolutepath,$cleaned_file);          my $absolutepath;
         if ($embed_file =~ m{^\w+://}) {          my $cleaned_file = &clean_path($embed_file);
             $cleaned_file = $embed_file;          if ($cleaned_file =~ m{^\w+://}) {
             $newfiles{$cleaned_file} = 1;              $newfiles{$cleaned_file} = 1;
             $mapping{$cleaned_file} = $embed_file;              $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;
             }              }
Line 10818  sub ask_for_embedded_content { Line 9899  sub ask_for_embedded_content {
     my $dirptr = 16384;      my $dirptr = 16384;
     foreach my $path (keys(%subdependencies)) {      foreach my $path (keys(%subdependencies)) {
         $currsubfile{$path} = {};          $currsubfile{$path} = {};
         if (($actionurl eq '/adm/portfolio') ||          if (($actionurl eq '/adm/portfolio') || 
             ($actionurl eq '/adm/coursegrp_portfolio')) {               ($actionurl eq '/adm/coursegrp_portfolio')) {
             my ($sublistref,$listerror) =              my ($sublistref,$listerror) =
                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);                  &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
             if (ref($sublistref) eq 'ARRAY') {              if (ref($sublistref) eq 'ARRAY') {
Line 10961  sub ask_for_embedded_content { Line 10042  sub ask_for_embedded_content {
         $counter = scalar(keys(%existing));          $counter = scalar(keys(%existing));
         $numpathchg = scalar(keys(%pathchanges));          $numpathchg = scalar(keys(%pathchanges));
         return ($output,$counter,$numpathchg,\%existing);          return ($output,$counter,$numpathchg,\%existing);
     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&      } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {               (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
         $counter = scalar(keys(%existing));          $counter = scalar(keys(%existing));
         $numpathchg = scalar(keys(%pathchanges));          $numpathchg = scalar(keys(%pathchanges));
Line 11190  sub ask_for_embedded_content { Line 10271  sub ask_for_embedded_content {
   
 Performs clean-up of directories, subdirectories and filename in an  Performs clean-up of directories, subdirectories and filename in an
 embedded object, referenced in an HTML file which is being uploaded  embedded object, referenced in an HTML file which is being uploaded
 to a course or portfolio, where  to a course or portfolio, where 
 "Upload embedded images/multimedia files if HTML file" checkbox was  "Upload embedded images/multimedia files if HTML file" checkbox was
 checked.  checked.
   
Line 11209  sub clean_path { Line 10290  sub clean_path {
         @contents = ($embed_file);          @contents = ($embed_file);
     }      }
     my $lastidx = scalar(@contents)-1;      my $lastidx = scalar(@contents)-1;
     for (my $i=0; $i<=$lastidx; $i++) {      for (my $i=0; $i<=$lastidx; $i++) { 
         $contents[$i]=~s{\\}{/}g;          $contents[$i]=~s{\\}{/}g;
         $contents[$i]=~s/\s+/\_/g;          $contents[$i]=~s/\s+/\_/g;
         $contents[$i]=~s{[^/\w\.\-]}{}g;          $contents[$i]=~s{[^/\w\.\-]}{}g;
Line 11348  sub upload_embedded { Line 10429  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 internal use.',$1)              $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';
                       .' '.&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)))) {
Line 11548  sub modify_html_refs { Line 10628  sub modify_html_refs {
     }      }
     my (%allfiles,%codebase,$output,$content);      my (%allfiles,%codebase,$output,$content);
     my @changes = &get_env_multiple('form.namechange');      my @changes = &get_env_multiple('form.namechange');
     unless ((@changes > 0)  || ($context eq 'syllabus')) {      unless ((@changes > 0) || ($context eq 'syllabus')) {
         if (wantarray) {          if (wantarray) {
             return ('',0,0);               return ('',0,0); 
         } else {          } else {
Line 11580  sub modify_html_refs { Line 10660  sub modify_html_refs {
                 return;                  return;
             }              }
         }           } 
         if (open(my $fh,'<',$container)) {          if (open(my $fh,"<$container")) {
             $content = join('', <$fh>);              $content = join('', <$fh>);
             close($fh);              close($fh);
         } else {          } else {
Line 11645  sub modify_html_refs { Line 10725  sub modify_html_refs {
                         }                          }
                     }                      }
                 } else {                  } else {
                     if (open(my $fh,'>',$container)) {                      if (open(my $fh,">$container")) {
                         print $fh $content;                          print $fh $content;
                         close($fh);                          close($fh);
                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',                          $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
Line 11683  sub modify_html_refs { Line 10763  sub modify_html_refs {
                         }                          }
                     }                      }
                     if ($rewrites) {                      if ($rewrites) {
                         my $saveresult;                          my $saveresult; 
                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);                          my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                         if ($url eq $container) {                          if ($url eq $container) {
                             my ($fname) = ($container =~ m{/([^/]+)$});                              my ($fname) = ($container =~ m{/([^/]+)$});
Line 11789  sub check_for_upload { Line 10869  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 = '<p class="LC_warning">'.                              my $msg = '<span class="LC_error">'.
                                       &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',                                        &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.                                            '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',                                        '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                                                    $disk_quota,$current_disk_usage).'</p>';                                                     $disk_quota,$current_disk_usage);
                             return ('will_exceed_quota',$msg);                              return ('will_exceed_quota',$msg);
                         }                          }
                     }                      }
Line 11802  sub check_for_upload { Line 10882  sub check_for_upload {
         }          }
     }      }
     if (($current_disk_usage + $filesize) > $disk_quota){      if (($current_disk_usage + $filesize) > $disk_quota){
         my $msg = '<p class="LC_warning">'.          my $msg = '<span class="LC_error">'.
                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.                  &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';                    '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
         return ('will_exceed_quota',$msg);          return ('will_exceed_quota',$msg);
     } elsif ($found_file) {      } elsif ($found_file) {
         if ($locked_file) {          if ($locked_file) {
             my $msg = '<p class="LC_warning">';              my $msg = '<span class="LC_error">';
             $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 .= '</p>';              $msg .= '</span><br />';
             $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 = '<p class="LC_error">';              my $msg = '<span class="LC_error">';
             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});              $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
             $msg .= '</p>';              $msg .= '</span>';
             return ('existingfile',$msg);              return ('existingfile',$msg);
         }          }
     }      }
Line 11907  sub decompress_form { Line 10987  sub decompress_form {
         }          }
     }      }
     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {      if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
         my @camtasia6 = ("$topdir/","$topdir/index.html",          my @camtasia = ("$topdir/","$topdir/index.html",
                         "$topdir/media/",                          "$topdir/media/",
                         "$topdir/media/$topdir.mp4",                          "$topdir/media/$topdir.mp4",
                         "$topdir/media/FirstFrame.png",                          "$topdir/media/FirstFrame.png",
                         "$topdir/media/player.swf",                          "$topdir/media/player.swf",
                         "$topdir/media/swfobject.js",                          "$topdir/media/swfobject.js",
                         "$topdir/media/expressInstall.swf");                          "$topdir/media/expressInstall.swf");
         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",          my @diffs = &compare_arrays(\@paths,\@camtasia);
                          "$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) {          if (@diffs == 0) {
             $is_camtasia = 6;              $is_camtasia = 1;
         } else {  
             @diffs = &compare_arrays(\@paths,\@camtasia8_1);  
             if (@diffs == 0) {  
                 $is_camtasia = 8;  
             } else {  
                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);  
                 if (@diffs == 0) {  
                     $is_camtasia = 8;  
                 }  
             }  
         }          }
     }      }
     my $output;      my $output;
Line 11978  sub decompress_form { Line 11008  sub decompress_form {
 function camtasiaToggle() {  function camtasiaToggle() {
     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {      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].checked) {
             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {              if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
   
                 document.getElementById('camtasia_titles').style.display='block';                  document.getElementById('camtasia_titles').style.display='block';
             } else {              } else {
                 document.getElementById('camtasia_titles').style.display='none';                  document.getElementById('camtasia_titles').style.display='none';
Line 12040  ENDCAM Line 11071  ENDCAM
     if ($is_camtasia) {      if ($is_camtasia) {
         $output .= $lt{'auto'}.'<br />'.          $output .= $lt{'auto'}.'<br />'.
                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.                     '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.                     '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                    $lt{'yes'}.'</label>&nbsp;<label>'.                     $lt{'yes'}.'</label>&nbsp;<label>'.
                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.                     '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                    $lt{'no'}.'</label></span><br />'.                     $lt{'no'}.'</label></span><br />'.
Line 12162  sub decompress_uploaded_file { Line 11193  sub decompress_uploaded_file {
   
 sub process_decompression {  sub process_decompression {
     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;      my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
     unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {  
         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.  
                &mt('Unexpected file path.').'</p>'."\n";  
     }  
     unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {  
         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.  
                &mt('Unexpected course context.').'</p>'."\n";  
     }  
     unless ($file eq &Apache::lonnet::clean_filename($file)) {  
         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.  
                &mt('Filename contained unexpected characters.').'</p>'."\n";  
     }  
     my ($dir,$error,$warning,$output);      my ($dir,$error,$warning,$output);
     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {      if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
         $error = &mt('Filename not a supported archive file type.').          $error = &mt('Filename not a supported archive file type.').
                  '<br />'.&mt('Filename 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');
Line 12208  sub process_decompression { Line 11227  sub process_decompression {
                 }                  }
             }              }
             my $numskip = scalar(@to_skip);              my $numskip = scalar(@to_skip);
             my $numoverwrite = scalar(@to_overwrite);              if (($numskip > 0) && 
             if (($numskip) && (!$numoverwrite)) {                  ($numskip == $env{'form.archive_itemcount'})) {
                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');                           $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
             } elsif ($dir eq '') {              } elsif ($dir eq '') {
                 $error = &mt('Directory containing archive file unavailable.');                  $error = &mt('Directory containing archive file unavailable.');
             } elsif (!$error) {              } elsif (!$error) {
                 my ($decompressed,$display);                  my ($decompressed,$display);
                 if (($numskip) || ($numoverwrite)) {                  if ($numskip > 0) {
                     my $tempdir = time.'_'.$$.int(rand(10000));                      my $tempdir = time.'_'.$$.int(rand(10000));
                     mkdir("$dir/$tempdir",0755);                      mkdir("$dir/$tempdir",0755);
                     if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {                      system("mv $dir/$file $dir/$tempdir/$file");
                         ($decompressed,$display) =                      ($decompressed,$display) = 
                             &decompress_uploaded_file($file,"$dir/$tempdir");                          &decompress_uploaded_file($file,"$dir/$tempdir");
                         foreach my $item (@to_skip) {                      foreach my $item (@to_skip) {
                             if (($item ne '') && ($item !~ /\.\./)) {                          if (($item ne '') && ($item !~ /\.\./)) {
                                 if (-f "$dir/$tempdir/$item") {                              if (-f "$dir/$tempdir/$item") { 
                                     unlink("$dir/$tempdir/$item");                                  unlink("$dir/$tempdir/$item");
                                 } elsif (-d "$dir/$tempdir/$item") {                              } elsif (-d "$dir/$tempdir/$item") {
                                     &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });                                  system("rm -rf $dir/$tempdir/$item");
                                 }  
                             }  
                         }  
                         foreach my $item (@to_overwrite) {  
                             if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {  
                                 if (($item ne '') && ($item !~ /\.\./)) {  
                                     if (-f "$dir/$item") {  
                                         unlink("$dir/$item");  
                                     } elsif (-d "$dir/$item") {  
                                         &File::Path::remove_tree("$dir/$item",{ safe => 1 });  
                                     }  
                                     &File::Copy::move("$dir/$tempdir/$item","$dir/$item");  
                                 }  
                             }                              }
                         }                          }
                         if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {  
                             &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });  
                         }  
                     }                      }
                       system("mv $dir/$tempdir/* $dir");
                       rmdir("$dir/$tempdir");   
                 } else {                  } else {
                     ($decompressed,$display) =                       ($decompressed,$display) = 
                         &decompress_uploaded_file($file,$dir);                          &decompress_uploaded_file($file,$dir);
Line 12263  sub process_decompression { Line 11268  sub process_decompression {
                     if (ref($newdirlistref) eq 'ARRAY') {                      if (ref($newdirlistref) eq 'ARRAY') {
                         foreach my $dir_line (@{$newdirlistref}) {                          foreach my $dir_line (@{$newdirlistref}) {
                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);                              my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                             unless (($item =~ /^\.+$/) || ($item eq $file)) {                               unless (($item =~ /^\.+$/) || ($item eq $file) || 
                                       ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
                                 push(@newitems,$item);                                  push(@newitems,$item);
                                 if ($dirptr&$testdir) {                                  if ($dirptr&$testdir) {
                                     $is_dir{$item} = 1;                                      $is_dir{$item} = 1;
Line 12298  sub process_decompression { Line 11304  sub process_decompression {
                                                            \%titles,\%children);                                                             \%titles,\%children);
                         }                          }
                         if ($env{'form.autoextract_camtasia'}) {                          if ($env{'form.autoextract_camtasia'}) {
                             my $version = $env{'form.autoextract_camtasia'};  
                             my %displayed;                              my %displayed;
                             my $total = 1;                              my $total = 1;
                             $env{'form.archive_directory'} = [];                              $env{'form.archive_directory'} = [];
Line 12317  sub process_decompression { Line 11322  sub process_decompression {
                                     $env{'form.archive_'.$i} = 'display';                                      $env{'form.archive_'.$i} = 'display';
                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};                                      $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                                     $displayed{'folder'} = $i;                                      $displayed{'folder'} = $i;
                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||                                  } elsif ($item eq "$contents[0]/index.html") {
                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {  
                                     $env{'form.archive_'.$i} = 'display';                                      $env{'form.archive_'.$i} = 'display';
                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};                                      $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                                     $displayed{'web'} = $i;                                      $displayed{'web'} = $i;
                                 } else {                                  } else {
                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||                                      if ($item eq "$contents[0]/media") {
                                         ((($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);                                          push(@{$env{'form.archive_directory'}},$i);
                                     }                                      }
                                     $env{'form.archive_'.$i} = 'dependency';                                      $env{'form.archive_'.$i} = 'dependency';
Line 12748  END Line 11750  END
 sub process_extracted_files {  sub process_extracted_files {
     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;      my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
     my $numitems = $env{'form.archive_count'};      my $numitems = $env{'form.archive_count'};
     return if ((!$numitems) || ($numitems =~ /\D/));      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,%prompttofetch);          %folders,%containers,%mapinner,%prompttofetch);
Line 12761  sub process_extracted_files { Line 11763  sub process_extracted_files {
     } else {      } else {
         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};          $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";          $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
         $dir = "$dir_root/$docudom/$docuname";          $dir = "$dir_root/$docudom/$docuname";    
     }      }
     my $currdir = "$dir_root/$destination";      my $currdir = "$dir_root/$destination";
     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});      (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
Line 12770  sub process_extracted_files { Line 11772  sub process_extracted_files {
         $folders{'0'} = $items[-2];          $folders{'0'} = $items[-2];
         if ($env{'form.folderpath'} =~ /\:1$/) {          if ($env{'form.folderpath'} =~ /\:1$/) {
             $containers{'0'}='page';              $containers{'0'}='page';
         } else {          } else {  
             $containers{'0'}='sequence';              $containers{'0'}='sequence';
         }          }
     }      }
Line 12850  sub process_extracted_files { Line 11852  sub process_extracted_files {
                                                         '.'.$containers{$outer},1,1);                                                          '.'.$containers{$outer},1,1);
                             $newseqid{$i} = $newidx;                              $newseqid{$i} = $newidx;
                             unless ($errtext) {                              unless ($errtext) {
                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',                                  $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                                                        &HTML::Entities::encode($docstitle,'<>&"'))..  
                                             '</li>'."\n";  
                             }                              }
                         }                          }
                     } else {                      } else {
Line 12861  sub process_extracted_files { Line 11861  sub process_extracted_files {
                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.                              my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.                                        $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                                       $title;                                        $title;
                             if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {                              if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {                                  mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);                              }
                                 }                              if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {                                  mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");                              }
                                 }                              if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {                                  system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
                                     if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {                                  $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                                         $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";                                  unless ($ishome) {
                                         unless ($ishome) {                                      my $fetch = "$newdest{$i}/$title";
                                             my $fetch = "$newdest{$i}/$title";                                      $fetch =~ s/^\Q$prefix$dir\E//;
                                             $fetch =~ s/^\Q$prefix$dir\E//;                                      $prompttofetch{$fetch} = 1;
                                             $prompttofetch{$fetch} = 1;  
                                         }  
                                    }  
                                 }                                  }
                                 $LONCAPA::map::resources[$newidx]=                              }
                                     $docstitle.':'.$url.':false:normal:res';                              $LONCAPA::map::resources[$newidx]=
                                 push(@LONCAPA::map::order, $newidx);                                  $docstitle.':'.$url.':false:normal:res';
                                 my ($outtext,$errtext)=                              push(@LONCAPA::map::order, $newidx);
                                     &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.                              my ($outtext,$errtext)=
                                                             $docuname.'/'.$folders{$outer}.                                  &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                                                             '.'.$containers{$outer},1,1);                                                          $docuname.'/'.$folders{$outer}.
                                 unless ($errtext) {                                                          '.'.$containers{$outer},1,1);
                                     if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {                              unless ($errtext) {
                                         $result .= '<li>'.&mt('File: [_1] added to course',                                  if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                                                               &HTML::Entities::encode($docstitle,'<>&"')).                                      $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                                                    '</li>'."\n";  
                                     }  
                                 }                                  }
                             } else {  
                                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',  
                                                 &HTML::Entities::encode($path,'<>&"')).'<br />';  
                             }                              }
                         }                          }
                     }                      }
                 }                  }
             } else {              } else {
                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',                  $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                                 &HTML::Entities::encode($path,'<>&"')).'<br />';  
             }              }
         }          }
         for (my $i=1; $i<=$numitems; $i++) {          for (my $i=1; $i<=$numitems; $i++) {
Line 12923  sub process_extracted_files { Line 11914  sub process_extracted_files {
                         }                          }
                         if ($itemidx eq '') {                          if ($itemidx eq '') {
                             $itemidx =  0;                              $itemidx =  0;
                         }                          } 
                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {                          if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                             if ($mapinner{$referrer{$i}}) {                              if ($mapinner{$referrer{$i}}) {
                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";                                  $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
Line 12962  sub process_extracted_files { Line 11953  sub process_extracted_files {
                         }                          }
                         if ($fullpath ne '') {                          if ($fullpath ne '') {
                             if (-e "$prefix$path") {                              if (-e "$prefix$path") {
                                 unless (rename("$prefix$path","$fullpath/$title")) {                                  system("mv $prefix$path $fullpath/$title");
                                      $warning .= &mt('Failed to rename dependency').'<br />';  
                                 }  
                             }                              }
                             if (-e "$fullpath/$title") {                              if (-e "$fullpath/$title") {
                                 my $showpath;                                  my $showpath;
Line 12972  sub process_extracted_files { Line 11961  sub process_extracted_files {
                                     $showpath = "$relpath/$title";                                      $showpath = "$relpath/$title";
                                 } else {                                  } else {
                                     $showpath = "/$title";                                      $showpath = "/$title";
                                 }                                  } 
                                 $result .= '<li>'.&mt('[_1] included as a dependency',                                  $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                                                       &HTML::Entities::encode($showpath,'<>&"')).                              } 
                                            '</li>'."\n";                              unless ($ishome) {
                                 unless ($ishome) {                                  my $fetch = "$fullpath/$title";
                                     my $fetch = "$fullpath/$title";                                  $fetch =~ s/^\Q$prefix$dir\E//; 
                                     $fetch =~ s/^\Q$prefix$dir\E//;                                  $prompttofetch{$fetch} = 1;
                                     $prompttofetch{$fetch} = 1;  
                                 }  
                             }                              }
                         }                          }
                     }                      }
                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {                  } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',                      $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                                     &HTML::Entities::encode($path,'<>&"'),                                      $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
                                     &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).  
                                 '<br />';  
                 }                  }
             } else {              } else {
                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',                  $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                                 &HTML::Entities::encode($path)).'<br />';  
             }              }
         }          }
         if (keys(%todelete)) {          if (keys(%todelete)) {
Line 13070  sub cleanup_empty_dirs { Line 12054  sub cleanup_empty_dirs {
   
 =pod  =pod
   
 =item * &get_folder_hierarchy()  =item &get_folder_hierarchy()
   
 Provides hierarchy of names of folders/sub-folders containing the current  Provides hierarchy of names of folders/sub-folders containing the current
 item,  item,
Line 13266  sub upfile_store { Line 12250  sub upfile_store {
     $env{'form.upfile'}=~s/\n+/\n/gs;      $env{'form.upfile'}=~s/\n+/\n/gs;
     $env{'form.upfile'}=~s/\n+$//gs;      $env{'form.upfile'}=~s/\n+$//gs;
   
     my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.      my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                                      '_enroll_'.$env{'request.course.id'}.'_'.   '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
                                      time.'_'.$$);  
     return if ($datatoken eq '');  
   
     {      {
         my $datafile = $r->dir_config('lonDaemons').          my $datafile = $r->dir_config('lonDaemons').
                            '/tmp/'.$datatoken.'.tmp';                             '/tmp/'.$datatoken.'.tmp';
         if ( open(my $fh,'>',$datafile) ) {          if ( open(my $fh,">$datafile") ) {
             print $fh $env{'form.upfile'};              print $fh $env{'form.upfile'};
             close($fh);              close($fh);
         }          }
Line 13284  sub upfile_store { Line 12265  sub upfile_store {
   
 =pod  =pod
   
 =item * &load_tmp_file($r,$datatoken)  =item * &load_tmp_file($r)
   
 Load uploaded file from tmp, $r should be the HTTP Request object,  Load uploaded file from tmp, $r should be the HTTP Request object,
 $datatoken is the name to assign to the temporary file.  needs $env{'form.datatoken'},
 sets $env{'form.upfile'} to the contents of the file  sets $env{'form.upfile'} to the contents of the file
   
 =cut  =cut
   
 sub load_tmp_file {  sub load_tmp_file {
     my ($r,$datatoken) = @_;      my $r=shift;
     return if ($datatoken eq '');  
     my @studentdata=();      my @studentdata=();
     {      {
         my $studentfile = $r->dir_config('lonDaemons').          my $studentfile = $r->dir_config('lonDaemons').
                               '/tmp/'.$datatoken.'.tmp';                                '/tmp/'.$env{'form.datatoken'}.'.tmp';
         if ( open(my $fh,'<',$studentfile) ) {          if ( open(my $fh,"<$studentfile") ) {
             @studentdata=<$fh>;              @studentdata=<$fh>;
             close($fh);              close($fh);
         }          }
Line 13307  sub load_tmp_file { Line 12287  sub load_tmp_file {
     $env{'form.upfile'}=join('',@studentdata);      $env{'form.upfile'}=join('',@studentdata);
 }  }
   
 sub valid_datatoken {  
     my ($datatoken) = @_;  
     if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {  
         return $datatoken;  
     }  
     return;  
 }  
   
 =pod  =pod
   
 =item * &upfile_record_sep()  =item * &upfile_record_sep()
Line 13755  sub DrawBarGraph { Line 12727  sub DrawBarGraph {
         @Labels = @$labels;          @Labels = @$labels;
     } else {      } else {
         for (my $i=0;$i<@{$Values[0]};$i++) {          for (my $i=0;$i<@{$Values[0]};$i++) {
             push(@Labels,$i+1);              push (@Labels,$i+1);
         }          }
     }      }
     #      #
Line 14194  generated by lonerrorhandler.pm, CHECKRP Line 13166  generated by lonerrorhandler.pm, CHECKRP
 lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.  lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
   
 Inputs:  Inputs:
 defmail (scalar - email address of default recipient),  defmail (scalar - email address of default recipient), 
 mailing type (scalar: errormail, packagesmail, helpdeskmail,  mailing type (scalar: errormail, packagesmail, helpdeskmail,
 requestsmail, updatesmail, or idconflictsmail).  requestsmail, updatesmail, or idconflictsmail).
   
 defdom (domain for which to retrieve configuration settings),  defdom (domain for which to retrieve configuration settings),
   
 origmail (scalar - email address of recipient from loncapa.conf,  origmail (scalar - email address of recipient from loncapa.conf, 
 i.e., predates configuration by DC via domainprefs.pm  i.e., predates configuration by DC via domainprefs.pm 
   
 $requname username of requester (if mailing type is helpdeskmail)  
   
 $requdom domain of requester (if mailing type is helpdeskmail)  
   
 $reqemail e-mail address of requester (if mailing type is helpdeskmail)  
   
 Returns: comma separated list of addresses to which to send e-mail.  Returns: comma separated list of addresses to which to send e-mail.
   
Line 14218  Returns: comma separated list of address Line 13184  Returns: comma separated list of address
 ############################################################  ############################################################
 ############################################################  ############################################################
 sub build_recipient_list {  sub build_recipient_list {
     my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;      my ($defmail,$mailing,$defdom,$origmail) = @_;
     my @recipients;      my @recipients;
     my ($otheremails,$lastresort,$allbcc,$addtext);      my $otheremails;
     my %domconfig =      my %domconfig =
         &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);           &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
     if (ref($domconfig{'contacts'}) eq 'HASH') {      if (ref($domconfig{'contacts'}) eq 'HASH') {
         if (exists($domconfig{'contacts'}{$mailing})) {          if (exists($domconfig{'contacts'}{$mailing})) {
             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {              if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
Line 14234  sub build_recipient_list { Line 13200  sub build_recipient_list {
                             push(@recipients,$addr);                              push(@recipients,$addr);
                         }                          }
                     }                      }
                 }                      $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                 $otheremails = $domconfig{'contacts'}{$mailing}{'others'};  
                 if ($mailing eq 'helpdeskmail') {  
                     if ($domconfig{'contacts'}{$mailing}{'bcc'}) {  
                         my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});  
                         my @ok_bccs;  
                         foreach my $bcc (@bccs) {  
                             $bcc =~ s/^\s+//g;  
                             $bcc =~ s/\s+$//g;  
                             if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {  
                                 if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {  
                                     push(@ok_bccs,$bcc);  
                                 }  
                             }  
                         }  
                         if (@ok_bccs > 0) {  
                             $allbcc = join(', ',@ok_bccs);  
                         }  
                     }  
                     $addtext = $domconfig{'contacts'}{$mailing}{'include'};  
                 }                  }
             }              }
         } elsif ($origmail ne '') {          } elsif ($origmail ne '') {
             $lastresort = $origmail;              push(@recipients,$origmail);
         }  
         if ($mailing eq 'helpdeskmail') {  
             if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&  
                 (keys(%{$domconfig{'contacts'}{'overrides'}}))) {  
                 my ($inststatus,$inststatus_checked);  
                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&  
                     ($env{'user.domain'} ne 'public')) {  
                     $inststatus_checked = 1;  
                     $inststatus = $env{'environment.inststatus'};  
                 }  
                 unless ($inststatus_checked) {  
                     if (($requname ne '') && ($requdom ne '')) {  
                         if (($requname =~ /^$match_username$/) &&  
                             ($requdom =~ /^$match_domain$/) &&  
                             (&Apache::lonnet::domain($requdom))) {  
                             my $requhome = &Apache::lonnet::homeserver($requname,  
                                                                       $requdom);  
                             unless ($requhome eq 'no_host') {  
                                 my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');  
                                 $inststatus = $userenv{'inststatus'};  
                                 $inststatus_checked = 1;  
                             }  
                         }  
                     }  
                 }  
                 unless ($inststatus_checked) {  
                     if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {  
                         my %srch = (srchby     => 'email',  
                                     srchdomain => $defdom,  
                                     srchterm   => $reqemail,  
                                     srchtype   => 'exact');  
                         my %srch_results = &Apache::lonnet::usersearch(\%srch);  
                         foreach my $uname (keys(%srch_results)) {  
                             if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {  
                                 $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});  
                                 $inststatus_checked = 1;  
                                 last;  
                             }  
                         }  
                         unless ($inststatus_checked) {  
                             my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);  
                             if ($dirsrchres eq 'ok') {  
                                 foreach my $uname (keys(%srch_results)) {  
                                     if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {  
                                         $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});  
                                         $inststatus_checked = 1;  
                                         last;  
                                     }  
                                 }  
                             }  
                         }  
                     }  
                 }  
                 if ($inststatus ne '') {  
                     foreach my $status (split(/\:/,$inststatus)) {  
                         if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {  
                             my @contacts = ('adminemail','supportemail');  
                             foreach my $item (@contacts) {  
                                 if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {  
                                     my $addr = $domconfig{'contacts'}{'overrides'}{$status};  
                                     if (!grep(/^\Q$addr\E$/,@recipients)) {  
                                         push(@recipients,$addr);  
                                     }  
                                 }  
                             }  
                             $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};  
                             if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {  
                                 my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});  
                                 my @ok_bccs;  
                                 foreach my $bcc (@bccs) {  
                                     $bcc =~ s/^\s+//g;  
                                     $bcc =~ s/\s+$//g;  
                                     if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {  
                                         if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {  
                                             push(@ok_bccs,$bcc);  
                                         }  
                                     }  
                                 }  
                                 if (@ok_bccs > 0) {  
                                     $allbcc = join(', ',@ok_bccs);  
                                 }  
                             }  
                             $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};  
                             last;  
                         }  
                     }  
                 }  
             }  
         }          }
     } elsif ($origmail ne '') {      } elsif ($origmail ne '') {
         $lastresort = $origmail;          push(@recipients,$origmail);
     }  
     if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {  
         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {  
             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};  
             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};  
             my %what = (  
                           perlvar => 1,  
                        );  
             my $primary = &Apache::lonnet::domain($defdom,'primary');  
             if ($primary) {  
                 my $gotaddr;  
                 my ($result,$returnhash) =  
                     &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });  
                 if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {  
                     if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {  
                         $lastresort = $returnhash->{'lonSupportEMail'};  
                         $gotaddr = 1;  
                     }  
                 }  
                 unless ($gotaddr) {  
                     my $uintdom = &Apache::lonnet::internet_dom($primary);  
                     my $intdom = &Apache::lonnet::internet_dom($lonhost);  
                     unless ($uintdom eq $intdom) {  
                         my %domconfig =  
                             &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);  
                         if (ref($domconfig{'contacts'}) eq 'HASH') {  
                             if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {  
                                 my @contacts = ('adminemail','supportemail');  
                                 foreach my $item (@contacts) {  
                                     if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {  
                                         my $addr = $domconfig{'contacts'}{$item};  
                                         if (!grep(/^\Q$addr\E$/,@recipients)) {  
                                             push(@recipients,$addr);  
                                         }  
                                     }  
                                 }  
                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {  
                                     $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};  
                                 }  
                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {  
                                     my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});  
                                     my @ok_bccs;  
                                     foreach my $bcc (@bccs) {  
                                         $bcc =~ s/^\s+//g;  
                                         $bcc =~ s/\s+$//g;  
                                         if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {  
                                             if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {  
                                                 push(@ok_bccs,$bcc);  
                                             }  
                                         }  
                                     }  
                                     if (@ok_bccs > 0) {  
                                         $allbcc = join(', ',@ok_bccs);  
                                     }  
                                 }  
                                 $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};  
                             }  
                         }  
                     }  
                 }  
             }  
         }  
     }      }
     if (defined($defmail)) {      if (defined($defmail)) {
         if ($defmail ne '') {          if ($defmail ne '') {
Line 14430  sub build_recipient_list { Line 13227  sub build_recipient_list {
             }              }
         }          }
     }      }
     if ($mailing eq 'helpdeskmail') {      my $recipientlist = join(',',@recipients); 
         if ((!@recipients) && ($lastresort ne '')) {      return $recipientlist;
             push(@recipients,$lastresort);  
         }  
     } elsif ($lastresort ne '') {  
         if (!grep(/^\Q$lastresort\E$/,@recipients)) {  
             push(@recipients,$lastresort);  
         }  
     }  
     my $recipientlist = join(',',@recipients);  
     if (wantarray) {  
         return ($recipientlist,$allbcc,$addtext);  
     } else {  
         return $recipientlist;  
     }  
 }  }
   
 ############################################################  ############################################################
Line 14535  jsarray (reference to array of categorie Line 13319  jsarray (reference to array of categorie
 subcats (reference to hash of arrays containing all subcategories within each   subcats (reference to hash of arrays containing all subcategories within each 
          category, -recursive)           category, -recursive)
   
 maxd (reference to hash used to hold max depth for all top-level categories).  
   
 Returns: nothing  Returns: nothing
   
 Side effects: populates trails and allitems hash references.  Side effects: populates trails and allitems hash references.
Line 14544  Side effects: populates trails and allit Line 13326  Side effects: populates trails and allit
 =cut  =cut
   
 sub extract_categories {  sub extract_categories {
     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;      my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
     if (ref($categories) eq 'HASH') {      if (ref($categories) eq 'HASH') {
         &gather_categories($categories,$cats,$idx,$jsarray);          &gather_categories($categories,$cats,$idx,$jsarray);
         if (ref($cats->[0]) eq 'ARRAY') {          if (ref($cats->[0]) eq 'ARRAY') {
Line 14570  sub extract_categories { Line 13352  sub extract_categories {
                         if (ref($subcats) eq 'HASH') {                          if (ref($subcats) eq 'HASH') {
                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');                              push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                         }                          }
                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);                          &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                     }                      }
                 } else {                  } else {
                     if (ref($subcats) eq 'HASH') {                      if (ref($subcats) eq 'HASH') {
                         $subcats->{$item} = [];                          $subcats->{$item} = [];
                     }                      }
                     if (ref($maxd) eq 'HASH') {  
                         $maxd->{$name} = 1;  
                     }  
                 }                  }
             }              }
         }          }
Line 14588  sub extract_categories { Line 13367  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 14616  Side effects: populates trails and allit Line 13395  Side effects: populates trails and allit
 =cut  =cut
   
 sub recurse_categories {  sub recurse_categories {
     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;      my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
     my $shallower = $depth - 1;      my $shallower = $depth - 1;
     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {      if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {          for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
Line 14643  sub recurse_categories { Line 13422  sub recurse_categories {
                 }                  }
             }              }
             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,              &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                                 $subcats,$maxd);                                  $subcats);
             pop(@{$parents});              pop(@{$parents});
         }          }
     } else {      } else {
         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;          my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
         my $trailstr = join(' &raquo; ',(@{$parents},$category));          my $trailstr = join(' -&gt; ',(@{$parents},$category));
         if ($allitems->{$item} eq '') {          if ($allitems->{$item} eq '') {
             push(@{$trails},$trailstr);              push(@{$trails},$trailstr);
             $allitems->{$item} = scalar(@{$trails})-1;              $allitems->{$item} = scalar(@{$trails})-1;
         }          }
         if (ref($maxd) eq 'HASH') {  
             if ($depth > $maxd->{$parents->[0]}) {  
                 $maxd->{$parents->[0]} = $depth;  
             }  
         }  
     }      }
     return;      return;
 }  }
   
 =pod  =pod
   
 =item * &assign_categories_table()  =item *&assign_categories_table()
   
 Create a datatable for display of hierarchical categories in a domain,  Create a datatable for display of hierarchical categories in a domain,
 with checkboxes to allow a course to be categorized.   with checkboxes to allow a course to be categorized. 
Line 14678  currcat - scalar with an & separated lis Line 13452  currcat - scalar with an & separated lis
   
 type    - scalar contains course type (Course or Community).  type    - scalar contains course type (Course or Community).
   
 disabled - scalar (optional) contains disabled="disabled" if input elements are  
            to be readonly (e.g., Domain Helpdesk role viewing course settings).  
   
 Returns: $output (markup to be displayed)   Returns: $output (markup to be displayed) 
   
 =cut  =cut
   
 sub assign_categories_table {  sub assign_categories_table {
     my ($cathash,$currcat,$type,$disabled) = @_;      my ($cathash,$currcat,$type) = @_;
     my $output;      my $output;
     if (ref($cathash) eq 'HASH') {      if (ref($cathash) eq 'HASH') {
         my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);          my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);          &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
         $maxdepth = scalar(@cats);          $maxdepth = scalar(@cats);
         if (@cats > 0) {          if (@cats > 0) {
             my $itemcount = 0;              my $itemcount = 0;
Line 14722  sub assign_categories_table { Line 13493  sub assign_categories_table {
                     }                      }
                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.                      $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                               '<input type="checkbox" name="usecategory" value="'.                                '<input type="checkbox" name="usecategory" value="'.
                               $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.                                $item.'"'.$checked.' />'.$parent_title.'</span>'.
                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';                                '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
                     my $depth = 1;                      my $depth = 1;
                     push(@path,$parent);                      push(@path,$parent);
                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);                      $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
                     pop(@path);                      pop(@path);
                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';                      $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
                     $itemcount ++;                      $itemcount ++;
Line 14744  sub assign_categories_table { Line 13515  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 14765  path - Array containing all categories b Line 13536  path - Array containing all categories b
   
 currcategories - reference to array of current categories assigned to the course  currcategories - reference to array of current categories assigned to the course
   
 disabled - scalar (optional) contains disabled="disabled" if input elements are  
            to be readonly (e.g., Domain Helpdesk role viewing course settings).  
   
 Returns: $output (markup to be displayed).  Returns: $output (markup to be displayed).
   
 =cut  =cut
   
 sub assign_category_rows {  sub assign_category_rows {
     my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;      my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
     my ($text,$name,$item,$chgstr);      my ($text,$name,$item,$chgstr);
     if (ref($cats) eq 'ARRAY') {      if (ref($cats) eq 'ARRAY') {
         my $maxdepth = scalar(@{$cats});          my $maxdepth = scalar(@{$cats});
Line 14796  sub assign_category_rows { Line 13564  sub assign_category_rows {
                     }                      }
                     $text .= '<tr><td><span class="LC_nobreak"><label>'.                      $text .= '<tr><td><span class="LC_nobreak"><label>'.
                              '<input type="checkbox" name="usecategory" value="'.                               '<input type="checkbox" name="usecategory" value="'.
                              $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.                               $item.'"'.$checked.' />'.$name.'</label></span>'.
                              '<input type="hidden" name="catname" value="'.$name.'" />'.                               '<input type="hidden" name="catname" value="'.$name.'" />'.
                              '</td><td>';                               '</td><td>';
                     if (ref($path) eq 'ARRAY') {                      if (ref($path) eq 'ARRAY') {
                         push(@{$path},$name);                          push(@{$path},$name);
                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);                          $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                         pop(@{$path});                          pop(@{$path});
                     }                      }
                     $text .= '</td></tr>';                      $text .= '</td></tr>';
Line 14813  sub assign_category_rows { Line 13581  sub assign_category_rows {
     return $text;      return $text;
 }  }
   
 =pod  
   
 =back  
   
 =cut  
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
Line 14949  sub commit_studentrole { Line 13711  sub commit_studentrole {
                     }                      }
                 }                  }
             } else {              } else {
                 if ($secchange) {                         if ($secchange) { 
                     $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;                      $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
                 } else {                  } else {
                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;                      $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
Line 15032  sub check_clone { Line 13794  sub check_clone {
                 return ($can_clone, $clonemsg, $cloneid, $clonehome);                  return ($can_clone, $clonemsg, $cloneid, $clonehome);
             }              }
         }          }
  if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&   if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {              (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
     $can_clone = 1;      $can_clone = 1;
  } else {   } else {
     my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],      my %clonehash = &Apache::lonnet::get('environment',['cloners'],
  $args->{'clonedomain'},$args->{'clonecourse'});   $args->{'clonedomain'},$args->{'clonecourse'});
             if ($clonehash{'cloners'} eq '') {      my @cloners = split(/,/,$clonehash{'cloners'});
                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});              if (grep(/^\*$/,@cloners)) {
                 if ($domdefs{'canclone'}) {                  $can_clone = 1;
                     unless ($domdefs{'canclone'} eq 'none') {              } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                         if ($domdefs{'canclone'} eq 'domain') {                  $can_clone = 1;
                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {  
                                 $can_clone = 1;  
                             }  
                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&  
                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {  
                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},  
                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {  
                                 $can_clone = 1;  
                             }  
                         }  
                     }  
                 }  
             } else {              } else {
         my @cloners = split(/,/,$clonehash{'cloners'});  
                 if (grep(/^\*$/,@cloners)) {  
                     $can_clone = 1;  
                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {  
                     $can_clone = 1;  
                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {  
                     $can_clone = 1;  
                 }  
                 unless ($can_clone) {  
                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&  
                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {  
                         my (%gotdomdefaults,%gotcodedefaults);  
                         foreach my $cloner (@cloners) {  
                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&  
                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {  
                                 my (%codedefaults,@code_order);  
                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {  
                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {  
                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};  
                                     }  
                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {  
                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};  
                                     }  
                                 } else {  
                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},  
                                                                             \%codedefaults,  
                                                                             \@code_order);  
                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;  
                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;  
                                 }  
                                 if (@code_order > 0) {  
                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,  
                                                                                 $cloner,$clonehash{'internal.coursecode'},  
                                                                                 $args->{'crscode'})) {  
                                         $can_clone = 1;  
                                         last;  
                                     }  
                                 }  
                             }  
                         }  
                     }  
                 }  
             }  
             unless ($can_clone) {  
                 my $ccrole = 'cc';                  my $ccrole = 'cc';
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     $ccrole = 'co';                      $ccrole = 'co';
                 }                  }
                 my %roleshash =          my %roleshash =
                     &Apache::lonnet::get_my_roles($args->{'ccuname'},      &Apache::lonnet::get_my_roles($args->{'ccuname'},
                                                   $args->{'ccdomain'},   $args->{'ccdomain'},
                                                   'userroles',['active'],[$ccrole],                                           'userroles',['active'],[$ccrole],
                                                   [$args->{'clonedomain'}]);   [$args->{'clonedomain'}]);
                 if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {          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'},                  } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                                                           $args->{'ccuname'},$args->{'ccdomain'})) {  
                     $can_clone = 1;                      $can_clone = 1;
                 }  
             }  
             unless ($can_clone) {  
                 if ($args->{'crstype'} eq 'Community') {  
                     $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});  
                 } else {                  } else {
                     $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'});                      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 15129  sub check_clone { Line 13833  sub check_clone {
 }  }
   
 sub construct_course {  sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,      my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
         $cnum,$category,$coderef) = @_;  
     my $outcome;      my $outcome;
     my $linefeed =  '<br />'."\n";      my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {      if ($context eq 'auto') {
Line 15227  sub construct_course { Line 13930  sub construct_course {
                    'plc.users.denied',                     'plc.users.denied',
                    'hidefromcat',                     'hidefromcat',
                    'checkforpriv',                     'checkforpriv',
                    'categories',                     'categories'],
                    'internal.uniquecode'],  
                    $$crsudom,$$crsunum);                     $$crsudom,$$crsunum);
         if ($args->{'textbook'}) {  
             $cenv{'internal.textbook'} = $args->{'textbook'};  
         }  
     }      }
   
 #  #
Line 15278  sub construct_course { Line 13977  sub construct_course {
                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});                  my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                 $cenv{'internal.sectionnums'} .= $item.',';                  $cenv{'internal.sectionnums'} .= $item.',';
                 unless ($addcheck eq 'ok') {                  unless ($addcheck eq 'ok') {
                     push(@badclasses,$class);                      push @badclasses, $class;
                 }                  }
             }              }
             $cenv{'internal.sectionnums'} =~ s/,$//;              $cenv{'internal.sectionnums'} =~ s/,$//;
Line 15306  sub construct_course { Line 14005  sub construct_course {
                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});                  my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                 $cenv{'internal.crosslistings'} .= $item.',';                  $cenv{'internal.crosslistings'} .= $item.',';
                 unless ($addcheck eq 'ok') {                  unless ($addcheck eq 'ok') {
                     push(@badclasses,$xl);                      push @badclasses, $xl;
                 }                  }
             }              }
             $cenv{'internal.crosslistings'} =~ s/,$//;              $cenv{'internal.crosslistings'} =~ s/,$//;
Line 15341  sub construct_course { Line 14040  sub construct_course {
     }      }
     if (@badclasses > 0) {      if (@badclasses > 0) {
         my %lt=&Apache::lonlocal::texthash(          my %lt=&Apache::lonlocal::texthash(
                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',                  'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.  However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
                 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',                  'dnhr' => 'does not have rights to access enrollment in these classes',
                 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',                  'adby' => 'as determined by the policies of your institution on access to official classlists'
         );          );
         my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.          my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                            &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};                             ' ('.$lt{'adby'}.')';
         if ($context eq 'auto') {          if ($context eq 'auto') {
             $outcome .= $badclass_msg.$linefeed;              $outcome .= $badclass_msg.$linefeed;
         } else {  
             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";              $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
         }              foreach my $item (@badclasses) {
         foreach my $item (@badclasses) {                  if ($context eq 'auto') {
                       $outcome .= " - $item\n";
                   } else {
                       $outcome .= "<li>$item</li>\n";
                   }
               }
             if ($context eq 'auto') {              if ($context eq 'auto') {
                 $outcome .= " - $item\n";                  $outcome .= $linefeed;
             } else {              } else {
                 $outcome .= "<li>$item</li>\n";                  $outcome .= "</ul><br /><br /></div>\n";
             }              }
         }          } 
         if ($context eq 'auto') {  
             $outcome .= $linefeed;  
         } else {  
             $outcome .= "</ul><br /><br /></div>\n";  
         }  
     }      }
     if ($args->{'no_end_date'}) {      if ($args->{'no_end_date'}) {
         $args->{'endaccess'} = 0;          $args->{'endaccess'} = 0;
Line 15395  sub construct_course { Line 14093  sub construct_course {
        if ($args->{'setcontent'}) {         if ($args->{'setcontent'}) {
            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};             $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
        }         }
        if ($args->{'setcomment'}) {  
            $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};  
        }  
     }      }
     if ($args->{'reshome'}) {      if ($args->{'reshome'}) {
  $cenv{'reshome'}=$args->{'reshome'}.'/';   $cenv{'reshome'}=$args->{'reshome'}.'/';
Line 15420  sub construct_course { Line 14115  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 15507  sub construct_course { Line 14183  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 15588  sub group_term { Line 14210  sub group_term {
 }  }
   
 sub course_types {  sub course_types {
     my @types = ('official','unofficial','community','textbook');      my @types = ('official','unofficial','community');
     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 15654  sub escape_url { Line 14275  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 &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;      return join('/',@urlslices).'/'.$lastitem;
 }  }
   
 sub compare_arrays {  sub compare_arrays {
Line 15708  sub init_user_environment { Line 14329  sub init_user_environment {
     opendir(DIR,$lonids);      opendir(DIR,$lonids);
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {   if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                     if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",      unlink($lonids.'/'.$filename);
                             &GDBM_READER(),0640)) {  
                         my $linkedfile;  
                         if (exists($oldenv{'user.linkedenv'})) {  
                             $linkedfile = $oldenv{'user.linkedenv'};  
                         }  
                         untie(%oldenv);  
                         if (unlink("$lonids/$filename")) {  
                             if ($linkedfile =~ /^[a-f0-9]+_linked$/) {  
                                 if (-l "$lonids/$linkedfile.id") {  
                                     unlink("$lonids/$linkedfile.id");  
                                 }  
                             }  
                         }  
                     } else {  
                         unlink($lonids.'/'.$filename);  
                     }  
  }   }
     }      }
     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 15752  sub init_user_environment { Line 14346  sub init_user_environment {
     }      }
 # ------------------------------------ Check browser type and MathML capability  # ------------------------------------ Check browser type and MathML capability
   
     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,      my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);          $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
   
 # ------------------------------------------------------------- Get environment  # ------------------------------------------------------------- Get environment
   
Line 15786  sub init_user_environment { Line 14380  sub init_user_environment {
      "browser.os"         => $clientos,       "browser.os"         => $clientos,
              "browser.mobile"     => $clientmobile,               "browser.mobile"     => $clientmobile,
              "browser.info"       => $clientinfo,               "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 15806  sub init_user_environment { Line 14399  sub init_user_environment {
     $env{'browser.interface'}=$form->{'interface'};      $env{'browser.interface'}=$form->{'interface'};
  }   }
   
         if ($form->{'iptoken'}) {          my %is_adv = ( is_adv => $env{'user.adv'} );
             my $lonhost = $r->dir_config('lonHostID');          my %domdef;
             $initial_env{"user.noloadbalance"} = $lonhost;          unless ($domain eq 'public') {
             $env{'user.noloadbalance'} = $lonhost;              %domdef = &Apache::lonnet::get_domain_defaults($domain);
         }          }
   
         if ($form->{'noloadbalance'}) {          foreach my $tool ('aboutme','blog','webdav','portfolio') {
             my @hosts = &Apache::lonnet::current_machine_ids();              $userenv{'availabletools.'.$tool} = 
             my $hosthere = $form->{'noloadbalance'};                  &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
             if (grep(/^\Q$hosthere\E$/,@hosts)) {                                                    undef,\%userenv,\%domdef,\%is_adv);
                 $initial_env{"user.noloadbalance"} = $hosthere;  
                 $env{'user.noloadbalance'} = $hosthere;  
             }  
         }          }
   
         unless ($domain eq 'public') {          foreach my $crstype ('official','unofficial','community') {
             my %is_adv = ( is_adv => $env{'user.adv'} );              $userenv{'canrequest.'.$crstype} =
             my %domdef = &Apache::lonnet::get_domain_defaults($domain);                  &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                     'reload','requestcourses',
             foreach my $tool ('aboutme','blog','webdav','portfolio') {  
                 $userenv{'availabletools.'.$tool} =   
                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',  
                                                       undef,\%userenv,\%domdef,\%is_adv);  
             }  
   
             foreach my $crstype ('official','unofficial','community','textbook') {  
                 $userenv{'canrequest.'.$crstype} =  
                     &Apache::lonnet::usertools_access($username,$domain,$crstype,  
                                                       'reload','requestcourses',  
                                                       \%userenv,\%domdef,\%is_adv);  
             }  
   
             $userenv{'canrequest.author'} =  
                 &Apache::lonnet::usertools_access($username,$domain,'requestauthor',  
                                                   'reload','requestauthor',  
                                                   \%userenv,\%domdef,\%is_adv);                                                    \%userenv,\%domdef,\%is_adv);
             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],          }
                                                  $domain,$username);  
             my $reqstatus = $reqauthor{'author_status'};          $userenv{'canrequest.author'} =
             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {              &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                 if (ref($reqauthor{'author'}) eq 'HASH') {                                          'reload','requestauthor',
                     $userenv{'requestauthorqueued'} = $reqstatus.':'.                                          \%userenv,\%domdef,\%is_adv);
                                                       $reqauthor{'author'}{'timestamp'};          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'};
             }              }
         }          }
   
Line 15937  sub clean_symb { Line 14516  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') &&
 =pod                    (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                     (ref($randomizetry) eq 'HASH'));
 =head1 Routines for building display used to search for courses      foreach my $key (keys(%Apache::lonnet::needsrelease)) {
           my ($item,$name,$value) = split(/:/,$key);
           if ($item eq 'parameter') {
 =over 4              if (ref($checkparms->{$name}) eq 'ARRAY') {
                   unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
 =item * &build_filters()                      push(@{$checkparms->{$name}},$value);
                   }
 Create markup for a table used to set filters to use when selecting  
 courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm  
 and quotacheck.pl  
   
   
 Inputs:  
   
 filterlist - anonymous array of fields to include as potential filters  
   
 crstype - course type  
   
 roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used  
               to pop-open a course selector (will contain "extra element").  
   
 multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1  
   
 filter - anonymous hash of criteria and their values  
   
 action - form action  
   
 numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)  
   
 caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)  
   
 cloneruname - username of owner of new course who wants to clone  
   
 clonerudom - domain of owner of new course who wants to clone  
   
 typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)  
   
 codetitlesref - reference to array of titles of components in institutional codes (official courses)  
   
 codedom - domain  
   
 formname - value of form element named "form".  
   
 fixeddom - domain, if fixed.  
   
 prevphase - value to assign to form element named "phase" when going back to the previous screen  
   
 cnameelement - name of form element in form on opener page which will receive title of selected course  
   
 cnumelement - name of form element in form on opener page which will receive courseID  of selected course  
   
 cdomelement - name of form element in form on opener page which will receive domain of selected course  
   
 setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file  
   
 clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course  
   
 clonewarning - warning message about missing information for intended course owner when DC creates a course  
   
   
 Returns: $output - HTML for display of search criteria, and hidden form elements.  
   
   
 Side Effects: None  
   
 =cut  
   
 # ---------------------------------------------- search for courses based on last activity etc.  
   
 sub build_filters {  
     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,  
         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,  
         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,  
         $cnameelement,$cnumelement,$cdomelement,$setroles,  
         $clonetext,$clonewarning) = @_;  
     my ($list,$jscript);  
     my $onchange = 'javascript:updateFilters(this)';  
     my ($domainselectform,$sincefilterform,$createdfilterform,  
         $ownerdomselectform,$persondomselectform,$instcodeform,  
         $typeselectform,$instcodetitle);  
     if ($formname eq '') {  
         $formname = $caller;  
     }  
     foreach my $item (@{$filterlist}) {  
         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||  
                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {  
             if ($item eq 'domainfilter') {  
                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});  
             } elsif ($item eq 'coursefilter') {  
                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});  
             } elsif ($item eq 'ownerfilter') {  
                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});  
             } elsif ($item eq 'ownerdomfilter') {  
                 $filter->{'ownerdomfilter'} =  
                     &LONCAPA::clean_domain($filter->{$item});  
                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},  
                                                        'ownerdomfilter',1);  
             } elsif ($item eq 'personfilter') {  
                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});  
             } elsif ($item eq 'persondomfilter') {  
                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},  
                                                         'persondomfilter',1);  
             } else {  
                 $filter->{$item} =~ s/\W//g;  
             }  
             if (!$filter->{$item}) {  
                 $filter->{$item} = '';  
             }  
         }  
         if ($item eq 'domainfilter') {  
             my $allow_blank = 1;  
             if ($formname eq 'portform') {  
                 $allow_blank=0;  
             } elsif ($formname eq 'studentform') {  
                 $allow_blank=0;  
             }  
             if ($fixeddom) {  
                 $domainselectform = '<input type="hidden" name="domainfilter"'.  
                                     ' value="'.$codedom.'" />'.  
                                     &Apache::lonnet::domain($codedom,'description');  
             } else {              } else {
                 $domainselectform = &select_dom_form($filter->{$item},                  push(@{$checkparms->{$name}},$value);
                                                      'domainfilter',  
                                                       $allow_blank,'',$onchange);  
             }              }
         } else {          } elsif ($item eq 'resourcetag') {
             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');              if ($name eq 'responsetype') {
         }                  $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
     }  
   
     # 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) {          } elsif ($item eq 'course') {
                 $instcodetitle .= '<br />('.$codedom.')';              if ($name eq 'crstype') {
                   $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
             }              }
         }          }
     }      }
     my $output = qq|      ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
 <form method="post" name="filterpicker" action="$action">      ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
 <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  
   
 =back  
   
 =head1 Routines for version requirements for current course.  
   
 =over 4  
   
 =item * &check_release_required()  
   
 Compares required LON-CAPA version with version on server, and  
 if required version is newer looks for a server with the required version.  
   
 Looks first at servers in user's owen domain; if none suitable, looks at  
 servers in course's domain are permitted to host sessions for user's domain.  
   
 Inputs:  
   
 $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)  
   
 $courseid - Course ID of current course  
   
 $rolecode - User's current role in course (for switchserver query string).  
   
 $required - LON-CAPA version needed by course (format: Major.Minor).  
   
   
 Returns:  
   
 $switchserver - query string tp append to /adm/switchserver call (if  
                 current server's LON-CAPA version is too old.  
   
 $warning - Message is displayed if no suitable server could be found.  
   
 =cut  
   
 sub check_release_required {  
     my ($loncaparev,$courseid,$rolecode,$required) = @_;  
     my ($switchserver,$warning);  
     if ($required ne '') {  
         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);  
         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);  
         if ($reqdmajor ne '' && $reqdminor ne '') {  
             my $otherserver;  
             if (($major eq '' && $minor eq '') ||  
                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {  
                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);  
                 my $switchlcrev =  
                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},  
                                                            $userdomserver);  
                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);  
                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||  
                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {  
                     my $cdom = $env{'course.'.$courseid.'.domain'};  
                     if ($cdom ne $env{'user.domain'}) {  
                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);  
                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);  
                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);  
                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);  
                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});  
                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);  
                         my $canhost =  
                             &Apache::lonnet::can_host_session($env{'user.domain'},  
                                                               $coursedomserver,  
                                                               $remoterev,  
                                                               $udomdefaults{'remotesessions'},  
                                                               $defdomdefaults{'hostedsessions'});  
   
                         if ($canhost) {  
                             $otherserver = $coursedomserver;  
                         } else {  
                             $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");  
                         }  
                     } else {  
                         $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");  
                     }  
                 } else {  
                     $otherserver = $userdomserver;  
                 }  
             }  
             if ($otherserver ne '') {  
                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;  
             }  
         }  
     }  
     return ($switchserver,$warning);  
 }  
   
 =pod  
   
 =item * &check_release_result()  
   
 Inputs:  
   
 $switchwarning - Warning message if no suitable server found to host session.  
   
 $switchserver - query string to append to /adm/switchserver containing lonHostID  
                 and current role.  
   
 Returns: HTML to display with information about requirement to switch server.  
          Either displaying warning with link to Roles/Courses screen or  
          display link to switchserver.  
   
 =cut  
   
 sub check_release_result {  
     my ($switchwarning,$switchserver) = @_;  
     my $output = &start_page('Selected course unavailable on this server').  
                  '<p class="LC_warning">';  
     if ($switchwarning) {  
         $output .= $switchwarning.'<br /><a href="/adm/roles">';  
         if (&show_course()) {  
             $output .= &mt('Display courses');  
         } else {  
             $output .= &mt('Display roles');  
         }  
         $output .= '</a>';  
     } elsif ($switchserver) {  
         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').  
                    '<br />'.  
                    '<a href="/adm/switchserver?'.$switchserver.'">'.  
                    &mt('Switch Server').  
                    '</a>';  
     }  
     $output .= '</p>'.&end_page();  
     return $output;  
 }  
   
 =pod  
   
 =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 {  sub update_content_constraints {
     my ($cdom,$cnum,$chome,$cid) = @_;      my ($cdom,$cnum,$chome,$cid) = @_;
     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');      my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
Line 16787  sub recurse_supplemental { Line 14657  sub recurse_supplemental {
 }  }
   
 sub symb_to_docspath {  sub symb_to_docspath {
     my ($symb,$navmapref) = @_;      my ($symb) = @_;
     return unless ($symb && ref($navmapref));      return unless ($symb);
     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);      my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
     if ($resurl=~/\.(sequence|page)$/) {      if ($resurl=~/\.(sequence|page)$/) {
         $mapurl=$resurl;          $mapurl=$resurl;
Line 16796  sub symb_to_docspath { Line 14666  sub symb_to_docspath {
         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};          $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
     }      }
     my $mapresobj;      my $mapresobj;
     unless (ref($$navmapref)) {      my $navmap = Apache::lonnavmaps::navmap->new();
         $$navmapref = Apache::lonnavmaps::navmap->new();      if (ref($navmap)) {
     }          $mapresobj = $navmap->getResourceByUrl($mapurl);
     if (ref($$navmapref)) {  
         $mapresobj = $$navmapref->getResourceByUrl($mapurl);  
     }      }
     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};      $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
     my $type=$2;      my $type=$2;
Line 16810  sub symb_to_docspath { Line 14678  sub symb_to_docspath {
         if ($pcslist ne '') {          if ($pcslist ne '') {
             foreach my $pc (split(/,/,$pcslist)) {              foreach my $pc (split(/,/,$pcslist)) {
                 next if ($pc <= 1);                  next if ($pc <= 1);
                 my $res = $$navmapref->getByMapPc($pc);                  my $res = $navmap->getByMapPc($pc);
                 if (ref($res)) {                  if (ref($res)) {
                     my $thisurl = $res->src();                      my $thisurl = $res->src();
                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};                      $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
Line 16857  sub symb_to_docspath { Line 14725  sub symb_to_docspath {
 }  }
   
 sub captcha_display {  sub captcha_display {
     my ($context,$lonhost,$defdom) = @_;      my ($context,$lonhost) = @_;
     my ($output,$error);      my ($output,$error);
     my ($captcha,$pubkey,$privkey,$version) =      my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
         &get_captcha_config($context,$lonhost,$defdom);  
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         $output = &create_captcha();          $output = &create_captcha();
         unless ($output) {          unless ($output) {
             $error = 'captcha';              $error = 'captcha'; 
         }          }
     } elsif ($captcha eq 'recaptcha') {      } elsif ($captcha eq 'recaptcha') {
         $output = &create_recaptcha($pubkey,$version);          $output = &create_recaptcha($pubkey);
         unless ($output) {          unless ($output) {
             $error = 'recaptcha';              $error = 'recaptcha'; 
         }          }
     }      }
     return ($output,$error,$captcha,$version);      return ($output,$error);
 }  }
   
 sub captcha_response {  sub captcha_response {
     my ($context,$lonhost,$defdom) = @_;      my ($context,$lonhost) = @_;
     my ($captcha_chk,$captcha_error);      my ($captcha_chk,$captcha_error);
     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);      my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         ($captcha_chk,$captcha_error) = &check_captcha();          ($captcha_chk,$captcha_error) = &check_captcha();
     } elsif ($captcha eq 'recaptcha') {      } elsif ($captcha eq 'recaptcha') {
         $captcha_chk = &check_recaptcha($privkey,$version);          $captcha_chk = &check_recaptcha($privkey);
     } else {      } else {
         $captcha_chk = 1;          $captcha_chk = 1;
     }      }
Line 16890  sub captcha_response { Line 14757  sub captcha_response {
 }  }
   
 sub get_captcha_config {  sub get_captcha_config {
     my ($context,$lonhost,$dom_in_effect) = @_;      my ($context,$lonhost) = @_;
     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);      my ($captcha,$pubkey,$privkey,$hashtocheck);
     my $hostname = &Apache::lonnet::hostname($lonhost);      my $hostname = &Apache::lonnet::hostname($lonhost);
     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);      my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);      my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
Line 16907  sub get_captcha_config { Line 14774  sub get_captcha_config {
                     }                      }
                     if ($privkey && $pubkey) {                      if ($privkey && $pubkey) {
                         $captcha = 'recaptcha';                          $captcha = 'recaptcha';
                         $version = $hashtocheck->{'recaptchaversion'};  
                         if ($version ne '2') {  
                             $version = 1;  
                         }  
                     } else {                      } else {
                         $captcha = 'original';                          $captcha = 'original';
                     }                      }
Line 16928  sub get_captcha_config { Line 14791  sub get_captcha_config {
             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};              $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
             if ($privkey && $pubkey) {              if ($privkey && $pubkey) {
                 $captcha = 'recaptcha';                  $captcha = 'recaptcha';
                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};  
                 if ($version ne '2') {  
                     $version = 1;  
                 }  
             } else {              } else {
                 $captcha = 'original';                  $captcha = 'original';
             }              }
         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {          } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
             $captcha = 'original';              $captcha = 'original';
         }          }
     } elsif ($context eq 'passwords') {  
         if ($dom_in_effect) {  
             my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);  
             if ($passwdconf{'captcha'} eq 'recaptcha') {  
                 if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {  
                     $pubkey = $passwdconf{'recaptchakeys'}{'public'};  
                     $privkey = $passwdconf{'recaptchakeys'}{'private'};  
                 }  
                 if ($privkey && $pubkey) {  
                     $captcha = 'recaptcha';  
                     $version = $passwdconf{'recaptchaversion'};  
                     if ($version ne '2') {  
                         $version = 1;  
                     }  
                 } else {  
                     $captcha = 'original';  
                 }  
             } elsif ($passwdconf{'captcha'} ne 'notused') {  
                 $captcha = 'original';  
             }  
         }  
     }      }
     return ($captcha,$pubkey,$privkey,$version);      return ($captcha,$pubkey,$privkey);
 }  }
   
 sub create_captcha {  sub create_captcha {
Line 16977  sub create_captcha { Line 14815  sub create_captcha {
         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {          if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".              $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                       &mt('Type in the letters/numbers shown below').'&nbsp;'.                        &mt('Type in the letters/numbers shown below').'&nbsp;'.
                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.                       '<input type="text" size="5" name="code" value="" /><br />'.
                       '<br />'.                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';  
             last;              last;
         }          }
     }      }
Line 17019  sub check_captcha { Line 14856  sub check_captcha {
 }  }
   
 sub create_recaptcha {  sub create_recaptcha {
     my ($pubkey,$version) = @_;      my ($pubkey) = @_;
     if ($version >= 2) {      my $captcha = Captcha::reCAPTCHA->new;
         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';      return $captcha->get_options_setter({theme => 'white'})."\n".
     } else {             $captcha->get_html($pubkey).
         my $use_ssl;             &mt('If either word is hard to read, [_1] will replace them.',
         if ($ENV{'SERVER_PORT'} == 443) {                 '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
             $use_ssl = 1;             '<br /><br />';
         }  
         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 {  sub check_recaptcha {
     my ($privkey,$version) = @_;      my ($privkey) = @_;
     my $captcha_chk;      my $captcha_chk;
     if ($version >= 2) {      my $captcha = Captcha::reCAPTCHA->new;
         my $ua = LWP::UserAgent->new;      my $captcha_result =
         $ua->timeout(10);          $captcha->check_answer(
         my %info = (                                  $privkey,
                      secret   => $privkey,                                  $ENV{'REMOTE_ADDR'},
                      response => $env{'form.g-recaptcha-response'},                                  $env{'form.recaptcha_challenge_field'},
                      remoteip => $ENV{'REMOTE_ADDR'},                                  $env{'form.recaptcha_response_field'},
                    );                                );
         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);      if ($captcha_result->{is_valid}) {
         if ($response->is_success)  {          $captcha_chk = 1;
             my $data = JSON::DWIW->from_json($response->decoded_content);  
             if (ref($data) eq 'HASH') {  
                 if ($data->{'success'}) {  
                     $captcha_chk = 1;  
                 }  
             }  
         }  
     } else {  
         my $captcha = Captcha::reCAPTCHA->new;  
         my $captcha_result =  
             $captcha->check_answer(  
                                     $privkey,  
                                     $ENV{'REMOTE_ADDR'},  
                                     $env{'form.recaptcha_challenge_field'},  
                                     $env{'form.recaptcha_response_field'},  
                                   );  
         if ($captcha_result->{is_valid}) {  
             $captcha_chk = 1;  
         }  
     }      }
     return $captcha_chk;      return $captcha_chk;
 }  }
   
 sub emailusername_info {  =pod
     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');  
     my %titles = &Apache::lonlocal::texthash (  
                      lastname      => 'Last Name',  
                      firstname     => 'First Name',  
                      institution   => 'School/college/university',  
                      location      => "School's city, state/province, country",  
                      web           => "School's web address",  
                      officialemail => 'E-mail address at institution (if different)',  
                      id            => 'Student/Employee ID',  
                  );  
     return (\@fields,\%titles);  
 }  
   
 sub cleanup_html {  =back
     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:  =cut
 #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);  
 #  
 ##################################################  
 #          password associated functions         #  
 ##################################################  
 sub des_keys {  
     # Make a new key for DES encryption.  
     # Each key has two parts which are returned separately.  
     # Please note:  Each key must be passed through the &hex function  
     # before it is output to the web browser.  The hex versions cannot  
     # be used to decrypt.  
     my @hexstr=('0','1','2','3','4','5','6','7',  
                 '8','9','a','b','c','d','e','f');  
     my $lkey='';  
     for (0..7) {  
         $lkey.=$hexstr[rand(15)];  
     }  
     my $ukey='';  
     for (0..7) {  
         $ukey.=$hexstr[rand(15)];  
     }  
     return ($lkey,$ukey);  
 }  
   
 sub des_decrypt {  
     my ($key,$cyphertext) = @_;  
     my $keybin=pack("H16",$key);  
     my $cypher;  
     if ($Crypt::DES::VERSION>=2.03) {  
         $cypher=new Crypt::DES $keybin;  
     } else {  
         $cypher=new DES $keybin;  
     }  
     my $plaintext='';  
     my $cypherlength = length($cyphertext);  
     my $numchunks = int($cypherlength/32);  
     for (my $j=0; $j<$numchunks; $j++) {  
         my $start = $j*32;  
         my $cypherblock = substr($cyphertext,$start,32);  
         my $chunk =  
             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));  
         $chunk .=  
             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));  
         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );  
         $plaintext .= $chunk;  
     }  
     return $plaintext;  
 }  
   
 sub is_nonframeable {  
     my ($url,$absolute,$hostname,$ip,$nocache) = @_;  
     my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);  
     return if (($remprotocol eq '') || ($remhost eq ''));  
   
     $remprotocol = lc($remprotocol);  
     $remhost = lc($remhost);  
     my $remport = 80;  
     if ($remprotocol eq 'https') {  
         $remport = 443;  
     }  
     my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);  
     if ($cached) {  
         unless ($nocache) {  
             if ($result) {  
                 return 1;  
             } else {  
                 return 0;  
             }  
         }  
     }  
     my $uselink;  
     my $request = new HTTP::Request('HEAD',$url);  
     my $ua = LWP::UserAgent->new;  
     $ua->timeout(5);  
     my $response=$ua->request($request);  
     if ($response->is_success()) {  
         my $secpolicy = lc($response->header('content-security-policy'));  
         my $xframeop = lc($response->header('x-frame-options'));  
         $secpolicy =~ s/^\s+|\s+$//g;  
         $xframeop =~ s/^\s+|\s+$//g;  
         if (($secpolicy ne '') || ($xframeop ne '')) {  
             my $remotehost = $remprotocol.'://'.$remhost;  
             my ($origin,$protocol,$port);  
             if ($ENV{'SERVER_PORT'} =~/^\d+$/) {  
                 $port = $ENV{'SERVER_PORT'};  
             } else {  
                 $port = 80;  
             }  
             if ($absolute eq '') {  
                 $protocol = 'http:';  
                 if ($port == 443) {  
                     $protocol = 'https:';  
                 }  
                 $origin = $protocol.'//'.lc($hostname);  
             } else {  
                 $origin = lc($absolute);  
                 ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});  
             }  
             if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {  
                 my $framepolicy = $1;  
                 $framepolicy =~ s/^\s+|\s+$//g;  
                 my @policies = split(/\s+/,$framepolicy);  
                 if (@policies) {  
                     if (grep(/^\Q'none'\E$/,@policies)) {  
                         $uselink = 1;  
                     } else {  
                         $uselink = 1;  
                         if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||  
                                 (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||  
                                 (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {  
                             undef($uselink);  
                         }  
                         if ($uselink) {  
                             if (grep(/^\Q'self'\E$/,@policies)) {  
                                 if (($origin ne '') && ($remotehost eq $origin)) {  
                                     undef($uselink);  
                                 }  
                             }  
                         }  
                         if ($uselink) {  
                             my @possok;  
                             if ($ip ne '') {  
                                 push(@possok,$ip);  
                             }  
                             my $hoststr = '';  
                             foreach my $part (reverse(split(/\./,$hostname))) {  
                                 if ($hoststr eq '') {  
                                     $hoststr = $part;  
                                 } else {  
                                     $hoststr = "$part.$hoststr";  
                                 }  
                                 if ($hoststr eq $hostname) {  
                                     push(@possok,$hostname);  
                                 } else {  
                                     push(@possok,"*.$hoststr");  
                                 }  
                             }  
                             if (@possok) {  
                                 foreach my $poss (@possok) {  
                                     last if (!$uselink);  
                                     foreach my $policy (@policies) {  
                                         if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {  
                                             undef($uselink);  
                                             last;  
                                         }  
                                     }  
                                 }  
                             }  
                         }  
                     }  
                 }  
             } elsif ($xframeop ne '') {  
                 $uselink = 1;  
                 my @policies = split(/\s*,\s*/,$xframeop);  
                 if (@policies) {  
                     unless (grep(/^deny$/,@policies)) {  
                         if ($origin ne '') {  
                             if (grep(/^sameorigin$/,@policies)) {  
                                 if ($remotehost eq $origin) {  
                                     undef($uselink);  
                                 }  
                             }  
                             if ($uselink) {  
                                 foreach my $policy (@policies) {  
                                     if ($policy =~ /^allow-from\s*(.+)$/) {  
                                         my $allowfrom = $1;  
                                         if (($allowfrom ne '') && ($allowfrom eq $origin)) {  
                                             undef($uselink);  
                                             last;  
                                         }  
                                     }  
                                 }  
                             }  
                         }  
                     }  
                 }  
             }  
         }  
     }  
     if ($nocache) {  
         if ($cached) {  
             my $devalidate;  
             if ($uselink && !$result) {  
                 $devalidate = 1;  
             } elsif (!$uselink && $result) {  
                 $devalidate = 1;  
             }  
             if ($devalidate) {  
                 &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);  
             }  
         }  
     } else {  
         if ($uselink) {  
             $result = 1;  
         } else {  
             $result = 0;  
         }  
         &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);  
     }  
     return $uselink;  
 }  
   
 1;  1;
 __END__;  __END__;
Removed from v.1.1075.2.144  
changed lines
  Added in v.1.1150

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