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

Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.53 and 1.1075.2.103

version 1.1075.2.53, 2013/09/22 01:58:13 version 1.1075.2.103, 2016/08/06 20:15:00
Line 69  use Apache::lontexconvert(); Line 69  use Apache::lontexconvert();
 use Apache::lonclonecourse();  use Apache::lonclonecourse();
 use Apache::lonuserutils();  use Apache::lonuserutils();
 use Apache::lonuserstate();  use Apache::lonuserstate();
   use Apache::courseclassifier();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use 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 Crypt::DES;
   use DynaLoader; # for Crypt::DES version
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);  use vars qw(%defaultdesign);
Line 529  ENDAUTHORBRW Line 533  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 580  sub coursebrowser_javascript { Line 584  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 955  sub select_datelocale { Line 965  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 977  sub select_datelocale { Line 988  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 988  sub select_datelocale { Line 1000  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 1289  sub helpLatexCheatsheet { Line 1301  sub helpLatexCheatsheet {
     unless ($not_author) {      unless ($not_author) {
         $out .= ' <span>'          $out .= ' <span>'
        .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)         .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
        .'</span>';         .'</span> <span>'
                  .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
                  .'</span>';
     }      }
     $out .= '</span>'; # End cheatsheet      $out .= '</span>'; # End cheatsheet
     return $out;      return $out;
Line 1352  sub help_open_menu { Line 1366  sub help_open_menu {
 sub top_nav_help {  sub top_nav_help {
     my ($text) = @_;      my ($text) = @_;
     $text = &mt($text);      $text = &mt($text);
     my $stay_on_page = 1;      my $stay_on_page;
       unless ($env{'environment.remote'} eq 'on') {
     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"          $stay_on_page = 1;
                      : "javascript:helpMenu('open')";      }
     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);      my ($link,$banner_link);
       unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
           $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                            : "javascript:helpMenu('open')";
           $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
       }
     my $title = &mt('Get help');      my $title = &mt('Get help');
       if ($link) {
     return <<"END";          return <<"END";
 $banner_link  $banner_link
  <a href="$link" title="$title">$text</a>  <a href="$link" title="$title">$text</a>
 END  END
       } else {
           return '&nbsp;'.$text.'&nbsp;';
       }
 }  }
   
 sub help_menu_js {  sub help_menu_js {
Line 1410  function helpMenu(target) { Line 1431  function helpMenu(target) {
     return;      return;
 }  }
 function writeHelp(caller) {  function writeHelp(caller) {
     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" />\\n<frame name="bodyframe" src="$details_link" />\\n$end_page')      caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
     caller.document.close()      caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
     caller.focus()      caller.document.close();
       caller.focus();
 }  }
 // END LON-CAPA Internal -->  // END LON-CAPA Internal -->
 // ]]>  // ]]>
Line 1724  RESIZE Line 1746  RESIZE
   
 =head1 Excel and CSV file utility routines  =head1 Excel and CSV file utility routines
   
 =over 4  
   
 =cut  =cut
   
 ###############################################################  ###############################################################
Line 1733  RESIZE Line 1753  RESIZE
   
 =pod  =pod
   
   =over 4
   
 =item * &csv_translate($text)   =item * &csv_translate($text) 
   
 Translate $text to allow it to be output as a 'comma separated values'   Translate $text to allow it to be output as a 'comma separated values' 
Line 2328  Outputs: Line 2350  Outputs:
   
 =item * $clientinfo  =item * $clientinfo
   
   =item * $clientosversion
   
 =back  =back
   
 =back   =back 
Line 2347  sub decode_user_agent { Line 2371  sub decode_user_agent {
     my $clientmathml='';      my $clientmathml='';
     my $clientunicode='0';      my $clientunicode='0';
     my $clientmobile=0;      my $clientmobile=0;
       my $clientosversion='';
     for (my $i=0;$i<=$#browsertype;$i++) {      for (my $i=0;$i<=$#browsertype;$i++) {
         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);          my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
  if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {   if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
     $clientbrowser=$bname;      $clientbrowser=$bname;
             $httpbrowser=~/$vreg/i;              $httpbrowser=~/$vreg/i;
Line 2368  sub decode_user_agent { Line 2393  sub decode_user_agent {
     if ($httpbrowser=~/next/i) { $clientos='next'; }      if ($httpbrowser=~/next/i) { $clientos='next'; }
     if (($httpbrowser=~/mac/i) ||      if (($httpbrowser=~/mac/i) ||
         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }          ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
     if ($httpbrowser=~/win/i) { $clientos='win'; }      if ($httpbrowser=~/win/i) {
           $clientos='win';
           if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
               $clientosversion = $1;
           }
       }
     if ($httpbrowser=~/embed/i) { $clientos='pda'; }      if ($httpbrowser=~/embed/i) { $clientos='pda'; }
     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {      if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
         $clientmobile=lc($1);          $clientmobile=lc($1);
Line 2379  sub decode_user_agent { Line 2409  sub decode_user_agent {
         $clientinfo = 'chromeframe-'.$1;          $clientinfo = 'chromeframe-'.$1;
     }      }
     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,      return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
             $clientunicode,$clientos,$clientmobile,$clientinfo);              $clientunicode,$clientos,$clientmobile,$clientinfo,
               $clientosversion);
 }  }
   
 ###############################################################  ###############################################################
Line 3655  sub user_lang { Line 3686  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 3677  Return string with previous attempt on p Line 3708  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 3684  The output string is a table containing Line 3720  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 3694  sub get_previous_attempt { Line 3730  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 3717  sub get_previous_attempt { Line 3758  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 3728  sub get_previous_attempt { Line 3781  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 3760  sub get_previous_attempt { Line 3856  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 3771  sub get_previous_attempt { Line 3873  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 4223  sub findallcourses { Line 4331  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$uname,$udom,$url) = @_;      my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
   
     if (!defined($udom)) {      if (defined($udom) && defined($uname)) {
           # If uname and udom are for a course, check for blocks in the course.
           if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
               my ($startblock,$endblock,$triggerblock) =
                   &get_blocks($setters,$activity,$udom,$uname,$url);
               return ($startblock,$endblock,$triggerblock);
           }
       } else {
         $udom = $env{'user.domain'};          $udom = $env{'user.domain'};
     }  
     if (!defined($uname)) {  
         $uname = $env{'user.name'};          $uname = $env{'user.name'};
     }      }
   
     # If uname and udom are for a course, check for blocks in the course.  
   
     if (&Apache::lonnet::is_course($udom,$uname)) {  
         my ($startblock,$endblock,$triggerblock) =   
             &get_blocks($setters,$activity,$udom,$uname,$url);  
         return ($startblock,$endblock,$triggerblock);  
     }  
   
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
     my $triggerblock = '';      my $triggerblock = '';
Line 4249  sub blockcheck { Line 4354  sub blockcheck {
     # boards, chat or groups, check for blocking in current course only.      # boards, chat or groups, check for blocking in current course only.
   
     if (($activity eq 'boards' || $activity eq 'chat' ||      if (($activity eq 'boards' || $activity eq 'chat' ||
          $activity eq 'groups') && ($env{'request.course.id'})) {           $activity eq 'groups' || $activity eq 'printout') &&
           ($env{'request.course.id'})) {
         foreach my $key (keys(%live_courses)) {          foreach my $key (keys(%live_courses)) {
             if ($key ne $env{'request.course.id'}) {              if ($key ne $env{'request.course.id'}) {
                 delete($live_courses{$key});                  delete($live_courses{$key});
Line 4513  sub parse_block_record { Line 4619  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
     my ($activity,$uname,$udom,$url) = @_;      my ($activity,$uname,$udom,$url,$is_course) = @_;
     my %setters;      my %setters;
   
 # check for active blocking  # check for active blocking
     my ($startblock,$endblock,$triggerblock) =       my ($startblock,$endblock,$triggerblock) = 
         &blockcheck(\%setters,$activity,$uname,$udom,$url);          &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
     my $blocked = 0;      my $blocked = 0;
     if ($startblock && $endblock) {      if ($startblock && $endblock) {
         $blocked = 1;          $blocked = 1;
Line 4530  sub blocking_status { Line 4636  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 4551  END_MYBLOCK Line 4657  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 4675  sub get_domainconf { Line 4785  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 5015  Inputs: Line 5130  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 5058  sub bodytag { Line 5170  sub bodytag {
     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};       @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
   
  # role and realm   # role and realm
     my ($role,$realm) = split(/\./,$env{'request.role'},2);      my ($role,$realm) = split(m{\./},$env{'request.role'},2);
       if ($realm) {
           $realm = '/'.$realm;
       }
     if ($role  eq 'ca') {      if ($role  eq 'ca') {
         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});          my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
         $realm = &plainname($rname,$rdom);          $realm = &plainname($rname,$rdom);
Line 5082  sub bodytag { Line 5197  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 5155  sub bodytag { Line 5270  sub bodytag {
         }          }
         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;          $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
   
           #if directed to not display the secondary menu, don't.
           if ($args->{'no_secondary_menu'}) {
               return $bodytag;
           }
         #don't show menus for public users          #don't show menus for public users
         if (!$public){          if (!$public){
             $bodytag .= Apache::lonmenu::secondary_menu($httphost);              $bodytag .= Apache::lonmenu::secondary_menu($httphost);
Line 5196  sub bodytag { Line 5315  sub bodytag {
     }      }
     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';      my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
   
       my $help=($no_inline_link?''
                 :&Apache::loncommon::top_nav_help('Help'));
   
     # Explicit link to get inline menu      # Explicit link to get inline menu
     my $menu= ($no_inline_link?''      my $menu= ($no_inline_link?''
                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');                 :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
Line 5213  sub bodytag { Line 5335  sub bodytag {
     unless ($env{'form.inhibitmenu'}) {      unless ($env{'form.inhibitmenu'}) {
         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>          $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
                        <ol class="LC_primary_menu LC_floatright LC_right">                         <ol class="LC_primary_menu LC_floatright LC_right">
                          <li>$help</li>
                        <li>$menu</li>                         <li>$menu</li>
                        </ol><div id="LC_realm"> $realm $dc_info</div>|;                         </ol><div id="LC_realm"> $realm $dc_info</div>|;
     }      }
Line 5271  sub make_attr_string { Line 5394  sub make_attr_string {
     }      }
   
     my $attr_string;      my $attr_string;
     foreach my $attr (keys(%$attr_ref)) {      foreach my $attr (sort(keys(%$attr_ref))) {
  $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';   $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
     }      }
     return $attr_string;      return $attr_string;
Line 5301  sub endbodytag { Line 5424  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 6485  div.LC_edit_problem_saves { Line 6607  div.LC_edit_problem_saves {
   white-space: nowrap;    white-space: nowrap;
 }  }
   
   .LC_edit_problem_latexhelper{
       text-align: right;
   }
   
   #LC_edit_problem_colorful div{
       margin-left: 40px;
   }
   
 img.stift {  img.stift {
   border-width: 0;    border-width: 0;
   vertical-align: middle;    vertical-align: middle;
Line 6572  fieldset { Line 6702  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 7262  sub headtag { Line 7396  sub headtag {
   
     my $result =      my $result =
  '<head>'.   '<head>'.
  &font_settings();   &font_settings($args);
   
     my $inhibitprint = &print_suppression();      my $inhibitprint;
       if ($args->{'print_suppress'}) {
           $inhibitprint = &print_suppression();
       }
   
     if (!$args->{'frameset'}) {      if (!$args->{'frameset'}) {
  $result .= &Apache::lonhtmlcommon::htmlareaheaders();   $result .= &Apache::lonhtmlcommon::htmlareaheaders();
Line 7304  sub headtag { Line 7441  sub headtag {
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 <meta http-equiv="Refresh" content="$time; url=$url" />  <meta http-equiv="Refresh" content="$time; url=$url" />
 ADDMETA  ADDMETA
       } else {
           unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
               my $requrl = $env{'request.uri'};
               if ($requrl eq '') {
                   $requrl = $ENV{'REQUEST_URI'};
                   $requrl =~ s/\?.+$//;
               }
               unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                       (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                        ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                       my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                       if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                           my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                           if ($domdefs{'offloadnow'}{$lonhost}) {
                               my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                               if (($newserver) && ($newserver ne $lonhost)) {
                                   my $numsec = 5;
                                   my $timeout = $numsec * 1000;
                                   my ($newurl,$locknum,%locks,$msg);
                                   if ($env{'request.role.adv'}) {
                                       ($locknum,%locks) = &Apache::lonnet::get_locks();
                                   }
                                   my $disable_submit = 0;
                                   if ($requrl =~ /$LONCAPA::assess_re/) {
                                       $disable_submit = 1;
                                   }
                                   if ($locknum) {
                                       my @lockinfo = sort(values(%locks));
                                       $msg = &mt('Once the following tasks are complete: ')."\\n".
                                              join(", ",sort(values(%locks)))."\\n".
                                              &mt('your session will be transferred to a different server, after you click "Roles".');
                                   } else {
                                       if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                                           $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                                       }
                                       $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                                       $newurl = '/adm/switchserver?otherserver='.$newserver;
                                       if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                                           $newurl .= '&role='.$env{'request.role'};
                                       }
                                       if ($env{'request.symb'}) {
                                           $newurl .= '&symb='.$env{'request.symb'};
                                       } else {
                                           $newurl .= '&origurl='.$requrl;
                                       }
                                   }
                                   &js_escape(\$msg);
                                   $result.=<<OFFLOAD
   <meta http-equiv="pragma" content="no-cache" />
   <script type="text/javascript">
   // <![CDATA[
   function LC_Offload_Now() {
       var dest = "$newurl";
       if (dest != '') {
           window.location.href="$newurl";
       }
   }
   \$(document).ready(function () {
       window.alert('$msg');
       if ($disable_submit) {
           \$(".LC_hwk_submit").prop("disabled", true);
           \$( ".LC_textline" ).prop( "readonly", "readonly");
       }
       setTimeout('LC_Offload_Now()', $timeout);
   });
   // ]]>
   </script>
   OFFLOAD
                               }
                           }
                       }
                   }
               }
           }
     }      }
     if (!defined($title)) {      if (!defined($title)) {
  $title = 'The LearningOnline Network with CAPA';   $title = 'The LearningOnline Network with CAPA';
     }      }
     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }      if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
     $result .= '<title> LON-CAPA '.$title.'</title>'      $result .= '<title> LON-CAPA '.$title.'</title>'
  .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'   .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
       if (!$args->{'frameset'}) {
           $result .= ' /';
       }
       $result .= '>'
         .$inhibitprint          .$inhibitprint
  .$head_extra;   .$head_extra;
     if ($env{'browser.mobile'}) {      if ($env{'browser.mobile'}) {
Line 7327  ADDMETA Line 7544  ADDMETA
   
 Returns neccessary <meta> to set the proper encoding  Returns neccessary <meta> to set the proper encoding
   
 Inputs: none  Inputs: optional reference to HASH -- $args passed to &headtag()
   
 =cut  =cut
   
 sub font_settings {  sub font_settings {
       my ($args) = @_;
     my $headerstring='';      my $headerstring='';
     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {      if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
           ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
  $headerstring.=   $headerstring.=
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';      '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
           if (!$args->{'frameset'}) {
               $headerstring.= ' /';
           }
           $headerstring .= '>'."\n";
     }      }
     return $headerstring;      return $headerstring;
 }  }
Line 7380  sub print_suppression { Line 7603  sub print_suppression {
         }          }
         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};          my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};          my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
         my $blocked = &blocking_status('printout',$cnum,$cdom);          my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
         if ($blocked) {          if ($blocked) {
             my $checkrole = "cm./$cdom/$cnum";              my $checkrole = "cm./$cdom/$cnum";
             if ($env{'request.course.sec'} ne '') {              if ($env{'request.course.sec'} ne '') {
Line 7427  Inputs: none Line 7650  Inputs: none
 =cut  =cut
   
 sub xml_begin {  sub xml_begin {
       my ($is_frameset) = @_;
     my $output='';      my $output='';
   
     if ($env{'browser.mathml'}) {      if ($env{'browser.mathml'}) {
Line 7438  sub xml_begin { Line 7662  sub xml_begin {
     .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'      .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '               .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
     .'xmlns="http://www.w3.org/1999/xhtml">';      .'xmlns="http://www.w3.org/1999/xhtml">';
       } elsif ($is_frameset) {
           $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   '<html>'."\n";
     } else {      } else {
  $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'   $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';                  '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
     }      }
     return $output;      return $output;
 }  }
Line 7487  $args - additional optional args support Line 7714  $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
              group          -> includes the current group, if page is for a               group          -> includes the current group, if page is for a
Line 7509  sub start_page { Line 7733  sub start_page {
     my ($result,@advtools);      my ($result,@advtools);
   
     if (! exists($args->{'skip_phases'}{'head'}) ) {      if (! exists($args->{'skip_phases'}{'head'}) ) {
         $result .= &xml_begin() . &headtag($title, $head_extra, $args);          $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
     }      }
           
     if (! exists($args->{'skip_phases'}{'body'}) ) {      if (! exists($args->{'skip_phases'}{'body'}) ) {
Line 7615  function set_wishlistlink(title, path) { Line 7839  function set_wishlistlink(title, path) {
         title = document.title;          title = document.title;
         title = title.replace(/^LON-CAPA /,'');          title = title.replace(/^LON-CAPA /,'');
     }      }
       title = encodeURIComponent(title);
       title = title.replace("'","\\\'");
     if (!path) {      if (!path) {
         path = location.pathname;          path = location.pathname;
     }      }
       path = encodeURIComponent(path);
       path = path.replace("'","\\\'");
     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,      Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                       'wishlistNewLink','width=560,height=350,scrollbars=0');                        'wishlistNewLink','width=560,height=350,scrollbars=0');
 }  }
Line 7660  var modalWindow = { Line 7888  var modalWindow = {
 };  };
  var openMyModal = function(source,width,height,scrolling,transparency,style)   var openMyModal = function(source,width,height,scrolling,transparency,style)
  {   {
                   source = source.replace("'","&#39;");
  modalWindow.windowId = "myModal";   modalWindow.windowId = "myModal";
  modalWindow.width = width;   modalWindow.width = width;
  modalWindow.height = height;   modalWindow.height = height;
  modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+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 7932  sub validate_page { Line 8161  sub validate_page {
   
   
 sub start_scrollbox {  sub start_scrollbox {
     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready)=@_;      my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
     unless ($outerwidth) { $outerwidth='520px'; }      unless ($outerwidth) { $outerwidth='520px'; }
     unless ($width) { $width='500px'; }      unless ($width) { $width='500px'; }
     unless ($height) { $height='200px'; }      unless ($height) { $height='200px'; }
Line 7952  sub start_scrollbox { Line 8181  sub start_scrollbox {
 $nicescroll_js  $nicescroll_js
   
 <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">  <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
 <div style="overflow:auto; width:$width; height: $height;"$div_id>  <div style="overflow:auto; width:$width; height:$height;"$div_id>
 END  END
 }  }
   
Line 8267  role status: active, previous or future. Line 8496  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 8678  Incoming parameters: Line 8907  Incoming parameters:
 2. user's domain  2. user's domain
 3. quota name - portfolio, author, or course  3. quota name - portfolio, author, or course
    (if no quota name provided, defaults to portfolio).     (if no quota name provided, defaults to portfolio).
 4. crstype - official, unofficial or community, if quota name is  4. crstype - official, unofficial, textbook or community, if quota name is
    course     course
   
 Returns:  Returns:
 1. Disk quota (in Mb) assigned to student.  1. Disk quota (in MB) assigned to student.
 2. (Optional) Type of setting: custom or default  2. (Optional) Type of setting: custom or default
    (individually assigned or default for user's      (individually assigned or default for user's 
    institutional status).     institutional status).
Line 8752  sub get_user_quota { Line 8981  sub get_user_quota {
         if ($quota eq '' || wantarray) {          if ($quota eq '' || wantarray) {
             if ($quotaname eq 'course') {              if ($quotaname eq 'course') {
                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);                  my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) {                  if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                       ($crstype eq 'community') || ($crstype eq 'textbook')) {
                     $defquota = $domdefs{$crstype.'quota'};                      $defquota = $domdefs{$crstype.'quota'};
                 }                  }
                 if ($defquota eq '') {                  if ($defquota eq '') {
Line 8798  Incoming parameters: Line 9028  Incoming parameters:
   
 Returns:  Returns:
   
 1. Default disk quota (in Mb) for user portfolios in the domain.  1. Default disk quota (in MB) for user portfolios in the domain.
 2. (Optional) institutional type which determined the value of the  2. (Optional) institutional type which determined the value of the
    default quota.     default quota.
   
 If a value has been stored in the domain's configuration db,  If a value has been stored in the domain's configuration db,
 it will return that, otherwise it returns 20 (for backwards   it will return that, otherwise it returns 20 (for backwards 
 compatibility with domains which have not set up a configuration  compatibility with domains which have not set up a configuration
 db file; the original statically defined portfolio quota was 20 Mb).   db file; the original statically defined portfolio quota was 20 MB). 
   
 If the user's status includes multiple types (e.g., staff and student),  If the user's status includes multiple types (e.g., staff and student),
 the largest default quota which applies to the user determines the  the largest default quota which applies to the user determines the
Line 8893  space to be exceeded. Line 9123  space to be exceeded.
 Same, if upload of a file directly to a course/community via Course Editor  Same, if upload of a file directly to a course/community via Course Editor
 will cause quota for uploaded content for the course to be exceeded.  will cause quota for uploaded content for the course to be exceeded.
   
 Inputs: 6  Inputs: 7 
 1. username or coursenum  1. username or coursenum
 2. domain  2. domain
 3. context ('author' or 'course')  3. context ('author' or 'course')
 4. filename of file for which action is being requested  4. filename of file for which action is being requested
 5. filesize (kB) of file  5. filesize (kB) of file
 6. action being taken: copy or upload.  6. action being taken: copy or upload.
   7. quotatype (in course context -- official, unofficial, community or textbook).
   
 Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,  Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
          otherwise return null.           otherwise return null.
Line 8909  Returns: 1 scalar: HTML to display conta Line 9140  Returns: 1 scalar: HTML to display conta
 =cut  =cut
   
 sub excess_filesize_warning {  sub excess_filesize_warning {
     my ($uname,$udom,$context,$filename,$filesize,$action) = @_;      my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
     my $current_disk_usage = 0;      my $current_disk_usage = 0;
     my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB      my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
     if ($context eq 'author') {      if ($context eq 'author') {
         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";          my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);          $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
Line 8922  sub excess_filesize_warning { Line 9153  sub excess_filesize_warning {
     }      }
     $disk_quota = int($disk_quota * 1000);      $disk_quota = int($disk_quota * 1000);
     if (($current_disk_usage + $filesize) > $disk_quota) {      if (($current_disk_usage + $filesize) > $disk_quota) {
         return '<p><span class="LC_warning">'.          return '<p class="LC_warning">'.
                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",                  &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</span>'.                      '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',                 '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                             $disk_quota,$current_disk_usage).                              $disk_quota,$current_disk_usage).
                '</p>';                 '</p>';
     }      }
Line 8995  sub user_picker { Line 9226  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 9008  sub user_picker { Line 9239  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 9017  sub user_picker { Line 9250  sub user_picker {
                     'whse'      => "When searching by last,first you must include at least one character in the first name.",                      'whse'      => "When searching by last,first you must include at least one character in the first name.",
                      'thfo'     => "The following need to be corrected before the search can be run:",                       'thfo'     => "The following need to be corrected before the search can be run:",
                                        );                                         );
       &html_escape(\%html_lt);
       &js_escape(\%js_lt);
     my $domform = &select_dom_form($currdom,'srchdomain',1,1);      my $domform = &select_dom_form($currdom,'srchdomain',1,1);
     my $srchinsel = ' <select name="srchin">';      my $srchinsel = ' <select name="srchin">';
   
Line 9031  sub user_picker { Line 9266  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 9043  sub user_picker { Line 9278  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 9055  sub user_picker { Line 9290  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 9143  function validateEntry(callingForm) { Line 9378  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 9200  $new_user_create Line 9435  $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 9216  END_BLOCK Line 9451  END_BLOCK
   
 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 9376  sub personal_data_fieldtitles { Line 9715  sub personal_data_fieldtitles {
   
 sub sorted_inst_types {  sub sorted_inst_types {
     my ($dom) = @_;      my ($dom) = @_;
     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);      my ($usertypes,$order);
       my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
       if (ref($domdefaults{'inststatus'}) eq 'HASH') {
           $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
           $order = $domdefaults{'inststatus'}{'inststatusorder'};
       } else {
           ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
       }
     my $othertitle = &mt('All users');      my $othertitle = &mt('All users');
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         $othertitle  = &mt('Any users');          $othertitle  = &mt('Any users');
Line 9839  sub ask_for_embedded_content { Line 10185  sub ask_for_embedded_content {
                     ($path) =                      ($path) =
                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});                          ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                 }                  }
                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);                  if ($toplevel=~/^\/*(uploaded|editupload)/) {
                       $fileloc = $toplevel;
                       $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                       my ($udom,$uname,$fname) =
                           ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                       $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   } else {
                       $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   }
                 $fileloc =~ s{^/}{};                  $fileloc =~ s{^/}{};
                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});                  ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");                  $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
Line 9861  sub ask_for_embedded_content { Line 10215  sub ask_for_embedded_content {
         } else {          } else {
             $embed_file = $file;              $embed_file = $file;
         }          }
         my $absolutepath;          my ($absolutepath,$cleaned_file);
         my $cleaned_file = &clean_path($embed_file);          if ($embed_file =~ m{^\w+://}) {
         if ($cleaned_file =~ m{^\w+://}) {              $cleaned_file = $embed_file;
             $newfiles{$cleaned_file} = 1;              $newfiles{$cleaned_file} = 1;
             $mapping{$cleaned_file} = $embed_file;              $mapping{$cleaned_file} = $embed_file;
         } else {          } else {
               $cleaned_file = &clean_path($embed_file);
             if ($embed_file =~ m{^/}) {              if ($embed_file =~ m{^/}) {
                 $absolutepath = $embed_file;                  $absolutepath = $embed_file;
             }              }
Line 10264  sub ask_for_embedded_content { Line 10619  sub ask_for_embedded_content {
     return ($output,$counter,$numpathchg);      return ($output,$counter,$numpathchg);
 }  }
   
   
 =pod  =pod
   
 =item * clean_path($name)  =item * clean_path($name)
Line 10870  sub check_for_upload { Line 11224  sub check_for_upload {
                     if ($currsize < $filesize) {                      if ($currsize < $filesize) {
                         my $extra = $filesize - $currsize;                          my $extra = $filesize - $currsize;
                         if (($current_disk_usage + $extra) > $disk_quota) {                          if (($current_disk_usage + $extra) > $disk_quota) {
                             my $msg = '<span class="LC_error">'.                              my $msg = '<p class="LC_warning">'.
                                       &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',                                        &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.                                            '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',                                        '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                                                    $disk_quota,$current_disk_usage);                                                     $disk_quota,$current_disk_usage).'</p>';
                             return ('will_exceed_quota',$msg);                              return ('will_exceed_quota',$msg);
                         }                          }
                     }                      }
Line 10883  sub check_for_upload { Line 11237  sub check_for_upload {
         }          }
     }      }
     if (($current_disk_usage + $filesize) > $disk_quota){      if (($current_disk_usage + $filesize) > $disk_quota){
         my $msg = '<span class="LC_error">'.          my $msg = '<p class="LC_warning">'.
                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.                  &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);                    '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
         return ('will_exceed_quota',$msg);          return ('will_exceed_quota',$msg);
     } elsif ($found_file) {      } elsif ($found_file) {
         if ($locked_file) {          if ($locked_file) {
             my $msg = '<span class="LC_error">';              my $msg = '<p class="LC_warning">';
             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');              $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
             $msg .= '</span><br />';              $msg .= '</p>';
             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');              $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
             return ('file_locked',$msg);              return ('file_locked',$msg);
         } else {          } else {
             my $msg = '<span class="LC_error">';              my $msg = '<p class="LC_error">';
             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});              $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
             $msg .= '</span>';              $msg .= '</p>';
             return ('existingfile',$msg);              return ('existingfile',$msg);
         }          }
     }      }
Line 10988  sub decompress_form { Line 11342  sub decompress_form {
         }          }
     }      }
     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {      if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
         my @camtasia = ("$topdir/","$topdir/index.html",          my @camtasia6 = ("$topdir/","$topdir/index.html",
                         "$topdir/media/",                          "$topdir/media/",
                         "$topdir/media/$topdir.mp4",                          "$topdir/media/$topdir.mp4",
                         "$topdir/media/FirstFrame.png",                          "$topdir/media/FirstFrame.png",
                         "$topdir/media/player.swf",                          "$topdir/media/player.swf",
                         "$topdir/media/swfobject.js",                          "$topdir/media/swfobject.js",
                         "$topdir/media/expressInstall.swf");                          "$topdir/media/expressInstall.swf");
         my @diffs = &compare_arrays(\@paths,\@camtasia);          my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
                            "$topdir/$topdir.mp4",
                            "$topdir/$topdir\_config.xml",
                            "$topdir/$topdir\_controller.swf",
                            "$topdir/$topdir\_embed.css",
                            "$topdir/$topdir\_First_Frame.png",
                            "$topdir/$topdir\_player.html",
                            "$topdir/$topdir\_Thumbnails.png",
                            "$topdir/playerProductInstall.swf",
                            "$topdir/scripts/",
                            "$topdir/scripts/config_xml.js",
                            "$topdir/scripts/handlebars.js",
                            "$topdir/scripts/jquery-1.7.1.min.js",
                            "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                            "$topdir/scripts/modernizr.js",
                            "$topdir/scripts/player-min.js",
                            "$topdir/scripts/swfobject.js",
                            "$topdir/skins/",
                            "$topdir/skins/configuration_express.xml",
                            "$topdir/skins/express_show/",
                            "$topdir/skins/express_show/player-min.css",
                            "$topdir/skins/express_show/spritesheet.png");
           my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                            "$topdir/$topdir.mp4",
                            "$topdir/$topdir\_config.xml",
                            "$topdir/$topdir\_controller.swf",
                            "$topdir/$topdir\_embed.css",
                            "$topdir/$topdir\_First_Frame.png",
                            "$topdir/$topdir\_player.html",
                            "$topdir/$topdir\_Thumbnails.png",
                            "$topdir/playerProductInstall.swf",
                            "$topdir/scripts/",
                            "$topdir/scripts/config_xml.js",
                            "$topdir/scripts/techsmith-smart-player.min.js",
                            "$topdir/skins/",
                            "$topdir/skins/configuration_express.xml",
                            "$topdir/skins/express_show/",
                            "$topdir/skins/express_show/spritesheet.min.css",
                            "$topdir/skins/express_show/spritesheet.png",
                            "$topdir/skins/express_show/techsmith-smart-player.min.css");
           my @diffs = &compare_arrays(\@paths,\@camtasia6);
         if (@diffs == 0) {          if (@diffs == 0) {
             $is_camtasia = 1;              $is_camtasia = 6;
           } else {
               @diffs = &compare_arrays(\@paths,\@camtasia8_1);
               if (@diffs == 0) {
                   $is_camtasia = 8;
               } else {
                   @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   if (@diffs == 0) {
                       $is_camtasia = 8;
                   }
               }
         }          }
     }      }
     my $output;      my $output;
Line 11009  sub decompress_form { Line 11413  sub decompress_form {
 function camtasiaToggle() {  function camtasiaToggle() {
     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {      for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {          if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {              if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
   
                 document.getElementById('camtasia_titles').style.display='block';                  document.getElementById('camtasia_titles').style.display='block';
             } else {              } else {
                 document.getElementById('camtasia_titles').style.display='none';                  document.getElementById('camtasia_titles').style.display='none';
Line 11072  ENDCAM Line 11475  ENDCAM
     if ($is_camtasia) {      if ($is_camtasia) {
         $output .= $lt{'auto'}.'<br />'.          $output .= $lt{'auto'}.'<br />'.
                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.                     '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.                     '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                    $lt{'yes'}.'</label>&nbsp;<label>'.                     $lt{'yes'}.'</label>&nbsp;<label>'.
                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.                     '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                    $lt{'no'}.'</label></span><br />'.                     $lt{'no'}.'</label></span><br />'.
Line 11195  sub decompress_uploaded_file { Line 11598  sub decompress_uploaded_file {
 sub process_decompression {  sub process_decompression {
     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;      my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
     my ($dir,$error,$warning,$output);      my ($dir,$error,$warning,$output);
     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {      if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
         $error = &mt('Filename not a supported archive file type.').          $error = &mt('Filename not a supported archive file type.').
                  '<br />'.&mt('Filename should end with one of: [_1].',                   '<br />'.&mt('Filename should end with one of: [_1].',
                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');                                '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
Line 11305  sub process_decompression { Line 11708  sub process_decompression {
                                                            \%titles,\%children);                                                             \%titles,\%children);
                         }                          }
                         if ($env{'form.autoextract_camtasia'}) {                          if ($env{'form.autoextract_camtasia'}) {
                               my $version = $env{'form.autoextract_camtasia'};
                             my %displayed;                              my %displayed;
                             my $total = 1;                              my $total = 1;
                             $env{'form.archive_directory'} = [];                              $env{'form.archive_directory'} = [];
Line 11323  sub process_decompression { Line 11727  sub process_decompression {
                                     $env{'form.archive_'.$i} = 'display';                                      $env{'form.archive_'.$i} = 'display';
                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};                                      $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                                     $displayed{'folder'} = $i;                                      $displayed{'folder'} = $i;
                                 } elsif ($item eq "$contents[0]/index.html") {                                  } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                                            (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
                                     $env{'form.archive_'.$i} = 'display';                                      $env{'form.archive_'.$i} = 'display';
                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};                                      $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                                     $displayed{'web'} = $i;                                      $displayed{'web'} = $i;
                                 } else {                                  } else {
                                     if ($item eq "$contents[0]/media") {                                      if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                                           ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                                                ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
                                         push(@{$env{'form.archive_directory'}},$i);                                          push(@{$env{'form.archive_directory'}},$i);
                                     }                                      }
                                     $env{'form.archive_'.$i} = 'dependency';                                      $env{'form.archive_'.$i} = 'dependency';
Line 12055  sub cleanup_empty_dirs { Line 12462  sub cleanup_empty_dirs {
   
 =pod  =pod
   
 =item &get_folder_hierarchy()  =item * &get_folder_hierarchy()
   
 Provides hierarchy of names of folders/sub-folders containing the current  Provides hierarchy of names of folders/sub-folders containing the current
 item,  item,
Line 13368  sub extract_categories { Line 13775  sub extract_categories {
   
 =pod  =pod
   
 =item *&recurse_categories()  =item * &recurse_categories()
   
 Recursively used to generate breadcrumb trails for course categories.  Recursively used to generate breadcrumb trails for course categories.
   
Line 13439  sub recurse_categories { Line 13846  sub recurse_categories {
   
 =pod  =pod
   
 =item *&assign_categories_table()  =item * &assign_categories_table()
   
 Create a datatable for display of hierarchical categories in a domain,  Create a datatable for display of hierarchical categories in a domain,
 with checkboxes to allow a course to be categorized.   with checkboxes to allow a course to be categorized. 
Line 13516  sub assign_categories_table { Line 13923  sub assign_categories_table {
   
 =pod  =pod
   
 =item *&assign_category_rows()  =item * &assign_category_rows()
   
 Create a datatable row for display of nested categories in a domain,  Create a datatable row for display of nested categories in a domain,
 with checkboxes to allow a course to be categorized,called recursively.  with checkboxes to allow a course to be categorized,called recursively.
Line 13582  sub assign_category_rows { Line 13989  sub assign_category_rows {
     return $text;      return $text;
 }  }
   
   =pod
   
   =back
   
   =cut
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
Line 13799  sub check_clone { Line 14212  sub check_clone {
             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {              (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
     $can_clone = 1;      $can_clone = 1;
  } else {   } else {
     my %clonehash = &Apache::lonnet::get('environment',['cloners'],      my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
  $args->{'clonedomain'},$args->{'clonecourse'});   $args->{'clonedomain'},$args->{'clonecourse'});
     my @cloners = split(/,/,$clonehash{'cloners'});              if ($clonehash{'cloners'} eq '') {
             if (grep(/^\*$/,@cloners)) {                  my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                 $can_clone = 1;                  if ($domdefs{'canclone'}) {
             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {                      unless ($domdefs{'canclone'} eq 'none') {
                 $can_clone = 1;                          if ($domdefs{'canclone'} eq 'domain') {
                               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 13834  sub check_clone { Line 14305  sub check_clone {
 }  }
   
 sub construct_course {  sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;      my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
     my $outcome;      my $outcome;
     my $linefeed =  '<br />'."\n";      my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {      if ($context eq 'auto') {
Line 13931  sub construct_course { Line 14402  sub construct_course {
                    'plc.users.denied',                     'plc.users.denied',
                    'hidefromcat',                     'hidefromcat',
                    'checkforpriv',                     'checkforpriv',
                    'categories'],                     'categories',
                      'internal.uniquecode'],
                    $$crsudom,$$crsunum);                     $$crsudom,$$crsunum);
           if ($args->{'textbook'}) {
               $cenv{'internal.textbook'} = $args->{'textbook'};
           }
     }      }
   
 #  #
Line 14116  sub construct_course { Line 14591  sub construct_course {
  }   }
     }      }
   
   #
   #  generate and store uniquecode (available to course requester), if course should have one.
   #
       if ($args->{'uniquecode'}) {
           my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
           if ($code) {
               $cenv{'internal.uniquecode'} = $code;
               my %crsinfo =
                   &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
               if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
               }
               if (ref($coderef)) {
                   $$coderef = $code;
               }
           }
       }
   
     if ($args->{'disresdis'}) {      if ($args->{'disresdis'}) {
         $cenv{'pch.roles.denied'}='st';          $cenv{'pch.roles.denied'}='st';
     }      }
Line 14184  sub construct_course { Line 14678  sub construct_course {
     return (1,$outcome);      return (1,$outcome);
 }  }
   
   sub make_unique_code {
       my ($cdom,$cnum) = @_;
       # get lock on uniquecodes db
       my $lockhash = {
                         $cnum."\0".'uniquecodes' => $env{'user.name'}.
                                                     ':'.$env{'user.domain'},
                      };
       my $tries = 0;
       my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
       my ($code,$error);
   
       while (($gotlock ne 'ok') && ($tries<3)) {
           $tries ++;
           sleep 1;
           $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
       }
       if ($gotlock eq 'ok') {
           my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
           my $gotcode;
           my $attempts = 0;
           while ((!$gotcode) && ($attempts < 100)) {
               $code = &generate_code();
               if (!exists($currcodes{$code})) {
                   $gotcode = 1;
                   unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                       $error = 'nostore';
                   }
               }
               $attempts ++;
           }
           my @del_lock = ($cnum."\0".'uniquecodes');
           my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
       } else {
           $error = 'nolock';
       }
       return ($code,$error);
   }
   
   sub generate_code {
       my $code;
       my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
       for (my $i=0; $i<6; $i++) {
           my $lettnum = int (rand 2);
           my $item = '';
           if ($lettnum) {
               $item = $letts[int( rand(18) )];
           } else {
               $item = 1+int( rand(8) );
           }
           $code .= $item;
       }
       return $code;
   }
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
Line 14211  sub group_term { Line 14759  sub group_term {
 }  }
   
 sub course_types {  sub course_types {
     my @types = ('official','unofficial','community');      my @types = ('official','unofficial','community','textbook');
     my %typename = (      my %typename = (
                          official   => 'Official course',                           official   => 'Official course',
                          unofficial => 'Unofficial course',                           unofficial => 'Unofficial course',
                          community  => 'Community',                           community  => 'Community',
                            textbook   => 'Textbook course',
                    );                     );
     return (\@types,\%typename);      return (\@types,\%typename);
 }  }
Line 14276  sub escape_url { Line 14825  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 14334  sub init_user_environment { Line 14883  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 14347  sub init_user_environment { Line 14907  sub init_user_environment {
     }      }
 # ------------------------------------ Check browser type and MathML capability  # ------------------------------------ Check browser type and MathML capability
   
     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,      my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
         $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);          $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
   
 # ------------------------------------------------------------- Get environment  # ------------------------------------------------------------- Get environment
   
Line 14381  sub init_user_environment { Line 14941  sub init_user_environment {
      "browser.os"         => $clientos,       "browser.os"         => $clientos,
              "browser.mobile"     => $clientmobile,               "browser.mobile"     => $clientmobile,
              "browser.info"       => $clientinfo,               "browser.info"       => $clientinfo,
                "browser.osversion"  => $clientosversion,
      "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},       "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
      "request.course.fn"  => '',       "request.course.fn"  => '',
      "request.course.uri" => '',       "request.course.uri" => '',
Line 14400  sub init_user_environment { Line 14961  sub init_user_environment {
     $env{'browser.interface'}=$form->{'interface'};      $env{'browser.interface'}=$form->{'interface'};
  }   }
   
           if ($form->{'iptoken'}) {
               my $lonhost = $r->dir_config('lonHostID');
               $initial_env{"user.noloadbalance"} = $lonhost;
               $env{'user.noloadbalance'} = $lonhost;
           }
   
         my %is_adv = ( is_adv => $env{'user.adv'} );          my %is_adv = ( is_adv => $env{'user.adv'} );
         my %domdef;          my %domdef;
         unless ($domain eq 'public') {          unless ($domain eq 'public') {
Line 14412  sub init_user_environment { Line 14979  sub init_user_environment {
                                                   undef,\%userenv,\%domdef,\%is_adv);                                                    undef,\%userenv,\%domdef,\%is_adv);
         }          }
   
         foreach my $crstype ('official','unofficial','community') {          foreach my $crstype ('official','unofficial','community','textbook') {
             $userenv{'canrequest.'.$crstype} =              $userenv{'canrequest.'.$crstype} =
                 &Apache::lonnet::usertools_access($username,$domain,$crstype,                  &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                   'reload','requestcourses',                                                    'reload','requestcourses',
Line 14517  sub clean_symb { Line 15084  sub clean_symb {
     return ($symb,$enc);      return ($symb,$enc);
 }  }
   
 sub build_release_hashes {  ############################################################
     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;  ############################################################
     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&  
                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&  =pod
                   (ref($randomizetry) eq 'HASH'));  
     foreach my $key (keys(%Apache::lonnet::needsrelease)) {  =head1 Routines for building display used to search for courses
         my ($item,$name,$value) = split(/:/,$key);  
         if ($item eq 'parameter') {  
             if (ref($checkparms->{$name}) eq 'ARRAY') {  =over 4
                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {  
                     push(@{$checkparms->{$name}},$value);  =item * &build_filters()
                 }  
   Create markup for a table used to set filters to use when selecting
   courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
   and quotacheck.pl
   
   
   Inputs:
   
   filterlist - anonymous array of fields to include as potential filters
   
   crstype - course type
   
   roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                 to pop-open a course selector (will contain "extra element").
   
   multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
   
   filter - anonymous hash of criteria and their values
   
   action - form action
   
   numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
   
   caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
   
   cloneruname - username of owner of new course who wants to clone
   
   clonerudom - domain of owner of new course who wants to clone
   
   typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
   
   codetitlesref - reference to array of titles of components in institutional codes (official courses)
   
   codedom - domain
   
   formname - value of form element named "form".
   
   fixeddom - domain, if fixed.
   
   prevphase - value to assign to form element named "phase" when going back to the previous screen
   
   cnameelement - name of form element in form on opener page which will receive title of selected course
   
   cnumelement - name of form element in form on opener page which will receive courseID  of selected course
   
   cdomelement - name of form element in form on opener page which will receive domain of selected course
   
   setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
   
   clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
   
   clonewarning - warning message about missing information for intended course owner when DC creates a course
   
   
   Returns: $output - HTML for display of search criteria, and hidden form elements.
   
   
   Side Effects: None
   
   =cut
   
   # ---------------------------------------------- search for courses based on last activity etc.
   
   sub build_filters {
       my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
           $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
           $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
           $cnameelement,$cnumelement,$cdomelement,$setroles,
           $clonetext,$clonewarning) = @_;
       my ($list,$jscript);
       my $onchange = 'javascript:updateFilters(this)';
       my ($domainselectform,$sincefilterform,$createdfilterform,
           $ownerdomselectform,$persondomselectform,$instcodeform,
           $typeselectform,$instcodetitle);
       if ($formname eq '') {
           $formname = $caller;
       }
       foreach my $item (@{$filterlist}) {
           unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
               if ($item eq 'domainfilter') {
                   $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
               } elsif ($item eq 'coursefilter') {
                   $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
               } elsif ($item eq 'ownerfilter') {
                   $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
               } elsif ($item eq 'ownerdomfilter') {
                   $filter->{'ownerdomfilter'} =
                       &LONCAPA::clean_domain($filter->{$item});
                   $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                                                          'ownerdomfilter',1);
               } elsif ($item eq 'personfilter') {
                   $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
               } elsif ($item eq 'persondomfilter') {
                   $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                                                           'persondomfilter',1);
             } else {              } else {
                 push(@{$checkparms->{$name}},$value);                  $filter->{$item} =~ s/\W//g;
             }              }
         } elsif ($item eq 'resourcetag') {              if (!$filter->{$item}) {
             if ($name eq 'responsetype') {                  $filter->{$item} = '';
                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}  
             }              }
         } elsif ($item eq 'course') {          }
             if ($name eq 'crstype') {          if ($item eq 'domainfilter') {
                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};              my $allow_blank = 1;
               if ($formname eq 'portform') {
                   $allow_blank=0;
               } elsif ($formname eq 'studentform') {
                   $allow_blank=0;
               }
               if ($fixeddom) {
                   $domainselectform = '<input type="hidden" name="domainfilter"'.
                                       ' value="'.$codedom.'" />'.
                                       &Apache::lonnet::domain($codedom,'description');
               } else {
                   $domainselectform = &select_dom_form($filter->{$item},
                                                        'domainfilter',
                                                         $allow_blank,'',$onchange);
             }              }
           } else {
               $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
           }
       }
   
       # last course activity filter and selection
       $sincefilterform = &timebased_select_form('sincefilter',$filter);
   
       # course created filter and selection
       if (exists($filter->{'createdfilter'})) {
           $createdfilterform = &timebased_select_form('createdfilter',$filter);
       }
   
       my %lt = &Apache::lonlocal::texthash(
                   'cac' => "$crstype Activity",
                   'ccr' => "$crstype Created",
                   'cde' => "$crstype Title",
                   'cdo' => "$crstype Domain",
                   'ins' => 'Institutional Code',
                   'inc' => 'Institutional Categorization',
                   'cow' => "$crstype Owner/Co-owner",
                   'cop' => "$crstype Personnel Includes",
                   'cog' => 'Type',
                );
   
       if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
           my $typeval = 'Course';
           if ($crstype eq 'Community') {
               $typeval = 'Community';
           }
           $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
       } else {
           $typeselectform =  '<select name="type" size="1"';
           if ($onchange) {
               $typeselectform .= ' onchange="'.$onchange.'"';
           }
           $typeselectform .= '>'."\n";
           foreach my $posstype ('Course','Community') {
               $typeselectform.='<option value="'.$posstype.'"'.
                   ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
           }
           $typeselectform.="</select>";
       }
   
       my ($cloneableonlyform,$cloneabletitle);
       if (exists($filter->{'cloneableonly'})) {
           my $cloneableon = '';
           my $cloneableoff = ' checked="checked"';
           if ($filter->{'cloneableonly'}) {
               $cloneableon = $cloneableoff;
               $cloneableoff = '';
           }
           $cloneableonlyform = '<span class="LC_nobreak"><label><input type="radio" name="cloneableonly" value="1" '.$cloneableon.'/>&nbsp;'.&mt('Required').'</label>'.('&nbsp;'x3).'<label><input type="radio" name="cloneableonly" value="" '.$cloneableoff.' />&nbsp;'.&mt('No restriction').'</label></span>';
           if ($formname eq 'ccrs') {
               $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
           } else {
               $cloneabletitle = &mt('Cloneable by you');
           }
       }
       my $officialjs;
       if ($crstype eq 'Course') {
           if (exists($filter->{'instcodefilter'})) {
   #            if (($fixeddom) || ($formname eq 'requestcrs') ||
   #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
               if ($codedom) {
                   $officialjs = 1;
                   ($instcodeform,$jscript,$$numtitlesref) =
                       &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                                                                     $officialjs,$codetitlesref);
                   if ($jscript) {
                       $jscript = '<script type="text/javascript">'."\n".
                                  '// <![CDATA['."\n".
                                  $jscript."\n".
                                  '// ]]>'."\n".
                                  '</script>'."\n";
                   }
               }
               if ($instcodeform eq '') {
                   $instcodeform =
                       '<input type="text" name="instcodefilter" size="10" value="'.
                       $list->{'instcodefilter'}.'" />';
                   $instcodetitle = $lt{'ins'};
               } else {
                   $instcodetitle = $lt{'inc'};
               }
               if ($fixeddom) {
                   $instcodetitle .= '<br />('.$codedom.')';
               }
           }
       }
       my $output = qq|
   <form method="post" name="filterpicker" action="$action">
   <input type="hidden" name="form" value="$formname" />
   |;
       if ($formname eq 'modifycourse') {
           $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                      '<input type="hidden" name="prevphase" value="'.
                      $prevphase.'" />'."\n";
       } elsif ($formname eq 'quotacheck') {
           $output .= qq|
   <input type="hidden" name="sortby" value="" />
   <input type="hidden" name="sortorder" value="" />
   |;
       } else {
           my $name_input;
           if ($cnameelement ne '') {
               $name_input = '<input type="hidden" name="cnameelement" value="'.
                             $cnameelement.'" />';
           }
           $output .= qq|
   <input type="hidden" name="cnumelement" value="$cnumelement" />
   <input type="hidden" name="cdomelement" value="$cdomelement" />
   $name_input
   $roleelement
   $multelement
   $typeelement
   |;
           if ($formname eq 'portform') {
               $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
         }          }
     }      }
     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});      if ($fixeddom) {
     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});          $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
       }
       $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
       if ($sincefilterform) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                     .$sincefilterform
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if ($createdfilterform) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                     .$createdfilterform
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if ($domainselectform) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                     .$domainselectform
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if ($typeselectform) {
           if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
               $output .= $typeselectform;
           } else {
               $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                         .$typeselectform
                         .&Apache::lonhtmlcommon::row_closure();
           }
       }
       if ($instcodeform) {
           $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                     .$instcodeform
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if (exists($filter->{'ownerfilter'})) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                      '<table><tr><td>'.&mt('Username').'<br />'.
                      '<input type="text" name="ownerfilter" size="20" value="'.
                      $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                      $ownerdomselectform.'</td></tr></table>'.
                      &Apache::lonhtmlcommon::row_closure();
       }
       if (exists($filter->{'personfilter'})) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                      '<table><tr><td>'.&mt('Username').'<br />'.
                      '<input type="text" name="personfilter" size="20" value="'.
                      $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                      $persondomselectform.'</td></tr></table>'.
                      &Apache::lonhtmlcommon::row_closure();
       }
       if (exists($filter->{'coursefilter'})) {
           $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                     .'<input type="text" name="coursefilter" size="25" value="'
                     .$list->{'coursefilter'}.'" />'
                     .&Apache::lonhtmlcommon::row_closure();
       }
       if ($cloneableonlyform) {
           $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                      $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
       }
       if (exists($filter->{'descriptfilter'})) {
           $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                     .'<input type="text" name="descriptfilter" size="40" value="'
                     .$list->{'descriptfilter'}.'" />'
                     .&Apache::lonhtmlcommon::row_closure(1);
       }
       $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                  '<input type="hidden" name="updater" value="" />'."\n".
                  '<input type="submit" name="gosearch" value="'.
                  &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
       return $jscript.$clonewarning.$output;
   }
   
   =pod
   
   =item * &timebased_select_form()
   
   Create markup for a dropdown list used to select a time-based
   filter e.g., Course Activity, Course Created, when searching for courses
   or communities
   
   Inputs:
   
   item - name of form element (sincefilter or createdfilter)
   
   filter - anonymous hash of criteria and their values
   
   Returns: HTML for a select box contained a blank, then six time selections,
            with value set in incoming form variables currently selected.
   
   Side Effects: None
   
   =cut
   
   sub timebased_select_form {
       my ($item,$filter) = @_;
       if (ref($filter) eq 'HASH') {
           $filter->{$item} =~ s/[^\d-]//g;
           if (!$filter->{$item}) { $filter->{$item}=-1; }
           return &select_form(
                               $filter->{$item},
                               $item,
                               {      '-1' => '',
                                   '86400' => &mt('today'),
                                  '604800' => &mt('last week'),
                                 '2592000' => &mt('last month'),
                                 '7776000' => &mt('last three months'),
                                '15552000' => &mt('last six months'),
                                '31104000' => &mt('last year'),
                       'select_form_order' =>
                              ['-1','86400','604800','2592000','7776000',
                               '15552000','31104000']});
       }
   }
   
   =pod
   
   =item * &js_changer()
   
   Create script tag containing Javascript used to submit course search form
   when course type or domain is changed, and also to hide 'Searching ...' on
   page load completion for page showing search result.
   
   Inputs: None
   
   Returns: markup containing updateFilters() and hideSearching() javascript functions.
   
   Side Effects: None
   
   =cut
   
   sub js_changer {
       return <<ENDJS;
   <script type="text/javascript">
   // <![CDATA[
   function updateFilters(caller) {
       if (typeof(caller) != "undefined") {
           document.filterpicker.updater.value = caller.name;
       }
       document.filterpicker.submit();
   }
   
   function hideSearching() {
       if (document.getElementById('searching')) {
           document.getElementById('searching').style.display = 'none';
       }
     return;      return;
 }  }
   
   // ]]>
   </script>
   
   ENDJS
   }
   
   =pod
   
   =item * &search_courses()
   
   Process selected filters form course search form and pass to lonnet::courseiddump
   to retrieve a hash for which keys are courseIDs which match the selected filters.
   
   Inputs:
   
   dom - domain being searched
   
   type - course type ('Course' or 'Community' or '.' if any).
   
   filter - anonymous hash of criteria and their values
   
   numtitles - for institutional codes - number of categories
   
   cloneruname - optional username of new course owner
   
   clonerudom - optional domain of new course owner
   
   domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
               (used when DC is using course creation form)
   
   codetitles - reference to array of titles of components in institutional codes (official courses).
   
   cc_clone - escaped comma separated list of courses for which course cloner has active CC role
              (and so can clone automatically)
   
   reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
   
   reqinstcode - institutional code of new course, where search_courses is used to identify potential
                 courses to clone
   
   Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
   
   
   Side Effects: None
   
   =cut
   
   
   sub search_courses {
       my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
           $cc_clone,$reqcrsdom,$reqinstcode) = @_;
       my (%courses,%showcourses,$cloner);
       if (($filter->{'ownerfilter'} ne '') ||
           ($filter->{'ownerdomfilter'} ne '')) {
           $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                                          $filter->{'ownerdomfilter'};
       }
       foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
           if (!$filter->{$item}) {
               $filter->{$item}='.';
           }
       }
       my $now = time;
       my $timefilter =
          ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
       my ($createdbefore,$createdafter);
       if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
           $createdbefore = $now;
           $createdafter = $now-$filter->{'createdfilter'};
       }
       my ($instcodefilter,$regexpok);
       if ($numtitles) {
           if ($env{'form.official'} eq 'on') {
               $instcodefilter =
                   &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
               $regexpok = 1;
           } elsif ($env{'form.official'} eq 'off') {
               $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
               unless ($instcodefilter eq '') {
                   $regexpok = -1;
               }
           }
       } else {
           $instcodefilter = $filter->{'instcodefilter'};
       }
       if ($instcodefilter eq '') { $instcodefilter = '.'; }
       if ($type eq '') { $type = '.'; }
   
       if (($clonerudom ne '') && ($cloneruname ne '')) {
           $cloner = $cloneruname.':'.$clonerudom;
       }
       %courses = &Apache::lonnet::courseiddump($dom,
                                                $filter->{'descriptfilter'},
                                                $timefilter,
                                                $instcodefilter,
                                                $filter->{'combownerfilter'},
                                                $filter->{'coursefilter'},
                                                undef,undef,$type,$regexpok,undef,undef,
                                                undef,undef,$cloner,$cc_clone,
                                                $filter->{'cloneableonly'},
                                                $createdbefore,$createdafter,undef,
                                                $domcloner,undef,$reqcrsdom,$reqinstcode);
       if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
           my $ccrole;
           if ($type eq 'Community') {
               $ccrole = 'co';
           } else {
               $ccrole = 'cc';
           }
           my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                                                        $filter->{'persondomfilter'},
                                                        'userroles',undef,
                                                        [$ccrole,'in','ad','ep','ta','cr'],
                                                        $dom);
           foreach my $role (keys(%rolehash)) {
               my ($cnum,$cdom,$courserole) = split(':',$role);
               my $cid = $cdom.'_'.$cnum;
               if (exists($courses{$cid})) {
                   if (ref($courses{$cid}) eq 'HASH') {
                       if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                           if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                               push (@{$courses{$cid}{roles}},$courserole);
                           }
                       } else {
                           $courses{$cid}{roles} = [$courserole];
                       }
                       $showcourses{$cid} = $courses{$cid};
                   }
               }
           }
           %courses = %showcourses;
       }
       return %courses;
   }
   
   =pod
   
   =back
   
   =head1 Routines for version requirements for current course.
   
   =over 4
   
   =item * &check_release_required()
   
   Compares required LON-CAPA version with version on server, and
   if required version is newer looks for a server with the required version.
   
   Looks first at servers in user's owen domain; if none suitable, looks at
   servers in course's domain are permitted to host sessions for user's domain.
   
   Inputs:
   
   $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
   
   $courseid - Course ID of current course
   
   $rolecode - User's current role in course (for switchserver query string).
   
   $required - LON-CAPA version needed by course (format: Major.Minor).
   
   
   Returns:
   
   $switchserver - query string tp append to /adm/switchserver call (if
                   current server's LON-CAPA version is too old.
   
   $warning - Message is displayed if no suitable server could be found.
   
   =cut
   
   sub check_release_required {
       my ($loncaparev,$courseid,$rolecode,$required) = @_;
       my ($switchserver,$warning);
       if ($required ne '') {
           my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
           my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
           if ($reqdmajor ne '' && $reqdminor ne '') {
               my $otherserver;
               if (($major eq '' && $minor eq '') ||
                   (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   my $switchlcrev =
                       &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                                                              $userdomserver);
                   my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                       (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                       my $cdom = $env{'course.'.$courseid.'.domain'};
                       if ($cdom ne $env{'user.domain'}) {
                           my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                           my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                           my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                           my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                           my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                           my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                           my $canhost =
                               &Apache::lonnet::can_host_session($env{'user.domain'},
                                                                 $coursedomserver,
                                                                 $remoterev,
                                                                 $udomdefaults{'remotesessions'},
                                                                 $defdomdefaults{'hostedsessions'});
   
                           if ($canhost) {
                               $otherserver = $coursedomserver;
                           } else {
                               $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
                           }
                       } else {
                           $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
                       }
                   } else {
                       $otherserver = $userdomserver;
                   }
               }
               if ($otherserver ne '') {
                   $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
               }
           }
       }
       return ($switchserver,$warning);
   }
   
   =pod
   
   =item * &check_release_result()
   
   Inputs:
   
   $switchwarning - Warning message if no suitable server found to host session.
   
   $switchserver - query string to append to /adm/switchserver containing lonHostID
                   and current role.
   
   Returns: HTML to display with information about requirement to switch server.
            Either displaying warning with link to Roles/Courses screen or
            display link to switchserver.
   
   =cut
   
   sub check_release_result {
       my ($switchwarning,$switchserver) = @_;
       my $output = &start_page('Selected course unavailable on this server').
                    '<p class="LC_warning">';
       if ($switchwarning) {
           $output .= $switchwarning.'<br /><a href="/adm/roles">';
           if (&show_course()) {
               $output .= &mt('Display courses');
           } else {
               $output .= &mt('Display roles');
           }
           $output .= '</a>';
       } elsif ($switchserver) {
           $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                      '<br />'.
                      '<a href="/adm/switchserver?'.$switchserver.'">'.
                      &mt('Switch Server').
                      '</a>';
       }
       $output .= '</p>'.&end_page();
       return $output;
   }
   
   =pod
   
   =item * &needs_coursereinit()
   
   Determine if course contents stored for user's session needs to be
   refreshed, because content has changed since "Big Hash" last tied.
   
   Check for change is made if time last checked is more than 10 minutes ago
   (by default).
   
   Inputs:
   
   $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
   
   $interval (optional) - Time which may elapse (in s) between last check for content
                          change in current course. (default: 600 s).
   
   Returns: an array; first element is:
   
   =over 4
   
   'switch' - if content updates mean user's session
              needs to be switched to a server running a newer LON-CAPA version
   
   'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
              on current server hosting user's session
   
   ''       - if no action required.
   
   =back
   
   If first item element is 'switch':
   
   second item is $switchwarning - Warning message if no suitable server found to host session.
   
   third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                                 and current role.
   
   otherwise: no other elements returned.
   
   =back
   
   =cut
   
   sub needs_coursereinit {
       my ($loncaparev,$interval) = @_;
       return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       my $now = time;
       if ($interval eq '') {
           $interval = 600;
       }
       if (($now-$env{'request.course.timechecked'})>$interval) {
           my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
           &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
           if ($lastchange > $env{'request.course.tied'}) {
               my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
               if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                       &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                                                $curr_reqd_hash{'internal.releaserequired'}});
                       my ($switchserver,$switchwarning) =
                           &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                                                   $curr_reqd_hash{'internal.releaserequired'});
                       if ($switchwarning ne '' || $switchserver ne '') {
                           return ('switch',$switchwarning,$switchserver);
                       }
                   }
               }
               return ('update');
           }
       }
       return ();
   }
   
 sub update_content_constraints {  sub update_content_constraints {
     my ($cdom,$cnum,$chome,$cid) = @_;      my ($cdom,$cnum,$chome,$cid) = @_;
     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');      my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
Line 14740  sub captcha_display { Line 16016  sub captcha_display {
             $error = 'recaptcha';              $error = 'recaptcha';
         }          }
     }      }
     return ($output,$error);      return ($output,$error,$captcha);
 }  }
   
 sub captcha_response {  sub captcha_response {
Line 14816  sub create_captcha { Line 16092  sub create_captcha {
         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {          if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".              $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                       &mt('Type in the letters/numbers shown below').'&nbsp;'.                        &mt('Type in the letters/numbers shown below').'&nbsp;'.
                      '<input type="text" size="5" name="code" value="" /><br />'.                        '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';                        '<br />'.
                         '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
             last;              last;
         }          }
     }      }
Line 14865  sub create_recaptcha { Line 16142  sub create_recaptcha {
     my $captcha = Captcha::reCAPTCHA->new;      my $captcha = Captcha::reCAPTCHA->new;
     return $captcha->get_options_setter({theme => 'white'})."\n".      return $captcha->get_options_setter({theme => 'white'})."\n".
            $captcha->get_html($pubkey,undef,$use_ssl).             $captcha->get_html($pubkey,undef,$use_ssl).
            &mt('If either word is hard to read, [_1] will replace them.',             &mt('If the text is hard to read, [_1] will replace them.',
                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').                 '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
            '<br /><br />';             '<br /><br />';
 }  }
Line 14887  sub check_recaptcha { Line 16164  sub check_recaptcha {
     return $captcha_chk;      return $captcha_chk;
 }  }
   
 =pod  sub emailusername_info {
       my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
       my %titles = &Apache::lonlocal::texthash (
                        lastname      => 'Last Name',
                        firstname     => 'First Name',
                        institution   => 'School/college/university',
                        location      => "School's city, state/province, country",
                        web           => "School's web address",
                        officialemail => 'E-mail address at institution (if different)',
                        id            => 'Student/Employee ID',
                    );
       return (\@fields,\%titles);
   }
   
 =back  sub cleanup_html {
       my ($incoming) = @_;
       my $outgoing;
       if ($incoming ne '') {
           $outgoing = $incoming;
           $outgoing =~ s/;/&#059;/g;
           $outgoing =~ s/\#/&#035;/g;
           $outgoing =~ s/\&/&#038;/g;
           $outgoing =~ s/</&#060;/g;
           $outgoing =~ s/>/&#062;/g;
           $outgoing =~ s/\(/&#040/g;
           $outgoing =~ s/\)/&#041;/g;
           $outgoing =~ s/"/&#034;/g;
           $outgoing =~ s/'/&#039;/g;
           $outgoing =~ s/\$/&#036;/g;
           $outgoing =~ s{/}{&#047;}g;
           $outgoing =~ s/=/&#061;/g;
           $outgoing =~ s/\\/&#092;/g
       }
       return $outgoing;
   }
   
   # Checks for critical messages and returns a redirect url if one exists.
   # $interval indicates how often to check for messages.
   sub critical_redirect {
       my ($interval) = @_;
       if ((time-$env{'user.criticalcheck.time'})>$interval) {
           my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                                           $env{'user.name'});
           &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
           my $redirecturl;
           if ($what[0]) {
               if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   $redirecturl='/adm/email?critical=display';
                   my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   return (1, $url);
               }
           }
       }
       return ();
   }
   
 =cut  # Use:
   #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
   #
   ##################################################
   #          password associated functions         #
   ##################################################
   sub des_keys {
       # Make a new key for DES encryption.
       # Each key has two parts which are returned separately.
       # Please note:  Each key must be passed through the &hex function
       # before it is output to the web browser.  The hex versions cannot
       # be used to decrypt.
       my @hexstr=('0','1','2','3','4','5','6','7',
                   '8','9','a','b','c','d','e','f');
       my $lkey='';
       for (0..7) {
           $lkey.=$hexstr[rand(15)];
       }
       my $ukey='';
       for (0..7) {
           $ukey.=$hexstr[rand(15)];
       }
       return ($lkey,$ukey);
   }
   
   sub des_decrypt {
       my ($key,$cyphertext) = @_;
       my $keybin=pack("H16",$key);
       my $cypher;
       if ($Crypt::DES::VERSION>=2.03) {
           $cypher=new Crypt::DES $keybin;
       } else {
           $cypher=new DES $keybin;
       }
       my $plaintext=
           $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
       $plaintext.=
           $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
       $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
       return $plaintext;
   }
   
 1;  1;
 __END__;  __END__;
Removed from v.1.1075.2.53  
changed lines
  Added in v.1.1075.2.103

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