Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.79 and 1.1075.2.125

version 1.1075.2.79, 2014/06/22 13:31:52 version 1.1075.2.125, 2017/03/15 03:39:49
Line 72  use Apache::lonuserstate(); Line 72  use Apache::lonuserstate();
 use Apache::courseclassifier();  use Apache::courseclassifier();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale::Catalog;  use DateTime::Locale;
   use Encode();
 use Authen::Captcha;  use Authen::Captcha;
 use Captcha::reCAPTCHA;  use Captcha::reCAPTCHA;
   use JSON::DWIW;
   use LWP::UserAgent;
 use Crypt::DES;  use Crypt::DES;
 use DynaLoader; # for Crypt::DES version  use DynaLoader; # for Crypt::DES version
   
Line 259  BEGIN { Line 262  BEGIN {
  next if ($line =~ /^\#/);   next if ($line =~ /^\#/);
  chomp($line);   chomp($line);
                 my ($extension,$category)=(split(/\s+/,$line,2));                  my ($extension,$category)=(split(/\s+/,$line,2));
                 push @{$category_extensions{lc($category)}},$extension;                  push(@{$category_extensions{lc($category)}},$extension);
             }              }
             close($fh);              close($fh);
         }          }
Line 532  ENDAUTHORBRW Line 535  ENDAUTHORBRW
   
 sub coursebrowser_javascript {  sub coursebrowser_javascript {
     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,      my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
         $credits_element) = @_;          $credits_element,$instcode) = @_;
     my $wintitle = 'Course_Browser';      my $wintitle = 'Course_Browser';
     if ($crstype eq 'Community') {      if ($crstype eq 'Community') {
         $wintitle = 'Community_Browser';          $wintitle = 'Community_Browser';
Line 583  sub coursebrowser_javascript { Line 586  sub coursebrowser_javascript {
             var ownername = document.forms[formid].ccuname.value;              var ownername = document.forms[formid].ccuname.value;
             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;              var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
             url += '&cloner='+ownername+':'+ownerdom;              url += '&cloner='+ownername+':'+ownerdom;
               if (type == 'Course') {
                   url += '&crscode='+document.forms[formid].crscode.value;
               }
           }
           if (formname == 'requestcrs') {
               url += '&crsdom=$domainfilter&crscode=$instcode';
         }          }
         if (multflag !=null && multflag != '') {          if (multflag !=null && multflag != '') {
             url += '&multiple='+multflag;              url += '&multiple='+multflag;
Line 927  ENDSCRT Line 936  ENDSCRT
 }  }
   
 sub select_timezone {  sub select_timezone {
    my ($name,$selected,$onchange,$includeempty)=@_;     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
    if ($includeempty) {     if ($includeempty) {
        $output .= '<option value=""';         $output .= '<option value=""';
        if (($selected eq '') || ($selected eq 'local')) {         if (($selected eq '') || ($selected eq 'local')) {
Line 949  sub select_timezone { Line 958  sub select_timezone {
 }  }
   
 sub select_datelocale {  sub select_datelocale {
     my ($name,$selected,$onchange,$includeempty)=@_;      my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";      my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
     if ($includeempty) {      if ($includeempty) {
         $output .= '<option value=""';          $output .= '<option value=""';
         if ($selected eq '') {          if ($selected eq '') {
Line 958  sub select_datelocale { Line 967  sub select_datelocale {
         }          }
         $output .= '> </option>';          $output .= '> </option>';
     }      }
       my @languages = &Apache::lonlocal::preferred_languages();
     my (@possibles,%locale_names);      my (@possibles,%locale_names);
     my @locales = DateTime::Locale::Catalog::Locales;      my @locales = DateTime::Locale->ids();
     foreach my $locale (@locales) {      foreach my $id (@locales) {
         if (ref($locale) eq 'HASH') {          if ($id ne '') {
             my $id = $locale->{'id'};              my ($en_terr,$native_terr);
             if ($id ne '') {              my $loc = DateTime::Locale->load($id);
                 my $en_terr = $locale->{'en_territory'};              if (ref($loc)) {
                 my $native_terr = $locale->{'native_territory'};                  $en_terr = $loc->name();
                 my @languages = &Apache::lonlocal::preferred_languages();                  $native_terr = $loc->native_name();
                 if (grep(/^en$/,@languages) || !@languages) {                  if (grep(/^en$/,@languages) || !@languages) {
                     if ($en_terr ne '') {                      if ($en_terr ne '') {
                         $locale_names{$id} = '('.$en_terr.')';                          $locale_names{$id} = '('.$en_terr.')';
Line 980  sub select_datelocale { Line 990  sub select_datelocale {
                         $locale_names{$id} = '('.$en_terr.')';                          $locale_names{$id} = '('.$en_terr.')';
                     }                      }
                 }                  }
                 push (@possibles,$id);                  $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
                   push(@possibles,$id);
             }              }
         }          }
     }      }
Line 991  sub select_datelocale { Line 1002  sub select_datelocale {
         }          }
         $output.=">$item";          $output.=">$item";
         if ($locale_names{$item} ne '') {          if ($locale_names{$item} ne '') {
             $output.="  $locale_names{$item}</option>\n";              $output.='  '.$locale_names{$item};
         }          }
         $output.="</option>\n";          $output.="</option>\n";
     }      }
Line 1000  sub select_datelocale { Line 1011  sub select_datelocale {
 }  }
   
 sub select_language {  sub select_language {
     my ($name,$selected,$includeempty) = @_;      my ($name,$selected,$includeempty,$noedit) = @_;
     my %langchoices;      my %langchoices;
     if ($includeempty) {      if ($includeempty) {
         %langchoices = ('' => 'No language preference');          %langchoices = ('' => 'No language preference');
Line 1012  sub select_language { Line 1023  sub select_language {
         }          }
     }      }
     %langchoices = &Apache::lonlocal::texthash(%langchoices);      %langchoices = &Apache::lonlocal::texthash(%langchoices);
     return &select_form($selected,$name,\%langchoices);      return &select_form($selected,$name,\%langchoices,undef,$noedit);
 }  }
   
 =pod  =pod
Line 1127  sub linked_select_forms { Line 1138  sub linked_select_forms {
         $result.="select2data.d_$s1.texts = new Array(";                  $result.="select2data.d_$s1.texts = new Array(";        
         my @s2texts;          my @s2texts;
         foreach my $value (@s2values) {          foreach my $value (@s2values) {
             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};              push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
         }          }
         $result.="\"@s2texts\");\n";          $result.="\"@s2texts\");\n";
     }      }
Line 1733  RESIZE Line 1744  RESIZE
   
 }  }
   
   sub colorfuleditor_js {
       return <<"COLORFULEDIT"
   <script type="text/javascript">
   // <![CDATA[>
       function fold_box(curDepth, lastresource){
   
       // we need a list because there can be several blocks you need to fold in one tag
           var block = document.getElementsByName('foldblock_'+curDepth);
       // but there is only one folding button per tag
           var foldbutton = document.getElementById('folding_btn_'+curDepth);
   
           if(block.item(0).style.display == 'none'){
   
               foldbutton.value = '@{[&mt("Hide")]}';
               for (i = 0; i < block.length; i++){
                   block.item(i).style.display = '';
               }
           }else{
   
               foldbutton.value = '@{[&mt("Show")]}';
               for (i = 0; i < block.length; i++){
                   // block.item(i).style.visibility = 'collapse';
                   block.item(i).style.display = 'none';
               }
           };
           saveState(lastresource);
       }
   
       function saveState (lastresource) {
   
           var tag_list = getTagList();
           if(tag_list != null){
               var timestamp = new Date().getTime();
               var key = lastresource;
   
               // the value pattern is: 'time;key1,value1;key2,value2; ... '
               // starting with timestamp
               var value = timestamp+';';
   
               // building the list of key-value pairs
               for(var i = 0; i < tag_list.length; i++){
                   value += tag_list[i]+',';
                   value += document.getElementsByName(tag_list[i])[0].style.display+';';
               }
   
               // only iterate whole storage if nothing to override
               if(localStorage.getItem(key) == null){
   
                   // prevent storage from growing large
                   if(localStorage.length > 50){
                       var regex_getTimestamp = /^(?:\d)+;/;
                       var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                       var oldest_key;
   
                       for(var i = 1; i < localStorage.length; i++){
                           if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                               oldest_key = localStorage.key(i);
                               oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                           }
                       }
                       localStorage.removeItem(oldest_key);
                   }
               }
               localStorage.setItem(key,value);
           }
       }
   
       // restore folding status of blocks (on page load)
       function restoreState (lastresource) {
           if(localStorage.getItem(lastresource) != null){
               var key = lastresource;
               var value = localStorage.getItem(key);
               var regex_delTimestamp = /^\d+;/;
   
               value.replace(regex_delTimestamp, '');
   
               var valueArr = value.split(';');
               var pairs;
               var elements;
               for (var i = 0; i < valueArr.length; i++){
                   pairs = valueArr[i].split(',');
                   elements = document.getElementsByName(pairs[0]);
   
                   for (var j = 0; j < elements.length; j++){
                       elements[j].style.display = pairs[1];
                       if (pairs[1] == "none"){
                           var regex_id = /([_\\d]+)\$/;
                           regex_id.exec(pairs[0]);
                           document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                       }
                   }
               }
           }
       }
   
       function getTagList () {
   
           var stringToSearch = document.lonhomework.innerHTML;
   
           var ret = new Array();
           var regex_findBlock = /(foldblock_.*?)"/g;
           var tag_list = stringToSearch.match(regex_findBlock);
   
           if(tag_list != null){
               for(var i = 0; i < tag_list.length; i++){
                   ret.push(tag_list[i].replace(/"/, ''));
               }
           }
           return ret;
       }
   
       function saveScrollPosition (resource) {
           var tag_list = getTagList();
   
           // we dont always want to jump to the first block
           // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
           if(\$(window).scrollTop() > 170){
               if(tag_list != null){
                   var result;
                   for(var i = 0; i < tag_list.length; i++){
                       if(isElementInViewport(tag_list[i])){
                           result += tag_list[i]+';';
                       }
                   }
                   sessionStorage.setItem('anchor_'+resource, result);
               }
           } else {
               // we dont need to save zero, just delete the item to leave everything tidy
               sessionStorage.removeItem('anchor_'+resource);
           }
       }
   
       function restoreScrollPosition(resource){
   
           var elem = sessionStorage.getItem('anchor_'+resource);
           if(elem != null){
               var tag_list = elem.split(';');
               var elem_list;
   
               for(var i = 0; i < tag_list.length; i++){
                   elem_list = document.getElementsByName(tag_list[i]);
   
                   if(elem_list.length > 0){
                       elem = elem_list[0];
                       break;
                   }
               }
               elem.scrollIntoView();
           }
       }
   
       function isElementInViewport(el) {
   
           // change to last element instead of first
           var elem = document.getElementsByName(el);
           var rect = elem[0].getBoundingClientRect();
   
           return (
               rect.top >= 0 &&
               rect.left >= 0 &&
               rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
               rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
           );
       }
   
       function autosize(depth){
           var cmInst = window['cm'+depth];
           var fitsizeButton = document.getElementById('fitsize'+depth);
   
           // is fixed size, switching to dynamic
           if (sessionStorage.getItem("autosized_"+depth) == null) {
               cmInst.setSize("","auto");
               fitsizeButton.value = "@{[&mt('Fixed size')]}";
               sessionStorage.setItem("autosized_"+depth, "yes");
   
           // is dynamic size, switching to fixed
           } else {
               cmInst.setSize("","300px");
               fitsizeButton.value = "@{[&mt('Dynamic size')]}";
               sessionStorage.removeItem("autosized_"+depth);
           }
       }
   
   
   
   // ]]>
   </script>
   COLORFULEDIT
   }
   
   sub xmleditor_js {
       return <<XMLEDIT
   <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
   <script type="text/javascript">
   // <![CDATA[>
   
       function saveScrollPosition (resource) {
   
           var scrollPos = \$(window).scrollTop();
           sessionStorage.setItem(resource,scrollPos);
       }
   
       function restoreScrollPosition(resource){
   
           var scrollPos = sessionStorage.getItem(resource);
           \$(window).scrollTop(scrollPos);
       }
   
       // unless internet explorer
       if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
   
           \$(document).ready(function() {
                \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
           });
       }
   
       // inserts text at cursor position into codemirror (xml editor only)
       function insertText(text){
           cm.focus();
           var curPos = cm.getCursor();
           cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
       }
   // ]]>
   </script>
   XMLEDIT
   }
   
   sub insert_folding_button {
       my $curDepth = $Apache::lonxml::curdepth;
       my $lastresource = $env{'request.ambiguous'};
   
       return "<input type=\"button\" id=\"folding_btn_$curDepth\"
               value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
   }
   
   
 =pod  =pod
   
 =head1 Excel and CSV file utility routines  =head1 Excel and CSV file utility routines
Line 1992  sub multiple_select_form { Line 2239  sub multiple_select_form {
   
 =pod  =pod
   
 =item * &select_form($defdom,$name,$hashref,$onchange)  =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select options from a ref to a hash containing:  allow a user to select options from a ref to a hash containing:
 option_name => displayed text. An optional $onchange can include  option_name => displayed text. An optional $onchange can include
 a javascript onchange item, e.g., onchange="this.form.submit();"    a javascript onchange item, e.g., onchange="this.form.submit();".
   An optional arg -- $readonly -- if true will cause the select form
   to be disabled, e.g., for the case where an instructor has a section-
   specific role, and is viewing/modifying parameters.  
   
 See lonrights.pm for an example invocation and use.  See lonrights.pm for an example invocation and use.
   
Line 2005  See lonrights.pm for an example invocati Line 2255  See lonrights.pm for an example invocati
   
 #-------------------------------------------  #-------------------------------------------
 sub select_form {  sub select_form {
     my ($def,$name,$hashref,$onchange) = @_;      my ($def,$name,$hashref,$onchange,$readonly) = @_;
     return unless (ref($hashref) eq 'HASH');      return unless (ref($hashref) eq 'HASH');
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
Line 2179  sub select_level_form { Line 2429  sub select_level_form {
   
 =pod  =pod
   
 =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)  =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select the domain to preform an operation in.    allow a user to select the domain to preform an operation in.  
Line 2194  The optional $onchange argument specifie Line 2444  The optional $onchange argument specifie
   
 The optional $incdoms is a reference to an array of domains which will be the only available options.  The optional $incdoms is a reference to an array of domains which will be the only available options.
   
 The optional $excdoms is a reference to an array of domains which will be excluded from the available options.   The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
   
   The optional $disabled argument, if true, adds the disabled attribute to the select tag. 
   
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
 sub select_dom_form {  sub select_dom_form {
     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;      my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
     }      }
       if ($disabled) {
           $disabled = ' disabled="disabled"';
       }
     my (@domains,%exclude);      my (@domains,%exclude);
     if (ref($incdoms) eq 'ARRAY') {      if (ref($incdoms) eq 'ARRAY') {
         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});          @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
Line 2214  sub select_dom_form { Line 2469  sub select_dom_form {
     if (ref($excdoms) eq 'ARRAY') {      if (ref($excdoms) eq 'ARRAY') {
         map { $exclude{$_} = 1; } @{$excdoms};          map { $exclude{$_} = 1; } @{$excdoms};
     }      }
     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";      my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
     foreach my $dom (@domains) {      foreach my $dom (@domains) {
         next if ($exclude{$dom});          next if ($exclude{$dom});
         $selectdomain.="<option value=\"$dom\" ".          $selectdomain.="<option value=\"$dom\" ".
Line 2590  sub authform_kerberos { Line 2845  sub authform_kerberos {
               @_,                @_,
               );                );
     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,      my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
         $autharg,$jscall);          $autharg,$jscall,$disabled);
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
     if ($in{'kerb_def_auth'} eq 'krb5') {      if ($in{'kerb_def_auth'} eq 'krb5') {
        $check5 = ' checked="checked"';         $check5 = ' checked="checked"';
     } else {      } else {
        $check4 = ' checked="checked"';         $check4 = ' checked="checked"';
     }      }
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
     $krbarg = $in{'kerb_def_dom'};      $krbarg = $in{'kerb_def_dom'};
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'krb') {          if ($in{'curr_authtype'} eq 'krb') {
Line 2641  sub authform_kerberos { Line 2899  sub authform_kerberos {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="krb" />';                      $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2650  sub authform_kerberos { Line 2908  sub authform_kerberos {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="krb" '.          $authtype = '<input type="radio" name="login" value="krb" '.
                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.                      'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                     $krbcheck.' />';                      $krbcheck.$disabled.' />';
     }      }
     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||      if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&          ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
Line 2663  sub authform_kerberos { Line 2921  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               'onchange="'.$jscall.'"'.$disabled.' />',
          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',           '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',           '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
  '</label>');   '</label>');
     } elsif ($can_assign{'krb4'}) {      } elsif ($can_assign{'krb4'}) {
         $result .= &mt          $result .= &mt
Line 2674  sub authform_kerberos { Line 2932  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               'onchange="'.$jscall.'"'.$disabled.' />',
          '<label><input type="hidden" name="krbver" value="4" />',           '<label><input type="hidden" name="krbver" value="4" />',
          '</label>');           '</label>');
     } elsif ($can_assign{'krb5'}) {      } elsif ($can_assign{'krb5'}) {
Line 2684  sub authform_kerberos { Line 2942  sub authform_kerberos {
          '<label>'.$authtype,           '<label>'.$authtype,
          '</label><input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               'onchange="'.$jscall.'"'.$disabled.' />',
          '<label><input type="hidden" name="krbver" value="5" />',           '<label><input type="hidden" name="krbver" value="5" />',
          '</label>');           '</label>');
     }      }
Line 2697  sub authform_internal { Line 2955  sub authform_internal {
                 kerb_def_dom => 'MSU.EDU',                  kerb_def_dom => 'MSU.EDU',
                 @_,                  @_,
                 );                  );
     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);      my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'int') {          if ($in{'curr_authtype'} eq 'int') {
             if ($can_assign{'int'}) {              if ($can_assign{'int'}) {
Line 2727  sub authform_internal { Line 2988  sub authform_internal {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="int" />';                      $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2735  sub authform_internal { Line 2996  sub authform_internal {
     $jscall = "javascript:changed_radio('int',$in{'formname'});";      $jscall = "javascript:changed_radio('int',$in{'formname'});";
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.          $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';                      ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
     }      }
     $autharg = '<input type="password" size="10" name="intarg" value="'.      $autharg = '<input type="password" size="10" name="intarg" value="'.
                $intarg.'" onchange="'.$jscall.'" />';                 $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
     $result = &mt      $result = &mt
         ('[_1] Internally authenticated (with initial password [_2])',          ('[_1] Internally authenticated (with initial password [_2])',
          '<label>'.$authtype,'</label>'.$autharg);           '<label>'.$authtype,'</label>'.$autharg);
     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';      $result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
     return $result;      return $result;
 }  }
   
Line 2752  sub authform_local { Line 3013  sub authform_local {
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);      my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'loc') {          if ($in{'curr_authtype'} eq 'loc') {
             if ($can_assign{'loc'}) {              if ($can_assign{'loc'}) {
Line 2782  sub authform_local { Line 3046  sub authform_local {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="loc" />';                      $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2791  sub authform_local { Line 3055  sub authform_local {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="loc" '.          $authtype = '<input type="radio" name="login" value="loc" '.
                     $loccheck.' onchange="'.$jscall.'" onclick="'.                      $loccheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'" />';                      $jscall.'"'.$disabled.' />';
     }      }
     $autharg = '<input type="text" size="10" name="locarg" value="'.      $autharg = '<input type="text" size="10" name="locarg" value="'.
                $locarg.'" onchange="'.$jscall.'" />';                 $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
     $result = &mt('[_1] Local Authentication with argument [_2]',      $result = &mt('[_1] Local Authentication with argument [_2]',
                   '<label>'.$authtype,'</label>'.$autharg);                    '<label>'.$authtype,'</label>'.$autharg);
     return $result;      return $result;
Line 2806  sub authform_filesystem { Line 3070  sub authform_filesystem {
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my ($fsyscheck,$result,$authtype,$autharg,$jscall);      my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});      my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
     if (defined($in{'curr_authtype'})) {      if (defined($in{'curr_authtype'})) {
         if ($in{'curr_authtype'} eq 'fsys') {          if ($in{'curr_authtype'} eq 'fsys') {
             if ($can_assign{'fsys'}) {              if ($can_assign{'fsys'}) {
Line 2833  sub authform_filesystem { Line 3100  sub authform_filesystem {
         if (defined($in{'mode'})) {          if (defined($in{'mode'})) {
             if ($in{'mode'} eq 'modifycourse') {              if ($in{'mode'} eq 'modifycourse') {
                 if ($authnum == 1) {                  if ($authnum == 1) {
                     $authtype = '<input type="radio" name="login" value="fsys" />';                      $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
                 }                  }
             }              }
         }          }
Line 2842  sub authform_filesystem { Line 3109  sub authform_filesystem {
     if ($authtype eq '') {      if ($authtype eq '') {
         $authtype = '<input type="radio" name="login" value="fsys" '.          $authtype = '<input type="radio" name="login" value="fsys" '.
                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.                      $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'" />';                      $jscall.'"'.$disabled.' />';
     }      }
     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.      $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                ' onchange="'.$jscall.'" />';                 ' onchange="'.$jscall.'"'.$disabled.' />';
     $result = &mt      $result = &mt
         ('[_1] Filesystem Authenticated (with initial password [_2])',          ('[_1] Filesystem Authenticated (with initial password [_2])',
          '<label><input type="radio" name="login" value="fsys" '.           '<label><input type="radio" name="login" value="fsys" '.
          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',           $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
          '</label><input type="password" size="10" name="fsysarg" value="" '.           '</label><input type="password" size="10" name="fsysarg" value="" '.
                   'onchange="'.$jscall.'" />');                    'onchange="'.$jscall.'"'.$disabled.' />');
     return $result;      return $result;
 }  }
   
Line 2873  sub get_assignable_auth { Line 3140  sub get_assignable_auth {
             my $context;              my $context;
             if ($env{'request.role'} =~ /^au/) {              if ($env{'request.role'} =~ /^au/) {
                 $context = 'author';                  $context = 'author';
             } elsif ($env{'request.role'} =~ /^dc/) {              } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
                 $context = 'domain';                  $context = 'domain';
             } elsif ($env{'request.course.id'}) {              } elsif ($env{'request.course.id'}) {
                 $context = 'course';                  $context = 'course';
Line 3677  sub user_lang { Line 3944  sub user_lang {
 =over 4  =over 4
   
 =item * &get_previous_attempt($symb, $username, $domain, $course,  =item * &get_previous_attempt($symb, $username, $domain, $course,
     $getattempt, $regexp, $gradesub)      $getattempt, $regexp, $gradesub, $usec, $identifier)
   
 Return string with previous attempt on problem. Arguments:  Return string with previous attempt on problem. Arguments:
   
Line 3699  Return string with previous attempt on p Line 3966  Return string with previous attempt on p
   
 =item * $gradesub: routine that processes the string if it matches $regexp  =item * $gradesub: routine that processes the string if it matches $regexp
   
   =item * $usec: section of the desired student
   
   =item * $identifier: counter for student (multiple students one problem) or
       problem (one student; whole sequence).
   
 =back  =back
   
 The output string is a table containing all desired attempts, if any.  The output string is a table containing all desired attempts, if any.
Line 3706  The output string is a table containing Line 3978  The output string is a table containing
 =cut  =cut
   
 sub get_previous_attempt {  sub get_previous_attempt {
   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;    my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
   my $prevattempts='';    my $prevattempts='';
   no strict 'refs';    no strict 'refs';
   if ($symb) {    if ($symb) {
Line 3716  sub get_previous_attempt { Line 3988  sub get_previous_attempt {
       my %lasthash=();        my %lasthash=();
       my $version;        my $version;
       for ($version=1;$version<=$returnhash{'version'};$version++) {        for ($version=1;$version<=$returnhash{'version'};$version++) {
         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {          foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
   $lasthash{$key}=$returnhash{$version.':'.$key};              if ($key =~ /\.rawrndseed$/) {
                   my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
               } else {
                   $lasthash{$key}=$returnhash{$version.':'.$key};
               }
         }          }
       }        }
       $prevattempts=&start_data_table().&start_data_table_header_row();        $prevattempts=&start_data_table().&start_data_table_header_row();
       $prevattempts.='<th>'.&mt('History').'</th>';        $prevattempts.='<th>'.&mt('History').'</th>';
       my (%typeparts,%lasthidden);        my (%typeparts,%lasthidden,%regraded,%hidestatus);
       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});        my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
       foreach my $key (sort(keys(%lasthash))) {        foreach my $key (sort(keys(%lasthash))) {
  my ($ign,@parts) = split(/\./,$key);   my ($ign,@parts) = split(/\./,$key);
Line 3739  sub get_previous_attempt { Line 4016  sub get_previous_attempt {
                       $lasthidden{$ign.'.'.$id} = 1;                        $lasthidden{$ign.'.'.$id} = 1;
                   }                    }
               }                }
                 if ($identifier ne '') {
                     my $id = join(',',@parts);
                     if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                                                  $domain,$username,$usec,undef,$course) =~ /^no/) {
                         $hidestatus{$ign.'.'.$id} = 1;
                     }
                 }
             } elsif ($data eq 'regrader') {
                 if (($identifier ne '') && (@parts)) {
                     my $id = join(',',@parts);
                     $regraded{$ign.'.'.$id} = 1;
                 }
           }             } 
  } else {   } else {
   if ($#parts == 0) {    if ($#parts == 0) {
Line 3750  sub get_previous_attempt { Line 4039  sub get_previous_attempt {
       }        }
       $prevattempts.=&end_data_table_header_row();        $prevattempts.=&end_data_table_header_row();
       if ($getattempt eq '') {        if ($getattempt eq '') {
           my (%solved,%resets,%probstatus);
           if (($identifier ne '') && (keys(%regraded) > 0)) {
               for ($version=1;$version<=$returnhash{'version'};$version++) {
                   foreach my $id (keys(%regraded)) {
                       if (($returnhash{$version.':'.$id.'.regrader'}) &&
                           ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                           ($returnhash{$version.':'.$id.'.award'} eq '')) {
                           push(@{$resets{$id}},$version);
                       }
                   }
               }
           }
  for ($version=1;$version<=$returnhash{'version'};$version++) {   for ($version=1;$version<=$returnhash{'version'};$version++) {
             my @hidden;              my (@hidden,@unsolved);
             if (%typeparts) {              if (%typeparts) {
                 foreach my $id (keys(%typeparts)) {                  foreach my $id (keys(%typeparts)) {
                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {                      if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
                           ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                         push(@hidden,$id);                          push(@hidden,$id);
                       } elsif ($identifier ne '') {
                           unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                                   ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                                   ($hidestatus{$id})) {
                               next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
                               if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                                   push(@{$solved{$id}},$version);
                               } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                                        (ref($solved{$id}) eq 'ARRAY')) {
                                   my $skip;
                                   if (ref($resets{$id}) eq 'ARRAY') {
                                       foreach my $reset (@{$resets{$id}}) {
                                           if ($reset > $solved{$id}[-1]) {
                                               $skip=1;
                                               last;
                                           }
                                       }
                                   }
                                   unless ($skip) {
                                       my ($ign,$partslist) = split(/\./,$id,2);
                                       push(@unsolved,$partslist);
                                   }
                               }
                           }
                     }                      }
                 }                  }
             }              }
             $prevattempts.=&start_data_table_row().              $prevattempts.=&start_data_table_row().
                            '<td>'.&mt('Transaction [_1]',$version).'</td>';                             '<td>'.&mt('Transaction [_1]',$version);
               if (@unsolved) {
                   $prevattempts .= '<span class="LC_nobreak"><label>'.
                                    '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                                    &mt('Hide').'</label></span>';
               }
               $prevattempts .= '</td>';
             if (@hidden) {              if (@hidden) {
                 foreach my $key (sort(keys(%lasthash))) {                  foreach my $key (sort(keys(%lasthash))) {
                     next if ($key =~ /\.foilorder$/);                      next if ($key =~ /\.foilorder$/);
Line 3782  sub get_previous_attempt { Line 4114  sub get_previous_attempt {
                         }                          }
                     } else {                      } else {
                         if ($key =~ /\./) {                          if ($key =~ /\./) {
                             my $value = &format_previous_attempt_value($key,                              my $value = $returnhash{$version.':'.$key};
                                               $returnhash{$version.':'.$key});                              if ($key =~ /\.rndseed$/) {
                             $prevattempts.='<td>'.$value.'&nbsp;</td>';                                  my ($id) = ($key =~ /^(.+)\.rndseed$/);
                                   if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                                       $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                                   }
                               }
                               $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                                              '&nbsp;</td>';
                         } else {                          } else {
                             $prevattempts.='<td>&nbsp;</td>';                              $prevattempts.='<td>&nbsp;</td>';
                         }                          }
Line 3793  sub get_previous_attempt { Line 4131  sub get_previous_attempt {
             } else {              } else {
         foreach my $key (sort(keys(%lasthash))) {          foreach my $key (sort(keys(%lasthash))) {
                     next if ($key =~ /\.foilorder$/);                      next if ($key =~ /\.foilorder$/);
     my $value = &format_previous_attempt_value($key,                      my $value = $returnhash{$version.':'.$key};
             $returnhash{$version.':'.$key});                      if ($key =~ /\.rndseed$/) {
     $prevattempts.='<td>'.$value.'&nbsp;</td>';                          my ($id) = ($key =~ /^(.+)\.rndseed$/);
                           if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                               $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                           }
                       }
                       $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                                      '&nbsp;</td>';
         }          }
             }              }
     $prevattempts.=&end_data_table_row();      $prevattempts.=&end_data_table_row();
Line 4352  sub blockcheck { Line 4696  sub blockcheck {
                                                                 $tdom,$spec,$trest,$area);                                                                  $tdom,$spec,$trest,$area);
                         }                          }
                     }                      }
                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);                      my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {                      if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                         if ($1) {                          if ($1) {
                             $no_userblock = 1;                              $no_userblock = 1;
Line 4550  sub blocking_status { Line 4894  sub blocking_status {
 # build a link to a popup window containing the details  # build a link to a popup window containing the details
     my $querystring  = "?activity=$activity";      my $querystring  = "?activity=$activity";
 # $uname and $udom decide whose portfolio the user is trying to look at  # $uname and $udom decide whose portfolio the user is trying to look at
     if ($activity eq 'port') {      if (($activity eq 'port') || ($activity eq 'passwd')) {
         $querystring .= "&amp;udom=$udom"      if $udom;          $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);
         $querystring .= "&amp;uname=$uname"    if $uname;          $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
     } elsif ($activity eq 'docs') {      } elsif ($activity eq 'docs') {
         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');          $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
     }      }
Line 4571  END_MYBLOCK Line 4915  END_MYBLOCK
       
     my $popupUrl = "/adm/blockingstatus/$querystring";      my $popupUrl = "/adm/blockingstatus/$querystring";
     my $text = &mt('Communication Blocked');      my $text = &mt('Communication Blocked');
       my $class = 'LC_comblock';
     if ($activity eq 'docs') {      if ($activity eq 'docs') {
         $text = &mt('Content Access Blocked');          $text = &mt('Content Access Blocked');
           $class = '';
     } elsif ($activity eq 'printout') {      } elsif ($activity eq 'printout') {
         $text = &mt('Printing Blocked');          $text = &mt('Printing Blocked');
       } elsif ($activity eq 'passwd') {
           $text = &mt('Password Changing Blocked');
     }      }
     $output .= <<"END_BLOCK";      $output .= <<"END_BLOCK";
 <div class='LC_comblock'>  <div class='$class'>
   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'    <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
   title='$text'>    title='$text'>
   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>    <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
Line 4593  END_BLOCK Line 4941  END_BLOCK
 ###############################################  ###############################################
   
 sub check_ip_acc {  sub check_ip_acc {
     my ($acc)=@_;      my ($acc,$clientip)=@_;
     &Apache::lonxml::debug("acc is $acc");      &Apache::lonxml::debug("acc is $acc");
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed=0;      my $allowed=0;
     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};      my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
   
     my $name;      my $name;
     foreach my $pattern (split(',',$acc)) {      foreach my $pattern (split(',',$acc)) {
Line 4695  sub get_domainconf { Line 5043  sub get_domainconf {
             if (keys(%{$domconfig{'login'}})) {              if (keys(%{$domconfig{'login'}})) {
                 foreach my $key (keys(%{$domconfig{'login'}})) {                  foreach my $key (keys(%{$domconfig{'login'}})) {
                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {                      if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                         if ($key eq 'loginvia') {                          if (($key eq 'loginvia') || ($key eq 'headtag')) {
                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {                              if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {                                  foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {                                      if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {                                          if ($key eq 'loginvia') {
                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};                                              if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                                             $designhash{$udom.'.login.loginvia'} = $server;                                                  my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {                                                  $designhash{$udom.'.login.loginvia'} = $server;
                                                   if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};                                                      $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                                             } else {                                                  } else {
                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};                                                      $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                                                   }
                                             }                                              }
                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {                                          } elsif ($key eq 'headtag') {
                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};                                              if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                                                   $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
                                             }                                              }
                                         }                                          }
                                           if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                                               $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                                           }
                                     }                                      }
                                 }                                  }
                             }                              }
Line 5035  Inputs: Line 5388  Inputs:
   
 =item * $args, optional argument valid values are  =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg              no_auto_mt_title -> prevents &mt()ing the title arg
             inherit_jsmath -> when creating popup window in a page,  
                               should it have jsmath forced on by the  
                               current page  
   
 =item * $advtoolsref, optional argument, ref to an array containing  =item * $advtoolsref, optional argument, ref to an array containing
             inlineremote items to be added in "Functions" menu below              inlineremote items to be added in "Functions" menu below
Line 5090  sub bodytag { Line 5440  sub bodytag {
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         if ($env{'request.role'} !~ /^cr/) {          if ($env{'request.role'} !~ /^cr/) {
             $role = &Apache::lonnet::plaintext($role,&course_type());              $role = &Apache::lonnet::plaintext($role,&course_type());
           } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
               if ($env{'request.role.desc'}) {
                   $role = $env{'request.role.desc'};
               } else {
                   $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
               }
           } else {
               $role = (split(/\//,$role,4))[-1];
         }          }
         if ($env{'request.course.sec'}) {          if ($env{'request.course.sec'}) {
             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};              $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
Line 5105  sub bodytag { Line 5463  sub bodytag {
   
 # construct main body tag  # construct main body tag
     my $bodytag = "<body $extra_body_attr>".      my $bodytag = "<body $extra_body_attr>".
  &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});   &Apache::lontexconvert::init_math_support();
   
     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);      &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
   
Line 5129  sub bodytag { Line 5487  sub bodytag {
         $dc_info =~ s/\s+$//;          $dc_info =~ s/\s+$//;
     }      }
   
     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;      $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
   
     if ($env{'request.state'} eq 'construct') { $forcereg=1; }      if ($env{'request.state'} eq 'construct') { $forcereg=1; }
   
Line 5190  sub bodytag { Line 5548  sub bodytag {
             if ($env{'request.state'} eq 'construct') {              if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,
                                 $args->{'bread_crumbs'});                                  $args->{'bread_crumbs'});
             } elsif ($forcereg) {               } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                             $args->{'group'});                                                              $args->{'group'},
                                                               $args->{'hide_buttons'});
             } else {              } else {
                 my $forbodytag;                  my $forbodytag;
                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},                  &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
Line 5332  sub endbodytag { Line 5691  sub endbodytag {
     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {      unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
         $endbodytag='</body>';          $endbodytag='</body>';
     }      }
     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;  
     if ( exists( $env{'internal.head.redirect'} ) ) {      if ( exists( $env{'internal.head.redirect'} ) ) {
         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {          if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
     $endbodytag=      $endbodytag=
Line 5507  div.LC_confirm_box .LC_success img { Line 5865  div.LC_confirm_box .LC_success img {
   vertical-align: middle;    vertical-align: middle;
 }  }
   
   .LC_maxwidth {
     max-width: 100%;
     height: auto;
   }
   
   .LC_textsize_mobile {
     \@media only screen and (max-device-width: 480px) {
         -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
     }
   }
   
 .LC_icon {  .LC_icon {
   border: none;    border: none;
   vertical-align: middle;    vertical-align: middle;
Line 5628  table#LC_menubuttons img { Line 5997  table#LC_menubuttons img {
   vertical-align: middle;    vertical-align: middle;
 }  }
   
   .LC_breadcrumbs_hoverable {
     background: $sidebg;
   }
   
 td.LC_table_cell_checkbox {  td.LC_table_cell_checkbox {
   text-align: center;    text-align: center;
 }  }
Line 6485  div.LC_edit_problem_footer, Line 6858  div.LC_edit_problem_footer,
 div.LC_edit_problem_footer div,  div.LC_edit_problem_footer div,
 div.LC_edit_problem_editxml_header,  div.LC_edit_problem_editxml_header,
 div.LC_edit_problem_editxml_header div {  div.LC_edit_problem_editxml_header div {
   margin-top: 5px;    z-index: 100;
 }  }
   
 div.LC_edit_problem_header_title {  div.LC_edit_problem_header_title {
Line 6501  table.LC_edit_problem_header_title { Line 6874  table.LC_edit_problem_header_title {
   background: $tabbg;    background: $tabbg;
 }  }
   
 div.LC_edit_problem_discards {  div.LC_edit_actionbar {
   float: left;      background-color: $sidebg;
   padding-bottom: 5px;      margin: 0;
       padding: 0;
       line-height: 200%;
 }  }
   
 div.LC_edit_problem_saves {  div.LC_edit_actionbar div{
   float: right;      padding: 0;
   padding-bottom: 5px;      margin: 0;
       display: inline-block;
 }  }
   
 .LC_edit_opt {  .LC_edit_opt {
Line 6524  div.LC_edit_problem_saves { Line 6900  div.LC_edit_problem_saves {
     margin-left: 40px;      margin-left: 40px;
 }  }
   
   #LC_edit_problem_codemirror div{
       margin-left: 0px;
   }
   
 img.stift {  img.stift {
   border-width: 0;    border-width: 0;
   vertical-align: middle;    vertical-align: middle;
Line 6611  fieldset { Line 6991  fieldset {
   /* overflow: hidden; */    /* overflow: hidden; */
 }  }
   
   article.geogebraweb div {
       margin: 0;
   }
   
 fieldset > legend {  fieldset > legend {
   font-weight: bold;    font-weight: bold;
   padding: 0 5px 0 5px;    padding: 0 5px 0 5px;
Line 6638  fieldset > legend { Line 7022  fieldset > legend {
 ol.LC_primary_menu {  ol.LC_primary_menu {
   margin: 0;    margin: 0;
   padding: 0;    padding: 0;
   background-color: $pgbg_or_bgcolor;  
 }  }
   
 ol#LC_PathBreadcrumbs {  ol#LC_PathBreadcrumbs {
Line 6650  ol.LC_primary_menu li { Line 7033  ol.LC_primary_menu li {
   vertical-align: middle;    vertical-align: middle;
   text-align: left;    text-align: left;
   list-style: none;    list-style: none;
     position: relative;
   float: left;    float: left;
     z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
     line-height: 1.5em;
 }  }
   
 ol.LC_primary_menu li a {  ol.LC_primary_menu li a, 
   ol.LC_primary_menu li p {
   display: block;    display: block;
   margin: 0;    margin: 0;
   padding: 0 5px 0 10px;    padding: 0 5px 0 10px;
   text-decoration: none;    text-decoration: none;
 }  }
   
 ol.LC_primary_menu li ul {  ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
     display: inline-block;
     width: 95%;
     text-align: left;
   }
   
   ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
     display: inline-block;
     width: 5%;
     float: right;
     text-align: right;
     font-size: 70%;
   }
   
   ol.LC_primary_menu ul {
   display: none;    display: none;
   width: 10em;    width: 15em;
   background-color: $data_table_light;    background-color: $data_table_light;
     position: absolute;
     top: 100%;
   }
   
   ol.LC_primary_menu ul ul {
     left: 100%;
     top: 0;
 }  }
   
 ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {  ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
   display: block;    display: block;
   position: absolute;    position: absolute;
   margin: 0;    margin: 0;
Line 6675  ol.LC_primary_menu li:hover ul, ol.LC_pr Line 7083  ol.LC_primary_menu li:hover ul, ol.LC_pr
 }  }
   
 ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {  ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
   /* First Submenu -> size should be smaller than the menu title of the whole menu */
   font-size: 90%;    font-size: 90%;
   vertical-align: top;    vertical-align: top;
   float: none;    float: none;
   border-left: 1px solid black;    border-left: 1px solid black;
   border-right: 1px solid black;    border-right: 1px solid black;
   /* A dark bottom border to visualize different menu options;
   overwritten in the create_submenu routine for the last border-bottom of the menu */
     border-bottom: 1px solid $data_table_dark;
 }  }
   
 ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {  ol.LC_primary_menu li li p:hover {
   background-color:$data_table_light;    color:$button_hover;
     text-decoration:none;
     background-color:$data_table_dark;
 }  }
   
 ol.LC_primary_menu li li a:hover {  ol.LC_primary_menu li li a:hover {
Line 6691  ol.LC_primary_menu li li a:hover { Line 7105  ol.LC_primary_menu li li a:hover {
    background-color:$data_table_dark;     background-color:$data_table_dark;
 }  }
   
   /* Font-size equal to the size of the predecessors*/
   ol.LC_primary_menu li:hover li li {
     font-size: 100%;
   }
   
 ol.LC_primary_menu li img {  ol.LC_primary_menu li img {
   vertical-align: bottom;    vertical-align: bottom;
   height: 1.1em;    height: 1.1em;
Line 6747  ul#LC_secondary_menu li { Line 7166  ul#LC_secondary_menu li {
   font-weight: bold;    font-weight: bold;
   line-height: 1.8em;    line-height: 1.8em;
   border-right: 1px solid black;    border-right: 1px solid black;
   vertical-align: middle;  
   float: left;    float: left;
 }  }
   
Line 7254  span.roman {font-family: serif; font-sty Line 7672  span.roman {font-family: serif; font-sty
 span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}  span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
 span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}  span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
   
   #LC_minitab_header {
     float:left;
     width:100%;
     background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
     font-size:93%;
     line-height:normal;
     margin: 0.5em 0 0.5em 0;
   }
   #LC_minitab_header ul {
     margin:0;
     padding:10px 10px 0;
     list-style:none;
   }
   #LC_minitab_header li {
     float:left;
     background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
     margin:0;
     padding:0 0 0 9px;
   }
   #LC_minitab_header a {
     display:block;
     background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
     padding:5px 15px 4px 6px;
   }
   #LC_minitab_header #LC_current_minitab {
     background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
   }
   #LC_minitab_header #LC_current_minitab a {
     background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
     padding-bottom:5px;
   }
   
   
 END  END
 }  }
   
Line 7346  sub headtag { Line 7797  sub headtag {
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 <meta http-equiv="Refresh" content="$time; url=$url" />  <meta http-equiv="Refresh" content="$time; url=$url" />
 ADDMETA  ADDMETA
       } else {
           unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
               my $requrl = $env{'request.uri'};
               if ($requrl eq '') {
                   $requrl = $ENV{'REQUEST_URI'};
                   $requrl =~ s/\?.+$//;
               }
               unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                       (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                        ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                       my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                       if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                           my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                           if ($domdefs{'offloadnow'}{$lonhost}) {
                               my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                               if (($newserver) && ($newserver ne $lonhost)) {
                                   my $numsec = 5;
                                   my $timeout = $numsec * 1000;
                                   my ($newurl,$locknum,%locks,$msg);
                                   if ($env{'request.role.adv'}) {
                                       ($locknum,%locks) = &Apache::lonnet::get_locks();
                                   }
                                   my $disable_submit = 0;
                                   if ($requrl =~ /$LONCAPA::assess_re/) {
                                       $disable_submit = 1;
                                   }
                                   if ($locknum) {
                                       my @lockinfo = sort(values(%locks));
                                       $msg = &mt('Once the following tasks are complete: ')."\\n".
                                              join(", ",sort(values(%locks)))."\\n".
                                              &mt('your session will be transferred to a different server, after you click "Roles".');
                                   } else {
                                       if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                                           $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                                       }
                                       $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                                       $newurl = '/adm/switchserver?otherserver='.$newserver;
                                       if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                                           $newurl .= '&role='.$env{'request.role'};
                                       }
                                       if ($env{'request.symb'}) {
                                           $newurl .= '&symb='.$env{'request.symb'};
                                       } else {
                                           $newurl .= '&origurl='.$requrl;
                                       }
                                   }
                                   &js_escape(\$msg);
                                   $result.=<<OFFLOAD
   <meta http-equiv="pragma" content="no-cache" />
   <script type="text/javascript">
   // <![CDATA[
   function LC_Offload_Now() {
       var dest = "$newurl";
       if (dest != '') {
           window.location.href="$newurl";
       }
   }
   \$(document).ready(function () {
       window.alert('$msg');
       if ($disable_submit) {
           \$(".LC_hwk_submit").prop("disabled", true);
           \$( ".LC_textline" ).prop( "readonly", "readonly");
       }
       setTimeout('LC_Offload_Now()', $timeout);
   });
   // ]]>
   </script>
   OFFLOAD
                               }
                           }
                       }
                   }
               }
           }
     }      }
     if (!defined($title)) {      if (!defined($title)) {
  $title = 'The LearningOnline Network with CAPA';   $title = 'The LearningOnline Network with CAPA';
Line 7359  ADDMETA Line 7886  ADDMETA
     $result .= '>'      $result .= '>'
         .$inhibitprint          .$inhibitprint
  .$head_extra;   .$head_extra;
     if ($env{'browser.mobile'}) {      my $clientmobile;
       if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
           (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
       } else {
           $clientmobile = $env{'browser.mobile'};
       }
       if ($clientmobile) {
         $result .= '          $result .= '
 <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">  <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
 <meta name="apple-mobile-web-app-capable" content="yes" />';  <meta name="apple-mobile-web-app-capable" content="yes" />';
Line 7543  $args - additional optional args support Line 8076  $args - additional optional args support
              no_inline_link -> if true and in remote mode, don't show the               no_inline_link -> if true and in remote mode, don't show the
                                     'Switch To Inline Menu' link                                      'Switch To Inline Menu' link
              no_auto_mt_title -> prevent &mt()ing the title arg               no_auto_mt_title -> prevent &mt()ing the title arg
              inherit_jsmath -> when creating popup window in a page,  
                                     should it have jsmath forced on by the  
                                     current page  
              bread_crumbs ->             Array containing breadcrumbs               bread_crumbs ->             Array containing breadcrumbs
              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs               bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
                bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                                       to lonhtmlcommon::breadcrumbs
              group          -> includes the current group, if page is for a               group          -> includes the current group, if page is for a
                                specific group                                 specific group
   
Line 7613  sub start_page { Line 8145  sub start_page {
                 if (@advtools > 0) {                  if (@advtools > 0) {
                     &Apache::lonmenu::advtools_crumbs(@advtools);                      &Apache::lonmenu::advtools_crumbs(@advtools);
                 }                  }
                   my $menulink;
                   # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                   if (exists($args->{'bread_crumbs_nomenu'})) {
                       $menulink = 0;
                   } else {
                       undef($menulink);
                   }
  #if bread_crumbs_component exists show it as headline else show only the breadcrumbs   #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
  if(exists($args->{'bread_crumbs_component'})){   if(exists($args->{'bread_crumbs_component'})){
  $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});   $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
  }else{   }else{
  $result .= &Apache::lonhtmlcommon::breadcrumbs();   $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
  }   }
     } elsif (($env{'environment.remote'} eq 'on') &&      } elsif (($env{'environment.remote'} eq 'on') &&
              ($env{'form.inhibitmenu'} ne 'yes') &&               ($env{'form.inhibitmenu'} ne 'yes') &&
Line 7672  function set_wishlistlink(title, path) { Line 8210  function set_wishlistlink(title, path) {
         title = title.replace(/^LON-CAPA /,'');          title = title.replace(/^LON-CAPA /,'');
     }      }
     title = encodeURIComponent(title);      title = encodeURIComponent(title);
       title = title.replace("'","\\\'");
     if (!path) {      if (!path) {
         path = location.pathname;          path = location.pathname;
     }      }
     path = encodeURIComponent(path);      path = encodeURIComponent(path);
       path = path.replace("'","\\\'");
     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,      Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                       'wishlistNewLink','width=560,height=350,scrollbars=0');                        'wishlistNewLink','width=560,height=350,scrollbars=0');
 }  }
Line 7718  var modalWindow = { Line 8258  var modalWindow = {
 };  };
  var openMyModal = function(source,width,height,scrolling,transparency,style)   var openMyModal = function(source,width,height,scrolling,transparency,style)
  {   {
                   source = source.replace(/'/g,"&#39;");
  modalWindow.windowId = "myModal";   modalWindow.windowId = "myModal";
  modalWindow.width = width;   modalWindow.width = width;
  modalWindow.height = height;   modalWindow.height = height;
  modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";   modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
  modalWindow.open();   modalWindow.open();
  };   };
 // END LON-CAPA Internal -->  // END LON-CAPA Internal -->
 // ]]>  // ]]>
 </script>  </script>
Line 8325  role status: active, previous or future. Line 8866  role status: active, previous or future.
 sub check_user_status {  sub check_user_status {
     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;      my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);      my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
     my @uroles = keys %userinfo;      my @uroles = keys(%userinfo);
     my $srchstr;      my $srchstr;
     my $active_chk = 'none';      my $active_chk = 'none';
     my $now = time;      my $now = time;
Line 9033  sub get_secgrprole_info { Line 9574  sub get_secgrprole_info {
 }  }
   
 sub user_picker {  sub user_picker {
     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;      my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom) = @_;
     my $currdom = $dom;      my $currdom = $dom;
       my @alldoms = &Apache::lonnet::all_domains();
       if (@alldoms == 1) {
           my %domsrch = &Apache::lonnet::get_dom('configuration',
                                                  ['directorysrch'],$alldoms[0]);
           my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
           my $showdom = $domdesc;
           if ($showdom eq '') {
               $showdom = $dom;
           }
           if (ref($domsrch{'directorysrch'}) eq 'HASH') {
               if ((!$domsrch{'directorysrch'}{'available'}) &&
                   ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
                   return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
               }
           }
       }
     my %curr_selected = (      my %curr_selected = (
                         srchin => 'dom',                          srchin => 'dom',
                         srchby => 'lastname',                          srchby => 'lastname',
Line 9055  sub user_picker { Line 9612  sub user_picker {
         }          }
         $srchterm = $srch->{'srchterm'};          $srchterm = $srch->{'srchterm'};
     }      }
     my %lt=&Apache::lonlocal::texthash(      my %html_lt=&Apache::lonlocal::texthash(
                     'usr'       => 'Search criteria',                      'usr'       => 'Search criteria',
                     'doma'      => 'Domain/institution to search',                      'doma'      => 'Domain/institution to search',
                     'uname'     => 'username',                      'uname'     => 'username',
Line 9068  sub user_picker { Line 9625  sub user_picker {
                     'exact'     => 'is',                      'exact'     => 'is',
                     'contains'  => 'contains',                      'contains'  => 'contains',
                     'begins'    => 'begins with',                      'begins'    => 'begins with',
                                          );
       my %js_lt=&Apache::lonlocal::texthash(
                     'youm'      => "You must include some text to search for.",                      'youm'      => "You must include some text to search for.",
                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",                      'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",                      'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
Line 9077  sub user_picker { Line 9636  sub user_picker {
                     'whse'      => "When searching by last,first you must include at least one character in the first name.",                      'whse'      => "When searching by last,first you must include at least one character in the first name.",
                      'thfo'     => "The following need to be corrected before the search can be run:",                       'thfo'     => "The following need to be corrected before the search can be run:",
                                        );                                         );
     my $domform = &select_dom_form($currdom,'srchdomain',1,1);      &html_escape(\%html_lt);
       &js_escape(\%js_lt);
       my $domform;
       if ($fixeddom) {
           $domform = &select_dom_form($currdom,'srchdomain',1,1,undef,[$currdom]);
       } else {
           $domform = &select_dom_form($currdom,'srchdomain',1,1);
       }
     my $srchinsel = ' <select name="srchin">';      my $srchinsel = ' <select name="srchin">';
   
     my @srchins = ('crs','dom','alc','instd');      my @srchins = ('crs','dom','alc','instd');
Line 9091  sub user_picker { Line 9657  sub user_picker {
         next if ($option eq 'crs' && !$env{'request.course.id'});          next if ($option eq 'crs' && !$env{'request.course.id'});
         if ($curr_selected{'srchin'} eq $option) {          if ($curr_selected{'srchin'} eq $option) {
             $srchinsel .= '               $srchinsel .= ' 
    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
         } else {          } else {
             $srchinsel .= '              $srchinsel .= '
    <option value="'.$option.'">'.$lt{$option}.'</option>';     <option value="'.$option.'">'.$html_lt{$option}.'</option>';
         }          }
     }      }
     $srchinsel .= "\n  </select>\n";      $srchinsel .= "\n  </select>\n";
Line 9103  sub user_picker { Line 9669  sub user_picker {
     foreach my $option ('lastname','lastfirst','uname') {      foreach my $option ('lastname','lastfirst','uname') {
         if ($curr_selected{'srchby'} eq $option) {          if ($curr_selected{'srchby'} eq $option) {
             $srchbysel .= '              $srchbysel .= '
    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
         } else {          } else {
             $srchbysel .= '              $srchbysel .= '
    <option value="'.$option.'">'.$lt{$option}.'</option>';     <option value="'.$option.'">'.$html_lt{$option}.'</option>';
          }           }
     }      }
     $srchbysel .= "\n  </select>\n";      $srchbysel .= "\n  </select>\n";
Line 9115  sub user_picker { Line 9681  sub user_picker {
     foreach my $option ('begins','contains','exact') {      foreach my $option ('begins','contains','exact') {
         if ($curr_selected{'srchtype'} eq $option) {          if ($curr_selected{'srchtype'} eq $option) {
             $srchtypesel .= '              $srchtypesel .= '
    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';     <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
         } else {          } else {
             $srchtypesel .= '              $srchtypesel .= '
    <option value="'.$option.'">'.$lt{$option}.'</option>';     <option value="'.$option.'">'.$html_lt{$option}.'</option>';
         }          }
     }      }
     $srchtypesel .= "\n  </select>\n";      $srchtypesel .= "\n  </select>\n";
Line 9203  function validateEntry(callingForm) { Line 9769  function validateEntry(callingForm) {
   
     if (srchterm == "") {      if (srchterm == "") {
         checkok = 0;          checkok = 0;
         msg += "$lt{'youm'}\\n";          msg += "$js_lt{'youm'}\\n";
     }      }
   
     if (srchtype== 'begins') {      if (srchtype== 'begins') {
         if (srchterm.length < 2) {          if (srchterm.length < 2) {
             checkok = 0;              checkok = 0;
             msg += "$lt{'thte'}\\n";              msg += "$js_lt{'thte'}\\n";
         }          }
     }      }
   
     if (srchtype== 'contains') {      if (srchtype== 'contains') {
         if (srchterm.length < 3) {          if (srchterm.length < 3) {
             checkok = 0;              checkok = 0;
             msg += "$lt{'thet'}\\n";              msg += "$js_lt{'thet'}\\n";
         }          }
     }      }
     if (srchin == 'instd') {      if (srchin == 'instd') {
         if (srchdomain == '') {          if (srchdomain == '') {
             checkok = 0;              checkok = 0;
             msg += "$lt{'yomc'}\\n";              msg += "$js_lt{'yomc'}\\n";
         }          }
     }      }
     if (srchin == 'dom') {      if (srchin == 'dom') {
         if (srchdomain == '') {          if (srchdomain == '') {
             checkok = 0;              checkok = 0;
             msg += "$lt{'ymcd'}\\n";              msg += "$js_lt{'ymcd'}\\n";
         }          }
     }      }
     if (srchby == 'lastfirst') {      if (srchby == 'lastfirst') {
         if (srchterm.indexOf(",") == -1) {          if (srchterm.indexOf(",") == -1) {
             checkok = 0;              checkok = 0;
             msg += "$lt{'whus'}\\n";              msg += "$js_lt{'whus'}\\n";
         }          }
         if (srchterm.indexOf(",") == srchterm.length -1) {          if (srchterm.indexOf(",") == srchterm.length -1) {
             checkok = 0;              checkok = 0;
             msg += "$lt{'whse'}\\n";              msg += "$js_lt{'whse'}\\n";
         }          }
     }      }
     if (checkok == 0) {      if (checkok == 0) {
         alert("$lt{'thfo'}\\n"+msg);          alert("$js_lt{'thfo'}\\n"+msg);
         return;          return;
     }      }
     if (checkok == 1) {      if (checkok == 1) {
Line 9260  $new_user_create Line 9826  $new_user_create
 END_BLOCK  END_BLOCK
   
     $output .= &Apache::lonhtmlcommon::start_pick_box().      $output .= &Apache::lonhtmlcommon::start_pick_box().
                &Apache::lonhtmlcommon::row_title($lt{'doma'}).                 &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
                $domform.                 $domform.
                &Apache::lonhtmlcommon::row_closure().                 &Apache::lonhtmlcommon::row_closure().
                &Apache::lonhtmlcommon::row_title($lt{'usr'}).                 &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
                $srchbysel.                 $srchbysel.
                $srchtypesel.                  $srchtypesel. 
                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.                 '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
Line 9271  END_BLOCK Line 9837  END_BLOCK
                &Apache::lonhtmlcommon::row_closure(1)                 &Apache::lonhtmlcommon::row_closure(1)
                &Apache::lonhtmlcommon::end_pick_box().                 &Apache::lonhtmlcommon::end_pick_box().
                '<br />';                 '<br />';
     return $output;      return ($output,1);
 }  }
   
 sub user_rule_check {  sub user_rule_check {
     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;      my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
     my $response;      my ($response,%inst_response);
     if (ref($usershash) eq 'HASH') {      if (ref($usershash) eq 'HASH') {
         foreach my $user (keys(%{$usershash})) {          if (keys(%{$usershash}) > 1) {
             my ($uname,$udom) = split(/:/,$user);              my (%by_username,%by_id,%userdoms);
             next if ($udom eq '' || $uname eq '');              my $checkid;
             my ($id,$newuser);  
             if (ref($usershash->{$user}) eq 'HASH') {  
                 $newuser = $usershash->{$user}->{'newuser'};  
                 $id = $usershash->{$user}->{'id'};  
             }  
             my $inst_response;  
             if (ref($checks) eq 'HASH') {              if (ref($checks) eq 'HASH') {
                 if (defined($checks->{'username'})) {                  if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                     ($inst_response,%{$inst_results->{$user}}) =                       $checkid = 1;
                         &Apache::lonnet::get_instuser($udom,$uname);                  }
                 } elsif (defined($checks->{'id'})) {              }
                     ($inst_response,%{$inst_results->{$user}}) =              foreach my $user (keys(%{$usershash})) {
                         &Apache::lonnet::get_instuser($udom,undef,$id);                  my ($uname,$udom) = split(/:/,$user);
                   if ($checkid) {
                       if (ref($usershash->{$user}) eq 'HASH') {
                           if ($usershash->{$user}->{'id'} ne '') {
                               $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
                               $userdoms{$udom} = 1;
                               if (ref($inst_results) eq 'HASH') {
                                   $inst_results->{$uname.':'.$udom} = {};
                               }
                           }
                       }
                   } else {
                       $by_username{$udom}{$uname} = 1;
                       $userdoms{$udom} = 1;
                       if (ref($inst_results) eq 'HASH') {
                           $inst_results->{$uname.':'.$udom} = {};
                       }
                   }
               }
               foreach my $udom (keys(%userdoms)) {
                   if (!$got_rules->{$udom}) {
                       my %domconfig = &Apache::lonnet::get_dom('configuration',
                                                                ['usercreation'],$udom);
                       if (ref($domconfig{'usercreation'}) eq 'HASH') {
                           foreach my $item ('username','id') {
                               if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                                   $$curr_rules{$udom}{$item} =
                                       $domconfig{'usercreation'}{$item.'_rule'};
                               }
                           }
                       }
                       $got_rules->{$udom} = 1;
                   }
               }
               if ($checkid) {
                   foreach my $udom (keys(%by_id)) {
                       my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                       if ($outcome eq 'ok') {
                           foreach my $id (keys(%{$by_id{$udom}})) {
                               my $uname = $by_id{$udom}{$id};
                               $inst_response{$uname.':'.$udom} = $outcome;
                           }
                           if (ref($results) eq 'HASH') {
                               foreach my $uname (keys(%{$results})) {
                                   if (exists($inst_response{$uname.':'.$udom})) {
                                       $inst_response{$uname.':'.$udom} = $outcome;
                                       $inst_results->{$uname.':'.$udom} = $results->{$uname};
                                   }
                               }
                           }
                       }
                 }                  }
             } else {              } else {
                 ($inst_response,%{$inst_results->{$user}}) =                  foreach my $udom (keys(%by_username)) {
                     &Apache::lonnet::get_instuser($udom,$uname);                      my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                 return;                      if ($outcome eq 'ok') {
                           foreach my $uname (keys(%{$by_username{$udom}})) {
                               $inst_response{$uname.':'.$udom} = $outcome;
                           }
                           if (ref($results) eq 'HASH') {
                               foreach my $uname (keys(%{$results})) {
                                   $inst_results->{$uname.':'.$udom} = $results->{$uname};
                               }
                           }
                       }
                   }
             }              }
             if (!$got_rules->{$udom}) {          } elsif (keys(%{$usershash}) == 1) {
                 my %domconfig = &Apache::lonnet::get_dom('configuration',              my $user = (keys(%{$usershash}))[0];
                                                   ['usercreation'],$udom);              my ($uname,$udom) = split(/:/,$user);
                 if (ref($domconfig{'usercreation'}) eq 'HASH') {              if (($udom ne '') && ($uname ne '')) {
                     foreach my $item ('username','id') {                  if (ref($usershash->{$user}) eq 'HASH') {
                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {                      if (ref($checks) eq 'HASH') {
                             $$curr_rules{$udom}{$item} =                           if (defined($checks->{'username'})) {
                                 $domconfig{'usercreation'}{$item.'_rule'};                              ($inst_response{$user},%{$inst_results->{$user}}) =
                                   &Apache::lonnet::get_instuser($udom,$uname);
                           } elsif (defined($checks->{'id'})) {
                               if ($usershash->{$user}->{'id'} ne '') {
                                   ($inst_response{$user},%{$inst_results->{$user}}) =
                                       &Apache::lonnet::get_instuser($udom,undef,
                                                                     $usershash->{$user}->{'id'});
                               } else {
                                   ($inst_response{$user},%{$inst_results->{$user}}) =
                                       &Apache::lonnet::get_instuser($udom,$uname);
                               }
                           }
                       } else {
                          ($inst_response{$user},%{$inst_results->{$user}}) =
                               &Apache::lonnet::get_instuser($udom,$uname);
                          return;
                       }
                       if (!$got_rules->{$udom}) {
                           my %domconfig = &Apache::lonnet::get_dom('configuration',
                                                                    ['usercreation'],$udom);
                           if (ref($domconfig{'usercreation'}) eq 'HASH') {
                               foreach my $item ('username','id') {
                                   if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                                      $$curr_rules{$udom}{$item} =
                                          $domconfig{'usercreation'}{$item.'_rule'};
                                   }
                               }
                         }                          }
                           $got_rules->{$udom} = 1;
                     }                      }
                 }                  }
                 $got_rules->{$udom} = 1;                } else {
                   return;
               }
           } else {
               return;
           }
           foreach my $user (keys(%{$usershash})) {
               my ($uname,$udom) = split(/:/,$user);
               next if (($udom eq '') || ($uname eq ''));
               my $id;
               if (ref($inst_results) eq 'HASH') {
                   if (ref($inst_results->{$user}) eq 'HASH') {
                       $id = $inst_results->{$user}->{'id'};
                   }
               }
               if ($id eq '') {
                   if (ref($usershash->{$user})) {
                       $id = $usershash->{$user}->{'id'};
                   }
             }              }
             foreach my $item (keys(%{$checks})) {              foreach my $item (keys(%{$checks})) {
                 if (ref($$curr_rules{$udom}) eq 'HASH') {                  if (ref($$curr_rules{$udom}) eq 'HASH') {
                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {                      if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                         if (@{$$curr_rules{$udom}{$item}} > 0) {                          if (@{$$curr_rules{$udom}{$item}} > 0) {
                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});                              my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                                                                                $$curr_rules{$udom}{$item});
                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {                              foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                                 if ($rule_check{$rule}) {                                  if ($rule_check{$rule}) {
                                     $$rulematch{$user}{$item} = $rule;                                      $$rulematch{$user}{$item} = $rule;
                                     if ($inst_response eq 'ok') {                                      if ($inst_response{$user} eq 'ok') {
                                         if (ref($inst_results) eq 'HASH') {                                          if (ref($inst_results) eq 'HASH') {
                                             if (ref($inst_results->{$user}) eq 'HASH') {                                              if (ref($inst_results->{$user}) eq 'HASH') {
                                                 if (keys(%{$inst_results->{$user}}) == 0) {                                                  if (keys(%{$inst_results->{$user}}) == 0) {
                                                     $$alerts{$item}{$udom}{$uname} = 1;                                                      $$alerts{$item}{$udom}{$uname} = 1;
                                                   } elsif ($item eq 'id') {
                                                       if ($inst_results->{$user}->{'id'} eq '') {
                                                           $$alerts{$item}{$udom}{$uname} = 1;
                                                       }
                                                 }                                                  }
                                             }                                              }
                                         }                                          }
Line 9482  sub get_institutional_codes { Line 10152  sub get_institutional_codes {
         foreach (@currxlists) {          foreach (@currxlists) {
             if (m/^([^:]+):(\w*)$/) {              if (m/^([^:]+):(\w*)$/) {
                 unless (grep/^$1$/,@{$allcourses}) {                  unless (grep/^$1$/,@{$allcourses}) {
                     push @{$allcourses},$1;                      push(@{$allcourses},$1);
                     $$LC_code{$1} = $2;                      $$LC_code{$1} = $2;
                 }                  }
             }              }
Line 9495  sub get_institutional_codes { Line 10165  sub get_institutional_codes {
                 my $sec = $coursecode.$1;                  my $sec = $coursecode.$1;
                 my $lc_sec = $2;                  my $lc_sec = $2;
                 unless (grep/^$sec$/,@{$allcourses}) {                  unless (grep/^$sec$/,@{$allcourses}) {
                     push @{$allcourses},$sec;                      push(@{$allcourses},$sec);
                     $$LC_code{$sec} = $lc_sec;                      $$LC_code{$sec} = $lc_sec;
                 }                  }
             }              }
Line 9593  reservable_now - ref to hash of student_ Line 10263  reservable_now - ref to hash of student_
   
     Keys in inner hash are:      Keys in inner hash are:
     (a) symb: either blank or symb to which slot use is restricted.      (a) symb: either blank or symb to which slot use is restricted.
     (b) endreserve: end date of reservation period.       (b) endreserve: end date of reservation period.
       (c) uniqueperiod: start,end dates when slot is to be uniquely
           selected.
   
 sorted_future - ref to array of student_schedulable slots reservable in  sorted_future - ref to array of student_schedulable slots reservable in
                 the future, ordered by start date of reservation period.                  the future, ordered by start date of reservation period.
Line 9604  future_reservable - ref to hash of stude Line 10276  future_reservable - ref to hash of stude
     Keys in inner hash are:      Keys in inner hash are:
     (a) symb: either blank or symb to which slot use is restricted.      (a) symb: either blank or symb to which slot use is restricted.
     (b) startreserve:  start date of reservation period.      (b) startreserve:  start date of reservation period.
       (c) uniqueperiod: start,end dates when slot is to be uniquely
           selected.
   
 =back  =back
   
Line 9657  sub get_future_slots { Line 10331  sub get_future_slots {
             my $startreserve = $slots{$slot}->{'startreserve'};              my $startreserve = $slots{$slot}->{'startreserve'};
             my $endreserve = $slots{$slot}->{'endreserve'};              my $endreserve = $slots{$slot}->{'endreserve'};
             my $symb = $slots{$slot}->{'symb'};              my $symb = $slots{$slot}->{'symb'};
               my $uniqueperiod;
               if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
               }
             if (($startreserve < $now) &&              if (($startreserve < $now) &&
                 (!$endreserve || $endreserve > $now)) {                  (!$endreserve || $endreserve > $now)) {
                 my $lastres = $endreserve;                  my $lastres = $endreserve;
Line 9665  sub get_future_slots { Line 10343  sub get_future_slots {
                 }                  }
                 $reservable_now{$slot} = {                  $reservable_now{$slot} = {
                                            symb       => $symb,                                             symb       => $symb,
                                            endreserve => $lastres                                             endreserve => $lastres,
                                              uniqueperiod => $uniqueperiod,   
                                          };                                           };
             } elsif (($startreserve > $now) &&              } elsif (($startreserve > $now) &&
                      (!$endreserve || $endreserve > $startreserve)) {                       (!$endreserve || $endreserve > $startreserve)) {
                 $future_reservable{$slot} = {                  $future_reservable{$slot} = {
                                               symb         => $symb,                                                symb         => $symb,
                                               startreserve => $startreserve                                                startreserve => $startreserve,
                                                 uniqueperiod => $uniqueperiod,
                                             };                                              };
             }              }
         }          }
Line 11070  sub decompress_form { Line 11750  sub decompress_form {
                         "$topdir/media/player.swf",                          "$topdir/media/player.swf",
                         "$topdir/media/swfobject.js",                          "$topdir/media/swfobject.js",
                         "$topdir/media/expressInstall.swf");                          "$topdir/media/expressInstall.swf");
         my @camtasia8 = ("$topdir/","$topdir/$topdir.html",          my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
                          "$topdir/$topdir.mp4",                           "$topdir/$topdir.mp4",
                          "$topdir/$topdir\_config.xml",                           "$topdir/$topdir\_config.xml",
                          "$topdir/$topdir\_controller.swf",                           "$topdir/$topdir\_controller.swf",
Line 11092  sub decompress_form { Line 11772  sub decompress_form {
                          "$topdir/skins/express_show/",                           "$topdir/skins/express_show/",
                          "$topdir/skins/express_show/player-min.css",                           "$topdir/skins/express_show/player-min.css",
                          "$topdir/skins/express_show/spritesheet.png");                           "$topdir/skins/express_show/spritesheet.png");
           my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                            "$topdir/$topdir.mp4",
                            "$topdir/$topdir\_config.xml",
                            "$topdir/$topdir\_controller.swf",
                            "$topdir/$topdir\_embed.css",
                            "$topdir/$topdir\_First_Frame.png",
                            "$topdir/$topdir\_player.html",
                            "$topdir/$topdir\_Thumbnails.png",
                            "$topdir/playerProductInstall.swf",
                            "$topdir/scripts/",
                            "$topdir/scripts/config_xml.js",
                            "$topdir/scripts/techsmith-smart-player.min.js",
                            "$topdir/skins/",
                            "$topdir/skins/configuration_express.xml",
                            "$topdir/skins/express_show/",
                            "$topdir/skins/express_show/spritesheet.min.css",
                            "$topdir/skins/express_show/spritesheet.png",
                            "$topdir/skins/express_show/techsmith-smart-player.min.css");
         my @diffs = &compare_arrays(\@paths,\@camtasia6);          my @diffs = &compare_arrays(\@paths,\@camtasia6);
         if (@diffs == 0) {          if (@diffs == 0) {
             $is_camtasia = 6;              $is_camtasia = 6;
         } else {          } else {
             @diffs = &compare_arrays(\@paths,\@camtasia8);              @diffs = &compare_arrays(\@paths,\@camtasia8_1);
             if (@diffs == 0) {              if (@diffs == 0) {
                 $is_camtasia = 8;                  $is_camtasia = 8;
               } else {
                   @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   if (@diffs == 0) {
                       $is_camtasia = 8;
                   }
             }              }
         }          }
     }      }
Line 12833  sub DrawBarGraph { Line 13536  sub DrawBarGraph {
         @Labels = @$labels;          @Labels = @$labels;
     } else {      } else {
         for (my $i=0;$i<@{$Values[0]};$i++) {          for (my $i=0;$i<@{$Values[0]};$i++) {
             push (@Labels,$i+1);              push(@Labels,$i+1);
         }          }
     }      }
     #      #
Line 13292  Returns: comma separated list of address Line 13995  Returns: comma separated list of address
 sub build_recipient_list {  sub build_recipient_list {
     my ($defmail,$mailing,$defdom,$origmail) = @_;      my ($defmail,$mailing,$defdom,$origmail) = @_;
     my @recipients;      my @recipients;
     my $otheremails;      my ($otheremails,$lastresort,$allbcc,$addtext);
     my %domconfig =      my %domconfig =
          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
     if (ref($domconfig{'contacts'}) eq 'HASH') {      if (ref($domconfig{'contacts'}) eq 'HASH') {
         if (exists($domconfig{'contacts'}{$mailing})) {          if (exists($domconfig{'contacts'}{$mailing})) {
             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {              if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
Line 13306  sub build_recipient_list { Line 14009  sub build_recipient_list {
                             push(@recipients,$addr);                              push(@recipients,$addr);
                         }                          }
                     }                      }
                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};                  }
                   $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   if ($mailing eq 'helpdeskmail') {
                       if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
                           my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
                           my @ok_bccs;
                           foreach my $bcc (@bccs) {
                               $bcc =~ s/^\s+//g;
                               $bcc =~ s/\s+$//g;
                               if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                                   if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                                       push(@ok_bccs,$bcc);
                                   }
                               }
                           }
                           if (@ok_bccs > 0) {
                               $allbcc = join(', ',@ok_bccs);
                           }
                       }
                       $addtext = $domconfig{'contacts'}{$mailing}{'include'};
                 }                  }
             }              }
         } elsif ($origmail ne '') {          } elsif ($origmail ne '') {
             push(@recipients,$origmail);              $lastresort = $origmail;
         }          }
     } elsif ($origmail ne '') {      } elsif ($origmail ne '') {
         push(@recipients,$origmail);          $lastresort = $origmail;
       }
   
       if (($mailing eq 'helpdesk') && ($lastresort ne '')) {
           unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
               my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
               my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
               my %what = (
                             perlvar => 1,
                          );
               my $primary = &Apache::lonnet::domain($defdom,'primary');
               if ($primary) {
                   my $gotaddr;
                   my ($result,$returnhash) =
                       &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
                   if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
                       if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
                           $lastresort = $returnhash->{'lonSupportEMail'};
                           $gotaddr = 1;
                       }
                   }
                   unless ($gotaddr) {
                       my $uintdom = &Apache::lonnet::internet_dom($primary);
                       my $intdom = &Apache::lonnet::internet_dom($lonhost);
                       unless ($uintdom eq $intdom) {
                           my %domconfig =
                               &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
                           if (ref($domconfig{'contacts'}) eq 'HASH') {
                               if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
                                   my @contacts = ('adminemail','supportemail');
                                   foreach my $item (@contacts) {
                                       if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
                                           my $addr = $domconfig{'contacts'}{$item};
                                           if (!grep(/^\Q$addr\E$/,@recipients)) {
                                               push(@recipients,$addr);
                                           }
                                       }
                                   }
                                   if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
                                       $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
                                   }
                                   if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
                                       my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
                                       my @ok_bccs;
                                       foreach my $bcc (@bccs) {
                                           $bcc =~ s/^\s+//g;
                                           $bcc =~ s/\s+$//g;
                                           if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                                               if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                                                   push(@ok_bccs,$bcc);
                                               }
                                           }
                                       }
                                       if (@ok_bccs > 0) {
                                           $allbcc = join(', ',@ok_bccs);
                                       }
                                   }
                                   $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
                               }
                           }
                       }
                   }
               }
           }
     }      }
     if (defined($defmail)) {      if (defined($defmail)) {
         if ($defmail ne '') {          if ($defmail ne '') {
Line 13333  sub build_recipient_list { Line 14118  sub build_recipient_list {
             }              }
         }          }
     }      }
     my $recipientlist = join(',',@recipients);       if ($mailing eq 'helpdesk') {
     return $recipientlist;          if ((!@recipients) && ($lastresort ne '')) {
               push(@recipients,$lastresort);
           }
       } elsif ($lastresort ne '') {
           if (!grep(/^\Q$lastresort\E$/,@recipients)) {
               push(@recipients,$lastresort);
           }
       }
       my $recipientlist = join(',',@recipients);
       if (wantarray) {
           return ($recipientlist,$allbcc,$addtext);
       } else {
           return $recipientlist;
       }
 }  }
   
 ############################################################  ############################################################
Line 13558  currcat - scalar with an & separated lis Line 14356  currcat - scalar with an & separated lis
   
 type    - scalar contains course type (Course or Community).  type    - scalar contains course type (Course or Community).
   
   disabled - scalar (optional) contains disabled="disabled" if input elements are
              to be readonly (e.g., Domain Helpdesk role viewing course settings).
   
 Returns: $output (markup to be displayed)   Returns: $output (markup to be displayed) 
   
 =cut  =cut
   
 sub assign_categories_table {  sub assign_categories_table {
     my ($cathash,$currcat,$type) = @_;      my ($cathash,$currcat,$type,$disabled) = @_;
     my $output;      my $output;
     if (ref($cathash) eq 'HASH') {      if (ref($cathash) eq 'HASH') {
         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);          my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
Line 13599  sub assign_categories_table { Line 14400  sub assign_categories_table {
                     }                      }
                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.                      $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                               '<input type="checkbox" name="usecategory" value="'.                                '<input type="checkbox" name="usecategory" value="'.
                               $item.'"'.$checked.' />'.$parent_title.'</span>'.                                $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';                                '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
                     my $depth = 1;                      my $depth = 1;
                     push(@path,$parent);                      push(@path,$parent);
                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);                      $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
                     pop(@path);                      pop(@path);
                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';                      $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
                     $itemcount ++;                      $itemcount ++;
Line 13642  path - Array containing all categories b Line 14443  path - Array containing all categories b
   
 currcategories - reference to array of current categories assigned to the course  currcategories - reference to array of current categories assigned to the course
   
   disabled - scalar (optional) contains disabled="disabled" if input elements are
              to be readonly (e.g., Domain Helpdesk role viewing course settings).
   
 Returns: $output (markup to be displayed).  Returns: $output (markup to be displayed).
   
 =cut  =cut
   
 sub assign_category_rows {  sub assign_category_rows {
     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;      my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
     my ($text,$name,$item,$chgstr);      my ($text,$name,$item,$chgstr);
     if (ref($cats) eq 'ARRAY') {      if (ref($cats) eq 'ARRAY') {
         my $maxdepth = scalar(@{$cats});          my $maxdepth = scalar(@{$cats});
Line 13670  sub assign_category_rows { Line 14474  sub assign_category_rows {
                     }                      }
                     $text .= '<tr><td><span class="LC_nobreak"><label>'.                      $text .= '<tr><td><span class="LC_nobreak"><label>'.
                              '<input type="checkbox" name="usecategory" value="'.                               '<input type="checkbox" name="usecategory" value="'.
                              $item.'"'.$checked.' />'.$name.'</label></span>'.                               $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
                              '<input type="hidden" name="catname" value="'.$name.'" />'.                               '<input type="hidden" name="catname" value="'.$name.'" />'.
                              '</td><td>';                               '</td><td>';
                     if (ref($path) eq 'ARRAY') {                      if (ref($path) eq 'ARRAY') {
                         push(@{$path},$name);                          push(@{$path},$name);
                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);                          $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
                         pop(@{$path});                          pop(@{$path});
                     }                      }
                     $text .= '</td></tr>';                      $text .= '</td></tr>';
Line 13906  sub check_clone { Line 14710  sub check_clone {
                 return ($can_clone, $clonemsg, $cloneid, $clonehome);                  return ($can_clone, $clonemsg, $cloneid, $clonehome);
             }              }
         }          }
  if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&    if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {              (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
     $can_clone = 1;      $can_clone = 1;
  } else {   } else {
     my %clonehash = &Apache::lonnet::get('environment',['cloners'],      my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
  $args->{'clonedomain'},$args->{'clonecourse'});   $args->{'clonedomain'},$args->{'clonecourse'});
     my @cloners = split(/,/,$clonehash{'cloners'});              if ($clonehash{'cloners'} eq '') {
             if (grep(/^\*$/,@cloners)) {                  my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                 $can_clone = 1;                  if ($domdefs{'canclone'}) {
             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {                      unless ($domdefs{'canclone'} eq 'none') {
                 $can_clone = 1;                          if ($domdefs{'canclone'} eq 'domain') {
                               if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                                   $can_clone = 1;
                               }
                           } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                                    ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                               if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                                                                             $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                                   $can_clone = 1;
                               }
                           }
                       }
                   }
             } else {              } else {
           my @cloners = split(/,/,$clonehash{'cloners'});
                   if (grep(/^\*$/,@cloners)) {
                       $can_clone = 1;
                   } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                       $can_clone = 1;
                   } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                       $can_clone = 1;
                   }
                   unless ($can_clone) {
                       if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                           ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                           my (%gotdomdefaults,%gotcodedefaults);
                           foreach my $cloner (@cloners) {
                               if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                                   ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                                   my (%codedefaults,@code_order);
                                   if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                                       if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                                           %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                                       }
                                       if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                                           @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                                       }
                                   } else {
                                       &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                                                                               \%codedefaults,
                                                                               \@code_order);
                                       $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                                       $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                                   }
                                   if (@code_order > 0) {
                                       if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                                                                                   $cloner,$clonehash{'internal.coursecode'},
                                                                                   $args->{'crscode'})) {
                                           $can_clone = 1;
                                           last;
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
               unless ($can_clone) {
                 my $ccrole = 'cc';                  my $ccrole = 'cc';
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     $ccrole = 'co';                      $ccrole = 'co';
                 }                  }
         my %roleshash =                  my %roleshash =
     &Apache::lonnet::get_my_roles($args->{'ccuname'},                      &Apache::lonnet::get_my_roles($args->{'ccuname'},
  $args->{'ccdomain'},                                                    $args->{'ccdomain'},
                                          'userroles',['active'],[$ccrole],                                                    'userroles',['active'],[$ccrole],
  [$args->{'clonedomain'}]);                                                    [$args->{'clonedomain'}]);
         if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {                  if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                     $can_clone = 1;                      $can_clone = 1;
                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {                  } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                                                             $args->{'ccuname'},$args->{'ccdomain'})) {
                     $can_clone = 1;                      $can_clone = 1;
                   }
               }
               unless ($can_clone) {
                   if ($args->{'crstype'} eq 'Community') {
                       $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                 } else {                  } else {
                     if ($args->{'crstype'} eq 'Community') {                      $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                         $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});  
                     } else {  
                         $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});  
                     }  
         }          }
     }      }
         }          }
Line 13945  sub check_clone { Line 14807  sub check_clone {
 }  }
   
 sub construct_course {  sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;      my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
           $cnum,$category,$coderef) = @_;
     my $outcome;      my $outcome;
     my $linefeed =  '<br />'."\n";      my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {      if ($context eq 'auto') {
Line 14093  sub construct_course { Line 14956  sub construct_course {
                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});                  my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                 $cenv{'internal.sectionnums'} .= $item.',';                  $cenv{'internal.sectionnums'} .= $item.',';
                 unless ($addcheck eq 'ok') {                  unless ($addcheck eq 'ok') {
                     push @badclasses, $class;                      push(@badclasses,$class);
                 }                  }
             }              }
             $cenv{'internal.sectionnums'} =~ s/,$//;              $cenv{'internal.sectionnums'} =~ s/,$//;
Line 14121  sub construct_course { Line 14984  sub construct_course {
                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});                  my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                 $cenv{'internal.crosslistings'} .= $item.',';                  $cenv{'internal.crosslistings'} .= $item.',';
                 unless ($addcheck eq 'ok') {                  unless ($addcheck eq 'ok') {
                     push @badclasses, $xl;                      push(@badclasses,$xl);
                 }                  }
             }              }
             $cenv{'internal.crosslistings'} =~ s/,$//;              $cenv{'internal.crosslistings'} =~ s/,$//;
Line 14156  sub construct_course { Line 15019  sub construct_course {
     }      }
     if (@badclasses > 0) {      if (@badclasses > 0) {
         my %lt=&Apache::lonlocal::texthash(          my %lt=&Apache::lonlocal::texthash(
                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.  However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',                  'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
                 'dnhr' => 'does not have rights to access enrollment in these classes',                  'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
                 'adby' => 'as determined by the policies of your institution on access to official classlists'                  'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
         );          );
         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.          my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
                            ' ('.$lt{'adby'}.')';                             &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
         if ($context eq 'auto') {          if ($context eq 'auto') {
             $outcome .= $badclass_msg.$linefeed;              $outcome .= $badclass_msg.$linefeed;
           } else {
             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";              $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
             foreach my $item (@badclasses) {          }
                 if ($context eq 'auto') {          foreach my $item (@badclasses) {
                     $outcome .= " - $item\n";  
                 } else {  
                     $outcome .= "<li>$item</li>\n";  
                 }  
             }  
             if ($context eq 'auto') {              if ($context eq 'auto') {
                 $outcome .= $linefeed;                  $outcome .= " - $item\n";
             } else {              } else {
                 $outcome .= "</ul><br /><br /></div>\n";                  $outcome .= "<li>$item</li>\n";
             }              }
         }           }
           if ($context eq 'auto') {
               $outcome .= $linefeed;
           } else {
               $outcome .= "</ul><br /><br /></div>\n";
           }
     }      }
     if ($args->{'no_end_date'}) {      if ($args->{'no_end_date'}) {
         $args->{'endaccess'} = 0;          $args->{'endaccess'} = 0;
Line 14209  sub construct_course { Line 15073  sub construct_course {
        if ($args->{'setcontent'}) {         if ($args->{'setcontent'}) {
            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};             $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
        }         }
          if ($args->{'setcomment'}) {
              $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
          }
     }      }
     if ($args->{'reshome'}) {      if ($args->{'reshome'}) {
  $cenv{'reshome'}=$args->{'reshome'}.'/';   $cenv{'reshome'}=$args->{'reshome'}.'/';
Line 14465  sub escape_url { Line 15332  sub escape_url {
     my ($url)   = @_;      my ($url)   = @_;
     my @urlslices = split(/\//, $url,-1);      my @urlslices = split(/\//, $url,-1);
     my $lastitem = &escape(pop(@urlslices));      my $lastitem = &escape(pop(@urlslices));
     return join('/',@urlslices).'/'.$lastitem;      return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
 }  }
   
 sub compare_arrays {  sub compare_arrays {
Line 14523  sub init_user_environment { Line 15390  sub init_user_environment {
  }   }
     }      }
     closedir(DIR);      closedir(DIR);
   # If there is a undeleted lockfile for the user's paste buffer remove it.
               my $namespace = 'nohist_courseeditor';
               my $lockingkey = 'paste'."\0".'locked_num';
               my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                                                   $domain,$username);
               if (exists($lockhash{$lockingkey})) {
                   my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   unless ($delresult eq 'ok') {
                       &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   }
               }
  }   }
 # Give them a new cookie  # Give them a new cookie
  my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}   my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
Line 14596  sub init_user_environment { Line 15474  sub init_user_environment {
             $env{'user.noloadbalance'} = $lonhost;              $env{'user.noloadbalance'} = $lonhost;
         }          }
   
         my %is_adv = ( is_adv => $env{'user.adv'} );          if ($form->{'noloadbalance'}) {
         my %domdef;              my @hosts = &Apache::lonnet::current_machine_ids();
         unless ($domain eq 'public') {              my $hosthere = $form->{'noloadbalance'};
             %domdef = &Apache::lonnet::get_domain_defaults($domain);              if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   $initial_env{"user.noloadbalance"} = $hosthere;
                   $env{'user.noloadbalance'} = $hosthere;
               }
         }          }
   
         foreach my $tool ('aboutme','blog','webdav','portfolio') {          unless ($domain eq 'public') {
             $userenv{'availabletools.'.$tool} =               my %is_adv = ( is_adv => $env{'user.adv'} );
                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',              my %domdef = &Apache::lonnet::get_domain_defaults($domain);
                                                   undef,\%userenv,\%domdef,\%is_adv);  
         }  
   
         foreach my $crstype ('official','unofficial','community','textbook') {              foreach my $tool ('aboutme','blog','webdav','portfolio') {
             $userenv{'canrequest.'.$crstype} =                  $userenv{'availabletools.'.$tool} = 
                 &Apache::lonnet::usertools_access($username,$domain,$crstype,                      &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                                                   'reload','requestcourses',                                                        undef,\%userenv,\%domdef,\%is_adv);
                                                   \%userenv,\%domdef,\%is_adv);              }
         }  
   
         $userenv{'canrequest.author'} =              foreach my $crstype ('official','unofficial','community','textbook') {
             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',                  $userenv{'canrequest.'.$crstype} =
                                         'reload','requestauthor',                      &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                         \%userenv,\%domdef,\%is_adv);                                                        'reload','requestcourses',
         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],                                                        \%userenv,\%domdef,\%is_adv);
                                              $domain,$username);              }
         my $reqstatus = $reqauthor{'author_status'};  
         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {              $userenv{'canrequest.author'} =
             if (ref($reqauthor{'author'}) eq 'HASH') {                  &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                 $userenv{'requestauthorqueued'} = $reqstatus.':'.                                                    'reload','requestauthor',
                                                   $reqauthor{'author'}{'timestamp'};                                                    \%userenv,\%domdef,\%is_adv);
               my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                                                    $domain,$username);
               my $reqstatus = $reqauthor{'author_status'};
               if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   if (ref($reqauthor{'author'}) eq 'HASH') {
                       $userenv{'requestauthorqueued'} = $reqstatus.':'.
                                                         $reqauthor{'author'}{'timestamp'};
                   }
             }              }
         }          }
   
Line 14941  sub build_filters { Line 15827  sub build_filters {
         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".          $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                    '<input type="hidden" name="prevphase" value="'.                     '<input type="hidden" name="prevphase" value="'.
                    $prevphase.'" />'."\n";                     $prevphase.'" />'."\n";
     } elsif ($formname ne 'quotacheck') {      } elsif ($formname eq 'quotacheck') {
           $output .= qq|
   <input type="hidden" name="sortby" value="" />
   <input type="hidden" name="sortorder" value="" />
   |;
       } else {
         my $name_input;          my $name_input;
         if ($cnameelement ne '') {          if ($cnameelement ne '') {
             $name_input = '<input type="hidden" name="cnameelement" value="'.              $name_input = '<input type="hidden" name="cnameelement" value="'.
Line 15134  cloneruname - optional username of new c Line 16025  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).
   
   cc_clone - escaped comma separated list of courses for which course cloner has active CC role
              (and so can clone automatically)
   
   reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
   
   reqinstcode - institutional code of new course, where search_courses is used to identify potential
                 courses to clone
   
 Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.  Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
   
Line 15149  Side Effects: None Line 16047  Side Effects: None
   
   
 sub search_courses {  sub search_courses {
     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;      my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
           $cc_clone,$reqcrsdom,$reqinstcode) = @_;
     my (%courses,%showcourses,$cloner);      my (%courses,%showcourses,$cloner);
     if (($filter->{'ownerfilter'} ne '') ||      if (($filter->{'ownerfilter'} ne '') ||
         ($filter->{'ownerdomfilter'} ne '')) {          ($filter->{'ownerdomfilter'} ne '')) {
Line 15197  sub search_courses { Line 16096  sub search_courses {
                                              $filter->{'combownerfilter'},                                               $filter->{'combownerfilter'},
                                              $filter->{'coursefilter'},                                               $filter->{'coursefilter'},
                                              undef,undef,$type,$regexpok,undef,undef,                                               undef,undef,$type,$regexpok,undef,undef,
                                              undef,undef,$cloner,$env{'form.cc_clone'},                                               undef,undef,$cloner,$cc_clone,
                                              $filter->{'cloneableonly'},                                               $filter->{'cloneableonly'},
                                              $createdbefore,$createdafter,undef,                                               $createdbefore,$createdafter,undef,
                                              $domcloner);                                               $domcloner,undef,$reqcrsdom,$reqinstcode);
     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {      if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
         my $ccrole;          my $ccrole;
         if ($type eq 'Community') {          if ($type eq 'Community') {
Line 15220  sub search_courses { Line 16119  sub search_courses {
                 if (ref($courses{$cid}) eq 'HASH') {                  if (ref($courses{$cid}) eq 'HASH') {
                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {                      if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {                          if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                             push (@{$courses{$cid}{roles}},$courserole);                              push(@{$courses{$cid}{roles}},$courserole);
                         }                          }
                     } else {                      } else {
                         $courses{$cid}{roles} = [$courserole];                          $courses{$cid}{roles} = [$courserole];
Line 15234  sub search_courses { Line 16133  sub search_courses {
     return %courses;      return %courses;
 }  }
   
   =pod
   
   =back
   
   =head1 Routines for version requirements for current course.
   
   =over 4
   
   =item * &check_release_required()
   
   Compares required LON-CAPA version with version on server, and
   if required version is newer looks for a server with the required version.
   
   Looks first at servers in user's owen domain; if none suitable, looks at
   servers in course's domain are permitted to host sessions for user's domain.
   
   Inputs:
   
   $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
   
   $courseid - Course ID of current course
   
   $rolecode - User's current role in course (for switchserver query string).
   
   $required - LON-CAPA version needed by course (format: Major.Minor).
   
   
   Returns:
   
   $switchserver - query string tp append to /adm/switchserver call (if
                   current server's LON-CAPA version is too old.
   
   $warning - Message is displayed if no suitable server could be found.
   
   =cut
   
   sub check_release_required {
       my ($loncaparev,$courseid,$rolecode,$required) = @_;
       my ($switchserver,$warning);
       if ($required ne '') {
           my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
           my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
           if ($reqdmajor ne '' && $reqdminor ne '') {
               my $otherserver;
               if (($major eq '' && $minor eq '') ||
                   (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   my $switchlcrev =
                       &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                                                              $userdomserver);
                   my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                       (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                       my $cdom = $env{'course.'.$courseid.'.domain'};
                       if ($cdom ne $env{'user.domain'}) {
                           my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                           my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                           my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                           my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                           my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                           my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                           my $canhost =
                               &Apache::lonnet::can_host_session($env{'user.domain'},
                                                                 $coursedomserver,
                                                                 $remoterev,
                                                                 $udomdefaults{'remotesessions'},
                                                                 $defdomdefaults{'hostedsessions'});
   
                           if ($canhost) {
                               $otherserver = $coursedomserver;
                           } else {
                               $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
                           }
                       } else {
                           $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
                       }
                   } else {
                       $otherserver = $userdomserver;
                   }
               }
               if ($otherserver ne '') {
                   $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
               }
           }
       }
       return ($switchserver,$warning);
   }
   
 =pod  =pod
   
   =item * &check_release_result()
   
   Inputs:
   
   $switchwarning - Warning message if no suitable server found to host session.
   
   $switchserver - query string to append to /adm/switchserver containing lonHostID
                   and current role.
   
   Returns: HTML to display with information about requirement to switch server.
            Either displaying warning with link to Roles/Courses screen or
            display link to switchserver.
   
   =cut
   
   sub check_release_result {
       my ($switchwarning,$switchserver) = @_;
       my $output = &start_page('Selected course unavailable on this server').
                    '<p class="LC_warning">';
       if ($switchwarning) {
           $output .= $switchwarning.'<br /><a href="/adm/roles">';
           if (&show_course()) {
               $output .= &mt('Display courses');
           } else {
               $output .= &mt('Display roles');
           }
           $output .= '</a>';
       } elsif ($switchserver) {
           $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                      '<br />'.
                      '<a href="/adm/switchserver?'.$switchserver.'">'.
                      &mt('Switch Server').
                      '</a>';
       }
       $output .= '</p>'.&end_page();
       return $output;
   }
   
   =pod
   
   =item * &needs_coursereinit()
   
   Determine if course contents stored for user's session needs to be
   refreshed, because content has changed since "Big Hash" last tied.
   
   Check for change is made if time last checked is more than 10 minutes ago
   (by default).
   
   Inputs:
   
   $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
   
   $interval (optional) - Time which may elapse (in s) between last check for content
                          change in current course. (default: 600 s).
   
   Returns: an array; first element is:
   
   =over 4
   
   'switch' - if content updates mean user's session
              needs to be switched to a server running a newer LON-CAPA version
   
   'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
              on current server hosting user's session
   
   ''       - if no action required.
   
   =back
   
   If first item element is 'switch':
   
   second item is $switchwarning - Warning message if no suitable server found to host session.
   
   third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                                 and current role.
   
   otherwise: no other elements returned.
   
 =back  =back
   
 =cut  =cut
   
   sub needs_coursereinit {
       my ($loncaparev,$interval) = @_;
       return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       my $now = time;
       if ($interval eq '') {
           $interval = 600;
       }
       if (($now-$env{'request.course.timechecked'})>$interval) {
           my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
           &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
           if ($lastchange > $env{'request.course.tied'}) {
               my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
               if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                       &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                                                $curr_reqd_hash{'internal.releaserequired'}});
                       my ($switchserver,$switchwarning) =
                           &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                                                   $curr_reqd_hash{'internal.releaserequired'});
                       if ($switchwarning ne '' || $switchserver ne '') {
                           return ('switch',$switchwarning,$switchserver);
                       }
                   }
               }
               return ('update');
           }
       }
       return ();
   }
   
 sub update_content_constraints {  sub update_content_constraints {
     my ($cdom,$cnum,$chome,$cid) = @_;      my ($cdom,$cnum,$chome,$cid) = @_;
Line 15353  sub recurse_supplemental { Line 16449  sub recurse_supplemental {
 }  }
   
 sub symb_to_docspath {  sub symb_to_docspath {
     my ($symb) = @_;      my ($symb,$navmapref) = @_;
     return unless ($symb);      return unless ($symb && ref($navmapref));
     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);      my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
     if ($resurl=~/\.(sequence|page)$/) {      if ($resurl=~/\.(sequence|page)$/) {
         $mapurl=$resurl;          $mapurl=$resurl;
Line 15362  sub symb_to_docspath { Line 16458  sub symb_to_docspath {
         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};          $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
     }      }
     my $mapresobj;      my $mapresobj;
     my $navmap = Apache::lonnavmaps::navmap->new();      unless (ref($$navmapref)) {
     if (ref($navmap)) {          $$navmapref = Apache::lonnavmaps::navmap->new();
         $mapresobj = $navmap->getResourceByUrl($mapurl);      }
       if (ref($$navmapref)) {
           $mapresobj = $$navmapref->getResourceByUrl($mapurl);
     }      }
     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};      $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
     my $type=$2;      my $type=$2;
Line 15374  sub symb_to_docspath { Line 16472  sub symb_to_docspath {
         if ($pcslist ne '') {          if ($pcslist ne '') {
             foreach my $pc (split(/,/,$pcslist)) {              foreach my $pc (split(/,/,$pcslist)) {
                 next if ($pc <= 1);                  next if ($pc <= 1);
                 my $res = $navmap->getByMapPc($pc);                  my $res = $$navmapref->getByMapPc($pc);
                 if (ref($res)) {                  if (ref($res)) {
                     my $thisurl = $res->src();                      my $thisurl = $res->src();
                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};                      $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
Line 15423  sub symb_to_docspath { Line 16521  sub symb_to_docspath {
 sub captcha_display {  sub captcha_display {
     my ($context,$lonhost) = @_;      my ($context,$lonhost) = @_;
     my ($output,$error);      my ($output,$error);
     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);      my ($captcha,$pubkey,$privkey,$version) =
           &get_captcha_config($context,$lonhost);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         $output = &create_captcha();          $output = &create_captcha();
         unless ($output) {          unless ($output) {
             $error = 'captcha';              $error = 'captcha';
         }          }
     } elsif ($captcha eq 'recaptcha') {      } elsif ($captcha eq 'recaptcha') {
         $output = &create_recaptcha($pubkey);          $output = &create_recaptcha($pubkey,$version);
         unless ($output) {          unless ($output) {
             $error = 'recaptcha';              $error = 'recaptcha';
         }          }
     }      }
     return ($output,$error,$captcha);      return ($output,$error,$captcha,$version);
 }  }
   
 sub captcha_response {  sub captcha_response {
     my ($context,$lonhost) = @_;      my ($context,$lonhost) = @_;
     my ($captcha_chk,$captcha_error);      my ($captcha_chk,$captcha_error);
     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);      my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         ($captcha_chk,$captcha_error) = &check_captcha();          ($captcha_chk,$captcha_error) = &check_captcha();
     } elsif ($captcha eq 'recaptcha') {      } elsif ($captcha eq 'recaptcha') {
         $captcha_chk = &check_recaptcha($privkey);          $captcha_chk = &check_recaptcha($privkey,$version);
     } else {      } else {
         $captcha_chk = 1;          $captcha_chk = 1;
     }      }
Line 15454  sub captcha_response { Line 16553  sub captcha_response {
   
 sub get_captcha_config {  sub get_captcha_config {
     my ($context,$lonhost) = @_;      my ($context,$lonhost) = @_;
     my ($captcha,$pubkey,$privkey,$hashtocheck);      my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
     my $hostname = &Apache::lonnet::hostname($lonhost);      my $hostname = &Apache::lonnet::hostname($lonhost);
     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);      my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);      my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
Line 15470  sub get_captcha_config { Line 16569  sub get_captcha_config {
                     }                      }
                     if ($privkey && $pubkey) {                      if ($privkey && $pubkey) {
                         $captcha = 'recaptcha';                          $captcha = 'recaptcha';
                           $version = $hashtocheck->{'recaptchaversion'};
                           if ($version ne '2') {
                               $version = 1;
                           }
                     } else {                      } else {
                         $captcha = 'original';                          $captcha = 'original';
                     }                      }
Line 15487  sub get_captcha_config { Line 16590  sub get_captcha_config {
             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};              $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
             if ($privkey && $pubkey) {              if ($privkey && $pubkey) {
                 $captcha = 'recaptcha';                  $captcha = 'recaptcha';
                   $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   if ($version ne '2') {
                       $version = 1;
                   }
             } else {              } else {
                 $captcha = 'original';                  $captcha = 'original';
             }              }
Line 15494  sub get_captcha_config { Line 16601  sub get_captcha_config {
             $captcha = 'original';              $captcha = 'original';
         }          }
     }      }
     return ($captcha,$pubkey,$privkey);      return ($captcha,$pubkey,$privkey,$version);
 }  }
   
 sub create_captcha {  sub create_captcha {
Line 15553  sub check_captcha { Line 16660  sub check_captcha {
 }  }
   
 sub create_recaptcha {  sub create_recaptcha {
     my ($pubkey) = @_;      my ($pubkey,$version) = @_;
     my $use_ssl;      if ($version >= 2) {
     if ($ENV{'SERVER_PORT'} == 443) {          return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
         $use_ssl = 1;      } else {
     }          my $use_ssl;
     my $captcha = Captcha::reCAPTCHA->new;          if ($ENV{'SERVER_PORT'} == 443) {
     return $captcha->get_options_setter({theme => 'white'})."\n".              $use_ssl = 1;
            $captcha->get_html($pubkey,undef,$use_ssl).          }
            &mt('If either word is hard to read, [_1] will replace them.',          my $captcha = Captcha::reCAPTCHA->new;
                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').          return $captcha->get_options_setter({theme => 'white'})."\n".
            '<br /><br />';                 $captcha->get_html($pubkey,undef,$use_ssl).
                  &mt('If the text is hard to read, [_1] will replace them.',
                      '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                  '<br /><br />';
        }
 }  }
   
 sub check_recaptcha {  sub check_recaptcha {
     my ($privkey) = @_;      my ($privkey,$version) = @_;
     my $captcha_chk;      my $captcha_chk;
     my $captcha = Captcha::reCAPTCHA->new;      if ($version >= 2) {
     my $captcha_result =          my $ua = LWP::UserAgent->new;
         $captcha->check_answer(          $ua->timeout(10);
                                 $privkey,          my %info = (
                                 $ENV{'REMOTE_ADDR'},                       secret   => $privkey,
                                 $env{'form.recaptcha_challenge_field'},                       response => $env{'form.g-recaptcha-response'},
                                 $env{'form.recaptcha_response_field'},                       remoteip => $ENV{'REMOTE_ADDR'},
                               );                     );
     if ($captcha_result->{is_valid}) {          my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
         $captcha_chk = 1;          if ($response->is_success)  {
               my $data = JSON::DWIW->from_json($response->decoded_content);
               if (ref($data) eq 'HASH') {
                   if ($data->{'success'}) {
                       $captcha_chk = 1;
                   }
               }
           }
       } else {
           my $captcha = Captcha::reCAPTCHA->new;
           my $captcha_result =
               $captcha->check_answer(
                                       $privkey,
                                       $ENV{'REMOTE_ADDR'},
                                       $env{'form.recaptcha_challenge_field'},
                                       $env{'form.recaptcha_response_field'},
                                     );
           if ($captcha_result->{is_valid}) {
               $captcha_chk = 1;
           }
     }      }
     return $captcha_chk;      return $captcha_chk;
 }  }
   
 sub emailusername_info {  sub emailusername_info {
     my @fields = ('firstname','lastname','institution','web','location','officialemail');      my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
     my %titles = &Apache::lonlocal::texthash (      my %titles = &Apache::lonlocal::texthash (
                      lastname      => 'Last Name',                       lastname      => 'Last Name',
                      firstname     => 'First Name',                       firstname     => 'First Name',
Line 15592  sub emailusername_info { Line 16722  sub emailusername_info {
                      location      => "School's city, state/province, country",                       location      => "School's city, state/province, country",
                      web           => "School's web address",                       web           => "School's web address",
                      officialemail => 'E-mail address at institution (if different)',                       officialemail => 'E-mail address at institution (if different)',
                        id            => 'Student/Employee ID',
                  );                   );
     return (\@fields,\%titles);      return (\@fields,\%titles);
 }  }
Line 15672  sub des_decrypt { Line 16803  sub des_decrypt {
     } else {      } else {
         $cypher=new DES $keybin;          $cypher=new DES $keybin;
     }      }
     my $plaintext=      my $plaintext='';
         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));      my $cypherlength = length($cyphertext);
     $plaintext.=      my $numchunks = int($cypherlength/32);
         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));      for (my $j=0; $j<$numchunks; $j++) {
     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );          my $start = $j*32;
           my $cypherblock = substr($cyphertext,$start,32);
           my $chunk =
               $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
           $chunk .=
               $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
           $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
           $plaintext .= $chunk;
       }
     return $plaintext;      return $plaintext;
 }  }
   

Removed from v.1.1075.2.79  
changed lines
  Added in v.1.1075.2.125


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