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

Diff for /loncom/interface/loncommon.pm between versions 1.1161 and 1.1173

version 1.1161, 2013/11/26 03:17:07 version 1.1173, 2014/02/11 14:29:04
Line 1380  sub top_nav_help { Line 1380  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 1411  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 1441  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 1750  RESIZE Line 1756  RESIZE
   
 =head1 Excel and CSV file utility routines  =head1 Excel and CSV file utility routines
   
 =over 4  
   
 =cut  =cut
   
 ###############################################################  ###############################################################
Line 1759  RESIZE Line 1763  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 3884  sub get_previous_attempt { Line 3890  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 3906  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 3927  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 3956  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 5230  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 7342  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 7372  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 7469  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 7481  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 7553  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 8693  Incoming parameters: Line 8717  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 8791  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 8838  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 8933  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 8950  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 11031  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 11079  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 11142  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 11375  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 11394  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 12072  sub cleanup_empty_dirs { Line 12129  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 13385  sub extract_categories { Line 13442  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 13456  sub recurse_categories { Line 13513  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 13533  sub assign_categories_table { Line 13590  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 13851  sub check_clone { Line 13908  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 14005  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 14194  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 14281  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 14362  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 14570  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 14890  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 14975  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;
         }          }
     }      }
Removed from v.1.1161  
changed lines
  Added in v.1.1173

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