Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.161.2.21 and 1.1335

version 1.1075.2.161.2.21, 2024/02/28 01:21:29 version 1.1335, 2020/01/10 05:08:39
Line 61  use POSIX qw(strftime mktime); Line 61  use POSIX qw(strftime mktime);
 use Apache::lonmenu();  use Apache::lonmenu();
 use Apache::lonenc();  use Apache::lonenc();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonnavmaps();  use Apache::lonnet();
 use HTML::Entities;  use HTML::Entities;
 use Apache::lonhtmlcommon();  use Apache::lonhtmlcommon();
 use Apache::loncoursedata();  use Apache::loncoursedata();
Line 71  use Apache::lonuserutils(); Line 71  use Apache::lonuserutils();
 use Apache::lonuserstate();  use Apache::lonuserstate();
 use Apache::courseclassifier();  use Apache::courseclassifier();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::map();  use LONCAPA::LWPReq;
 use HTTP::Request;  use HTTP::Request;
 use DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale;  use DateTime::Locale;
 use Encode();  use Encode();
   use Text::Aspell;
 use Authen::Captcha;  use Authen::Captcha;
 use Captcha::reCAPTCHA;  use Captcha::reCAPTCHA;
 use JSON::DWIW;  use JSON::DWIW;
 use LWP::UserAgent;  use LWP::UserAgent;
 use Crypt::DES;  use Crypt::DES;
 use DynaLoader; # for Crypt::DES version  use DynaLoader; # for Crypt::DES version
   use MIME::Lite;
   use MIME::Types;
 use File::Copy();  use File::Copy();
 use File::Path();  use File::Path();
 use String::CRC32();  use String::CRC32();
Line 170  sub ssi_with_retries { Line 173  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 204  BEGIN { Line 208  BEGIN {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line=~/^\#/);                  next if ($line=~/^\#/);
                 chomp($line);                  chomp($line);
                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));                  my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
                 $language{$key}=$val.' - '.$enc;                  $language{$key}=$val.' - '.$enc;
                 if ($sup) {                  if ($sup) {
                     $supported_language{$key}=$sup;                      $supported_language{$key}=$sup;
       $supported_codes{$key}   = $code;
                 }                  }
  if ($latex) {   if ($latex) {
     $latex_language_bykey{$key} = $latex;      $latex_language_bykey{$key} = $latex;
     $latex_language{$two} = $latex;      $latex_language{$code} = $latex;
  }   }
             }              }
             close($fh);              close($fh);
Line 431  sub studentbrowser_javascript { Line 436  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,uident) {      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 446  sub studentbrowser_javascript { Line 451  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; }  
         if (uident !== '') { url+="&identelement="+uident; }  
         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 484  ENDRESBRW Line 483  ENDRESBRW
 }  }
   
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele,$courseadv,$clickerid,$identelem)=@_;     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 495  sub selectstudent_link { Line 494  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'";  
        } elsif ($identelem ne '') {  
            $callargs .= ",'','',''";  
        }  
        if ($identelem ne '') {  
            $callargs .= ",'".&Apache::lonhtmlcommon::entity_encode($identelem)."'";  
        }         }
        return '<span class="LC_nobreak">'.         return '<span class="LC_nobreak">'.
               '<a href="javascript:openstdbrowser('.$callargs.');">'.                '<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 696  if (!Array.prototype.indexOf) { Line 686  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 897  sub selectcourse_link { Line 887  sub selectcourse_link {
    my $linktext = &mt('Select Course');     my $linktext = &mt('Select Course');
    if ($selecttype eq 'Community') {     if ($selecttype eq 'Community') {
        $linktext = &mt('Select Community');         $linktext = &mt('Select Community');
      } elsif ($selecttype eq 'Placement') {
          $linktext = &mt('Select Placement Test'); 
    } elsif ($selecttype eq 'Course/Community') {     } elsif ($selecttype eq 'Course/Community') {
        $linktext = &mt('Select Course/Community');         $linktext = &mt('Select Course/Community');
        $type = '';         $type = '';
Line 932  sub check_uncheck_jscript { Line 924  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 957  ENDSCRT Line 949  ENDSCRT
 }  }
   
 sub select_timezone {  sub select_timezone {
    my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_;     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
    my $output='<select name="'.$name.'" '.$id.$onchange.$disabled.'>'."\n";     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
    if ($includeempty) {     if ($includeempty) {
        $output .= '<option value=""';         $output .= '<option value=""';
        if (($selected eq '') || ($selected eq 'local')) {         if (($selected eq '') || ($selected eq 'local')) {
Line 1013  sub select_datelocale { Line 1005  sub select_datelocale {
                 }                  }
                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});                  $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
                 push(@possibles,$id);                  push(@possibles,$id);
             }              } 
         }          }
     }      }
     foreach my $item (sort(@possibles)) {      foreach my $item (sort(@possibles)) {
Line 1049  sub select_language { Line 1041  sub select_language {
   
 =pod  =pod
   
   
   =item * &list_languages()
   
   Returns an array reference that is suitable for use in language prompters.
   Each array element is itself a two element array.  The first element
   is the language code.  The second element a descsriptiuon of the 
   language itself.  This is suitable for use in e.g.
   &Apache::edit::select_arg (once dereferenced that is).
   
   =cut 
   
   sub list_languages {
       my @lang_choices;
   
       foreach my $id (&languageids()) {
    my $code = &supportedlanguagecode($id);
    if ($code) {
       my $selector    = $supported_codes{$id};
       my $description = &plainlanguagedescription($id);
       push(@lang_choices, [$selector, $description]);
    }
       }
       return \@lang_choices;
   }
   
   =pod
   
 =item * &linked_select_forms(...)  =item * &linked_select_forms(...)
   
 linked_select_forms returns a string containing a <script></script> block  linked_select_forms returns a string containing a <script></script> block
Line 1081  linked_select_forms takes the following Line 1100  linked_select_forms takes the following
 =item * $onchangesecond, additional javascript call to execute for an onchange  =item * $onchangesecond, additional javascript call to execute for an onchange
         event for the second <select> tag          event for the second <select> tag
   
   =item * $suffix, to differentiate separate uses of select2data javascript
           objects in a page.
   
 =back   =back 
   
 Below is an example of such a hash.  Only the 'text', 'default', and   Below is an example of such a hash.  Only the 'text', 'default', and 
Line 1135  sub linked_select_forms { Line 1157  sub linked_select_forms {
         $hashref,          $hashref,
         $menuorder,          $menuorder,
         $onchangefirst,          $onchangefirst,
         $onchangesecond          $onchangesecond,
           $suffix
         ) = @_;          ) = @_;
     my $second = "document.$formname.$secondselectname";      my $second = "document.$formname.$secondselectname";
     my $first = "document.$formname.$firstselectname";      my $first = "document.$formname.$firstselectname";
Line 1143  sub linked_select_forms { Line 1166  sub linked_select_forms {
     my $result = '';      my $result = '';
     $result.='<script type="text/javascript" language="JavaScript">'."\n";      $result.='<script type="text/javascript" language="JavaScript">'."\n";
     $result.="// <![CDATA[\n";      $result.="// <![CDATA[\n";
     $result.="var select2data = new Object();\n";      $result.="var select2data${suffix} = new Object();\n";
     $" = '","';      $" = '","';
     my $debug = '';      my $debug = '';
     foreach my $s1 (sort(keys(%$hashref))) {      foreach my $s1 (sort(keys(%$hashref))) {
         $result.="select2data.d_$s1 = new Object();\n";                  $result.="select2data${suffix}['d_$s1'] = new Object();\n";        
         $result.="select2data.d_$s1.def = new String('".          $result.="select2data${suffix}['d_$s1'].def = new String('".
             $hashref->{$s1}->{'default'}."');\n";              $hashref->{$s1}->{'default'}."');\n";
         $result.="select2data.d_$s1.values = new Array(";          $result.="select2data${suffix}['d_$s1'].values = new Array(";
         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));          my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {          if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
             @s2values = @{$hashref->{$s1}->{'order'}};              @s2values = @{$hashref->{$s1}->{'order'}};
         }          }
         $result.="\"@s2values\");\n";          $result.="\"@s2values\");\n";
         $result.="select2data.d_$s1.texts = new Array(";                  $result.="select2data${suffix}['d_$s1'].texts = new Array(";        
         my @s2texts;          my @s2texts;
         foreach my $value (@s2values) {          foreach my $value (@s2values) {
             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});              push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
Line 1166  sub linked_select_forms { Line 1189  sub linked_select_forms {
     $"=' ';      $"=' ';
     $result.= <<"END";      $result.= <<"END";
   
 function select1_changed() {  function select1${suffix}_changed() {
     // Determine new choice      // Determine new choice
     var newvalue = "d_" + $first.value;      var newvalue = "d_" + $first.options[$first.selectedIndex].value;
     // update select2      // update select2
     var values     = select2data[newvalue].values;      var values     = select2data${suffix}[newvalue].values;
     var texts      = select2data[newvalue].texts;      var texts      = select2data${suffix}[newvalue].texts;
     var select2def = select2data[newvalue].def;      var select2def = select2data${suffix}[newvalue].def;
     var i;      var i;
     // out with the old      // out with the old
     for (i = 0; i < $second.options.length; i++) {      $second.options.length = 0;
         $second.options[i] = null;      // in with the new
     }  
     // in with the nuclear  
     for (i=0;i<values.length; i++) {      for (i=0;i<values.length; i++) {
         $second.options[i] = new Option(values[i]);          $second.options[i] = new Option(values[i]);
         $second.options[i].value = values[i];          $second.options[i].value = values[i];
Line 1192  function select1_changed() { Line 1213  function select1_changed() {
 </script>  </script>
 END  END
     # output the initial values for the selection lists      # output the initial values for the selection lists
     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";      $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
     my @order = sort(keys(%{$hashref}));      my @order = sort(keys(%{$hashref}));
     if (ref($menuorder) eq 'ARRAY') {      if (ref($menuorder) eq 'ARRAY') {
         @order = @{$menuorder};          @order = @{$menuorder};
Line 1228  END Line 1249  END
   
 =pod  =pod
   
 =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)  =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
   
 Returns a string corresponding to an HTML link to the given help  Returns a string corresponding to an HTML link to the given help
 $topic, where $topic corresponds to the name of a .tex file in  $topic, where $topic corresponds to the name of a .tex file in
Line 1252  $imgid is the id of the img tag used for Line 1273  $imgid is the id of the img tag used for
 used in a javascript call to switch the image src.  See   used in a javascript call to switch the image src.  See 
 lonhtmlcommon::htmlareaselectactive() for an example.  lonhtmlcommon::htmlareaselectactive() for an example.
   
 $links_target will optionally be set to a target (_top, _parent or _self).  
   
 =cut  =cut
   
 sub help_open_topic {  sub help_open_topic {
     my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;      my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     $width = 500 if (not defined $width);      $width = 500 if (not defined $width);
Line 1271  sub help_open_topic { Line 1290  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 1284  sub help_open_topic { Line 1299  sub help_open_topic {
   
     # Add the text      # Add the text
     my $target = ' target="_top"';      my $target = ' target="_top"';
     if ($links_target) {      if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
         $target = ' target="'.$links_target.'"';  
     } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||  
              (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {  
         $target = '';          $target = '';
     }      }
     if ($text ne "") {      if ($text ne "") {
Line 1331  sub helpLatexCheatsheet { Line 1343  sub helpLatexCheatsheet {
   .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)    .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
   .'</span>';    .'</span>';
     unless ($not_author) {      unless ($not_author) {
         $out .= ' <span>'          $out .= '<span>'
        .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)                 .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
        .'</span> <span>'                 .'</span> <span>'
                .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)                 .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
                .'</span>';         .'</span>';
     }      }
     $out .= '</span>'; # End cheatsheet      $out .= '</span>'; # End cheatsheet
     return $out;      return $out;
Line 1375  ENDOUTPUT Line 1387  ENDOUTPUT
   
 # now just updates the help link and generates a blue icon  # now just updates the help link and generates a blue icon
 sub help_open_menu {  sub help_open_menu {
     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target)       my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
  = @_;       = @_;    
     $stayOnPage = 1;      $stayOnPage = 1;
     my $output;      my $output;
     if ($component_help) {      if ($component_help) {
  if (!$text) {   if (!$text) {
     $output=&help_open_topic($component_help,undef,$stayOnPage,      $output=&help_open_topic($component_help,undef,$stayOnPage,
        $width,$height,'',$links_target);         $width,$height);
  } else {   } else {
     my $help_text;      my $help_text;
     $help_text=&unescape($topic);      $help_text=&unescape($topic);
     $output='<table><tr><td>'.      $output='<table><tr><td>'.
  &help_open_topic($component_help,$help_text,$stayOnPage,   &help_open_topic($component_help,$help_text,$stayOnPage,
  $width,$height,'',$links_target).'</td></tr></table>';   $width,$height).'</td></tr></table>';
  }   }
     }      }
     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);      my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
Line 1396  sub help_open_menu { Line 1408  sub help_open_menu {
 }  }
   
 sub top_nav_help {  sub top_nav_help {
     my ($text,$linkattr) = @_;      my ($text) = @_;
     $text = &mt($text);      $text = &mt($text);
     my $stay_on_page;      my $stay_on_page = 1;
     unless ($env{'environment.remote'} eq 'on') {  
         $stay_on_page = 1;  
     }  
     my ($link,$banner_link);      my ($link,$banner_link);
     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {      unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
         $link = ($stay_on_page) ? "javascript:helpMenu('display')"          $link = ($stay_on_page) ? "javascript:helpMenu('display')"
Line 1412  sub top_nav_help { Line 1422  sub top_nav_help {
     if ($link) {      if ($link) {
         return <<"END";          return <<"END";
 $banner_link  $banner_link
 <a href="$link" title="$title" $linkattr>$text</a>  <a href="$link" title="$title">$text</a>
 END  END
     } else {      } else {
         return '&nbsp;'.$text.'&nbsp;';          return '&nbsp;'.$text.'&nbsp;';
Line 1433  sub help_menu_js { Line 1443  sub help_menu_js {
  'js_ready'    => 1,   'js_ready'    => 1,
                                         'use_absolute' => $httphost,                                          'use_absolute' => $httphost,
  'add_entries' => {   'add_entries' => {
     'border' => '0',      'border' => '0', 
     'rows'   => "110,*",},});      'rows'   => "110,*",},});
     my $end_page =      my $end_page =
         &Apache::loncommon::end_page({'frameset' => 1,          &Apache::loncommon::end_page({'frameset' => 1,
Line 1498  sub help_open_bug { Line 1508  sub help_open_bug {
  $link = $url;   $link = $url;
     }      }
   
     my $target = '_top';      my $target = ' target="_top"';
     if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||      if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
         (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {          $target = '';
         $target = '_blank';  
     }      }
   
     # Add the text      # Add the text
     if ($text ne "")      if ($text ne "")
     {      {
  $template .=    $template .= 
   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".    "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
   "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";    "<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
     }      }
   
     # Add the graphic      # Add the graphic
     my $title = &mt('Report a Bug');      my $title = &mt('Report a Bug');
     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");      my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>   <a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 1728  the id of the element to resize, second Line 1736  the id of the element to resize, second
 surrounds everything that comes after the textarea, this routine needs  surrounds everything that comes after the textarea, this routine needs
 to be attached to the <body> for the onload and onresize events.  to be attached to the <body> for the onload and onresize events.
   
   =back
   
 =cut  =cut
   
 sub resize_textarea_js {  sub resize_textarea_js {
Line 1780  RESIZE Line 1790  RESIZE
 }  }
   
 sub colorfuleditor_js {  sub colorfuleditor_js {
       my $browse_or_search;
       my $respath;
       my ($cnum,$cdom) = &crsauthor_url();
       if ($cnum) {
           $respath = "/res/$cdom/$cnum/";
           my %js_lt = &Apache::lonlocal::texthash(
               sunm => 'Sub-directory name',
               save => 'Save page to make this permanent',
           );
           &js_escape(\%js_lt);
           $browse_or_search = <<"END";
   
       function toggleChooser(form,element,titleid,only,search) {
           var disp = 'none';
           if (document.getElementById('chooser_'+element)) {
               var curr = document.getElementById('chooser_'+element).style.display;
               if (curr == 'none') {
                   disp='inline';
                   if (form.elements['chooser_'+element].length) {
                       for (var i=0; i<form.elements['chooser_'+element].length; i++) {
                           form.elements['chooser_'+element][i].checked = false;
                       }
                   }
                   toggleResImport(form,element);
               }
               document.getElementById('chooser_'+element).style.display = disp;
           }
       }
   
       function toggleCrsFile(form,element,numdirs) {
           if (document.getElementById('chooser_'+element+'_crsres')) {
               var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
               if (curr == 'none') {
                   if (numdirs) {
                       form.elements['coursepath_'+element].selectedIndex = 0;
                       if (numdirs > 1) {
                           window['select1'+element+'_changed']();
                       }
                   }
               } 
               document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
               
           }
           if (document.getElementById('chooser_'+element+'_upload')) {
               document.getElementById('chooser_'+element+'_upload').style.display = 'none';
               if (document.getElementById('uploadcrsres_'+element)) {
                   document.getElementById('uploadcrsres_'+element).value = '';
               }
           }
           return;
       }
   
       function toggleCrsUpload(form,element,numcrsdirs) {
           if (document.getElementById('chooser_'+element+'_crsres')) {
               document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
           }
           if (document.getElementById('chooser_'+element+'_upload')) {
               var curr = document.getElementById('chooser_'+element+'_upload').style.display;
               if (curr == 'none') {
                   if (numcrsdirs) {
                      form.elements['crsauthorpath_'+element].selectedIndex = 0;
                      form.elements['newsubdir_'+element][0].checked = true;
                      toggleNewsubdir(form,element);
                   }
               }
               document.getElementById('chooser_'+element+'_upload').style.display = 'block';
           }
           return;
       }
   
       function toggleResImport(form,element) {
           var choices = new Array('crsres','upload');
           for (var i=0; i<choices.length; i++) {
               if (document.getElementById('chooser_'+element+'_'+choices[i])) {
                   document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
               }
           }
       }
   
       function toggleNewsubdir(form,element) {
           var newsub = form.elements['newsubdir_'+element];
           if (newsub) {
               if (newsub.length) {
                   for (var j=0; j<newsub.length; j++) {
                       if (newsub[j].checked) {
                           if (document.getElementById('newsubdirname_'+element)) {
                               if (newsub[j].value == '1') {
                                   document.getElementById('newsubdirname_'+element).type = "text";
                                   if (document.getElementById('newsubdir_'+element)) {
                                       document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
                                   }
                               } else {
                                   document.getElementById('newsubdirname_'+element).type = "hidden";
                                   document.getElementById('newsubdirname_'+element).value = "";
                                   document.getElementById('newsubdir_'+element).innerHTML = "";
                               }
                           }
                           break; 
                       }
                   }
               }
           }
       }
   
       function updateCrsFile(form,element) {
           var directory = form.elements['coursepath_'+element];
           var filename = form.elements['coursefile_'+element];
           var path = directory.options[directory.selectedIndex].value;
           var file = filename.options[filename.selectedIndex].value;
           form.elements[element].value = '$respath';
           if (path == '/') {
               form.elements[element].value += file;
           } else {
               form.elements[element].value += path+'/'+file;
           }
           unClean();
           if (document.getElementById('previewimg_'+element)) {
               document.getElementById('previewimg_'+element).src = form.elements[element].value;
               var newsrc = document.getElementById('previewimg_'+element).src; 
           }
           if (document.getElementById('showimg_'+element)) {
               document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
           }
           toggleChooser(form,element);
           return;
       }
   
       function uploadDone(suffix,name) {
           if (name) {
       document.forms["lonhomework"].elements[suffix].value = name;
               unClean();
               toggleChooser(document.forms["lonhomework"],suffix);
           }
       }
   
   \$(document).ready(function(){
   
       \$(document).delegate('form :submit', 'click', function( event ) {
           if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
               var buttonId = this.id;
               var suffix = buttonId.toString();
               suffix = suffix.replace(/^crsupload_/,'');
               event.preventDefault();
               document.lonhomework.target = 'crsupload_target_'+suffix;
               document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
               \$(this.form).submit();
               document.lonhomework.target = '';
               if (document.getElementById('crsuploadto_'+suffix)) {
                   document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
               }
               return false;
           }
       });
   });
   END
       }
     return <<"COLORFULEDIT"      return <<"COLORFULEDIT"
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[>  // <![CDATA[>
Line 1825  sub colorfuleditor_js { Line 1991  sub colorfuleditor_js {
             }              }
   
             // only iterate whole storage if nothing to override              // only iterate whole storage if nothing to override
             if(localStorage.getItem(key) == null){              if(localStorage.getItem(key) == null){        
   
                 // prevent storage from growing large                  // prevent storage from growing large
                 if(localStorage.length > 50){                  if(localStorage.length > 50){
                     var regex_getTimestamp = /^(?:\d)+;/;                      var regex_getTimestamp = /^(?:\d)+;/;
                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));                      var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                     var oldest_key;                      var oldest_key;
                       
                     for(var i = 1; i < localStorage.length; i++){                      for(var i = 1; i < localStorage.length; i++){
                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {                          if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                             oldest_key = localStorage.key(i);                              oldest_key = localStorage.key(i);
Line 1862  sub colorfuleditor_js { Line 2028  sub colorfuleditor_js {
                 pairs = valueArr[i].split(',');                  pairs = valueArr[i].split(',');
                 elements = document.getElementsByName(pairs[0]);                  elements = document.getElementsByName(pairs[0]);
   
                 for (var j = 0; j < elements.length; j++){                  for (var j = 0; j < elements.length; j++){  
                     elements[j].style.display = pairs[1];                      elements[j].style.display = pairs[1];
                     if (pairs[1] == "none"){                      if (pairs[1] == "none"){
                         var regex_id = /([_\\d]+)\$/;                          var regex_id = /([_\\d]+)\$/;
Line 1875  sub colorfuleditor_js { Line 2041  sub colorfuleditor_js {
     }      }
   
     function getTagList () {      function getTagList () {
           
         var stringToSearch = document.lonhomework.innerHTML;          var stringToSearch = document.lonhomework.innerHTML;
   
         var ret = new Array();          var ret = new Array();
Line 1883  sub colorfuleditor_js { Line 2049  sub colorfuleditor_js {
         var tag_list = stringToSearch.match(regex_findBlock);          var tag_list = stringToSearch.match(regex_findBlock);
   
         if(tag_list != null){          if(tag_list != null){
             for(var i = 0; i < tag_list.length; i++){              for(var i = 0; i < tag_list.length; i++){            
                 ret.push(tag_list[i].replace(/"/, ''));                  ret.push(tag_list[i].replace(/"/, ''));
             }              }
         }          }
Line 1920  sub colorfuleditor_js { Line 2086  sub colorfuleditor_js {
   
             for(var i = 0; i < tag_list.length; i++){              for(var i = 0; i < tag_list.length; i++){
                 elem_list = document.getElementsByName(tag_list[i]);                  elem_list = document.getElementsByName(tag_list[i]);
                   
                 if(elem_list.length > 0){                  if(elem_list.length > 0){
                     elem = elem_list[0];                      elem = elem_list[0];
                     break;                      break;
Line 1943  sub colorfuleditor_js { Line 2109  sub colorfuleditor_js {
             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */              rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
         );          );
     }      }
       
     function autosize(depth){      function autosize(depth){
         var cmInst = window['cm'+depth];          var cmInst = window['cm'+depth];
         var fitsizeButton = document.getElementById('fitsize'+depth);          var fitsizeButton = document.getElementById('fitsize'+depth);
Line 1962  sub colorfuleditor_js { Line 2128  sub colorfuleditor_js {
         }          }
     }      }
   
   $browse_or_search
   
 // ]]>  // ]]>
 </script>  </script>
Line 2010  sub insert_folding_button { Line 2176  sub insert_folding_button {
     my $curDepth = $Apache::lonxml::curdepth;      my $curDepth = $Apache::lonxml::curdepth;
     my $lastresource = $env{'request.ambiguous'};      my $lastresource = $env{'request.ambiguous'};
   
     return "<input type=\"button\" id=\"folding_btn_$curDepth\"      return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";              value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
 }  }
   
 =pod  sub crsauthor_url {
       my ($url) = @_;
 =item * &iframe_wrapper_headjs()      if ($url eq '') {
           $url = $ENV{'REQUEST_URI'};
 emits javascript containing two global vars to facilitate handling of resizing      }
 by code in iframe_wrapper_resizejs() used when an iframe is present in a page      my ($cnum,$cdom);
 with standard LON-CAPA menus.      if ($env{'request.course.id'}) {
           my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
 =cut          if ($audom ne '' && $auname ne '') {
               if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
 #                  ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
 # Where iframe is in use, if window.onload() executes before the custom resize function                  $cnum = $auname;
 # has been defined (jQuery), two global javascript vars (LCnotready and LCresizedef)                  $cdom = $audom;
 # are used to ensure document.ready() triggers a call to resize, so the iframe contents              }
 # do not obscure the Functions menu.          }
 #      }
       return ($cnum,$cdom);
 sub iframe_wrapper_headjs {  
     return <<"ENDJS";  
 <script type="text/javascript">  
 // <![CDATA[  
 var LCnotready = 0;  
 var LCresizedef = 0;  
 // ]]>  
 </script>  
   
 ENDJS  
   
 }  }
   
 =pod  sub import_crsauthor_form {
       my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
 =item * &iframe_wrapper_resizejs()      return (0) unless ($env{'request.course.id'});
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
 emits javascript used to handle resizing for a page containing      my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
 an iframe, to ensure that the iframe does not obscure any      my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
 standard LON-CAPA menu items.      return (0) unless (($cnum ne '') && ($cdom ne ''));
       my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
 =back      my @ids=&Apache::lonnet::current_machine_ids();
       my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
 =cut      
       if (grep(/^\Q$crshome\E$/,@ids)) {
 #          $is_home = 1;
 # jQuery to use when iframe is in use and a page resize occurs.      }
 # This script will ensure that the iframe does not obscure any      $relpath = "/priv/$cdom/$cnum";
 # standard LON-CAPA inline menus (primary, secondary, and/or      &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
 # breadcrumbs and Functions menus. Expects javascript from      my %lt = &Apache::lonlocal::texthash (
 # &iframe_wrapper_headjs() to be in head portion of the web page,          fnam => 'Filename',
 # e.g., by inclusion in second arg passed to &start_page().          dire => 'Directory',
 #      );
       my $numdirs = scalar(keys(%files));
 sub iframe_wrapper_resizejs {      my (%possexts,$singledir,@singledirfiles);
     my $offset = 5;      if ($only) {
     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']);          map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
     if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) {      }
         $offset = 0;      my (%nonemptydirs,$possdirs);
     }      if ($numdirs > 1) {
     return &Apache::lonhtmlcommon::scripttag(<<SCRIPT);          my @order;
     \$(document).ready( function() {          foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
         \$(window).unbind('resize').resize(function(){              if (ref($files{$key}) eq 'HASH') {
             var header = null;                  my $shown = $key;
             var offset = $offset;                  if ($key eq '') {
             var height = 0;                      $shown = '/';
             var hdrtop = 0;                  }
             if (\$('div.LC_menus_content:first').length) {                  my @ordered = ();
                 if (\$('div.LC_menus_content:first').hasClass ("shown")) {                  foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
                     header = \$('div.LC_menus_content:first');                      next if ($file =~ /\.rights$/);
                     offset = 12;                      if ($only) {
                 }                          my ($ext) = ($file =~ /\.([^.]+)$/);
             } else if (\$('div.LC_head_subbox:first').length) {                          unless ($possexts{lc($ext)}) {
                 header = \$('div.LC_head_subbox:first');                              next;
                 offset = 9;                          }
             } else {                      }
                 if (\$('#LC_breadcrumbs').length) {                      $selimport_menus{$key}->{'select2'}->{$file} = $file;
                     header = \$('#LC_breadcrumbs');                      push(@ordered,$file);
                   }
                   if (@ordered) {
                       push(@order,$key);
                       $nonemptydirs{$key} = 1;
                       $selimport_menus{$key}->{'text'} = $shown;
                       $selimport_menus{$key}->{'default'} = '';
                       $selimport_menus{$key}->{'select2'}->{''} = '';
                       $selimport_menus{$key}->{'order'} = \@ordered;
                 }                  }
             }              }
             if (header != null && header.length) {          }
                 height = header.height();          $possdirs = scalar(keys(%nonemptydirs));
                 hdrtop = header.position().top;          if ($possdirs > 1) {
               my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
               $output = $lt{'dire'}.
                         &linked_select_forms($form,'<br />'.
                                              $lt{'fnam'},'',
                                              $firstselectname,$secondselectname,
                                              \%selimport_menus,\@order,
                                              $onchangefirst,'',$suffix).'<br />';
           } elsif ($possdirs == 1) {
               $singledir = (keys(%nonemptydirs))[0];
               if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
                   @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
               }
               delete($selimport_menus{$singledir});
           }
       } elsif ($numdirs == 1) {
           $singledir = (keys(%files))[0];
           foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
               if ($only) {
                   my ($ext) = ($file =~ /\.([^.]+)$/);
                   unless ($possexts{lc($ext)}) {
                       next;
                   }
               } else {
                   next if ($file =~ /\.rights$/);
             }              }
             var pos = height + hdrtop + offset;              push(@singledirfiles,$file);
             \$('.LC_iframecontainer').css('top', pos);  
         });  
         LCresizedef = 1;  
         if (LCnotready == 1) {  
             LCnotready = 0;  
             \$(window).trigger('resize');  
         }          }
     });          if (@singledirfiles) {
     window.onload = function(){              $possdirs = 1;
          if (LCresizedef) {          }
              LCnotready = 0;      }
              \$(window).trigger('resize');      if (($possdirs == 1) && (@singledirfiles)) {
          } else {          my $showdir = $singledir;
              LCnotready = 1;          if ($singledir eq '') {
          }              $showdir = '/';
     };          }
 SCRIPT          $output = $lt{'dire'}.
                     '<select name="'.$firstselectname.'">'.
                     '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
                     '</select><br />'.
                     $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
                     '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
           foreach my $file (@singledirfiles) {
               $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
           }
           $output .= '</select><br />'."\n";
       }
       return ($possdirs,$output);
 }  }
   
 =pod  =pod
Line 2303  sub create_text_file { Line 2494  sub create_text_file {
 # ------------------------------------------  # ------------------------------------------
   
 sub domain_select {  sub domain_select {
     my ($name,$value,$multiple)=@_;      my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
       my @possdoms;
       if (ref($incdoms) eq 'ARRAY') {
           @possdoms = @{$incdoms};
       } else {
           @possdoms = &Apache::lonnet::all_domains();
       }
   
     my %domains=map {       my %domains=map { 
  $_ => $_.' '. &Apache::lonnet::domain($_,'description')    $_ => $_.' '. &Apache::lonnet::domain($_,'description') 
     } &Apache::lonnet::all_domains();      } @possdoms;
   
       if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
           foreach my $dom (@{$excdoms}) {
               delete($domains{$dom});
           }
       }
   
     if ($multiple) {      if ($multiple) {
  $domains{''}=&mt('Any domain');   $domains{''}=&mt('Any domain');
  $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];   $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
Line 2383  option_name => displayed text. An option Line 2588  option_name => displayed text. An option
 a javascript onchange item, e.g., onchange="this.form.submit();".  a javascript onchange item, e.g., onchange="this.form.submit();".
 An optional arg -- $readonly -- if true will cause the select form  An optional arg -- $readonly -- if true will cause the select form
 to be disabled, e.g., for the case where an instructor has a section-  to be disabled, e.g., for the case where an instructor has a section-
 specific role, and is viewing/modifying parameters.    specific role, and is viewing/modifying parameters. 
   
 See lonrights.pm for an example invocation and use.  See lonrights.pm for an example invocation and use.
   
Line 2586  The optional $incdoms is a reference to Line 2791  The optional $incdoms is a reference to
   
 The optional $excdoms is a reference to an array of domains which will be excluded from the available options.  The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
   
 The optional $disabled argument, if true, adds the disabled attribute to the select tag.   The optional $disabled argument, if true, adds the disabled attribute to the select tag.
   
 =cut  =cut
   
Line 2607  sub select_dom_form { Line 2812  sub select_dom_form {
     }      }
     if ($includeempty) { @domains=('',@domains); }      if ($includeempty) { @domains=('',@domains); }
     if (ref($excdoms) eq 'ARRAY') {      if (ref($excdoms) eq 'ARRAY') {
         map { $exclude{$_} = 1; } @{$excdoms};          map { $exclude{$_} = 1; } @{$excdoms}; 
     }      }
     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";      my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
     foreach my $dom (@domains) {      foreach my $dom (@domains) {
Line 2965  sub authform_nochange { Line 3170  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 3159  sub authform_local { Line 3364  sub authform_local {
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     if ($in{'readonly'}) {      if ($in{'readonly'}) {
         $disabled = ' disabled="disabled"';          $disabled = ' disabled="disabled"';
     }      } 
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'loc') {          if ($in{'curr_authtype'} eq 'loc') {
             if ($can_assign{'loc'}) {              if ($can_assign{'loc'}) {
Line 3229  sub authform_filesystem { Line 3434  sub authform_filesystem {
             } else {              } else {
                 $result = &mt('Currently Filesystem Authenticated.');                  $result = &mt('Currently Filesystem Authenticated.');
                 return $result;                  return $result;
             }                         }
         }          }
     } else {      } else {
         if ($authnum == 1) {          if ($authnum == 1) {
Line 3329  sub get_assignable_auth { Line 3534  sub get_assignable_auth {
                           krb5 => 1,                            krb5 => 1,
                           int  => 1,                            int  => 1,
                           loc  => 1,                            loc  => 1,
                             lti  => 1,
                      );                       );
     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);      my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
     if (ref($domconfig{'usercreation'}) eq 'HASH') {      if (ref($domconfig{'usercreation'}) eq 'HASH') {
Line 3421  sub check_passwd_rules { Line 3627  sub check_passwd_rules {
         $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);          $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
         $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);          $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
         $warning = &mt('Password did not satisfy the following:').'<ul>';          $warning = &mt('Password did not satisfy the following:').'<ul>';
         foreach my $rule ('min','max','uc','lc','num','spec') {          foreach my $rule ('min','max','uc','ls','num','spec') {
             if (grep(/^$rule$/,@brokerule)) {              if (grep(/^$rule$/,@brokerule)) {
                 $warning .= '<li>'.$rulenames{$rule}.'</li>';                  $warning .= '<li>'.$rulenames{$rule}.'</li>';
             }              }
Line 3434  sub check_passwd_rules { Line 3640  sub check_passwd_rules {
     return $warning;      return $warning;
 }  }
   
 sub passwd_validation_js {  
     my ($currpasswdval,$domain,$context,$id) = @_;  
     my (%passwdconf,$alertmsg);  
     if ($context eq 'linkprot') {  
         my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);  
         if (ref($domconfig{'ltisec'}) eq 'HASH') {  
             if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {  
                 %passwdconf = %{$domconfig{'ltisec'}{'rules'}};  
             }  
         }  
         if ($id eq 'add') {  
             $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';  
         } elsif ($id =~ /^\d+$/) {  
             my $pos = $id+1;  
             $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';  
         } else {  
             $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';  
         }  
     } else {  
         %passwdconf = &Apache::lonnet::get_passwdconf($domain);  
         $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';  
     }  
     my ($min,$max,@chars,$numrules,$intargjs,%alert);  
     $numrules = 0;  
     $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'};  
             $numrules ++;  
         }  
         @chars = @{$passwdconf{'chars'}};  
         if (@chars) {  
             $numrules ++;  
         }  
     }  
     if ($min > 0) {  
         $numrules ++;  
     }  
     if (($min > 0) || ($max ne '') || (@chars > 0)) {  
         if ($min) {  
             $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';  
         }  
         if ($max) {  
             $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';  
         }  
         my (@charalerts,@charrules);  
         if (@chars) {  
             if (grep(/^uc$/,@chars)) {  
                 push(@charalerts,&mt('contain at least one upper case letter'));  
                 push(@charrules,'uc');  
             }  
             if (grep(/^lc$/,@chars)) {  
                 push(@charalerts,&mt('contain at least one lower case letter'));  
                 push(@charrules,'lc');  
             }  
             if (grep(/^num$/,@chars)) {  
                 push(@charalerts,&mt('contain at least one number'));  
                 push(@charrules,'num');  
             }  
             if (grep(/^spec$/,@chars)) {  
                 push(@charalerts,&mt('contain at least one non-alphanumeric'));  
                 push(@charrules,'spec');  
             }  
         }  
         $intargjs = qq|            var rulesmsg = '';\n|.  
                     qq|            var currpwval = $currpasswdval;\n|;  
             if ($min) {  
                 $intargjs .= qq|  
             if (currpwval.length < $min) {  
                 rulesmsg += ' - $alert{min}';  
             }  
 |;  
             }  
             if ($max) {  
                 $intargjs .= qq|  
             if (currpwval.length > $max) {  
                 rulesmsg += ' - $alert{max}';  
             }  
 |;  
             }  
             if (@chars > 0) {  
                 my $charrulestr = '"'.join('","',@charrules).'"';  
                 my $charalertstr = '"'.join('","',@charalerts).'"';  
                 $intargjs .= qq|            var brokerules = new Array();\n|.  
                              qq|            var charrules = new Array($charrulestr);\n|.  
                              qq|            var charalerts = new Array($charalertstr);\n|;  
                 my %rules;  
                 map { $rules{$_} = 1; } @chars;  
                 if ($rules{'uc'}) {  
                     $intargjs .= qq|  
             var ucRegExp = /[A-Z]/;  
             if (!ucRegExp.test(currpwval)) {  
                 brokerules.push('uc');  
             }  
 |;  
                 }  
                 if ($rules{'lc'}) {  
                     $intargjs .= qq|  
             var lcRegExp = /[a-z]/;  
             if (!lcRegExp.test(currpwval)) {  
                 brokerules.push('lc');  
             }  
 |;  
                 }  
                 if ($rules{'num'}) {  
                      $intargjs .= qq|  
             var numRegExp = /[0-9]/;  
             if (!numRegExp.test(currpwval)) {  
                 brokerules.push('num');  
             }  
 |;  
                 }  
                 if ($rules{'spec'}) {  
                      $intargjs .= q|  
             var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;  
             if (!specRegExp.test(currpwval)) {  
                 brokerules.push('spec');  
             }  
 |;  
                 }  
                 $intargjs .= qq|  
             if (brokerules.length > 0) {  
                 for (var i=0; i<brokerules.length; i++) {  
                     for (var j=0; j<charrules.length; j++) {  
                         if (brokerules[i] == charrules[j]) {  
                             rulesmsg += ' - '+charalerts[j]+'\\n';  
                             break;  
                         }  
                     }  
                 }  
             }  
 |;  
             }  
             $intargjs .= qq|  
             if (rulesmsg != '') {  
                 rulesmsg = '$alertmsg'+rulesmsg;  
                 alert(rulesmsg);  
                 return false;  
             }  
 |;  
     }  
     return ($numrules,$intargjs);  
 }  
   
 ###############################################################  ###############################################################
 ##    Get Kerberos Defaults for Domain                 ##  ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################  ###############################################################
Line 3750  sub get_related_words { Line 3807  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 4001  sub syllabuswrapper { Line 4118  sub syllabuswrapper {
     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};      return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
 }  }
   
 sub aboutme_on {  
     my ($uname,$udom)=@_;  
     unless ($uname) { $uname=$env{'user.name'}; }  
     unless ($udom)  { $udom=$env{'user.domain'}; }  
     return if ($udom eq 'public' && $uname eq 'public');  
     my $hashkey=$uname.':'.$udom;  
     my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);  
     if ($cached) {  
         return $aboutme;  
     }  
     $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');  
     &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);  
     return $aboutme;  
 }  
   
 sub devalidate_aboutme_cache {  
     my ($uname,$udom)=@_;  
     if (!$udom)  { $udom =$env{'user.domain'}; }  
     if (!$uname) { $uname=$env{'user.name'};   }  
     return if ($udom eq 'public' && $uname eq 'public');  
     my $id=$uname.':'.$udom;  
     &Apache::lonnet::devalidate_cache_new('aboutme',$id);  
 }  
   
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
   
 sub track_student_link {  sub track_student_link {
Line 4244  category Line 4337  category
   
 sub filecategorytypes {  sub filecategorytypes {
     my ($cat) = @_;      my ($cat) = @_;
     return @{$category_extensions{lc($cat)}};      if (ref($category_extensions{lc($cat)}) eq 'ARRAY') { 
           return @{$category_extensions{lc($cat)}};
       } else {
           return ();
       }
 }  }
   
 =pod  =pod
Line 4411  Return string with previous attempt on p Line 4508  Return string with previous attempt on p
   
 =item * $usec: section of the desired student  =item * $usec: section of the desired student
   
 =item * $identifier: counter for student (multiple students one problem) or  =item * $identifier: counter for student (multiple students one problem) or 
     problem (one student; whole sequence).      problem (one student; whole sequence).
   
 =back  =back
Line 4498  sub get_previous_attempt { Line 4595  sub get_previous_attempt {
             my (@hidden,@unsolved);              my (@hidden,@unsolved);
             if (%typeparts) {              if (%typeparts) {
                 foreach my $id (keys(%typeparts)) {                  foreach my $id (keys(%typeparts)) {
                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||                      if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {                          ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                         push(@hidden,$id);                          push(@hidden,$id);
                     } elsif ($identifier ne '') {                      } elsif ($identifier ne '') {
Line 4559  sub get_previous_attempt { Line 4656  sub get_previous_attempt {
                         if ($key =~ /\./) {                          if ($key =~ /\./) {
                             my $value = $returnhash{$version.':'.$key};                              my $value = $returnhash{$version.':'.$key};
                             if ($key =~ /\.rndseed$/) {                              if ($key =~ /\.rndseed$/) {
                                 my ($id) = ($key =~ /^(.+)\.rndseed$/);                                  my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {                                  if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};                                      $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                                 }                                  }
Line 4576  sub get_previous_attempt { Line 4673  sub get_previous_attempt {
                     next if ($key =~ /\.foilorder$/);                      next if ($key =~ /\.foilorder$/);
                     my $value = $returnhash{$version.':'.$key};                      my $value = $returnhash{$version.':'.$key};
                     if ($key =~ /\.rndseed$/) {                      if ($key =~ /\.rndseed$/) {
                         my ($id) = ($key =~ /^(.+)\.rndseed$/);                          my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {                          if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};                              $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                         }                          }
Line 4607  sub get_previous_attempt { Line 4704  sub get_previous_attempt {
                       if ($key =~/$regexp$/ && (defined &$gradesub)) {                        if ($key =~/$regexp$/ && (defined &$gradesub)) {
                           $value = &$gradesub($value);                            $value = &$gradesub($value);
                       }                        }
                       $prevattempts.='<td>'.$value.'&nbsp;</td>';                        $prevattempts.='<td>'. $value.'&nbsp;</td>';
                   } else {                    } else {
                       $prevattempts.='<td>&nbsp;</td>';                        $prevattempts.='<td>&nbsp;</td>';
                   }                    }
Line 4623  sub get_previous_attempt { Line 4720  sub get_previous_attempt {
       if ($key =~/$regexp$/ && (defined &$gradesub)) {        if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   $value = &$gradesub($value);                    $value = &$gradesub($value);
               }                }
       $prevattempts.='<td>'.$value.'&nbsp;</td>';       $prevattempts.='<td>'.$value.'&nbsp;</td>';
           }            }
       }        }
       $prevattempts.= &end_data_table_row().&end_data_table();        $prevattempts.= &end_data_table_row().&end_data_table();
Line 4650  sub get_previous_attempt { Line 4747  sub get_previous_attempt {
 sub format_previous_attempt_value {  sub format_previous_attempt_value {
     my ($key,$value) = @_;      my ($key,$value) = @_;
     if (($key =~ /timestamp/) || ($key=~/duedate/)) {      if (($key =~ /timestamp/) || ($key=~/duedate/)) {
  $value = &Apache::lonlocal::locallocaltime($value);          $value = &Apache::lonlocal::locallocaltime($value);
     } elsif (ref($value) eq 'ARRAY') {      } elsif (ref($value) eq 'ARRAY') {
  $value = '('.join(', ', @{ $value }).')';          $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
     } elsif ($key =~ /answerstring$/) {      } elsif ($key =~ /answerstring$/) {
         my %answers = &Apache::lonnet::str2hash($value);          my %answers = &Apache::lonnet::str2hash($value);
           my @answer = %answers;
           %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
         my @anskeys = sort(keys(%answers));          my @anskeys = sort(keys(%answers));
         if (@anskeys == 1) {          if (@anskeys == 1) {
             my $answer = $answers{$anskeys[0]};              my $answer = $answers{$anskeys[0]};
Line 4677  sub format_previous_attempt_value { Line 4776  sub format_previous_attempt_value {
             }               } 
         }          }
     } else {      } else {
  $value = &unescape($value);          $value = &HTML::Entities::encode(&unescape($value), '"<>&');
     }      }
     return $value;      return $value;
 }  }
Line 4739  sub get_student_view { Line 4838  sub get_student_view {
   }    }
   if (defined($target)) { $form{'grade_target'} = $target; }    if (defined($target)) { $form{'grade_target'} = $target; }
   $feedurl=&Apache::lonnet::clutter($feedurl);    $feedurl=&Apache::lonnet::clutter($feedurl);
     if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
         $feedurl =~ s{^/adm/wrapper}{};
     }
   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);    my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
   $userview=~s/\<body[^\>]*\>//gi;    $userview=~s/\<body[^\>]*\>//gi;
   $userview=~s/\<\/body\>//gi;    $userview=~s/\<\/body\>//gi;
Line 4783  sub get_student_view_with_retries { Line 4885  sub get_student_view_with_retries {
     }      }
 }  }
   
 sub css_links {  
     my ($currsymb,$level) = @_;  
     my ($links,@symbs,%cssrefs,%httpref);  
     if ($level eq 'map') {  
         my $navmap = Apache::lonnavmaps::navmap->new();  
         if (ref($navmap)) {  
             my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);  
             my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);  
             foreach my $res (@resources) {  
                 if (ref($res) && $res->symb()) {  
                     push(@symbs,$res->symb());  
                 }  
             }  
         }  
     } else {  
         @symbs = ($currsymb);  
     }  
     foreach my $symb (@symbs) {  
         my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);  
         if ($css_href =~ /\S/) {  
             unless ($css_href =~ m{https?://}) {  
                 my $url = (&Apache::lonnet::decode_symb($symb))[-1];  
                 my $proburl =  &Apache::lonnet::clutter($url);  
                 my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});  
                 unless ($css_href =~ m{^/}) {  
                     $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);  
                 }  
                 if ($css_href =~ m{^/(res|uploaded)/}) {  
                     unless (($httpref{'httpref.'.$css_href}) ||  
                             (&Apache::lonnet::is_on_map($css_href))) {  
                         my $thisurl = $proburl;  
                         if ($env{'httpref.'.$proburl}) {  
                             $thisurl = $env{'httpref.'.$proburl};  
                         }  
                         $httpref{'httpref.'.$css_href} = $thisurl;  
                     }  
                 }  
             }  
             $cssrefs{$css_href} = 1;  
         }  
     }  
     if (keys(%httpref)) {  
         &Apache::lonnet::appenv(\%httpref);  
     }  
     if (keys(%cssrefs)) {  
         foreach my $css_href (keys(%cssrefs)) {  
             next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});  
             $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";  
         }  
     }  
     return $links;  
 }  
   
 =pod  =pod
   
 =item * &get_student_answers()   =item * &get_student_answers() 
Line 5091  sub findallcourses { Line 5140  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;      my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
   
     unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {  
         my ($has_evb,$check_ipaccess);  
         my $dom = $env{'user.domain'};  
         if ($env{'request.course.id'}) {  
             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};  
             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
             my $checkrole = "cm./$cdom/$cnum";  
             my $sec = $env{'request.course.sec'};  
             if ($sec ne '') {  
                 $checkrole .= "/$sec";  
             }  
             if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&  
                 ($env{'request.role'} !~ /^st/)) {  
                 $has_evb = 1;  
             }  
             unless ($has_evb) {  
                 if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||  
                     ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {  
                     if ($udom eq $cdom) {  
                         $check_ipaccess = 1;  
                     }  
                 }  
             }  
         } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||  
                 ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {  
             my $checkrole;  
             if ($env{'request.role.domain'} eq '') {  
                 $checkrole = "cm./$env{'user.domain'}/";  
             } else {  
                 $checkrole = "cm./$env{'request.role.domain'}/";  
             }  
             if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {  
                 $has_evb = 1;  
             }  
         }  
         unless ($has_evb || $check_ipaccess) {  
             my @machinedoms = &Apache::lonnet::current_machine_domains();  
             if (($dom eq 'public') && ($activity eq 'port')) {  
                 $dom = $udom;  
             }  
             if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {  
                 $check_ipaccess = 1;  
             } else {  
                 my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};  
                 my $internet_names = &Apache::lonnet::get_internet_names($lonhost);  
                 my $prim = &Apache::lonnet::domain($dom,'primary');  
                 my $intdom = &Apache::lonnet::internet_dom($prim);  
                 if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {  
                     if (grep(/^\Q$intdom\E$/,@{$internet_names})) {  
                         $check_ipaccess = 1;  
                     }  
                 }  
             }  
         }  
         if ($check_ipaccess) {  
             my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);  
             unless (defined($cached)) {  
                 my %domconfig =  
                     &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);  
                 $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);  
             }  
             if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {  
                 foreach my $id (keys(%{$ipaccessref})) {  
                     if (ref($ipaccessref->{$id}) eq 'HASH') {  
                         my $range = $ipaccessref->{$id}->{'ip'};  
                         if ($range) {  
                             if (&Apache::lonnet::ip_match($clientip,$range)) {  
                                 if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {  
                                     if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {  
                                         return ('','','',$id,$dom);  
                                         last;  
                                     }  
                                 }  
                             }  
                         }  
                     }  
                 }  
             }  
         }  
         if (($activity eq 'wishlist') || ($activity eq 'annotate')) {  
             return ();  
         }  
     }  
     if (defined($udom) && defined($uname)) {      if (defined($udom) && defined($uname)) {
         # If uname and udom are for a course, check for blocks in the course.          # If uname and udom are for a course, check for blocks in the course.
         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {          if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
             my ($startblock,$endblock,$triggerblock) =              my ($startblock,$endblock,$triggerblock) =
                 &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);                  &get_blocks($setters,$activity,$udom,$uname,$url);
             return ($startblock,$endblock,$triggerblock);              return ($startblock,$endblock,$triggerblock);
         }          }
     } else {      } else {
Line 5191  sub blockcheck { Line 5157  sub blockcheck {
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
     my $triggerblock = '';      my $triggerblock = '';
     my %live_courses;      my %live_courses = &findallcourses(undef,$uname,$udom);
     unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {  
         %live_courses = &findallcourses(undef,$uname,$udom);  
     }  
   
     # If uname is for a user, and activity is course-specific, i.e.,      # If uname is for a user, and activity is course-specific, i.e.,
     # boards, chat or groups, check for blocking in current course only.      # boards, chat or groups, check for blocking in current course only.
   
     if (($activity eq 'boards' || $activity eq 'chat' ||      if (($activity eq 'boards' || $activity eq 'chat' ||
          $activity eq 'groups' || $activity eq 'printout' ||           $activity eq 'groups' || $activity eq 'printout' ||
          $activity eq 'search' || $activity eq 'reinit' ||           $activity eq 'reinit' || $activity eq 'alert') &&
          $activity eq 'alert') && ($env{'request.course.id'})) {          ($env{'request.course.id'})) {
         foreach my $key (keys(%live_courses)) {          foreach my $key (keys(%live_courses)) {
             if ($key ne $env{'request.course.id'}) {              if ($key ne $env{'request.course.id'}) {
                 delete($live_courses{$key});                  delete($live_courses{$key});
Line 5309  sub blockcheck { Line 5272  sub blockcheck {
   
         # Retrieve blocking times and identity of blocker for course          # Retrieve blocking times and identity of blocker for course
         # of specified user, unless user has 'evb' privilege.          # of specified user, unless user has 'evb' privilege.
           
         my ($start,$end,$trigger) =           my ($start,$end,$trigger) = 
             &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);              &get_blocks($setters,$activity,$cdom,$cnum,$url);
         if (($start != 0) &&           if (($start != 0) && 
             (($startblock == 0) || ($startblock > $start))) {              (($startblock == 0) || ($startblock > $start))) {
             $startblock = $start;              $startblock = $start;
Line 5331  sub blockcheck { Line 5294  sub blockcheck {
 }  }
   
 sub get_blocks {  sub get_blocks {
     my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;      my ($setters,$activity,$cdom,$cnum,$url) = @_;
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
     my $triggerblock = '';      my $triggerblock = '';
Line 5344  sub get_blocks { Line 5307  sub get_blocks {
     my $now = time;      my $now = time;
     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);      my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
     if ($activity eq 'docs') {      if ($activity eq 'docs') {
         my ($blocked,$nosymbcache,$noenccheck);          @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
         if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {  
             $blocked = 1;  
             $nosymbcache = 1;  
             $noenccheck = 1;  
         }  
         @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);  
         foreach my $block (@blockers) {          foreach my $block (@blockers) {
             if ($block =~ /^firstaccess____(.+)$/) {              if ($block =~ /^firstaccess____(.+)$/) {
                 my $item = $1;                  my $item = $1;
Line 5478  sub parse_block_record { Line 5435  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
     my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;      my ($activity,$uname,$udom,$url,$is_course) = @_;
     my %setters;      my %setters;
   
 # check for active blocking  # check for active blocking
     if ($clientip eq '') {      my ($startblock,$endblock,$triggerblock) = 
         $clientip = &Apache::lonnet::get_requestor_ip();          &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
     }  
     my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =   
         &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);  
     my $blocked = 0;      my $blocked = 0;
     if (($startblock && $endblock) || ($by_ip)) {      if ($startblock && $endblock) {
         $blocked = 1;          $blocked = 1;
     }      }
   
Line 5497  sub blocking_status { Line 5451  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 (or information page) 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 'about') || ($activity eq 'passwd')) {      if (($activity eq 'port') || ($activity eq 'passwd')) {
         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);          $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);          $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
     } elsif ($activity eq 'docs') {      } elsif ($activity eq 'docs') {
         my $showurl = &Apache::lonenc::check_encrypt($url);          $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
         $querystring .= '&amp;url='.&HTML::Entities::encode($showurl,'\'&"<>');  
         if ($symb) {  
             my $showsymb = &Apache::lonenc::check_encrypt($symb);  
             $querystring .= '&amp;symb='.&HTML::Entities::encode($showsymb,'\'&"<>');  
         }  
     }      }
   
     my $output .= <<'END_MYBLOCK';      my $output .= <<'END_MYBLOCK';
Line 5532  END_MYBLOCK Line 5481  END_MYBLOCK
         $text = &mt('Printing Blocked');          $text = &mt('Printing Blocked');
     } elsif ($activity eq 'passwd') {      } elsif ($activity eq 'passwd') {
         $text = &mt('Password Changing Blocked');          $text = &mt('Password Changing Blocked');
     } elsif ($activity eq 'grades') {  
         $text = &mt('Gradebook Blocked');  
     } elsif ($activity eq 'search') {  
         $text = &mt('Search Blocked');  
     } elsif ($activity eq 'alert') {      } elsif ($activity eq 'alert') {
         $text = &mt('Checking Critical Messages Blocked');          $text = &mt('Checking Critical Messages Blocked');
     } elsif ($activity eq 'reinit') {      } elsif ($activity eq 'reinit') {
         $text = &mt('Checking Course Update Blocked');          $text = &mt('Checking Course Update Blocked');
     } elsif ($activity eq 'about') {  
         $text = &mt('Access to User Information Pages Blocked');  
     } elsif ($activity eq 'wishlist') {  
         $text = &mt('Access to Stored Links Blocked');  
     } elsif ($activity eq 'annotate') {  
         $text = &mt('Access to Annotations Blocked');  
     }      }
     $output .= <<"END_BLOCK";      $output .= <<"END_BLOCK";
 <div class='$class'>  <div class='$class'>
Line 5569  sub check_ip_acc { Line 5508  sub check_ip_acc {
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed=0;      my $allowed;
     my $ip;      my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
     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 {  
         my $remote_ip = &Apache::lonnet::get_requestor_ip();  
         $ip = $remote_ip || $env{'request.host'} || $clientip;  
     }  
   
     my $name;      my $name;
     my %access = (      my %access = (
Line 5589  sub check_ip_acc { Line 5521  sub check_ip_acc {
     foreach my $item (split(',',$acc)) {      foreach my $item (split(',',$acc)) {
         $item =~ s/^\s*//;          $item =~ s/^\s*//;
         $item =~ s/\s*$//;          $item =~ s/\s*$//;
           my $pattern;
         if ($item =~ /^\!(.+)$/) {          if ($item =~ /^\!(.+)$/) {
             push(@denies,$1);              push(@denies,$1);
         } else {          } else {
             push(@allows,$item);              push(@allows,$item);
         }          }
     }     }
     my $numdenies = scalar(@denies);     my $numdenies = scalar(@denies);
     my $numallows = scalar(@allows);     my $numallows = scalar(@allows);
     my $count = 0;     my $count = 0;
     foreach my $pattern (@denies,@allows) {     foreach my $pattern (@denies,@allows) {
         $count ++;          $count ++; 
         my $acctype = 'allowfrom';          my $acctype = 'allowfrom';
         if ($count <= $numdenies) {          if ($count <= $numdenies) {
             $acctype = 'denyfrom';              $acctype = 'denyfrom';
Line 5710  sub get_domainconf { Line 5643  sub get_domainconf {
                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};                                                  my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                                                 $designhash{$udom.'.login.loginvia'} = $server;                                                  $designhash{$udom.'.login.loginvia'} = $server;
                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {                                                  if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
   
                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};                                                      $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                                                 } else {                                                  } else {
                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};                                                      $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
Line 5726  sub get_domainconf { Line 5660  sub get_domainconf {
                                     }                                      }
                                 }                                  }
                             }                              }
                         } elsif ($key eq 'saml') {  
                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {  
                                 foreach my $host (keys(%{$domconfig{'login'}{$key}})) {  
                                     if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {  
                                         $designhash{$udom.'.login.'.$key.'_'.$host} = 1;  
                                         foreach my $item ('text','img','alt','url','title','window','notsso') {  
                                             $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};  
                                         }  
                                     }  
                                 }  
                             }  
                         } else {                          } else {
                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {                              foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                                 $designhash{$udom.'.login.'.$key.'_'.$img} =                                   $designhash{$udom.'.login.'.$key.'_'.$img} = 
Line 5841  sub domainlogo { Line 5764  sub domainlogo {
  &Apache::lonnet::repcopy($local_name);   &Apache::lonnet::repcopy($local_name);
     }      }
    $imgsrc = &lonhttpdurl($imgsrc);     $imgsrc = &lonhttpdurl($imgsrc);
         }          } 
         my $alttext = $domain;          return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
         if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {  
             $alttext = $designhash{$domain.'.login.alttext_domlogo'};  
         }  
         return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';  
     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {      } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
         return &Apache::lonnet::domain($domain,'description');          return &Apache::lonnet::domain($domain,'description');
     } else {      } else {
Line 5964  sub head_subbox { Line 5883  sub head_subbox {
 Input: (optional) filename from which breadcrumb trail is built.  Input: (optional) filename from which breadcrumb trail is built.
        In most cases no input as needed, as $env{'request.filename'}         In most cases no input as needed, as $env{'request.filename'}
        is appropriate for use in building the breadcrumb trail.         is appropriate for use in building the breadcrumb trail.
        frameset flag  
        If page header is being requested for use in a frameset, then  
        the second (option) argument -- frameset will be true, and  
        the target attribute set for links should be target="_parent".  
   
 Returns: HTML div with CSTR path and recent box  Returns: HTML div with CSTR path and recent box
          To be included on Authoring Space pages           To be included on Authoring Space pages
Line 5975  Returns: HTML div with CSTR path and rec Line 5890  Returns: HTML div with CSTR path and rec
 =cut  =cut
   
 sub CSTR_pageheader {  sub CSTR_pageheader {
     my ($trailfile,$frameset) = @_;      my ($trailfile) = @_;
     if ($trailfile eq '') {      if ($trailfile eq '') {
         $trailfile = $env{'request.filename'};          $trailfile = $env{'request.filename'};
     }      }
Line 5998  sub CSTR_pageheader { Line 5913  sub CSTR_pageheader {
         $lastitem = $thisdisfn;          $lastitem = $thisdisfn;
     }      }
   
     my ($target,$crumbtarget) = (' target="_top"','_top');      my ($crsauthor,$title);
     if ($frameset) {      if (($env{'request.course.id'}) &&
         $target = ' target="_parent"';          ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
         $crumbtarget = '_parent';          ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
     } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {          $crsauthor = 1;
           $title = &mt('Course Authoring Space');
       } else {
           $title = &mt('Authoring Space');
       }
   
       my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent"
       if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
         $target = '';          $target = '';
         $crumbtarget = '';          $crumbtarget = '';
     } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {  
         $target = ' target="'.$env{'request.deeplink.target'}.'"';  
         $crumbtarget = $env{'request.deeplink.target'};  
     }      }
   
     my $output =      my $output =
          '<div>'           '<div>'
         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?          .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
         .'<b>'.&mt('Authoring Space:').'</b> '          .'<b>'.$title.'</b> '
         .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'          .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);          .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
   
Line 6023  sub CSTR_pageheader { Line 5942  sub CSTR_pageheader {
             .$lastitem              .$lastitem
             .'</span>';              .'</span>';
     }      }
     $output .=  
          '<br />'  
         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"  
         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')  
         .'</form>'  
         .&Apache::lonmenu::constspaceform($frameset)  
         .'</div>';  
   
     return $output;  
 }  
   
 ##############################################      if ($crsauthor) {
 =pod          $output .= '</form>'.&Apache::lonmenu::constspaceform();
   
 =item * &nocodemirror()  
   
 Input: None  
   
 Returns: 1 if CodeMirror is deactivated based on  
          user's preference, or domain default,  
          if user indicated use of default.  
   
 =cut  
   
 sub nocodemirror {  
     my $nocodem = $env{'environment.nocodemirror'};  
     unless ($nocodem) {  
         my %domdefs = &Apache::lonnet::get_domain_defaults($env{'user.domain'});  
         if ($domdefs{'nocodemirror'}) {  
             $nocodem = 'yes';  
         }  
     }  
     if ($nocodem eq 'yes') {  
         return 1;  
     }  
     return;  
 }  
   
 ##############################################  
 =pod  
   
 =item * &permitted_editors()  
   
 Input: $uri (optional)  
   
 Returns: %editors hash in which keys are editors  
          permitted in current Authoring Space.  
          Value for each key is 1. Possible keys  
          are: edit, xml, and daxe. If no specific  
          set of editors has been set for the Author  
          who owns the Authoring Space, then the  
          domain default will be used.  If no domain  
          default has been set, then the keys will be  
          edit and xml.  
   
 =cut  
   
 sub permitted_editors {  
     my ($uri) = @_;  
     my ($is_author,$is_coauthor,$auname,$audom,%editors);  
     if ($env{'request.role'} =~ m{^au\./}) {  
         $is_author = 1;  
     } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)}) {  
         ($audom,$auname) = ($1,$2);  
         if (($audom ne '') && ($auname ne '')) {  
             if (($env{'user.domain'} eq $audom) &&  
                 ($env{'user.name'} eq $auname)) {  
                 $is_author = 1;  
             } else {  
                 $is_coauthor = 1;  
             }  
         }  
     } elsif ($env{'request.course.id'}) {  
         if ($env{'request.editurl'} =~ m{^/priv/($match_domain)/($match_username)/}) {  
             ($audom,$auname) = ($1,$2);  
         } elsif ($env{'request.uri'} =~ m{^/priv/($match_domain)/($match_username)/}) {  
             ($audom,$auname) = ($1,$2);  
         } elsif (($uri eq '/daxesave') &&  
                  ($env{'form.path'} =~ m{^/daxeopen/priv/($match_domain)/($match_username)/})) {  
             ($audom,$auname) = ($1,$2);  
         }  
         if (($audom ne '') && ($auname ne '')) {  
             if (($env{'user.domain'} eq $audom) &&  
                 ($env{'user.name'} eq $auname)) {  
                 $is_author = 1;  
             } else {  
                 $is_coauthor = 1;  
             }  
         }  
     }  
     if ($is_author) {  
         if (exists($env{'environment.editors'})) {  
             map { $editors{$_} = 1; } split(/,/,$env{'environment.editors'});  
         } else {  
             %editors = ( edit => 1,  
                          xml => 1,  
                        );  
         }  
     } elsif ($is_coauthor) {  
         if (exists($env{"environment.internal.editors./$audom/$auname"})) {  
             map { $editors{$_} = 1; } split(/,/,$env{"environment.internal.editors./$audom/$auname"});  
         } else {  
             %editors = ( edit => 1,  
                          xml => 1,  
                        );  
         }  
     } else {      } else {
         %editors = ( edit => 1,          $output .=
                      xml => 1,               '<br />'
                    );              #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
               .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
               .'</form>'
               .&Apache::lonmenu::constspaceform();
     }      }
     return %editors;      $output .= '</div>';
   
       return $output;
 }  }
   
 ###############################################  ###############################################
Line 6174  Inputs: Line 5995  Inputs:
   
 =item * $bgcolor, used to override the bgcolor on a webpage to a specific value  =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
   
 =item * $no_inline_link, if true and in remote mode, don't show the  
          'Switch To Inline Menu' link  
   
 =item * $args, optional argument valid values are  =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg              no_auto_mt_title -> prevents &mt()ing the title arg
             use_absolute     -> for external resource or syllabus, this will              use_absolute     -> for external resource or syllabus, this will
Line 6201  Inputs: Line 6019  Inputs:
             context, this will contain a reference to hash of items              context, this will contain a reference to hash of items
             to be included in the page header and/or inline menu.              to be included in the page header and/or inline menu.
   
 =item * $menucoll, optional argument, if specific menu collection is in  
             effect, either set as the default for the course, or set for  
             the deeplink paramater for $env{'request.deeplink.login'}  
             then $menucoll will be the number of that collection.  
   
 =item * $menuref, optional argument, reference to a hash, containing the  
             menu options included for the menu in effect, based on the  
             configuration for the numbered menu collection in use.  
   
 =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister  
             within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),  
             if so, $showncrumbsref is set there to 1, and will propagate back  
             via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()  
             being called a second time.  
   
 =back  =back
   
 Returns: A uniform header for LON-CAPA web pages.    Returns: A uniform header for LON-CAPA web pages.  
Line 6227  other decorations will be returned. Line 6030  other decorations will be returned.
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref,          $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_;
         $ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;  
   
     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 6257  sub bodytag { Line 6059  sub bodytag {
     if ($realm) {      if ($realm) {
         $realm = '/'.$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);
     }       } 
 # realm  # realm
     my ($cid,$sec);  
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         $cid = $env{'request.course.id'};  
         if ($env{'request.course.sec'}) {  
             $sec = $env{'request.course.sec'};  
         }  
     } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {  
         if (&Apache::lonnet::is_course($1,$2)) {  
             $cid = $1.'_'.$2;  
             $sec = $3;  
         }  
     }  
     if ($cid) {  
         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+)$}) {          } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
Line 6284  sub bodytag { Line 6074  sub bodytag {
                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);                  $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
             }              }
         } else {          } else {
             $role = (split(/\//,$role,4))[-1];              $role = (split(/\//,$role,4))[-1]; 
         }          }
         if ($sec) {          if ($env{'request.course.sec'}) {
             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$sec;              $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
         }             }   
  $realm = $env{'course.'.$cid.'.description'};   $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
     } else {      } else {
         $role = &Apache::lonnet::plaintext($role);          $role = &Apache::lonnet::plaintext($role);
     }      }
Line 6312  sub bodytag { Line 6102  sub bodytag {
  undef($role);   undef($role);
     }      }
   
     my $showcrstitle = 1;      if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
     if (($cid) && ($env{'request.lti.login'})) {  
         if (ref($ltimenu) eq 'HASH') {          if (ref($ltimenu) eq 'HASH') {
             unless ($ltimenu->{'role'}) {              unless ($ltimenu->{'role'}) {
                 undef($role);                  undef($role);
             }              }
             unless ($ltimenu->{'coursetitle'}) {              unless ($ltimenu->{'coursetitle'}) {
                 $realm='&nbsp;';                  $realm='&nbsp;';
                 $showcrstitle = 0;  
             }  
         }  
     } elsif (($cid) && ($menucoll)) {  
         if (ref($menuref) eq 'HASH') {  
             unless ($menuref->{'role'}) {  
                 undef($role);  
             }  
             unless ($menuref->{'crs'}) {  
                 $realm='&nbsp;';  
                 $showcrstitle = 0;  
             }              }
         }          }
     }      }
Line 6339  sub bodytag { Line 6117  sub bodytag {
     #      #
     # Extra info if you are the DC      # Extra info if you are the DC
     my $dc_info = '';      my $dc_info = '';
     if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&      if ($env{'user.adv'} && exists($env{'user.role.dc./'.
         (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {                          $env{'course.'.$env{'request.course.id'}.
                                    '.domain'}.'/'})) {
           my $cid = $env{'request.course.id'};
         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};          $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
         $dc_info =~ s/\s+$//;          $dc_info =~ s/\s+$//;
     }      }
   
     my $crstype;      my $crstype;
     if ($cid) {      if ($env{'request.course.id'}) {
         $crstype = $env{'course.'.$cid.'.type'};          $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
     } elsif ($args->{'crstype'}) {      } elsif ($args->{'crstype'}) {
         $crstype = $args->{'crstype'};          $crstype = $args->{'crstype'};
     }      }
       if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
     $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});          undef($role);
   
     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 {      } else {
           $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
       }
   
           if ($env{'request.state'} eq 'construct') { $forcereg=1; }
   
         #    if ($env{'request.state'} eq 'construct') {          #    if ($env{'request.state'} eq 'construct') {
         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls          #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
Line 6379  sub bodytag { Line 6146  sub bodytag {
         $bodytag .= Apache::lonhtmlcommon::scripttag(          $bodytag .= Apache::lonhtmlcommon::scripttag(
             Apache::lonmenu::utilityfunctions($httphost), 'start');              Apache::lonmenu::utilityfunctions($httphost), 'start');
   
         if ($args->{'collapsible_header'} ne '') {  
             my $alttext = &mt('menu state: collapsed');  
             my $tooltip = &mt('display standard menus');  
             $bodytag .= <<"END";  
 <div id="LC_expandingContainer" style="display:inline;">  
 <div id="LC_collapsible" class="LC_collapse_trigger" style="position: absolute;top: -5px;left: 0px; z-index:101; display:inline;">  
 <a href="#" style="text-decoration:none;"><img class="LC_collapsible_indicator" alt="$alttext" title="$tooltip" src="/res/adm/pages/collapsed.png" style="border:0;margin:0;padding:0;max-width:100%;height:auto" /></a></div>  
 <div class="LC_menus_content hidden">  
 END  
         }  
         unless ($args->{'no_primary_menu'}) {          unless ($args->{'no_primary_menu'}) {
             my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,              my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu);
                                                               $args->{'links_disabled'},  
                                                               $args->{'links_target'},  
                                                               $args->{'collapsible_header'});  
             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>|;
Line 6415  END Line 6170  END
             $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;              $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
         }          }
   
         #if directed to not display the secondary menu, don't.          #if directed to not display the secondary menu, don't.  
         if ($args->{'no_secondary_menu'}) {          if ($args->{'no_secondary_menu'}) {
             return $bodytag;              return $bodytag;
         }          }
Line 6423  END Line 6178  END
         if (!$public){          if (!$public){
             unless ($args->{'no_inline_menu'}) {              unless ($args->{'no_inline_menu'}) {
                 $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,                  $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
                                                             $args->{'no_primary_menu'},                                                              $args->{'no_primary_menu'});
                                                             $menucoll,$menuref,  
                                                             $args->{'links_disabled'},  
                                                             $args->{'links_target'});  
             }              }
             $bodytag .= Apache::lonmenu::serverform();              $bodytag .= Apache::lonmenu::serverform();
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');              $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {              if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,
                                 $args->{'bread_crumbs'},'','',$hostname,                                  $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
                                 $ltiscope,$ltiuri,$showncrumbsref);  
             } elsif ($forcereg) {              } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                 $args->{'group'},$args->{'hide_buttons'},                                                              $args->{'group'},
                                 $hostname,$ltiscope,$ltiuri,$showncrumbsref);                                                              $args->{'hide_buttons'},
                                                               $hostname,$ltiscope,$ltiuri);
             } else {              } else {
                 my $forbodytag;                  $bodytag .= 
                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},                      &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                                     $forcereg,$args->{'group'},                                                          $forcereg,$args->{'group'},
                                                     $args->{'bread_crumbs'},                                                          $args->{'bread_crumbs'},
                                                     $advtoolsref,'',$hostname,                                                          $advtoolsref,'',$hostname);
                                                     \$forbodytag);  
                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {  
                     $bodytag .= $forbodytag;  
                 }  
             }              }
         }else{          }else{
             # this is to seperate menu from content when there's no secondary              # this is to seperate menu from content when there's no secondary
Line 6455  END Line 6203  END
             $bodytag .= '<hr style="clear:both" />';              $bodytag .= '<hr style="clear:both" />';
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');               $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
         }          }
         if ($args->{'collapsible_header'} ne '') {  
             $bodytag .= $args->{'collapsible_header'}.  
                         '<div id="LC_collapsible_separator"></div>'.  
                         '</div></div>';  
         }  
         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) {          return $bodytag;
         $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 6540  sub make_attr_string { Line 6236  sub make_attr_string {
  delete($attr_ref->{$key});   delete($attr_ref->{$key});
     }      }
  }   }
         if ($env{'environment.remote'} eq 'on') {   $attr_ref->{'onload'}  = $on_load;
             $attr_ref->{'onload'}  =   $attr_ref->{'onunload'}= $on_unload;
                 &Apache::lonmenu::loadevents().  $on_load;  
             $attr_ref->{'onunload'}=  
                 &Apache::lonmenu::unloadevents().$on_unload;  
         } else {    
     $attr_ref->{'onload'}  = $on_load;  
     $attr_ref->{'onunload'}= $on_unload;  
         }  
     }      }
   
     my $attr_string;      my $attr_string;
Line 6584  sub endbodytag { Line 6273  sub 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'})) {
             my ($endbodyjs,$idattr);  
             if ($env{'internal.head.to_opener'}) {  
                 my $linkid = 'LC_continue_link';  
                 $idattr = ' id="'.$linkid.'"';  
                 my $redirect_for_js = &js_escape($env{'internal.head.redirect'});  
                 $endbodyjs=<<ENDJS;  
 <script type="text/javascript">  
 // <![CDATA[  
 function ebFunction(evt) {  
     evt.preventDefault();  
     var dest = '$redirect_for_js';  
     if (window.opener != null && !window.opener.closed) {  
         window.opener.location.href=dest;  
         window.close();  
     } else {  
         window.location.href=dest;  
     }  
     return false;  
 }  
   
 \$(document).ready(function () {  
   if (document.getElementById('$linkid')) {  
     var clickelem = document.getElementById('$linkid');  
     clickelem.addEventListener('click',ebFunction,false);  
   }  
 });  
 // ]]>  
 </script>  
 ENDJS  
             }  
     $endbodytag=      $endbodytag=
         "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".          "<br /><a href=\"$env{'internal.head.redirect'}\">".
         &mt('Continue').'</a>'.          &mt('Continue').'</a>'.
         $endbodytag;          $endbodytag;
         }          }
     }      }
     if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {  
         $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;  
     }  
     return $endbodytag;      return $endbodytag;
 }  }
   
Line 6707  form, .inline { Line 6363  form, .inline {
   display: inline;    display: inline;
 }  }
   
 .LC_menus_content.shown{  
   display: inline;  
 }  
   
 .LC_menus_content.hidden {  
   display: none;  
 }  
   
 .LC_right {  .LC_right {
   text-align:right;    text-align:right;
 }  }
Line 6735  form, .inline { Line 6383  form, .inline {
   width:400px;    width:400px;
 }  }
   
 #LC_collapsible_separator {  
     border: 1px solid black;  
     width: 99.9%;  
     height: 0px;  
 }  
   
 .LC_iframecontainer {  .LC_iframecontainer {
     width: 98%;      width: 98%;
     margin: 0;      margin: 0;
Line 6919  ul.LC_breadcrumb_tools_outerlist li { Line 6561  ul.LC_breadcrumb_tools_outerlist li {
     float: right;      float: right;
 }  }
   
   .LC_placement_prog {
       padding-right: 20px;
       font-weight: bold;
       font-size: 90%;
   }
   
 table#LC_title_bar td {  table#LC_title_bar td {
   background: $tabbg;    background: $tabbg;
 }  }
Line 7010  td.LC_menubuttons_text { Line 6658  td.LC_menubuttons_text {
 }  }
   
 td.LC_zero_height {  td.LC_zero_height {
   line-height: 0;    line-height: 0; 
   cellpadding: 0;    cellpadding: 0;
 }  }
   
Line 7335  td.LC_parm_overview_restrictions  { Line 6983  td.LC_parm_overview_restrictions  {
   border-collapse: collapse;    border-collapse: collapse;
 }  }
   
   span.LC_parm_recursive,
   td.LC_parm_recursive {
     font-weight: bold;
     font-size: smaller;
   }
   
 table.LC_parm_overview_restrictions td {  table.LC_parm_overview_restrictions td {
   border-width: 1px 4px 1px 4px;    border-width: 1px 4px 1px 4px;
   border-style: solid;    border-style: solid;
Line 7687  table.LC_data_table tr > td.LC_docs_entr Line 7341  table.LC_data_table tr > td.LC_docs_entr
   color: #990000;    color: #990000;
 }  }
   
   .LC_docs_alias {
     color: #440055;  
   }
   
 .LC_domprefs_email,  .LC_domprefs_email,
   .LC_docs_alias_name,
 .LC_docs_reinit_warn,  .LC_docs_reinit_warn,
 .LC_docs_ext_edit {  .LC_docs_ext_edit {
   font-size: x-small;    font-size: x-small;
Line 7936  fieldset { Line 7595  fieldset {
   /* overflow: hidden; */    /* overflow: hidden; */
 }  }
   
 fieldset#LC_selectuser {  
     margin: 0;  
     padding: 0;  
 }  
   
 article.geogebraweb div {  article.geogebraweb div {
     margin: 0;      margin: 0;
 }  }
Line 7989  ol.LC_primary_menu li { Line 7643  ol.LC_primary_menu li {
   line-height: 1.5em;    line-height: 1.5em;
 }  }
   
 ol.LC_primary_menu li a,   ol.LC_primary_menu li a,
 ol.LC_primary_menu li p {  ol.LC_primary_menu li p {
   display: block;    display: block;
   margin: 0;    margin: 0;
Line 8004  ol.LC_primary_menu li p span.LC_primary_ Line 7658  ol.LC_primary_menu li p span.LC_primary_
 }  }
   
 ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {  ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
   display: inline-block;    display: inline-block;
   width: 5%;    width: 5%;
   float: right;    float: right;
   text-align: right;    text-align: right;
Line 8039  ol.LC_primary_menu li:hover li, ol.LC_pr Line 7693  ol.LC_primary_menu li:hover li, ol.LC_pr
   float: none;    float: none;
   border-left: 1px solid black;    border-left: 1px solid black;
   border-right: 1px solid black;    border-right: 1px solid black;
 /* A dark bottom border to visualize different menu options;  /* A dark bottom border to visualize different menu options; 
 overwritten in the create_submenu routine for the last border-bottom of the menu */  overwritten in the create_submenu routine for the last border-bottom of the menu */
   border-bottom: 1px solid $data_table_dark;    border-bottom: 1px solid $data_table_dark; 
 }  }
   
 ol.LC_primary_menu li li p:hover {  ol.LC_primary_menu li li p:hover {
Line 8484  a#LC_content_toolbar_edittoplevel { Line 8138  a#LC_content_toolbar_edittoplevel {
   background-image:url(/res/adm/pages/edittoplevel.gif);    background-image:url(/res/adm/pages/edittoplevel.gif);
 }  }
   
 a#LC_content_toolbar_printout {  
   background-image:url(/res/adm/pages/printout.gif);  
 }  
   
 ul#LC_toolbar li a:hover {  ul#LC_toolbar li a:hover {
   background-position: bottom center;    background-position: bottom center;
 }  }
Line 8605  ul.LC_funclist li { Line 8255  ul.LC_funclist li {
  cursor:pointer;   cursor:pointer;
 }  }
   
 .LCisDisabled {  
   cursor: not-allowed;  
   opacity: 0.5;  
 }  
   
 a[aria-disabled="true"] {  
   color: currentColor;  
   display: inline-block;  /* For IE11/ MS Edge bug */  
   pointer-events: none;  
   text-decoration: none;  
 }  
   
 pre.LC_wordwrap {  pre.LC_wordwrap {
   white-space: pre-wrap;    white-space: pre-wrap;
   white-space: -moz-pre-wrap;    white-space: -moz-pre-wrap;
Line 8790  Inputs: $title - optional title for the Line 8428  Inputs: $title - optional title for the
                                    3- whether the side effect should occur                                     3- whether the side effect should occur
                            (side effect of setting                              (side effect of setting 
                                $env{'internal.head.redirect'} to the url                                  $env{'internal.head.redirect'} to the url 
                                redirected to)                                 redirected too)
                                    4- whether the redirect target should be  
                                       the opener of the current (pop-up)  
                                       window (side effect of setting  
                                       $env{'internal.head.to_opener'} to  
                                       1, if true.  
                                    5- whether encrypt check should be skipped  
             domain         -> force to color decorate a page for a specific              domain         -> force to color decorate a page for a specific
                                domain                                 domain
             function       -> force usage of a specific rolish color scheme              function       -> force usage of a specific rolish color scheme
Line 8833  sub headtag { Line 8465  sub headtag {
     if (!$args->{'frameset'}) {      if (!$args->{'frameset'}) {
  $result .= &Apache::lonhtmlcommon::htmlareaheaders();   $result .= &Apache::lonhtmlcommon::htmlareaheaders();
     }      }
     if ($args->{'force_register'}) {      if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
         $result .= &Apache::lonmenu::registerurl(1);          $result .= Apache::lonxml::display_title();
     }      }
     if (!$args->{'no_nav_bar'}       if (!$args->{'no_nav_bar'} 
  && !$args->{'only_body'}   && !$args->{'only_body'}
Line 8859  sub headtag { Line 8491  sub headtag {
         }          }
     }      }
     if (ref($args->{'redirect'})) {      if (ref($args->{'redirect'})) {
  my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};   my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
         if (!$skip_enc_check) {   $url = &Apache::lonenc::check_encrypt($url);
     $url = &Apache::lonenc::check_encrypt($url);  
         }  
  if (!$inhibit_continue) {   if (!$inhibit_continue) {
     $env{'internal.head.redirect'} = $url;      $env{'internal.head.redirect'} = $url;
  }   }
         $result.=<<"ADDMETA";   $result.=<<ADDMETA
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 ADDMETA  
         if ($to_opener) {  
             $env{'internal.head.to_opener'} = 1;  
             my $dest = &js_escape($url);  
             my $timeout = int($time * 1000);  
             $result .=<<"ENDJS";  
 <script type="text/javascript">  
 // <![CDATA[  
 function LC_To_Opener() {  
     var dest = '$dest';  
     if (dest != '') {  
         if (window.opener != null && !window.opener.closed) {  
             window.opener.location.href=dest;  
             window.close();  
         } else {  
             window.location.href=dest;  
         }  
     }  
 }  
 \$(document).ready(function () {  
     setTimeout('LC_To_Opener()',$timeout);  
 });  
 // ]]>  
 </script>  
 ENDJS  
         } else {  
             $result.=<<"ADDMETA";  
 <meta http-equiv="Refresh" content="$time; url=$url" />  <meta http-equiv="Refresh" content="$time; url=$url" />
 ADDMETA  ADDMETA
         }  
     } else {      } else {
         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {          unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
             my $requrl = $env{'request.uri'};              my $requrl = $env{'request.uri'};
Line 8911  ADDMETA Line 8513  ADDMETA
                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};                  my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {                  unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);                      my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                     my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};  
                     my ($offload,$offloadoth);  
                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {                      if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                           my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                         if ($domdefs{'offloadnow'}{$lonhost}) {                          if ($domdefs{'offloadnow'}{$lonhost}) {
                             $offload = 1;                              my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                             if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&                              if (($newserver) && ($newserver ne $lonhost)) {
                                 (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {                                  my $numsec = 5;
                                 unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {                                  my $timeout = $numsec * 1000;
                                     $offloadoth = 1;                                  my ($newurl,$locknum,%locks,$msg);
                                     $dom_in_use = $env{'user.domain'};                                  if ($env{'request.role.adv'}) {
                                       ($locknum,%locks) = &Apache::lonnet::get_locks();
                                 }                                  }
                             }                                  my $disable_submit = 0;
                         }                                  if ($requrl =~ /$LONCAPA::assess_re/) {
                     }                                      $disable_submit = 1;
                     unless ($offload) {  
                         if (ref($domdefs{'offloadoth'}) eq 'HASH') {  
                             if ($domdefs{'offloadoth'}{$lonhost}) {  
                                 if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&  
                                     (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {  
                                     unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {  
                                         $offload = 1;  
                                         $offloadoth = 1;  
                                         $dom_in_use = $env{'user.domain'};  
                                     }  
                                 }                                  }
                             }                                  if ($locknum) {
                         }                                      my @lockinfo = sort(values(%locks));
                     }                                      $msg = &mt('Once the following tasks are complete: ')."\\n".
                     if ($offload) {                                             join(", ",sort(values(%locks)))."\\n".
                         my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);                                             &mt('your session will be transferred to a different server, after you click "Roles".');
                         if (($newserver eq '') && ($offloadoth)) {  
                             my @domains = &Apache::lonnet::current_machine_domains();  
                             if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {  
                                 ($newserver) = &Apache::lonnet::choose_server($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";  
                                 if (&show_course()) {  
                                     $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');  
                                 } else {                                  } else {
                                     $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');                                      if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                                 }                                          $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                             } 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'}) {  
                                     my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});  
                                     if ($shownsymb =~ m{^/enc/}) {  
                                         my $reqdmajor = 2;  
                                         my $reqdminor = 11;  
                                         my $reqdsubminor = 3;  
                                         my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);  
                                         my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);  
                                         my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);  
                                         if (($major eq '' && $minor eq '') ||  
                                             (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||  
                                             (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||  
                                              ($reqdsubminor > $subminor))))) {  
                                             undef($shownsymb);  
                                         }  
                                     }                                      }
                                     if ($shownsymb) {                                      $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                                         &js_escape(\$shownsymb);                                      $newurl = '/adm/switchserver?otherserver='.$newserver;
                                         $newurl .= '&symb='.$shownsymb;                                      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;
                                     }                                      }
                                 } else {  
                                     my $shownurl = &Apache::lonenc::check_encrypt($requrl);  
                                     &js_escape(\$shownurl);  
                                     $newurl .= '&origurl='.$shownurl;  
                                 }                                  }
                             }                                  &js_escape(\$msg);
                             &js_escape(\$msg);                                  $result.=<<OFFLOAD
                             $result.=<<OFFLOAD  
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
Line 9024  function LC_Offload_Now() { Line 8570  function LC_Offload_Now() {
 // ]]>  // ]]>
 </script>  </script>
 OFFLOAD  OFFLOAD
                               }
                         }                          }
                     }                      }
                 }                  }
Line 9039  OFFLOAD Line 8586  OFFLOAD
     if (!$args->{'frameset'}) {      if (!$args->{'frameset'}) {
         $result .= ' /';          $result .= ' /';
     }      }
     $result .= '>'      $result .= '>' 
         .$inhibitprint          .$inhibitprint
  .$head_extra;   .$head_extra;
     my $clientmobile;      my $clientmobile;
Line 9072  sub font_settings { Line 8619  sub font_settings {
     my $headerstring='';      my $headerstring='';
     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||      if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {          ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
  $headerstring.=          $headerstring.=
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';              '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
         if (!$args->{'frameset'}) {          if (!$args->{'frameset'}) {
             $headerstring.= ' /';      $headerstring.= ' /';
         }          }
         $headerstring .= '>'."\n";   $headerstring .= '>'."\n";
     }      }
     return $headerstring;      return $headerstring;
 }  }
Line 9122  sub print_suppression { Line 8669  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 $clientip = &Apache::lonnet::get_requestor_ip();          my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
         my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);  
         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 9231  $args - additional optional args support Line 8777  $args - additional optional args support
              skip_phases    -> hash ref of                skip_phases    -> hash ref of 
                                     head -> skip the <html><head> generation                                      head -> skip the <html><head> generation
                                     body -> skip all <body> generation                                      body -> skip all <body> generation
              no_inline_link -> if true and in remote mode, don't show the  
                                     'Switch To Inline Menu' link  
              no_auto_mt_title -> prevent &mt()ing the title arg               no_auto_mt_title -> prevent &mt()ing the title arg
              bread_crumbs ->             Array containing breadcrumbs               bread_crumbs ->             Array containing breadcrumbs
              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs               bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
              bread_crumbs_nomenu -> if true will pass false as the value of $menulink               bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                                     to lonhtmlcommon::breadcrumbs                                      to lonhtmlcommon::breadcrumbs
              group          -> includes the current group, if page is for a               group          -> includes the current group, if page is for a 
                                specific group                                 specific group
              use_absolute   -> for request for external resource or syllabus, this               use_absolute   -> for request for external resource or syllabus, this
                                will contain https://<hostname> if server uses                                 will contain https://<hostname> if server uses
                                https (as per hosts.tab), but request is for http                                 https (as per hosts.tab), but request is for http
              hostname       -> hostname, originally from $r->hostname(), (optional).               hostname       -> hostname, originally from $r->hostname(), (optional).
              links_disabled -> Links in primary and secondary menus are disabled  
                                (Can enable them once page has loaded - see lonroles.pm  
                                for an example).  
              links_target   -> Target for links, e.g., _parent (optional).  
   
 =back  =back
   
Line 9260  sub start_page { Line 8800  sub start_page {
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));      #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
   
     $env{'internal.start_page'}++;      $env{'internal.start_page'}++;
     my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);      my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu);
   
     if (! exists($args->{'skip_phases'}{'head'}) ) {      if (! exists($args->{'skip_phases'}{'head'}) ) {
         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);          $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
Line 9295  sub start_page { Line 8835  sub start_page {
         ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},          ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
                                   $env{'course.'.$env{'request.course.id'}.'.domain'},                                    $env{'course.'.$env{'request.course.id'}.'.domain'},
                                   $env{'course.'.$env{'request.course.id'}.'.num'});                                    $env{'course.'.$env{'request.course.id'}.'.num'});
     } elsif ($env{'request.course.id'}) {  
         my $expiretime=600;  
         if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {  
             &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});  
         }  
         my ($deeplinkmenu,$menuref);  
         ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();  
         if ($menucoll) {  
             if (ref($menuref) eq 'HASH') {  
                 %menu = %{$menuref};  
             }  
             if ($menu{'top'} eq 'n') {  
                 $args->{'no_primary_menu'} = 1;  
             }  
             if ($menu{'inline'} eq 'n') {  
                 unless (&Apache::lonnet::allowed('opa')) {  
                     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};  
                     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
                     my $crstype = &course_type();  
                     my $now = time;  
                     my $ccrole;  
                     if ($crstype eq 'Community') {  
                         $ccrole = 'co';  
                     } else {  
                         $ccrole = 'cc';  
                     }  
                     if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {  
                         my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});  
                         if ((($start) && ($start<0)) ||  
                             (($end) && ($end<$now))  ||  
                             (($start) && ($now<$start))) {  
                             $args->{'no_inline_menu'} = 1;  
                         }  
                     } else {  
                         $args->{'no_inline_menu'} = 1;  
                     }  
                 }  
             }  
         }  
     }      }
       
     my $showncrumbs;  
     if (! exists($args->{'skip_phases'}{'body'}) ) {      if (! exists($args->{'skip_phases'}{'body'}) ) {
  if ($args->{'frameset'}) {   if ($args->{'frameset'}) {
     my $attr_string = &make_attr_string($args->{'force_register'},      my $attr_string = &make_attr_string($args->{'force_register'},
Line 9348  sub start_page { Line 8848  sub start_page {
                          $args->{'function'},       $args->{'add_entries'},                           $args->{'function'},       $args->{'add_entries'},
                          $args->{'only_body'},      $args->{'domain'},                           $args->{'only_body'},      $args->{'domain'},
                          $args->{'force_register'}, $args->{'no_nav_bar'},                           $args->{'force_register'}, $args->{'no_nav_bar'},
                          $args->{'bgcolor'},        $args->{'no_inline_link'},                           $args->{'bgcolor'},        $args,
                          $args,                     \@advtools,                           \@advtools,$ltiscope,$ltiuri,\%ltimenu);
                          $ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu,\$showncrumbs);  
         }          }
     }      }
   
Line 9372  sub start_page { Line 8871  sub start_page {
   
     #Breadcrumbs      #Breadcrumbs
     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {      if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
         unless ($showncrumbs) {  
  &Apache::lonhtmlcommon::clear_breadcrumbs();   &Apache::lonhtmlcommon::clear_breadcrumbs();
  #if any br links exists, add them to the breadcrumbs   #if any br links exists, add them to the breadcrumbs
  if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {            if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
Line 9387  sub start_page { Line 8885  sub start_page {
                 my $menulink;                  my $menulink;
                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.                  # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                 if ((exists($args->{'bread_crumbs_nomenu'})) ||                  if ((exists($args->{'bread_crumbs_nomenu'})) ||
                     ($ltiscope eq 'map') || ($ltiscope eq 'resource')) {                       ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
                        ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
                        ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
                        (!$env{'request.role.adv'}))) {
                     $menulink = 0;                      $menulink = 0;
                 } else {                  } else {
                     undef($menulink);                      undef($menulink);
                 }                  }
                 my $linkprotout;  
                 if ($env{'request.deeplink.login'}) {  
                     my $linkprotout = &Apache::lonmenu::linkprot_exit();  
                     if ($linkprotout) {  
                         &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);  
                     }  
                 }  
  #if bread_crumbs_component exists show it as headline else show only the breadcrumbs   #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
  if(exists($args->{'bread_crumbs_component'})){   if(exists($args->{'bread_crumbs_component'})){
  $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);   $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
  } else {                  } else {
  $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);   $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
  }   }
         }  
     } elsif (($env{'environment.remote'} eq 'on') &&  
              ($env{'form.inhibitmenu'} ne 'yes') &&  
              ($env{'request.noversionuri'} =~ m{^/res/}) &&  
              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {  
         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';  
     }      }
     return $result;      return $result;
 }  }
Line 9447  sub end_page { Line 8935  sub end_page {
     return $result;      return $result;
 }  }
   
 sub menucoll_in_effect {  
     my ($menucoll,$deeplinkmenu,%menu);  
     if ($env{'request.course.id'}) {  
         $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};  
         if ($env{'request.deeplink.login'}) {  
             my ($deeplink_symb,$deeplink,$check_login_symb);  
             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};  
             if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {  
                 if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {  
                     my $navmap = Apache::lonnavmaps::navmap->new();  
                     if (ref($navmap)) {  
                         $deeplink = $navmap->get_mapparam(undef,  
                                                           &Apache::lonnet::declutter($env{'request.noversionuri'}),  
                                                           '0.deeplink');  
                     } else {  
                         $check_login_symb = 1;  
                     }  
                 } else {  
                     my $symb=&Apache::lonnet::symbread();  
                     if ($symb) {  
                         $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);  
                     } else {  
                         $check_login_symb = 1;  
                     }  
                 }  
             } else {  
                 $check_login_symb = 1;  
             }  
             if ($check_login_symb) {  
                 $deeplink_symb = &deeplink_login_symb($cnum,$cdom);  
                 if ($deeplink_symb =~ /\.(page|sequence)$/) {  
                     my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);  
                     my $navmap = Apache::lonnavmaps::navmap->new();  
                     if (ref($navmap)) {  
                         $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');  
                     }  
                 } else {  
                     $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);  
                 }  
             }  
             if ($deeplink ne '') {  
                 my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);  
                 if ($display =~ /^\d+$/) {  
                     $deeplinkmenu = 1;  
                     $menucoll = $display;  
                 }  
             }  
         }  
         if ($menucoll) {  
             %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);  
         }  
     }  
     return ($menucoll,$deeplinkmenu,\%menu);  
 }  
   
 sub deeplink_login_symb {  
     my ($cnum,$cdom) = @_;  
     my $login_symb;  
     if ($env{'request.deeplink.login'}) {  
         $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);  
     }  
     return $login_symb;  
 }  
   
 sub symb_from_tinyurl {  
     my ($url,$cnum,$cdom) = @_;  
     if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {  
         my $key = $1;  
         my ($tinyurl,$login);  
         my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);  
         if (defined($cached)) {  
             $tinyurl = $result;  
         } else {  
             my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);  
             my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);  
             if ($currtiny{$key} ne '') {  
                 $tinyurl = $currtiny{$key};  
                 &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);  
             }  
         }  
         if ($tinyurl ne '') {  
             my ($cnumreq,$symb) = split(/\&/,$tinyurl);  
             if (wantarray) {  
                 return ($cnumreq,$symb);  
             } elsif ($cnumreq eq $cnum) {  
                 return $symb;  
             }  
         }  
     }  
     if (wantarray) {  
         return ();  
     } else {  
         return;  
     }  
 }  
   
 sub usable_exttools {  
     my %tooltypes;  
     if ($env{'request.course.id'}) {  
         if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {  
            if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {  
                %tooltypes = (  
                              crs => 1,  
                              dom => 1,  
                             );  
            } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {  
                $tooltypes{'crs'} = 1;  
            } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {  
                $tooltypes{'dom'} = 1;  
            }  
         } else {  
             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};  
             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
             my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});  
             if ($crstype eq '') {  
                 $crstype = 'course';  
             }  
             if ($crstype eq 'course') {  
                 if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {  
                     $crstype = 'official';  
                 } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {  
                     $crstype = 'textbook';  
                 } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {  
                     $crstype = 'lti';  
                 } else {  
                     $crstype = 'unofficial';  
                 }  
             }  
             my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);  
             if ($domdefaults{$crstype.'domexttool'}) {  
                 $tooltypes{'dom'} = 1;  
             }  
             if ($domdefaults{$crstype.'exttool'}) {  
                 $tooltypes{'crs'} = 1;  
             }  
         }  
     }  
     return %tooltypes;  
 }  
   
 sub wishlist_window {  sub wishlist_window {
     return(<<'ENDWISHLIST');      return(<<'ENDWISHLIST');
 <script type="text/javascript">  <script type="text/javascript">
Line 9672  sub modal_link { Line 9019  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
 }  }
   
 sub modal_adhoc_script {  sub modal_adhoc_script {
     my ($funcname,$width,$height,$content,$possmathjax)=@_;      my ($funcname,$width,$height,$content)=@_;
     my $mathjax;  
     if ($possmathjax) {  
         $mathjax = <<'ENDJAX';  
                if (typeof MathJax == 'object') {  
                    MathJax.Hub.Queue(["Typeset",MathJax.Hub]);  
                }  
 ENDJAX  
     }  
     return (<<ENDADHOC);      return (<<ENDADHOC);
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
Line 9696  ENDJAX Line 9036  ENDJAX
                 modalWindow.height = $height;                  modalWindow.height = $height;
                 modalWindow.content = '$content';                  modalWindow.content = '$content';
                 modalWindow.open();                  modalWindow.open();
                 $mathjax  
         };            };  
 // ]]>  // ]]>
 </script>  </script>
Line 9704  ENDADHOC Line 9043  ENDADHOC
 }  }
   
 sub modal_adhoc_inner {  sub modal_adhoc_inner {
     my ($funcname,$width,$height,$content,$possmathjax)=@_;      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().
                  &end_page()                   &end_page()
              );               );
     return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);      return &modal_adhoc_script($funcname,$width,$height,$content);
 }  }
   
 sub modal_adhoc_window {  sub modal_adhoc_window {
     my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;      my ($funcname,$width,$height,$content,$linktext)=@_;
     return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).      return &modal_adhoc_inner($funcname,$width,$height,$content).
            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";             "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
 }  }
   
Line 10399  sub get_sections { Line 9738  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 10721  Incoming parameters: Line 10060  Incoming parameters:
 2. user's domain  2. user's domain
 3. quota name - portfolio, author, or course  3. quota name - portfolio, author, or course
    (if no quota name provided, defaults to portfolio).     (if no quota name provided, defaults to portfolio).
 4. crstype - official, unofficial, textbook or community, if quota name is  4. crstype - official, unofficial, textbook, placement or community, 
    course     if quota name is course
   
 Returns:  Returns:
 1. Disk quota (in MB) assigned to student.  1. Disk quota (in MB) assigned to student.
Line 10795  sub get_user_quota { Line 10134  sub get_user_quota {
         if ($quota eq '' || wantarray) {          if ($quota eq '' || wantarray) {
             if ($quotaname eq 'course') {              if ($quotaname eq 'course') {
                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);                  my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||                  if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
                     ($crstype eq 'community') || ($crstype eq 'textbook')) {                      ($crstype eq 'community') || ($crstype eq 'textbook') ||
                       ($crstype eq 'placement')) { 
                     $defquota = $domdefs{$crstype.'quota'};                      $defquota = $domdefs{$crstype.'quota'};
                 }                  }
                 if ($defquota eq '') {                  if ($defquota eq '') {
Line 10944  Inputs: 7 Line 10284  Inputs: 7
 4. filename of file for which action is being requested  4. filename of file for which action is being requested
 5. filesize (kB) of file  5. filesize (kB) of file
 6. action being taken: copy or upload.  6. action being taken: copy or upload.
 7. quotatype (in course context -- official, unofficial, community or textbook).  7. quotatype (in course context -- official, unofficial, textbook, placement or community).
   
 Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,  Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
          otherwise return null.           otherwise return null.
Line 10980  sub excess_filesize_warning { Line 10320  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 11088  sub user_picker { Line 10430  sub user_picker {
         $allow_blank = 0;          $allow_blank = 0;
         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);          $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
     } else {      } else {
         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);          my $defdom = $env{'request.role.domain'};
           my ($trusted,$untrusted);
           if (($context eq 'requestcrs') || ($context eq 'course')) {
               ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
           } elsif ($context eq 'author') {
               ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
           } elsif ($context eq 'domain') {
               ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
           }
           $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
     }      }
     my $srchinsel = ' <select name="srchin">';      my $srchinsel = ' <select name="srchin">';
   
Line 11293  sub user_rule_check { Line 10644  sub user_rule_check {
     if (ref($usershash) eq 'HASH') {      if (ref($usershash) eq 'HASH') {
         if (keys(%{$usershash}) > 1) {          if (keys(%{$usershash}) > 1) {
             my (%by_username,%by_id,%userdoms);              my (%by_username,%by_id,%userdoms);
             my $checkid;              my $checkid; 
             if (ref($checks) eq 'HASH') {              if (ref($checks) eq 'HASH') {
                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {                  if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                     $checkid = 1;                      $checkid = 1;
Line 11304  sub user_rule_check { Line 10655  sub user_rule_check {
                 if ($checkid) {                  if ($checkid) {
                     if (ref($usershash->{$user}) eq 'HASH') {                      if (ref($usershash->{$user}) eq 'HASH') {
                         if ($usershash->{$user}->{'id'} ne '') {                          if ($usershash->{$user}->{'id'} ne '') {
                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;                              $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; 
                             $userdoms{$udom} = 1;                              $userdoms{$udom} = 1;
                             if (ref($inst_results) eq 'HASH') {                              if (ref($inst_results) eq 'HASH') {
                                 $inst_results->{$uname.':'.$udom} = {};                                  $inst_results->{$uname.':'.$udom} = {};
Line 11374  sub user_rule_check { Line 10725  sub user_rule_check {
                 if (ref($usershash->{$user}) eq 'HASH') {                  if (ref($usershash->{$user}) eq 'HASH') {
                     if (ref($checks) eq 'HASH') {                      if (ref($checks) eq 'HASH') {
                         if (defined($checks->{'username'})) {                          if (defined($checks->{'username'})) {
                             ($inst_response{$user},%{$inst_results->{$user}}) =                              ($inst_response{$user},%{$inst_results->{$user}}) = 
                                 &Apache::lonnet::get_instuser($udom,$uname);                                  &Apache::lonnet::get_instuser($udom,$uname);
                         } elsif (defined($checks->{'id'})) {                          } elsif (defined($checks->{'id'})) {
                             if ($usershash->{$user}->{'id'} ne '') {                              if ($usershash->{$user}->{'id'} ne '') {
Line 11397  sub user_rule_check { Line 10748  sub user_rule_check {
                         if (ref($domconfig{'usercreation'}) eq 'HASH') {                          if (ref($domconfig{'usercreation'}) eq 'HASH') {
                             foreach my $item ('username','id') {                              foreach my $item ('username','id') {
                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {                                  if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                                    $$curr_rules{$udom}{$item} =                                     $$curr_rules{$udom}{$item} = 
                                        $domconfig{'usercreation'}{$item.'_rule'};                                         $domconfig{'usercreation'}{$item.'_rule'};
                                 }                                  }
                             }                              }
Line 11420  sub user_rule_check { Line 10771  sub user_rule_check {
                     $id = $inst_results->{$user}->{'id'};                      $id = $inst_results->{$user}->{'id'};
                 }                  }
             }              }
             if ($id eq '') {              if ($id eq '') { 
                 if (ref($usershash->{$user})) {                  if (ref($usershash->{$user})) {
                     $id = $usershash->{$user}->{'id'};                      $id = $usershash->{$user}->{'id'};
                 }                  }
Line 11581  sub sorted_inst_types { Line 10932  sub sorted_inst_types {
 }  }
   
 sub get_institutional_codes {  sub get_institutional_codes {
     my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;      my ($settings,$allcourses,$LC_code) = @_;
 # Get complete list of course sections to update  # Get complete list of course sections to update
     my @currsections = ();      my @currsections = ();
     my @currxlists = ();      my @currxlists = ();
     my (%unclutteredsec,%unclutteredlcsec);  
     my $coursecode = $$settings{'internal.coursecode'};      my $coursecode = $$settings{'internal.coursecode'};
     my $crskey = $crs.':'.$coursecode;  
     @{$unclutteredsec{$crskey}} = ();  
     @{$unclutteredlcsec{$crskey}} = ();  
   
     if ($$settings{'internal.sectionnums'} ne '') {      if ($$settings{'internal.sectionnums'} ne '') {
         @currsections = split(/,/,$$settings{'internal.sectionnums'});          @currsections = split(/,/,$$settings{'internal.sectionnums'});
Line 11600  sub get_institutional_codes { Line 10947  sub get_institutional_codes {
     }      }
   
     if (@currxlists > 0) {      if (@currxlists > 0) {
         foreach my $xl (@currxlists) {          foreach (@currxlists) {
             if ($xl =~ /^([^:]+):(\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 11609  sub get_institutional_codes { Line 10956  sub get_institutional_codes {
             }              }
         }          }
     }      }
    
     if (@currsections > 0) {      if (@currsections > 0) {
         foreach my $sec (@currsections) {          foreach (@currsections) {
             if ($sec =~ m/^(\w+):(\w*)$/ ) {              if (m/^(\w+):(\w*)$/) {
                 my $instsec = $1;                  my $sec = $coursecode.$1;
                 my $lc_sec = $2;                  my $lc_sec = $2;
                 unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {                  unless (grep/^$sec$/,@{$allcourses}) {
                     push(@{$unclutteredsec{$crskey}},$instsec);  
                     push(@{$unclutteredlcsec{$crskey}},$lc_sec);  
                 }  
             }  
         }  
     }  
   
     if (@{$unclutteredsec{$crskey}} > 0) {  
         my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);  
         if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {  
             for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {  
                 my $sec = $coursecode.$formattedsec{$crskey}[$i];  
                 unless (grep/^\Q$sec\E$/,@{$allcourses}) {  
                     push(@{$allcourses},$sec);                      push(@{$allcourses},$sec);
                     $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];                      $$LC_code{$sec} = $lc_sec;
                 }                  }
             }              }
         }          }
Line 11739  future_reservable - ref to hash of stude Line 11073  future_reservable - ref to hash of stude
   
     Keys in inner hash are:      Keys in inner hash are:
     (a) symb: either blank or symb to which slot use is restricted.      (a) symb: either blank or symb to which slot use is restricted.
     (b) startreserve:  start date of reservation period.      (b) startreserve: start date of reservation period.
     (c) uniqueperiod: start,end dates when slot is to be uniquely      (c) uniqueperiod: start,end dates when slot is to be uniquely
         selected.          selected.
   
Line 11749  future_reservable - ref to hash of stude Line 11083  future_reservable - ref to hash of stude
   
 sub get_future_slots {  sub get_future_slots {
     my ($cnum,$cdom,$now,$symb) = @_;      my ($cnum,$cdom,$now,$symb) = @_;
       my $map;
       if ($symb) {
           ($map) = &Apache::lonnet::decode_symb($symb);
       }
     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);      my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);      my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
     foreach my $slot (keys(%slots)) {      foreach my $slot (keys(%slots)) {
         next unless($slots{$slot}->{'type'} eq 'schedulable_student');          next unless($slots{$slot}->{'type'} eq 'schedulable_student');
         if ($symb) {          if ($symb) {
             next if (($slots{$slot}->{'symb'} ne '') &&               if ($slots{$slot}->{'symb'} ne '') {
                      ($slots{$slot}->{'symb'} ne $symb));                  my $canuse;
                   my %oksymbs;
                   my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
                   map { $oksymbs{$_} = 1; } @slotsymbs;
                   if ($oksymbs{$symb}) {
                       $canuse = 1;
                   } else {
                       foreach my $item (@slotsymbs) {
                           if ($item =~ /\.(page|sequence)$/) {
                               (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
                               if (($map ne '') && ($map eq $sloturl)) {
                                   $canuse = 1;
                                   last;
                               }
                           }
                       }
                   }
                   next unless ($canuse);
               }
         }          }
         if (($slots{$slot}->{'starttime'} > $now) &&          if (($slots{$slot}->{'starttime'} > $now) &&
             ($slots{$slot}->{'endtime'} > $now)) {              ($slots{$slot}->{'endtime'} > $now)) {
Line 11808  sub get_future_slots { Line 11164  sub get_future_slots {
                 $reservable_now{$slot} = {                  $reservable_now{$slot} = {
                                            symb       => $symb,                                             symb       => $symb,
                                            endreserve => $lastres,                                             endreserve => $lastres,
                                            uniqueperiod => $uniqueperiod,                                                uniqueperiod => $uniqueperiod,
                                          };                                           };
             } elsif (($startreserve > $now) &&              } elsif (($startreserve > $now) &&
                      (!$endreserve || $endreserve > $startreserve)) {                       (!$endreserve || $endreserve > $startreserve)) {
Line 11973  sub get_env_multiple { Line 11329  sub get_env_multiple {
     return(@values);      return(@values);
 }  }
   
   # Looks at given dependencies, and returns something depending on the context.
   # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
   # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
   # For all other contexts, returns ($output, $counter, $numpathchg).
   # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
   # $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
   # $numpathchg: integer with the number of cleaned up dependency paths.
   # \%existing: hash reference clean path -> 1 only for existing dependencies.
   # \%mapping: hash reference clean path -> original path for all dependencies.
   # @param {string} actionurl - The path to the handler, indicative of the context.
   # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
   # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
   # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
   # @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
   # @return {Array} - array depending on the context (not a reference)
 sub ask_for_embedded_content {  sub ask_for_embedded_content {
       # NOTE: documentation was added afterwards, it could be wrong
     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;      my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,      my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
         %currsubfile,%unused,$rem);          %currsubfile,%unused,$rem);
Line 11989  sub ask_for_embedded_content { Line 11361  sub ask_for_embedded_content {
     my $heading = &mt('Upload embedded files');      my $heading = &mt('Upload embedded files');
     my $buttontext = &mt('Upload');      my $buttontext = &mt('Upload');
   
       # fills these variables based on the context:
       # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
       # $path, $fileloc, $title, $rem, $filename
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         if ($actionurl eq '/adm/dependencies') {          if ($actionurl eq '/adm/dependencies') {
             $navmap = Apache::lonnavmaps::navmap->new();              $navmap = Apache::lonnavmaps::navmap->new();
Line 11996  sub ask_for_embedded_content { Line 11371  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 12028  sub ask_for_embedded_content { Line 11403  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 12073  sub ask_for_embedded_content { Line 11448  sub ask_for_embedded_content {
         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';          $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
         $fileloc =~ s{^/}{};          $fileloc =~ s{^/}{};
     }      }
       
       # parses the dependency paths to get some info
       # fills $newfiles, $mapping, $subdependencies, $dependencies
       # $newfiles: hash URL -> 1 for new files or external URLs
       # (will be completed later)
       # $mapping:
       #   for external URLs: external URL -> external URL
       #   for relative paths: clean path -> original path
       # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
       # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
     foreach my $file (keys(%{$allfiles})) {      foreach my $file (keys(%{$allfiles})) {
         my $embed_file;          my $embed_file;
         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {          if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
Line 12115  sub ask_for_embedded_content { Line 11500  sub ask_for_embedded_content {
             }              }
         }          }
     }      }
       
       # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
       # and lists
       # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
       # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
       # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
       #                                    the path had to be cleaned up
       # $existing: hash clean path -> 1 if the file exists
       # $numexisting: number of keys in $existing
       # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
       # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
       #                                      dependency subdirectories that are
       #                                      not listed as dependencies, with some exceptions using $rem
     my $dirptr = 16384;      my $dirptr = 16384;
     foreach my $path (keys(%subdependencies)) {      foreach my $path (keys(%subdependencies)) {
         $currsubfile{$path} = {};          $currsubfile{$path} = {};
         if (($actionurl eq '/adm/portfolio') ||          if (($actionurl eq '/adm/portfolio') || 
             ($actionurl eq '/adm/coursegrp_portfolio')) {               ($actionurl eq '/adm/coursegrp_portfolio')) {
             my ($sublistref,$listerror) =              my ($sublistref,$listerror) =
                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);                  &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
             if (ref($sublistref) eq 'ARRAY') {              if (ref($sublistref) eq 'ARRAY') {
Line 12190  sub ask_for_embedded_content { Line 11588  sub ask_for_embedded_content {
             }              }
         }          }
     }      }
       
       # fills $currfile, hash file name -> 1 or [$size,$mtime]
       # for files in $url or $fileloc (target directory) in some contexts
     my %currfile;      my %currfile;
     if (($actionurl eq '/adm/portfolio') ||      if (($actionurl eq '/adm/portfolio') ||
         ($actionurl eq '/adm/coursegrp_portfolio')) {          ($actionurl eq '/adm/coursegrp_portfolio')) {
Line 12228  sub ask_for_embedded_content { Line 11629  sub ask_for_embedded_content {
             }              }
         }          }
     }      }
       # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
       # are not in subdirectories, using $currfile
     foreach my $file (keys(%dependencies)) {      foreach my $file (keys(%dependencies)) {
         if (exists($currfile{$file})) {          if (exists($currfile{$file})) {
             unless ($mapping{$file} eq $file) {              unless ($mapping{$file} eq $file) {
Line 12256  sub ask_for_embedded_content { Line 11659  sub ask_for_embedded_content {
             $unused{$file} = 1;              $unused{$file} = 1;
         }          }
     }      }
       
       # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&      if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
         ($args->{'context'} eq 'paste')) {          ($args->{'context'} eq 'paste')) {
         $counter = scalar(keys(%existing));          $counter = scalar(keys(%existing));
         $numpathchg = scalar(keys(%pathchanges));          $numpathchg = scalar(keys(%pathchanges));
         return ($output,$counter,$numpathchg,\%existing);          return ($output,$counter,$numpathchg,\%existing);
     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&      } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {               (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
         $counter = scalar(keys(%existing));          $counter = scalar(keys(%existing));
         $numpathchg = scalar(keys(%pathchanges));          $numpathchg = scalar(keys(%pathchanges));
         return ($output,$counter,$numpathchg,\%existing,\%mapping);          return ($output,$counter,$numpathchg,\%existing,\%mapping);
     }      }
       
       # returns HTML otherwise, with dependency results and to ask for more uploads
       
       # $upload_output: missing dependencies (with upload form)
       # $modify_output: uploaded dependencies (in use)
       # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {      foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
         if ($actionurl eq '/adm/dependencies') {          if ($actionurl eq '/adm/dependencies') {
             next if ($embed_file =~ m{^\w+://});              next if ($embed_file =~ m{^\w+://});
Line 12490  sub ask_for_embedded_content { Line 11901  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 12509  sub clean_path { Line 11920  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 12848  sub modify_html_refs { Line 12259  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 12983  sub modify_html_refs { Line 12394  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 13509  sub process_decompression { Line 12920  sub process_decompression {
             }              }
             my $numskip = scalar(@to_skip);              my $numskip = scalar(@to_skip);
             my $numoverwrite = scalar(@to_overwrite);              my $numoverwrite = scalar(@to_overwrite);
             if (($numskip) && (!$numoverwrite)) {              if (($numskip) && (!$numoverwrite)) { 
                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');                           $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
             } elsif ($dir eq '') {              } elsif ($dir eq '') {
                 $error = &mt('Directory containing archive file unavailable.');                  $error = &mt('Directory containing archive file unavailable.');
Line 13519  sub process_decompression { Line 12930  sub process_decompression {
                     my $tempdir = time.'_'.$$.int(rand(10000));                      my $tempdir = time.'_'.$$.int(rand(10000));
                     mkdir("$dir/$tempdir",0755);                      mkdir("$dir/$tempdir",0755);
                     if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {                      if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
                         ($decompressed,$display) =                          ($decompressed,$display) = 
                             &decompress_uploaded_file($file,"$dir/$tempdir");                              &decompress_uploaded_file($file,"$dir/$tempdir");
                         foreach my $item (@to_skip) {                          foreach my $item (@to_skip) {
                             if (($item ne '') && ($item !~ /\.\./)) {                              if (($item ne '') && ($item !~ /\.\./)) {
                                 if (-f "$dir/$tempdir/$item") {                                  if (-f "$dir/$tempdir/$item") { 
                                     unlink("$dir/$tempdir/$item");                                      unlink("$dir/$tempdir/$item");
                                 } elsif (-d "$dir/$tempdir/$item") {                                  } elsif (-d "$dir/$tempdir/$item") {
                                     &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });                                      &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
Line 13563  sub process_decompression { Line 12974  sub process_decompression {
                     if (ref($newdirlistref) eq 'ARRAY') {                      if (ref($newdirlistref) eq 'ARRAY') {
                         foreach my $dir_line (@{$newdirlistref}) {                          foreach my $dir_line (@{$newdirlistref}) {
                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);                              my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                             unless (($item =~ /^\.+$/) || ($item eq $file)) {                               unless (($item =~ /^\.+$/) || ($item eq $file)) {
                                 push(@newitems,$item);                                  push(@newitems,$item);
                                 if ($dirptr&$testdir) {                                  if ($dirptr&$testdir) {
                                     $is_dir{$item} = 1;                                      $is_dir{$item} = 1;
Line 13618  sub process_decompression { Line 13029  sub process_decompression {
                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};                                      $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                                     $displayed{'folder'} = $i;                                      $displayed{'folder'} = $i;
                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||                                  } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {                                           (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
                                     $env{'form.archive_'.$i} = 'display';                                      $env{'form.archive_'.$i} = 'display';
                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};                                      $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                                     $displayed{'web'} = $i;                                      $displayed{'web'} = $i;
Line 14070  sub process_extracted_files { Line 13481  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 14151  sub process_extracted_files { Line 13562  sub process_extracted_files {
                             $newseqid{$i} = $newidx;                              $newseqid{$i} = $newidx;
                             unless ($errtext) {                              unless ($errtext) {
                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',                                  $result .=  '<li>'.&mt('Folder: [_1] added to course',
                                                        &HTML::Entities::encode($docstitle,'<>&"'))..                                                         &HTML::Entities::encode($docstitle,'<>&"')).
                                             '</li>'."\n";                                              '</li>'."\n";
                             }                              }
                         }                          }
Line 14161  sub process_extracted_files { Line 13572  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/) &&                              if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
                                 (($mapinner{$outer} eq 'default') || ($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);
                                 }                                  }
Line 14178  sub process_extracted_files { Line 13587  sub process_extracted_files {
                                             $fetch =~ s/^\Q$prefix$dir\E//;                                              $fetch =~ s/^\Q$prefix$dir\E//;
                                             $prompttofetch{$fetch} = 1;                                              $prompttofetch{$fetch} = 1;
                                         }                                          }
                                    }                                      }
                                 }                                  }
                                 $LONCAPA::map::resources[$newidx]=                                  $LONCAPA::map::resources[$newidx]=
                                     $docstitle.':'.$url.':false:normal:res';                                      $docstitle.':'.$url.':false:normal:res';
Line 14203  sub process_extracted_files { Line 13612  sub process_extracted_files {
                 }                  }
             } else {              } else {
                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',                  $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                                 &HTML::Entities::encode($path,'<>&"')).'<br />';                                  &HTML::Entities::encode($path,'<>&"')).'<br />'; 
             }              }
         }          }
         for (my $i=1; $i<=$numitems; $i++) {          for (my $i=1; $i<=$numitems; $i++) {
Line 14225  sub process_extracted_files { Line 13634  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 14274  sub process_extracted_files { Line 13683  sub process_extracted_files {
                                     $showpath = "$relpath/$title";                                      $showpath = "$relpath/$title";
                                 } else {                                  } else {
                                     $showpath = "/$title";                                      $showpath = "/$title";
                                 }                                  } 
                                 $result .= '<li>'.&mt('[_1] included as a dependency',                                  $result .= '<li>'.&mt('[_1] included as a dependency',
                                                       &HTML::Entities::encode($showpath,'<>&"')).                                                        &HTML::Entities::encode($showpath,'<>&"')).
                                            '</li>'."\n";                                             '</li>'."\n";
                                 unless ($ishome) {                                  unless ($ishome) {
                                     my $fetch = "$fullpath/$title";                                      my $fetch = "$fullpath/$title";
                                     $fetch =~ s/^\Q$prefix$dir\E//;                                      $fetch =~ s/^\Q$prefix$dir\E//; 
                                     $prompttofetch{$fetch} = 1;                                      $prompttofetch{$fetch} = 1;
                                 }                                  }
                             }                              }
Line 15496  generated by lonerrorhandler.pm, CHECKRP Line 14905  generated by lonerrorhandler.pm, CHECKRP
 lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.  lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
   
 Inputs:  Inputs:
 defmail (scalar - email address of default recipient),  defmail (scalar - email address of default recipient), 
 mailing type (scalar: errormail, packagesmail, helpdeskmail,  mailing type (scalar: errormail, packagesmail, helpdeskmail,
 requestsmail, updatesmail, or idconflictsmail).  requestsmail, updatesmail, or idconflictsmail).
   
 defdom (domain for which to retrieve configuration settings),  defdom (domain for which to retrieve configuration settings),
   
 origmail (scalar - email address of recipient from loncapa.conf,  origmail (scalar - email address of recipient from loncapa.conf, 
 i.e., predates configuration by DC via domainprefs.pm  i.e., predates configuration by DC via domainprefs.pm
   
 $requname username of requester (if mailing type is helpdeskmail)  $requname username of requester (if mailing type is helpdeskmail)
Line 15511  $requdom domain of requester (if mailing Line 14920  $requdom domain of requester (if mailing
   
 $reqemail e-mail address of requester (if mailing type is helpdeskmail)  $reqemail e-mail address of requester (if mailing type is helpdeskmail)
   
   
 Returns: comma separated list of addresses to which to send e-mail.  Returns: comma separated list of addresses to which to send e-mail.
   
 =back  =back
Line 15754  sub build_recipient_list { Line 15164  sub build_recipient_list {
   
 =pod  =pod
   
   =over 4
   
   =item * &mime_email()
   
   Sends an email with a possible attachment
   
   Inputs:
   
   =over 4
   
   from -              Sender's email address
   
   to -                Email address of recipient
   
   subject -           Subject of email
   
   body -              Body of email
   
   cc_string -         Carbon copy email address
   
   bcc -               Blind carbon copy email address
   
   type -              File type of attachment
   
   attachment_path -   Path of file to be attached
   
   file_name -         Name of file to be attached
   
   attachment_text -   The body of an attachment of type "TEXT"
   
   =back
   
   =back
   
   =cut
   
   ############################################################
   ############################################################
   
   sub mime_email {
       my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, 
           $file_name, $attachment_text) = @_;
       my $msg = MIME::Lite->new(
                From    => $from,
                To      => $to,
                Subject => $subject,
                Type    =>'TEXT',
                Data    => $body,
                );
       if ($cc_string ne '') {
           $msg->add("Cc" => $cc_string);
       }
       if ($bcc ne '') {
           $msg->add("Bcc" => $bcc);
       }
       $msg->attr("content-type"         => "text/plain");
       $msg->attr("content-type.charset" => "UTF-8");
       # Attach file if given
       if ($attachment_path) {
           unless ($file_name) {
               if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
           }
           my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
           $msg->attach(Type     => $type,
                        Path     => $attachment_path,
                        Filename => $file_name
                        );
       # Otherwise attach text if given
       } elsif ($attachment_text) {
           $msg->attach(Type => 'TEXT',
                        Data => $attachment_text);
       }
       # Send it
       $msg->send('sendmail');
   }
   
   ############################################################
   ############################################################
   
   =pod
   
 =head1 Course Catalog Routines  =head1 Course Catalog Routines
   
 =over 4  =over 4
Line 15858  sub extract_categories { Line 15349  sub extract_categories {
                     $trailstr = &mt('Official courses (with institutional codes)');                      $trailstr = &mt('Official courses (with institutional codes)');
                 } elsif ($name eq 'communities') {                  } elsif ($name eq 'communities') {
                     $trailstr = &mt('Communities');                      $trailstr = &mt('Communities');
                   } elsif ($name eq 'placement') {
                       $trailstr = &mt('Placement Tests');
                 } else {                  } else {
                     $trailstr = $name;                      $trailstr = $name;
                 }                  }
Line 16007  sub assign_categories_table { Line 15500  sub assign_categories_table {
                     next if ($parent eq 'instcode');                      next if ($parent eq 'instcode');
                     if ($type eq 'Community') {                      if ($type eq 'Community') {
                         next unless ($parent eq 'communities');                          next unless ($parent eq 'communities');
                       } elsif ($type eq 'Placement') {
                           next unless ($parent eq 'placement');
                     } else {                      } else {
                         next if ($parent eq 'communities');                          next if (($parent eq 'communities') || ($parent eq 'placement'));
                     }                      }
                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';                      my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                     my $item = &escape($parent).'::0';                      my $item = &escape($parent).'::0';
Line 16021  sub assign_categories_table { Line 15516  sub assign_categories_table {
                     my $parent_title = $parent;                      my $parent_title = $parent;
                     if ($parent eq 'communities') {                      if ($parent eq 'communities') {
                         $parent_title = &mt('Communities');                          $parent_title = &mt('Communities');
                       } elsif ($parent eq 'placement') {
                           $parent_title = &mt('Placement Tests');
                     }                      }
                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.                      $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                               '<input type="checkbox" name="usecategory" value="'.                                '<input type="checkbox" name="usecategory" value="'.
Line 16202  sub commit_studentrole { Line 15699  sub commit_studentrole {
                 }                  }
                 $oldsecurl = $uurl;                  $oldsecurl = $uurl;
                 $expire_role_result =                   $expire_role_result = 
                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','','',$context);                      &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
                 if ($env{'request.course.sec'} ne '') {                   if ($env{'request.course.sec'} ne '') { 
                     if ($expire_role_result eq 'refused') {                      if ($expire_role_result eq 'refused') {
                         my @roles = ('st');                          my @roles = ('st');
Line 16251  sub commit_studentrole { Line 15748  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 16314  sub check_clone { Line 15811  sub check_clone {
     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};      my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);      my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);      my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
     my $clonetitle;      my $clonemsg;
     my @clonemsg;  
     my $can_clone = 0;      my $can_clone = 0;
     my $lctype = lc($args->{'crstype'});      my $lctype = lc($args->{'crstype'});
     if ($lctype ne 'community') {      if ($lctype ne 'community') {
Line 16323  sub check_clone { Line 15819  sub check_clone {
     }      }
     if ($clonehome eq 'no_host') {      if ($clonehome eq 'no_host') {
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             push(@clonemsg,({              $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                               mt => 'No new community created.',  
                               args => [],  
                             },  
                             {  
                               mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',  
                               args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],  
                             }));  
         } else {          } else {
             push(@clonemsg,({              $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                               mt => 'No new course created.',          }     
                               args => [],  
                             },  
                             {  
                               mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',  
                               args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],  
                             }));  
         }  
     } else {      } else {
  my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});   my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
         $clonetitle = $clonedesc{'description'};  
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             if ($clonedesc{'type'} ne 'Community') {              if ($clonedesc{'type'} ne 'Community') {
                 push(@clonemsg,({                  $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                                   mt => 'No new community created.',                  return ($can_clone, $clonemsg, $cloneid, $clonehome);
                                   args => [],  
                                 },  
                                 {  
                                   mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',  
                                   args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],  
                                 }));  
                 return ($can_clone,\@clonemsg,$cloneid,$clonehome);  
             }              }
         }          }
  if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&   if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
Line 16371  sub check_clone { Line 15845  sub check_clone {
                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {                              if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                                 $can_clone = 1;                                  $can_clone = 1;
                             }                              }
                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&                          } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {                                   ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},                              if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {                                                                            $clonehash{'internal.coursecode'},$args->{'crscode'})) {
Line 16390  sub check_clone { Line 15864  sub check_clone {
                     $can_clone = 1;                      $can_clone = 1;
                 }                  }
                 unless ($can_clone) {                  unless ($can_clone) {
                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&                      if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {                          ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                         my (%gotdomdefaults,%gotcodedefaults);                          my (%gotdomdefaults,%gotcodedefaults);
                         foreach my $cloner (@cloners) {                          foreach my $cloner (@cloners) {
Line 16429  sub check_clone { Line 15903  sub check_clone {
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     $ccrole = 'co';                      $ccrole = 'co';
                 }                  }
                 my %roleshash =          my %roleshash =
                     &Apache::lonnet::get_my_roles($args->{'ccuname'},      &Apache::lonnet::get_my_roles($args->{'ccuname'},
                                                   $args->{'ccdomain'},            $args->{'ccdomain'},
                                                   'userroles',['active'],[$ccrole],                                                    'userroles',['active'],[$ccrole],
                                                   [$args->{'clonedomain'}]);            [$args->{'clonedomain'}]);
                 if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {          if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                     $can_clone = 1;                      $can_clone = 1;
                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},                  } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                                                           $args->{'ccuname'},$args->{'ccdomain'})) {                                                            $args->{'ccuname'},$args->{'ccdomain'})) {
Line 16443  sub check_clone { Line 15917  sub check_clone {
             }              }
             unless ($can_clone) {              unless ($can_clone) {
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     push(@clonemsg,({                      $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'});
                                       mt => 'No new community created.',  
                                       args => [],  
                                     },  
                                     {  
                                       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 => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],  
                                     }));  
                 } else {                  } else {
                     push(@clonemsg,({                      $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'});
                                       mt => 'No new course created.',                  }
                                       args => [],  
                                     },  
                                     {  
                                       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 => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],  
                                     }));  
         }  
     }      }
         }          }
     }      }
     return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);      return ($can_clone, $clonemsg, $cloneid, $clonehome);
 }  }
   
 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,$coderef,$callercontext,$user_lh) = @_;          $cnum,$category,$coderef) = @_;
     my ($outcome,$msgref,$clonemsgref);      my $outcome;
     my $linefeed =  '<br />'."\n";      my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {      if ($context eq 'auto') {
         $linefeed = "\n";          $linefeed = "\n";
Line 16479  sub construct_course { Line 15939  sub construct_course {
 #  #
 # Are we cloning?  # Are we cloning?
 #  #
     my ($can_clone,$cloneid,$clonehome,$clonetitle);      my ($can_clone, $clonemsg, $cloneid, $clonehome);
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {      if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
  ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);   ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
    if ($context ne 'auto') {
               if ($clonemsg ne '') {
           $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
               }
    }
    $outcome .= $clonemsg.$linefeed;
   
         if (!$can_clone) {          if (!$can_clone) {
     return (0,$outcome,$clonemsgref);      return (0,$outcome);
  }   }
     }      }
   
 #  #
 # Open course  # Open course
 #  #
     my $crstype = lc($args->{'crstype'});      my $showncrstype;
       if ($args->{'crstype'} eq 'Placement') {
           $showncrstype = 'placement test'; 
       } else {  
           $showncrstype = lc($args->{'crstype'});
       }
     my %cenv=();      my %cenv=();
     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},      $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                                              $args->{'cdescr'},                                               $args->{'cdescr'},
Line 16501  sub construct_course { Line 15973  sub construct_course {
                                              $args->{'ccuname'}.':'.                                               $args->{'ccuname'}.':'.
                                              $args->{'ccdomain'},                                               $args->{'ccdomain'},
                                              $args->{'crstype'},                                               $args->{'crstype'},
                                              $cnum,$context,$category,                                               $cnum,$context,$category);
                                              $callercontext);  
   
     # Note: The testing routines depend on this being output; see       # Note: The testing routines depend on this being output; see 
     # Utils::Course. This needs to at least be output as a comment      # Utils::Course. This needs to at least be output as a comment
     # if anyone ever decides to not show this, and Utils::Course::new      # if anyone ever decides to not show this, and Utils::Course::new
     # will need to be suitably modified.      # will need to be suitably modified.
     if (($callercontext eq 'auto') && ($user_lh ne '')) {      $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
         $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;  
     } else {  
         $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;  
     }  
     if ($$courseid =~ /^error:/) {      if ($$courseid =~ /^error:/) {
         return (0,$outcome,$clonemsgref);          return (0,$outcome);
     }      }
   
 #  #
Line 16523  sub construct_course { Line 15990  sub construct_course {
     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);      ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);      my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
     if ($crsuhome eq 'no_host') {      if ($crsuhome eq 'no_host') {
         if (($callercontext eq 'auto') && ($user_lh ne '')) {          $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
             $outcome .= &mt_user($user_lh,          return (0,$outcome);
                             'Course creation failed, unrecognized course home server.');  
         } else {  
             $outcome .= &mt('Course creation failed, unrecognized course home server.');  
         }  
         $outcome .= $linefeed;  
         return (0,$outcome,$clonemsgref);  
     }      }
     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;      $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
   
 #  #
 # Do the cloning  # Do the cloning
 #  #   
     my @clonemsg;  
     if ($can_clone && $cloneid) {      if ($can_clone && $cloneid) {
         push(@clonemsg,   $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
                       {   if ($context ne 'auto') {
                           mt => 'Created [_1] by cloning from [_2]',      $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                           args => [$crstype,$clonetitle],   }
                       });   $outcome .= $clonemsg.$linefeed;
  my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);   my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
 # Copy all files  # Copy all files
         my @info =   &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
             &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},  
                                                      $args->{'dateshift'},$args->{'crscode'},  
                                                      $args->{'ccuname'}.':'.$args->{'ccdomain'},  
                                                      $args->{'tinyurls'});  
         if (@info) {  
             push(@clonemsg,@info);  
         }  
 # Restore URL  # Restore URL
  $cenv{'url'}=$oldcenv{'url'};   $cenv{'url'}=$oldcenv{'url'};
 # Restore title  # Restore title
Line 16578  sub construct_course { Line 16031  sub construct_course {
                    'plc.users.denied',                     'plc.users.denied',
                    'hidefromcat',                     'hidefromcat',
                    'checkforpriv',                     'checkforpriv',
                    'categories'],                     'categories',
                      'internal.uniquecode'],
                    $$crsudom,$$crsunum);                     $$crsudom,$$crsunum);
         if ($args->{'textbook'}) {          if ($args->{'textbook'}) {
             $cenv{'internal.textbook'} = $args->{'textbook'};              $cenv{'internal.textbook'} = $args->{'textbook'};
Line 16593  sub construct_course { Line 16047  sub construct_course {
     if ($args->{'crstype'}) {      if ($args->{'crstype'}) {
         $cenv{'type'}=$args->{'crstype'};          $cenv{'type'}=$args->{'crstype'};
     }      }
     if ($args->{'lti'}) {  
         $cenv{'internal.lti'}=$args->{'lti'};  
     }  
     if ($args->{'crsid'}) {      if ($args->{'crsid'}) {
         $cenv{'courseid'}=$args->{'crsid'};          $cenv{'courseid'}=$args->{'crsid'};
     }      }
Line 16617  sub construct_course { Line 16068  sub construct_course {
         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};          $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
     }      }
     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.      my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
     my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.  
     if ($args->{'crssections'}) {      if ($args->{'crssections'}) {
         $cenv{'internal.sectionnums'} = '';          $cenv{'internal.sectionnums'} = '';
         if ($args->{'crssections'} =~ m/,/) {          if ($args->{'crssections'} =~ m/,/) {
Line 16631  sub construct_course { Line 16081  sub construct_course {
                 my $class = $args->{'crscode'}.$sec;                  my $class = $args->{'crscode'}.$sec;
                 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.',';
                 if ($addcheck eq 'ok') {                  unless ($addcheck eq 'ok') {
                     unless (grep(/^\Q$gp\E$/,@oklcsecs)) {  
                         push(@oklcsecs,$gp);  
                     }  
                 } else {  
                     push(@badclasses,$class);                      push(@badclasses,$class);
                 }                  }
             }              }
Line 16663  sub construct_course { Line 16109  sub construct_course {
                 my ($xl,$gp) = split/:/,$item;                  my ($xl,$gp) = split/:/,$item;
                 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.',';
                 if ($addcheck eq 'ok') {                  unless ($addcheck eq 'ok') {
                     unless (grep(/^\Q$gp\E$/,@oklcsecs)) {  
                         push(@oklcsecs,$gp);  
                     }  
                 } else {  
                     push(@badclasses,$xl);                      push(@badclasses,$xl);
                 }                  }
             }              }
Line 16725  sub construct_course { Line 16167  sub construct_course {
             $outcome .= $linefeed;              $outcome .= $linefeed;
         } else {          } else {
             $outcome .= "</ul><br /><br /></div>\n";              $outcome .= "</ul><br /><br /></div>\n";
         }          } 
     }      }
     if ($args->{'no_end_date'}) {      if ($args->{'no_end_date'}) {
         $args->{'endaccess'} = 0;          $args->{'endaccess'} = 0;
     }      }
 #  If an official course with institutional sections is created by cloning  
 #  an existing course, section-specific hiding of course totals in student's  
 #  view of grades as copied from cloned course, will be checked for valid  
 #  sections.  
     if (($can_clone && $cloneid) &&  
         ($cenv{'internal.coursecode'} ne '') &&  
         ($cenv{'grading'} eq 'standard') &&  
         ($cenv{'hidetotals'} ne '') &&  
         ($cenv{'hidetotals'} ne 'all')) {  
         my @hidesecs;  
         my $deletehidetotals;  
         if (@oklcsecs) {  
             foreach my $sec (split(/,/,$cenv{'hidetotals'})) {  
                 if (grep(/^\Q$sec$/,@oklcsecs)) {  
                     push(@hidesecs,$sec);  
                 }  
             }  
             if (@hidesecs) {  
                 $cenv{'hidetotals'} = join(',',@hidesecs);  
             } else {  
                 $deletehidetotals = 1;  
             }  
         } else {  
             $deletehidetotals = 1;  
         }  
         if ($deletehidetotals) {  
             delete($cenv{'hidetotals'});  
             &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);  
         }  
     }  
     $cenv{'internal.autostart'}=$args->{'enrollstart'};      $cenv{'internal.autostart'}=$args->{'enrollstart'};
     $cenv{'internal.autoend'}=$args->{'enrollend'};      $cenv{'internal.autoend'}=$args->{'enrollend'};
     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};      $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
Line 16824  sub construct_course { Line 16236  sub construct_course {
             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {              if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;                  $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');                  my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
             }              } 
             if (ref($coderef)) {              if (ref($coderef)) {
                 $$coderef = $code;                  $$coderef = $code;
             }              }
Line 16861  sub construct_course { Line 16273  sub construct_course {
 # Open all assignments  # Open all assignments
 #  #
     if ($args->{'openall'}) {      if ($args->{'openall'}) {
        my $opendate = time;  
        if ($args->{'openallfrom'} =~ /^\d+$/) {  
            $opendate = $args->{'openallfrom'};  
        }  
        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';         my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
        my %storecontent = ($storeunder         => $opendate,         my %storecontent = ($storeunder         => time,
                            $storeunder.'.type' => 'date_start');                             $storeunder.'.type' => 'date_start');
        $outcome .= &mt('All assignments open starting [_1]',         
                        &Apache::lonlocal::locallocaltime($opendate)).': '.         $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
                    &Apache::lonnet::cput                   ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
                        ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;  
    }     }
 #  #
 # Set first page  # Set first page
 #  #
     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')      unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
     || ($cloneid)) {      || ($cloneid)) {
    use LONCAPA::map;
  $outcome .= &mt('Setting first resource').': ';   $outcome .= &mt('Setting first resource').': ';
   
  my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';   my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
Line 16900  sub construct_course { Line 16308  sub construct_course {
         $outcome .= ($fatal?$errtext:'write ok').$linefeed;          $outcome .= ($fatal?$errtext:'write ok').$linefeed;
     }      }
   
     return (1,$outcome,\@clonemsg);  # 
   # Set params for Placement Tests
   #
       if ($args->{'crstype'} eq 'Placement') {
          my %storecontent; 
          my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
          my %defaults = (
                           buttonshide   => { value => 'yes',
                                              type => 'string_yesno',},
                           type          => { value => 'randomizetry',
                                              type  => 'string_questiontype',},
                           maxtries      => { value => 1,
                                              type => 'int_pos',},
                           problemstatus => { value => 'no',
                                              type  => 'string_problemstatus',},
                         );
          foreach my $key (keys(%defaults)) {
              $storecontent{$prefix.$key} = $defaults{$key}{'value'};
              $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
          }
          &Apache::lonnet::cput
                    ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
       }
   
       return (1,$outcome);
 }  }
   
 sub make_unique_code {  sub make_unique_code {
Line 16913  sub make_unique_code { Line 16345  sub make_unique_code {
     my $tries = 0;      my $tries = 0;
     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);      my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
     my ($code,$error);      my ($code,$error);
     
     while (($gotlock ne 'ok') && ($tries<3)) {      while (($gotlock ne 'ok') && ($tries<3)) {
         $tries ++;          $tries ++;
         sleep 1;          sleep 1;
Line 16960  sub generate_code { Line 16392  sub generate_code {
 ############################################################  ############################################################
 ############################################################  ############################################################
   
 #SD  # Community, Course and Placement Test
 # only Community and Course, or anything else?  
 sub course_type {  sub course_type {
     my ($cid) = @_;      my ($cid) = @_;
     if (!defined($cid)) {      if (!defined($cid)) {
Line 16979  sub group_term { Line 16410  sub group_term {
     my %names = (      my %names = (
                   'Course' => 'group',                    'Course' => 'group',
                   'Community' => 'group',                    'Community' => 'group',
                     'Placement' => 'group',
                 );                  );
     return $names{$crstype};      return $names{$crstype};
 }  }
   
 sub course_types {  sub course_types {
     my @types = ('official','unofficial','community','textbook','lti');      my @types = ('official','unofficial','community','textbook','placement','lti');
     my %typename = (      my %typename = (
                          official   => 'Official course',                           official   => 'Official course',
                          unofficial => 'Unofficial course',                           unofficial => 'Unofficial course',
                          community  => 'Community',                           community  => 'Community',
                          textbook   => 'Textbook course',                           textbook   => 'Textbook course',
                            placement  => 'Placement test',
                          lti        => 'LTI provider',                           lti        => 'LTI provider',
                    );                     );
     return (\@types,\%typename);      return (\@types,\%typename);
Line 17095  sub init_user_environment { Line 16528  sub init_user_environment {
   
     my $public=($username eq 'public' && $domain eq 'public');      my $public=($username eq 'public' && $domain eq 'public');
   
 # See if old ID present, if so, remove  
   
     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);      my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
     my $now=time;      my $now=time;
   
Line 17118  sub init_user_environment { Line 16549  sub init_user_environment {
  }   }
  if (!$cookie) { $cookie="publicuser_$oldest"; }   if (!$cookie) { $cookie="publicuser_$oldest"; }
     } else {      } else {
  # if this isn't a robot, kill any existing non-robot sessions   # See if old ID present, if so, remove if this isn't a robot,
    # killing any existing non-robot sessions
  if (!$args->{'robot'}) {   if (!$args->{'robot'}) {
     opendir(DIR,$lonids);      opendir(DIR,$lonids);
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
Line 17174  sub init_user_environment { Line 16606  sub init_user_environment {
   
     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);      my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
     my ($tmp) = keys(%userenv);      my ($tmp) = keys(%userenv);
     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {      if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
     } else {  
  undef(%userenv);   undef(%userenv);
     }      }
     if (($userenv{'interface'}) && (!$form->{'interface'})) {      if (($userenv{'interface'}) && (!$form->{'interface'})) {
Line 17190  sub init_user_environment { Line 16621  sub init_user_environment {
 # --------------------------------------------------------- Write first profile  # --------------------------------------------------------- Write first profile
   
     {      {
         my $ip = &Apache::lonnet::get_requestor_ip();  
  my %initial_env =    my %initial_env = 
     ("user.name"          => $username,      ("user.name"          => $username,
      "user.domain"        => $domain,       "user.domain"        => $domain,
Line 17209  sub init_user_environment { Line 16639  sub init_user_environment {
      "request.course.sec" => '',       "request.course.sec" => '',
      "request.role"       => 'cm',       "request.role"       => 'cm',
      "request.role.adv"   => $env{'user.adv'},       "request.role.adv"   => $env{'user.adv'},
      "request.host"       => $ip,);       "request.host"       => $ENV{'REMOTE_ADDR'},);
   
         if ($form->{'localpath'}) {          if ($form->{'localpath'}) {
     $initial_env{"browser.localpath"}  = $form->{'localpath'};      $initial_env{"browser.localpath"}  = $form->{'localpath'};
Line 17241  sub init_user_environment { Line 16671  sub init_user_environment {
             my %is_adv = ( is_adv => $env{'user.adv'} );              my %is_adv = ( is_adv => $env{'user.adv'} );
             my %domdef = &Apache::lonnet::get_domain_defaults($domain);              my %domdef = &Apache::lonnet::get_domain_defaults($domain);
   
             foreach my $tool ('aboutme','blog','webdav','portfolio','timezone') {              foreach my $tool ('aboutme','blog','webdav','portfolio') {
                 $userenv{'availabletools.'.$tool} =                   $userenv{'availabletools.'.$tool} = 
                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',                      &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                                                       undef,\%userenv,\%domdef,\%is_adv);                                                        undef,\%userenv,\%domdef,\%is_adv);
             }              }
   
             foreach my $crstype ('official','unofficial','community','textbook','lti') {              foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
                 $userenv{'canrequest.'.$crstype} =                  $userenv{'canrequest.'.$crstype} =
                     &Apache::lonnet::usertools_access($username,$domain,$crstype,                      &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                       'reload','requestcourses',                                                        'reload','requestcourses',
                                                       \%userenv,\%domdef,\%is_adv);                                                        \%userenv,\%domdef,\%is_adv);
             }              }
   
             if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&  
                 (exists($userroles->{"user.role.au./$domain/"}))) {  
                 if ($userenv{'authoreditors'}) {  
                     $userenv{'editors'} = $userenv{'authoreditors'};  
                 } elsif ($domdef{'editors'} ne '') {  
                     $userenv{'editors'} = $domdef{'editors'};  
                 } else {  
                     $userenv{'editors'} = 'edit,xml';  
                 }  
             }  
   
             $userenv{'canrequest.author'} =              $userenv{'canrequest.author'} =
                 &Apache::lonnet::usertools_access($username,$domain,'requestauthor',                  &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                                                   'reload','requestauthor',                                                    'reload','requestauthor',
Line 17272  sub init_user_environment { Line 16691  sub init_user_environment {
             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],              my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                                                  $domain,$username);                                                   $domain,$username);
             my $reqstatus = $reqauthor{'author_status'};              my $reqstatus = $reqauthor{'author_status'};
             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {              if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                 if (ref($reqauthor{'author'}) eq 'HASH') {                  if (ref($reqauthor{'author'}) eq 'HASH') {
                     $userenv{'requestauthorqueued'} = $reqstatus.':'.                      $userenv{'requestauthorqueued'} = $reqstatus.':'.
                                                       $reqauthor{'author'}{'timestamp'};                                                        $reqauthor{'author'}{'timestamp'};
                 }                  }
             }              }
               my ($types,$typename) = &course_types();
               if (ref($types) eq 'ARRAY') {
                   my @options = ('approval','validate','autolimit');
                   my $optregex = join('|',@options);
                   my (%willtrust,%trustchecked);
                   foreach my $type (@{$types}) {
                       my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
                       if ($dom_str ne '') {
                           my $updatedstr = '';
                           my @possdomains = split(',',$dom_str);
                           foreach my $entry (@possdomains) {
                               my ($extdom,$extopt) = split(':',$entry);
                               unless ($trustchecked{$extdom}) {
                                   $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
                                   $trustchecked{$extdom} = 1;
                               }
                               if ($willtrust{$extdom}) {
                                   $updatedstr .= $entry.',';
                               }
                           }
                           $updatedstr =~ s/,$//;
                           if ($updatedstr) {
                               $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
                           } else {
                               delete($userenv{'reqcrsotherdom.'.$type});
                           }
                       }
                   }
               }
         }          }
   
  $env{'user.environment'} = "$lonids/$cookie.id";   $env{'user.environment'} = "$lonids/$cookie.id";
   
  if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",   if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
Line 17383  and quotacheck.pl Line 16830  and quotacheck.pl
   
 Inputs:  Inputs:
   
 filterlist - anonymous array of fields to include as potential filters  filterlist - anonymous array of fields to include as potential filters 
   
 crstype - course type  crstype - course type
   
 roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used  roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
               to pop-open a course selector (will contain "extra element").                to pop-open a course selector (will contain "extra element"). 
   
 multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1  multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
   
Line 17404  cloneruname - username of owner of new c Line 16851  cloneruname - username of owner of new c
   
 clonerudom - domain of owner of new course who wants to clone  clonerudom - domain of owner of new course who wants to clone
   
 typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)  typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
   
 codetitlesref - reference to array of titles of components in institutional codes (official courses)  codetitlesref - reference to array of titles of components in institutional codes (official courses)
   
 codedom - domain  codedom - domain
   
 formname - value of form element named "form".  formname - value of form element named "form". 
   
 fixeddom - domain, if fixed.  fixeddom - domain, if fixed.
   
 prevphase - value to assign to form element named "phase" when going back to the previous screen  prevphase - value to assign to form element named "phase" when going back to the previous screen  
   
 cnameelement - name of form element in form on opener page which will receive title of selected course  cnameelement - name of form element in form on opener page which will receive title of selected course 
   
 cnumelement - name of form element in form on opener page which will receive courseID  of selected course  cnumelement - name of form element in form on opener page which will receive courseID  of selected course
   
Line 17507  sub build_filters { Line 16954  sub build_filters {
         $createdfilterform = &timebased_select_form('createdfilter',$filter);          $createdfilterform = &timebased_select_form('createdfilter',$filter);
     }      }
   
       my $prefix = $crstype;
       if ($crstype eq 'Placement') {
           $prefix = 'Placement Test'
       }
     my %lt = &Apache::lonlocal::texthash(      my %lt = &Apache::lonlocal::texthash(
                 'cac' => "$crstype Activity",                  'cac' => "$prefix Activity",
                 'ccr' => "$crstype Created",                  'ccr' => "$prefix Created",
                 'cde' => "$crstype Title",                  'cde' => "$prefix Title",
                 'cdo' => "$crstype Domain",                  'cdo' => "$prefix Domain",
                 'ins' => 'Institutional Code',                  'ins' => 'Institutional Code',
                 'inc' => 'Institutional Categorization',                  'inc' => 'Institutional Categorization',
                 'cow' => "$crstype Owner/Co-owner",                  'cow' => "$prefix Owner/Co-owner",
                 'cop' => "$crstype Personnel Includes",                  'cop' => "$prefix Personnel Includes",
                 'cog' => 'Type',                  'cog' => 'Type',
              );               );
   
Line 17523  sub build_filters { Line 16974  sub build_filters {
         my $typeval = 'Course';          my $typeval = 'Course';
         if ($crstype eq 'Community') {          if ($crstype eq 'Community') {
             $typeval = 'Community';              $typeval = 'Community';
           } elsif ($crstype eq 'Placement') {
               $typeval = 'Placement';
         }          }
         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';          $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
     } else {      } else {
Line 17531  sub build_filters { Line 16984  sub build_filters {
             $typeselectform .= ' onchange="'.$onchange.'"';              $typeselectform .= ' onchange="'.$onchange.'"';
         }          }
         $typeselectform .= '>'."\n";          $typeselectform .= '>'."\n";
         foreach my $posstype ('Course','Community') {          foreach my $posstype ('Course','Community','Placement') {
               my $shown;
               if ($posstype eq 'Placement') {
                   $shown = &mt('Placement Test');
               } else {
                   $shown = &mt($posstype);
               }
             $typeselectform.='<option value="'.$posstype.'"'.              $typeselectform.='<option value="'.$posstype.'"'.
                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";                  ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
         }          }
         $typeselectform.="</select>";          $typeselectform.="</select>";
     }      }
Line 17558  sub build_filters { Line 17017  sub build_filters {
         if (exists($filter->{'instcodefilter'})) {          if (exists($filter->{'instcodefilter'})) {
 #            if (($fixeddom) || ($formname eq 'requestcrs') ||  #            if (($fixeddom) || ($formname eq 'requestcrs') ||
 #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {  #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
             if ($codedom) {              if ($codedom) { 
                 $officialjs = 1;                  $officialjs = 1;
                 ($instcodeform,$jscript,$$numtitlesref) =                  ($instcodeform,$jscript,$$numtitlesref) =
                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',                      &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
Line 17687  $typeelement Line 17146  $typeelement
     return $jscript.$clonewarning.$output;      return $jscript.$clonewarning.$output;
 }  }
   
 =pod  =pod 
   
 =item * &timebased_select_form()  =item * &timebased_select_form()
   
Line 17702  item - name of form element (sincefilter Line 17161  item - name of form element (sincefilter
 filter - anonymous hash of criteria and their values  filter - anonymous hash of criteria and their values
   
 Returns: HTML for a select box contained a blank, then six time selections,  Returns: HTML for a select box contained a blank, then six time selections,
          with value set in incoming form variables currently selected.           with value set in incoming form variables currently selected. 
   
 Side Effects: None  Side Effects: None
   
Line 17739  page load completion for page showing se Line 17198  page load completion for page showing se
   
 Inputs: None  Inputs: None
   
 Returns: markup containing updateFilters() and hideSearching() javascript functions.  Returns: markup containing updateFilters() and hideSearching() javascript functions. 
   
 Side Effects: None  Side Effects: None
   
Line 17778  to retrieve a hash for which keys are co Line 17237  to retrieve a hash for which keys are co
   
 Inputs:  Inputs:
   
 dom - domain being searched  dom - domain being searched 
   
 type - course type ('Course' or 'Community' or '.' if any).  type - course type ('Course' or 'Community' or '.' if any).
   
Line 17790  cloneruname - optional username of new c Line 17249  cloneruname - optional username of new c
   
 clonerudom - optional domain of new course owner  clonerudom - optional domain of new course owner
   
 domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,  domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
             (used when DC is using course creation form)              (used when DC is using course creation form)
   
 codetitles - reference to array of titles of components in institutional codes (official courses).  codetitles - reference to array of titles of components in institutional codes (official courses).
Line 17800  cc_clone - escaped comma separated list Line 17259  cc_clone - escaped comma separated list
   
 reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone  reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
   
 reqinstcode - institutional code of new course, where search_courses is used to identify potential  reqinstcode - institutional code of new course, where search_courses is used to identify potential 
               courses to clone                courses to clone 
   
 Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.  Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
   
Line 17927  $required - LON-CAPA version needed by c Line 17386  $required - LON-CAPA version needed by c
   
 Returns:  Returns:
   
 $switchserver - query string tp append to /adm/switchserver call (if  $switchserver - query string tp append to /adm/switchserver call (if 
                 current server's LON-CAPA version is too old.                  current server's LON-CAPA version is too old. 
   
 $warning - Message is displayed if no suitable server could be found.  $warning - Message is displayed if no suitable server could be found.
   
Line 18041  Inputs: Line 17500  Inputs:
 $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)  $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
   
 $interval (optional) - Time which may elapse (in s) between last check for content  $interval (optional) - Time which may elapse (in s) between last check for content
                        change in current course. (default: 600 s).                         change in current course. (default: 600 s).  
   
 Returns: an array; first element is:  Returns: an array; first element is:
   
Line 18049  Returns: an array; first element is: Line 17508  Returns: an array; first element is:
   
 'switch' - if content updates mean user's session  'switch' - if content updates mean user's session
            needs to be switched to a server running a newer LON-CAPA version             needs to be switched to a server running a newer LON-CAPA version
    
 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)  'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
            on current server hosting user's session             on current server hosting user's session                
   
 ''       - if no action required.  ''       - if no action required.
   
Line 18059  Returns: an array; first element is: Line 17518  Returns: an array; first element is:
   
 If first item element is 'switch':  If first item element is 'switch':
   
 second item is $switchwarning - Warning message if no suitable server found to host session.  second item is $switchwarning - Warning message if no suitable server found to host session. 
   
 third item is $switchserver - query string to append to /adm/switchserver containing lonHostID  third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                               and current role.                                and current role. 
   
 otherwise: no other elements returned.  otherwise: no other elements returned.
   
Line 18081  sub needs_coursereinit { Line 17540  sub needs_coursereinit {
     }      }
     if (($now-$env{'request.course.timechecked'})>$interval) {      if (($now-$env{'request.course.timechecked'})>$interval) {
         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});          &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
         my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);          my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
         if ($blocked) {          if ($blocked) {
             return ();              return ();
         }          }
         my $update;          my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
         my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);          if ($lastchange > $env{'request.course.tied'}) {
         my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);              my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
         if ($lastmainchange > $env{'request.course.tied'}) {              if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
             my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);                  my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
             if ($needswitch) {                  if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                 return ('switch',$switchwarning,$switchserver);                      &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
             }                                               $curr_reqd_hash{'internal.releaserequired'}});
             $update = 'main';                      my ($switchserver,$switchwarning) =
         }                          &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
         if ($lastsuppchange > $env{'request.course.suppupdated'}) {                                                  $curr_reqd_hash{'internal.releaserequired'});
             if ($update) {                      if ($switchwarning ne '' || $switchserver ne '') {
                 $update = 'both';                          return ('switch',$switchwarning,$switchserver);
             } else {                      }
                 my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);  
                 if ($needswitch) {  
                     return ('switch',$switchwarning,$switchserver);  
                 } else {  
                     $update = 'supp';  
                 }                  }
             }              }
             return ($update);              return ('update');
         }  
     }  
     return ();  
 }  
   
 sub switch_for_update {  
     my ($loncaparev,$cdom,$cnum) = @_;  
     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 ();      return ();
 }  }
   
 sub update_content_constraints {  sub update_content_constraints {
     my ($cdom,$cnum,$chome,$cid) = @_;      my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');      my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});      my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
     my %checkresponsetypes;      my (%checkresponsetypes,%checkcrsrestypes);
     foreach my $key (keys(%Apache::lonnet::needsrelease)) {      foreach my $key (keys(%Apache::lonnet::needsrelease)) {
         my ($item,$name,$value) = split(/:/,$key);          my ($item,$name,$value) = split(/:/,$key);
         if ($item eq 'resourcetag') {          if ($item eq 'resourcetag') {
             if ($name eq 'responsetype') {              if ($name eq 'responsetype') {
                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}                  $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
             }              }
           } elsif ($item eq 'course') {
               if ($name eq 'courserestype') {
                   $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
               }
         }          }
     }      }
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
     if (defined($navmap)) {      if (defined($navmap)) {
         my %allresponses;          my (%allresponses,%allcrsrestypes);
         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {          foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
               if ($res->is_tool()) {
                   if ($allcrsrestypes{'exttool'}) {
                       $allcrsrestypes{'exttool'} ++;
                   } else {
                       $allcrsrestypes{'exttool'} = 1;
                   }
                   next;
               }
             my %responses = $res->responseTypes();              my %responses = $res->responseTypes();
             foreach my $key (keys(%responses)) {              foreach my $key (keys(%responses)) {
                 next unless(exists($checkresponsetypes{$key}));                  next unless(exists($checkresponsetypes{$key}));
Line 18160  sub update_content_constraints { Line 17607  sub update_content_constraints {
                 ($reqdmajor,$reqdminor) = ($major,$minor);                  ($reqdmajor,$reqdminor) = ($major,$minor);
             }              }
         }          }
           foreach my $key (keys(%allcrsrestypes)) {
               my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
               if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   ($reqdmajor,$reqdminor) = ($major,$minor);
               }
           }
         undef($navmap);          undef($navmap);
     }      }
       my (@resources,@order,@resparms,@zombies);
       if ($keeporder) {
           use LONCAPA::map;
           @resources = @LONCAPA::map::resources;
           @order = @LONCAPA::map::order;
           @resparms = @LONCAPA::map::resparms;
           @zombies = @LONCAPA::map::zombies;
       }
       my $suppmap = 'supplemental.sequence';
       my ($suppcount,$supptools,$errors) = (0,0,0);
       ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
                                                               $suppcount,$supptools,$errors);
       if ($keeporder) {
           @LONCAPA::map::resources = @resources;
           @LONCAPA::map::order = @order;
           @LONCAPA::map::resparms = @resparms;
           @LONCAPA::map::zombies = @zombies;
       }
       if ($supptools) {
           my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
           if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
               ($reqdmajor,$reqdminor) = ($major,$minor);
           }
       }
     unless (($reqdmajor eq '') && ($reqdminor eq '')) {      unless (($reqdmajor eq '') && ($reqdminor eq '')) {
         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);          &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
     }      }
Line 18182  sub allmaps_incourse { Line 17659  sub allmaps_incourse {
     if ($lastchange > $env{'request.course.tied'}) {      if ($lastchange > $env{'request.course.tied'}) {
         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");          my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
         unless ($ferr) {          unless ($ferr) {
             &update_content_constraints($cdom,$cnum,$chome,$cid);              &update_content_constraints($cdom,$cnum,$chome,$cid,1);
         }          }
     }      }
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
Line 18208  sub parse_supplemental_title { Line 17685  sub parse_supplemental_title {
         my $name =  &plainname($uname,$udom);          my $name =  &plainname($uname,$udom);
         $name = &HTML::Entities::encode($name,'"<>&\'');          $name = &HTML::Entities::encode($name,'"<>&\'');
         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');          $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;          $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
         if ($foldertitle ne '') {              $name.': <br />'.$foldertitle;
             $title .= ': <br />'.$foldertitle;  
         }  
     }      }
     if (wantarray) {      if (wantarray) {
         return ($title,$foldertitle,$renametitle);          return ($title,$foldertitle,$renametitle);
Line 18219  sub parse_supplemental_title { Line 17694  sub parse_supplemental_title {
     return $title;      return $title;
 }  }
   
 sub get_supplemental {  
     my ($cnum,$cdom,$ignorecache,$possdel)=@_;  
     my $hashid=$cnum.':'.$cdom;  
     my ($supplemental,$cached,$set_httprefs);  
     unless ($ignorecache) {  
         ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);  
     }  
     unless (defined($cached)) {  
         my $chome=&Apache::lonnet::homeserver($cnum,$cdom);  
         unless ($chome eq 'no_host') {  
             my @order = @LONCAPA::map::order;  
             my @resources = @LONCAPA::map::resources;  
             my @resparms = @LONCAPA::map::resparms;  
             my @zombies = @LONCAPA::map::zombies;  
             my ($errors,%ids,%hidden);  
             $errors =  
                 &recurse_supplemental($cnum,$cdom,'supplemental.sequence',  
                                       $errors,$possdel,\%ids,\%hidden);  
             @LONCAPA::map::order = @order;  
             @LONCAPA::map::resources = @resources;  
             @LONCAPA::map::resparms = @resparms;  
             @LONCAPA::map::zombies = @zombies;  
             $set_httprefs = 1;  
             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {  
                 &Apache::lonnet::appenv({'request.course.suppupdated' => time});  
             }  
             $supplemental = {  
                                ids => \%ids,  
                                hidden => \%hidden,  
                             };  
             &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);  
         }  
     }  
     return ($supplemental,$set_httprefs);  
 }  
   
 sub recurse_supplemental {  sub recurse_supplemental {
     my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;      my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
     if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {      if ($suppmap) {
         my $mapnum;  
         if ($suppmap eq 'supplemental.sequence') {  
             $mapnum = 0;  
         } else {  
             ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);  
         }  
         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);          my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
         if ($fatal) {          if ($fatal) {
             $errors ++;              $errors ++;
         } else {          } else {
             my @order = @LONCAPA::map::order;              if ($#LONCAPA::map::resources > 0) {
             if (@order > 0) {                  foreach my $res (@LONCAPA::map::resources) {
                 my @resources = @LONCAPA::map::resources;                      my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                 my @resparms = @LONCAPA::map::resparms;  
                 foreach my $idx (@order) {  
                     my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);  
                     if (($src ne '') && ($status eq 'res')) {                      if (($src ne '') && ($status eq 'res')) {
                         my $id = $mapnum.':'.$idx;  
                         push(@{$suppids->{$src}},$id);  
                         if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {  
                             $hiddensupp->{$id} = 1;  
                         }  
                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {                          if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                             $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,                              ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
                                                             $hiddensupp,$hiddensupp->{$id});                                                                     $numfiles,$numexttools,$errors);
                         } else {                          } else {
                             my $allowed;                              if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
                             if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {                                  $numexttools ++;
                                 $allowed = 1;  
                             } elsif ($possdel) {  
                                 foreach my $item (@{$suppids->{$src}}) {  
                                     next if ($item eq $id);  
                                     unless ($hiddensupp->{$item}) {  
                                        $allowed = 1;  
                                        last;  
                                     }  
                                 }  
                                 if ((!$allowed) && (exists($env{'httpref.'.$src}))) {  
                                     &Apache::lonnet::delenv('httpref.'.$src);  
                                 }  
                             }  
                             if ($allowed && (!exists($env{'httpref.'.$src}))) {  
                                 &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);  
                             }                              }
                               $numfiles ++;
                         }                          }
                     }                      }
                 }                  }
             }              }
         }          }
     }      }
     return $errors;      return ($numfiles,$numexttools,$errors);
 }  
   
 sub set_supp_httprefs {  
     my ($cnum,$cdom,$supplemental,$possdel) = @_;  
     if (ref($supplemental) eq 'HASH') {  
         if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {  
             foreach my $src (keys(%{$supplemental->{'ids'}})) {  
                 next if ($src =~ /\.sequence$/);  
                 if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {  
                     my $allowed;  
                     if ($env{'request.role.adv'}) {  
                         $allowed = 1;  
                     } else {  
                         foreach my $id (@{$supplemental->{'ids'}->{$src}}) {  
                             unless ($supplemental->{'hidden'}->{$id}) {  
                                 $allowed = 1;  
                                 last;  
                             }  
                         }  
                     }  
                     if (exists($env{'httpref.'.$src})) {  
                         if ($possdel) {  
                             unless ($allowed) {  
                                 &Apache::lonnet::delenv('httpref.'.$src);  
                             }  
                         }  
                     } elsif ($allowed) {  
                         &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);  
                     }  
                 }  
             }  
             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {  
                 &Apache::lonnet::appenv({'request.course.suppupdated' => time});  
             }  
         }  
     }  
 }  
   
 sub get_supp_parameter {  
     my ($resparm,$name)=@_;  
     return if ($resparm eq '');  
     my $value=undef;  
     my $ptype=undef;  
     foreach (split('&&&',$resparm)) {  
         my ($thistype,$thisname,$thisvalue)=split('___',$_);  
         if ($thisname eq $name) {  
             $value=$thisvalue;  
             $ptype=$thistype;  
         }  
     }  
     return $value;  
 }  }
   
 sub symb_to_docspath {  sub symb_to_docspath {
Line 18432  sub symb_to_docspath { Line 17792  sub symb_to_docspath {
     return $path;      return $path;
 }  }
   
 sub validate_folderpath {  
     my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;  
     if ($env{'form.folderpath'} ne '') {  
         my @items = split(/\&/,$env{'form.folderpath'});  
         my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);  
         for (my $i=0; $i<@items; $i++) {  
             my $odd = $i%2;  
             if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {  
                 $badpath = 1;  
             } elsif ($odd && $supplementalflag) {  
                 my $idx = $i-1;  
                 if ($items[$i] =~ /^([^:]*)::(|1):::$/) {  
                     my $esc_name = $1;  
                     if ((!$allowed) || ($items[$idx] eq 'supplemental')) {  
                         $supppath .= '&'.$esc_name;  
                         $changed = 1;  
                     } else {  
                         $supppath .= '&'.$items[$i];  
                     }  
                 } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {  
                     $changed = 1;  
                     my $is_hidden;  
                     unless ($got_supp) {  
                         my ($supplemental) = &get_supplemental($coursenum,$coursedom);  
                         if (ref($supplemental) eq 'HASH') {  
                             if (ref($supplemental->{'hidden'}) eq 'HASH') {  
                                 %supphidden = %{$supplemental->{'hidden'}};  
                             }  
                             if (ref($supplemental->{'ids'}) eq 'HASH') {  
                                 %suppids = %{$supplemental->{'ids'}};  
                             }  
                         }  
                         $got_supp = 1;  
                     }  
                     if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {  
                         my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];  
                         if ($supphidden{$mapid}) {  
                             $is_hidden = 1;  
                         }  
                     }  
                     $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';  
                 } else {  
                     $supppath .= '&'.$items[$i];  
                 }  
             } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {  
                 $badpath = 1;  
             } elsif ($supplementalflag) {  
                 $supppath .= '&'.$items[$i];  
             }  
             last if ($badpath);  
         }  
         if ($badpath) {  
             delete($env{'form.folderpath'});  
         } elsif ($changed && $supplementalflag) {  
             $supppath =~ s/^\&//;  
             $env{'form.folderpath'} = $supppath;  
         }  
     }  
     return;  
 }  
   
 sub captcha_display {  sub captcha_display {
     my ($context,$lonhost,$defdom) = @_;      my ($context,$lonhost,$defdom) = @_;
     my ($output,$error);      my ($output,$error);
     my ($captcha,$pubkey,$privkey,$version) =      my ($captcha,$pubkey,$privkey,$version) = 
         &get_captcha_config($context,$lonhost,$defdom);          &get_captcha_config($context,$lonhost,$defdom);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         $output = &create_captcha();          $output = &create_captcha();
Line 18567  sub get_captcha_config { Line 17866  sub get_captcha_config {
                 $captcha = 'recaptcha';                  $captcha = 'recaptcha';
                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};                  $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                 if ($version ne '2') {                  if ($version ne '2') {
                     $version = 1;                      $version = 1; 
                 }                  }
             } else {              } else {
                 $captcha = 'original';                  $captcha = 'original';
Line 18596  sub get_captcha_config { Line 17895  sub get_captcha_config {
                 $captcha = 'original';                  $captcha = 'original';
             }              }
         }          }
     }      } 
     return ($captcha,$pubkey,$privkey,$version);      return ($captcha,$pubkey,$privkey,$version);
 }  }
   
Line 18613  sub create_captcha { Line 17912  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".
                       '<span class="LC_nobreak">'.  
                       &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="new-password" />'.                        '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                       '</span><br />'.                        '<br />'.
                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';                        '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
             last;              last;
         }          }
Line 18662  sub check_captcha { Line 17960  sub check_captcha {
 sub create_recaptcha {  sub create_recaptcha {
     my ($pubkey,$version) = @_;      my ($pubkey,$version) = @_;
     if ($version >= 2) {      if ($version >= 2) {
         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.          return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
                '<div style="padding:0;clear:both;margin:0;border:0"></div>';  
     } else {      } else {
         my $use_ssl;          my $use_ssl;
         if ($ENV{'SERVER_PORT'} == 443) {          if ($ENV{'SERVER_PORT'} == 443) {
Line 18675  sub create_recaptcha { Line 17972  sub create_recaptcha {
                &mt('If the text is hard to read, [_1] will replace them.',                 &mt('If the text is hard to read, [_1] will replace them.',
                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').                     '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                '<br /><br />';                 '<br /><br />';
      }      }
 }  }
   
 sub check_recaptcha {  sub check_recaptcha {
     my ($privkey,$version) = @_;      my ($privkey,$version) = @_;
     my $captcha_chk;      my $captcha_chk;
     my $ip = &Apache::lonnet::get_requestor_ip();   
     if ($version >= 2) {      if ($version >= 2) {
         my $ua = LWP::UserAgent->new;  
         $ua->timeout(10);  
         my %info = (          my %info = (
                      secret   => $privkey,                       secret   => $privkey, 
                      response => $env{'form.g-recaptcha-response'},                       response => $env{'form.g-recaptcha-response'},
                      remoteip => $ip,                       remoteip => $ENV{'REMOTE_ADDR'},
                    );                     );
         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);          my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
           $request->content(join('&',map {
                            my $name = escape($_);
                            "$name=" . ( ref($info{$_}) eq 'ARRAY'
                            ? join("&$name=", map {escape($_) } @{$info{$_}})
                            : &escape($info{$_}) );
           } keys(%info)));
           my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
         if ($response->is_success)  {          if ($response->is_success)  {
             my $data = JSON::DWIW->from_json($response->decoded_content);              my $data = JSON::DWIW->from_json($response->decoded_content);
             if (ref($data) eq 'HASH') {              if (ref($data) eq 'HASH') {
Line 18704  sub check_recaptcha { Line 18005  sub check_recaptcha {
         my $captcha_result =          my $captcha_result =
             $captcha->check_answer(              $captcha->check_answer(
                                     $privkey,                                      $privkey,
                                     $ip,                                      $ENV{'REMOTE_ADDR'},
                                     $env{'form.recaptcha_challenge_field'},                                      $env{'form.recaptcha_challenge_field'},
                                     $env{'form.recaptcha_response_field'},                                      $env{'form.recaptcha_response_field'},
                                   );                                    );
Line 18753  sub cleanup_html { Line 18054  sub cleanup_html {
   
 # Checks for critical messages and returns a redirect url if one exists.  # Checks for critical messages and returns a redirect url if one exists.
 # $interval indicates how often to check for messages.  # $interval indicates how often to check for messages.
 # $context is the calling context -- roles, grades, contents, menu or flip.  # $context is the calling context -- roles, grades, contents, menu or flip. 
 sub critical_redirect {  sub critical_redirect {
     my ($interval,$context) = @_;      my ($interval,$context) = @_;
     unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {  
         return ();  
     }  
     if ((time-$env{'user.criticalcheck.time'})>$interval) {      if ((time-$env{'user.criticalcheck.time'})>$interval) {
         if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {          if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
             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('alert',undef,$cnum,$cdom,undef,1);              my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
             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 18775  sub critical_redirect { Line 18073  sub critical_redirect {
                 }                  }
             }              }
         }          }
         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},          my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                                         $env{'user.name'});                                          $env{'user.name'});
         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});          &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
         my $redirecturl;          my $redirecturl;
         if ($what[0]) {          if ($what[0]) {
             if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {      if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                 $redirecturl='/adm/email?critical=display';          $redirecturl='/adm/email?critical=display';
                 my $url=&Apache::lonnet::absolute_url().$redirecturl;          my $url=&Apache::lonnet::absolute_url().$redirecturl;
                 return (1, $url);                  return (1, $url);
             }              }
         }          }
     }      } 
     return ();      return ();
 }  }
   
Line 18840  sub des_decrypt { Line 18138  sub des_decrypt {
     return $plaintext;      return $plaintext;
 }  }
   
 sub get_requested_shorturls {  sub make_short_symbs {
     my ($cdom,$cnum,$navmap) = @_;      my ($cdom,$cnum,$navmap) = @_;
     return unless (ref($navmap));      return unless (ref($navmap));
     my ($numnew,$errors);      my ($numnew,@errors);
     my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');      my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
     if (@toshorten) {      if (@toshorten) {
         my (%maps,%resources,%titles);          my (%maps,%resources,%titles);
         &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,          &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                                                                'shorturls',$cdom,$cnum);                                                                 'shorturls',$cdom,$cnum);
           my %tocreate;
         if (keys(%resources)) {          if (keys(%resources)) {
             my %tocreate;  
             foreach my $item (sort {$a <=> $b} (@toshorten)) {              foreach my $item (sort {$a <=> $b} (@toshorten)) {
                 my $symb = $resources{$item};                  my $symb = $resources{$item};
                 if ($symb) {                  if ($symb) {
                     $tocreate{$cnum.'&'.$symb} = 1;                      $tocreate{$cnum.'&'.$symb} = 1;
                 }                  }
             }              }
             if (keys(%tocreate)) {  
                 ($numnew,$errors) = &make_short_symbs($cdom,$cnum,  
                                                       \%tocreate);  
             }  
         }          }
     }  
     return ($numnew,$errors);  
 }  
   
 sub make_short_symbs {  
     my ($cdom,$cnum,$tocreateref,$lockuser) = @_;  
     my ($numnew,@errors);  
     if (ref($tocreateref) eq 'HASH') {  
         my %tocreate = %{$tocreateref};  
         if (keys(%tocreate)) {          if (keys(%tocreate)) {
             my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);              my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
             my $su = Short::URL->new(no_vowels => 1);              my $su = Short::URL->new(no_vowels => 1);
Line 18878  sub make_short_symbs { Line 18163  sub make_short_symbs {
             my (%newunique,%addcourse,%courseonly,%failed);              my (%newunique,%addcourse,%courseonly,%failed);
             # get lock on tiny db              # get lock on tiny db
             my $now = time;              my $now = time;
             if ($lockuser eq '') {  
                 $lockuser = $env{'user.name'}.':'.$env{'user.domain'};  
             }  
             my $lockhash = {              my $lockhash = {
                                 "lock\0$now" => $lockuser,                                  "lock\0$now" => $env{'user.name'}.
                                                   ':'.$env{'user.domain'},
                             };                              };
             my $tries = 0;              my $tries = 0;
             my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);              my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
Line 18985  sub shorten_symbs { Line 18268  sub shorten_symbs {
         } else {          } else {
             foreach my $key (keys(%collisions)) {              foreach my $key (keys(%collisions)) {
                 $failed->{$key} = 1;                  $failed->{$key} = 1;
                 $failed->{$key} = 1;  
             }              }
         }          }
     }      }
Line 19015  sub is_nonframeable { Line 18297  sub is_nonframeable {
     }      }
     my $uselink;      my $uselink;
     my $request = new HTTP::Request('HEAD',$url);      my $request = new HTTP::Request('HEAD',$url);
     my $ua = LWP::UserAgent->new;      my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
     $ua->timeout(5);  
     my $response=$ua->request($request);  
     if ($response->is_success()) {      if ($response->is_success()) {
         my $secpolicy = lc($response->header('content-security-policy'));          my $secpolicy = lc($response->header('content-security-policy'));
         my $xframeop = lc($response->header('x-frame-options'));          my $xframeop = lc($response->header('x-frame-options'));
Line 19145  sub is_nonframeable { Line 18425  sub is_nonframeable {
     return $uselink;      return $uselink;
 }  }
   
 sub page_menu {  
     my ($menucolls,$menunum) = @_;  
     my %menu;  
     foreach my $item (split(/;/,$menucolls)) {  
         my ($num,$value) = split(/\%/,$item);  
         if ($num eq $menunum) {  
             my @entries = split(/\&/,$value);  
             foreach my $entry (@entries) {  
                 my ($name,$fields) = split(/=/,$entry);  
                 if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {  
                     $menu{$name} = $fields;  
                 } else {  
                     my @shown;  
                     if ($fields =~ /,/) {  
                         @shown = split(/,/,$fields);  
                     } else {  
                         @shown = ($fields);  
                     }  
                     if (@shown) {  
                         foreach my $field (@shown) {  
                             next if ($field eq '');  
                             $menu{$field} = 1;  
                         }  
                     }  
                 }  
             }  
         }  
     }  
     return %menu;  
 }  
   
 1;  1;
 __END__;  __END__;
   

Removed from v.1.1075.2.161.2.21  
changed lines
  Added in v.1.1335


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