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

Diff for /loncom/interface/loncommon.pm between versions 1.1162 and 1.1175

version 1.1162, 2013/12/01 21:29:12 version 1.1175, 2014/02/16 22:04:14
Line 75  use DateTime::Locale::Catalog; Line 75  use DateTime::Locale::Catalog;
 use Text::Aspell;  use Text::Aspell;
 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 1380  sub top_nav_help { Line 1382  sub top_nav_help {
     $text = &mt($text);      $text = &mt($text);
     my $stay_on_page = 1;      my $stay_on_page = 1;
   
     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"      my ($link,$banner_link);
                      : "javascript:helpMenu('open')";      unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);          $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 1406  sub help_menu_js { Line 1413  sub help_menu_js {
  'js_ready'    => 1,   'js_ready'    => 1,
                                         'use_absolute' => $httphost,                                          'use_absolute' => $httphost,
  'add_entries' => {   'add_entries' => {
     'border' => '0',      'border' => '0', 
     'rows'   => "110,*",},});      'rows'   => "110,*",},});
     my $end_page =      my $end_page =
         &Apache::loncommon::end_page({'frameset' => 1,          &Apache::loncommon::end_page({'frameset' => 1,
Line 1436  function helpMenu(target) { Line 1443  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 3884  sub get_previous_attempt { Line 3892  sub get_previous_attempt {
                       if ($key =~/$regexp$/ && (defined &$gradesub)) {                        if ($key =~/$regexp$/ && (defined &$gradesub)) {
                           $value = &$gradesub($value);                            $value = &$gradesub($value);
                       }                        }
                       $prevattempts.='<td>'.$value.'&nbsp;</td>';                        $prevattempts.='<td>'. $value.'&nbsp;</td>';
                   } else {                    } else {
                       $prevattempts.='<td>&nbsp;</td>';                        $prevattempts.='<td>&nbsp;</td>';
                   }                    }
Line 3900  sub get_previous_attempt { Line 3908  sub get_previous_attempt {
       if ($key =~/$regexp$/ && (defined &$gradesub)) {        if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   $value = &$gradesub($value);                    $value = &$gradesub($value);
               }                }
       $prevattempts.='<td>'.$value.'&nbsp;</td>';       $prevattempts.='<td>'.$value.'&nbsp;</td>';
           }            }
       }        }
       $prevattempts.= &end_data_table_row().&end_data_table();        $prevattempts.= &end_data_table_row().&end_data_table();
Line 3921  sub get_previous_attempt { Line 3929  sub get_previous_attempt {
 sub format_previous_attempt_value {  sub format_previous_attempt_value {
     my ($key,$value) = @_;      my ($key,$value) = @_;
     if (($key =~ /timestamp/) || ($key=~/duedate/)) {      if (($key =~ /timestamp/) || ($key=~/duedate/)) {
  $value = &Apache::lonlocal::locallocaltime($value);          $value = &Apache::lonlocal::locallocaltime($value);
     } elsif (ref($value) eq 'ARRAY') {      } elsif (ref($value) eq 'ARRAY') {
  $value = '('.join(', ', @{ $value }).')';          $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
     } elsif ($key =~ /answerstring$/) {      } elsif ($key =~ /answerstring$/) {
         my %answers = &Apache::lonnet::str2hash($value);          my %answers = &Apache::lonnet::str2hash($value);
           my @answer = %answers;
           %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
         my @anskeys = sort(keys(%answers));          my @anskeys = sort(keys(%answers));
         if (@anskeys == 1) {          if (@anskeys == 1) {
             my $answer = $answers{$anskeys[0]};              my $answer = $answers{$anskeys[0]};
Line 3948  sub format_previous_attempt_value { Line 3958  sub format_previous_attempt_value {
             }               } 
         }          }
     } else {      } else {
  $value = &unescape($value);          $value = &HTML::Entities::encode(&unescape($value), '"<>&');
     }      }
     return $value;      return $value;
 }  }
Line 5222  sub bodytag { Line 5232  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 7330  ADDMETA Line 7344  ADDMETA
     }      }
     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 7356  sub font_settings { Line 7374  sub font_settings {
     my $headerstring='';      my $headerstring='';
     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||      if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {          ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
  $headerstring.=          $headerstring.=
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'."\n";              '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
           if (!$args->{'frameset'}) {
       $headerstring.= ' /';
           }
    $headerstring .= '>'."\n";
     }      }
     return $headerstring;      return $headerstring;
 }  }
Line 7449  Inputs: none Line 7471  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 7460  sub xml_begin { Line 7483  sub xml_begin {
     .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'      .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '               .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
     .'xmlns="http://www.w3.org/1999/xhtml">';      .'xmlns="http://www.w3.org/1999/xhtml">';
       } elsif ($is_frameset) {
           $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   '<html>'."\n";
     } else {      } else {
  $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n"   $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";                  '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
     }      }
     return $output;      return $output;
 }  }
Line 7529  sub start_page { Line 7555  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 7630  function set_wishlistlink(title, path) { Line 7656  function set_wishlistlink(title, path) {
         title = document.title;          title = document.title;
         title = title.replace(/^LON-CAPA /,'');          title = title.replace(/^LON-CAPA /,'');
     }      }
       title = encodeURIComponent(title);
     if (!path) {      if (!path) {
         path = location.pathname;          path = location.pathname;
     }      }
       path = encodeURIComponent(path);
     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 8693  Incoming parameters: Line 8721  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 8767  sub get_user_quota { Line 8795  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 8813  Incoming parameters: Line 8842  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 8908  space to be exceeded. Line 8937  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 8924  Returns: 1 scalar: HTML to display conta Line 8954  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 11005  sub decompress_form { Line 11035  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 = ("$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 @diffs = &compare_arrays(\@paths,\@camtasia6);
         if (@diffs == 0) {          if (@diffs == 0) {
             $is_camtasia = 1;              $is_camtasia = 6;
           } else {
               @diffs = &compare_arrays(\@paths,\@camtasia8);
               if (@diffs == 0) {
                   $is_camtasia = 8;
               }
         }          }
     }      }
     my $output;      my $output;
Line 11026  sub decompress_form { Line 11083  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 {
Line 11089  ENDCAM Line 11146  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 11322  sub process_decompression { Line 11379  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 11340  sub process_decompression { Line 11398  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 13851  sub check_clone { Line 13912  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 13948  sub construct_course { Line 14009  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 14133  sub construct_course { Line 14198  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 14201  sub construct_course { Line 14285  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 14228  sub group_term { Line 14366  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 14435  sub init_user_environment { Line 14574  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 14755  sub captcha_display { Line 14894  sub captcha_display {
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         $output = &create_captcha();          $output = &create_captcha();
         unless ($output) {          unless ($output) {
             $error = 'captcha';               $error = 'captcha';
         }          }
     } elsif ($captcha eq 'recaptcha') {      } elsif ($captcha eq 'recaptcha') {
         $output = &create_recaptcha($pubkey);          $output = &create_recaptcha($pubkey);
         unless ($output) {          unless ($output) {
             $error = 'recaptcha';               $error = 'recaptcha';
         }          }
     }      }
     return ($output,$error);      return ($output,$error);
Line 14840  sub create_captcha { Line 14979  sub create_captcha {
             $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="" /><br />'.
                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
             last;              last;
         }          }
     }      }
Line 14910  sub check_recaptcha { Line 15049  sub check_recaptcha {
     return $captcha_chk;      return $captcha_chk;
 }  }
   
   sub emailusername_info {
       my @fields = ('lastname','firstname','institution','web','location','officialemail');
       my %titles = &Apache::lonlocal::texthash (
                        lastname      => 'Last Name',
                        firstname     => 'First Name',
                        institution   => 'School/college/university',
                        location      => "School's city, state/province, country",
                        web           => "School's web address",
                        officialemail => 'E-mail address at institution (if different)',
                    );
       return (\@fields,\%titles);
   }
   
 sub cleanup_html {  sub cleanup_html {
     my ($incoming) = @_;      my ($incoming) = @_;
     my $outgoing;      my $outgoing;
Line 14932  sub cleanup_html { Line 15084  sub cleanup_html {
     return $outgoing;      return $outgoing;
 }  }
   
   # 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;
   }
   
 =pod  =pod
   
 =back  =back
Removed from v.1.1162  
changed lines
  Added in v.1.1175

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