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

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1403 and 1.1408

version 1.1403, 2019/01/27 23:16:36 version 1.1408, 2019/04/26 20:22:27
Line 77  use CGI::Cookie; Line 77  use CGI::Cookie;
   
 use Encode;  use Encode;
   
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir  use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $deftex
             $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease              $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
             %managerstab);              %managerstab);
   
Line 101  use LONCAPA::Configuration; Line 101  use LONCAPA::Configuration;
 use LONCAPA::lonmetadata;  use LONCAPA::lonmetadata;
 use LONCAPA::Lond;  use LONCAPA::Lond;
 use LONCAPA::LWPReq;  use LONCAPA::LWPReq;
   use LONCAPA::transliterate;
   
 use File::Copy;  use File::Copy;
   
Line 1251  sub changepass { Line 1252  sub changepass {
     } elsif ($answer =~ "invalid_client") {      } elsif ($answer =~ "invalid_client") {
         &logthis("$server refused to change $uname in $udom password because ".          &logthis("$server refused to change $uname in $udom password because ".
                  "it was a reset by e-mail originating from an invalid server.");                   "it was a reset by e-mail originating from an invalid server.");
       } elsif ($answer =~ "^prioruse") {
          &logthis("$server refused to change $uname in $udom password because ".
                   "the password had been used before");
     }      }
     return $answer;      return $answer;
 }  }
Line 2720  sub course_portal_url { Line 2724  sub course_portal_url {
     return $firsturl;      return $firsturl;
 }  }
   
   # --------------------------------------------- Get domain config for passwords
   
   sub get_passwdconf {
       my ($dom) = @_;
       my (%passwdconf,$gotconf,$lookup);
       my ($result,$cached)=&is_cached_new('passwdconf',$dom);
       if (defined($cached)) {
           if (ref($result) eq 'HASH') {
               %passwdconf = %{$result};
               $gotconf = 1;
           }
       }
       unless ($gotconf) {
           my %domconfig = &get_dom('configuration',['passwords'],$dom);
           if (ref($domconfig{'passwords'}) eq 'HASH') {
               %passwdconf = %{$domconfig{'passwords'}};
           }
           my $cachetime = 24*60*60;
           &do_cache_new('passwdconf',$dom,\%passwdconf,$cachetime);
       }
       return %passwdconf;
   }
   
 # --------------------------------------------------- Assign a key to a student  # --------------------------------------------------- Assign a key to a student
   
 sub assign_access_key {  sub assign_access_key {
Line 3856  sub clean_filename { Line 3883  sub clean_filename {
     }      }
 # Replace spaces by underscores  # Replace spaces by underscores
     $fname=~s/\s+/\_/g;      $fname=~s/\s+/\_/g;
   # Transliterate non-ascii text to ascii
       my $lang = &Apache::lonlocal::current_language();
       $fname = &LONCAPA::transliterate::fname_to_ascii($fname,$lang);
 # Replace all other weird characters by nothing  # Replace all other weird characters by nothing
     $fname=~s{[^/\w\.\-]}{}g;      $fname=~s{[^/\w\.\-]}{}g;
 # Replace all .\d. sequences with _\d. so they no longer look like version  # Replace all .\d. sequences with _\d. so they no longer look like version
Line 3863  sub clean_filename { Line 3893  sub clean_filename {
     $fname=~s/\.(\d+)(?=\.)/_$1/g;      $fname=~s/\.(\d+)(?=\.)/_$1/g;
     return $fname;      return $fname;
 }  }
   
 # This Function checks if an Image's dimensions exceed either $resizewidth (width)   # This Function checks if an Image's dimensions exceed either $resizewidth (width) 
 # or $resizeheight (height) - both pixels. If so, the image is scaled to produce an   # or $resizeheight (height) - both pixels. If so, the image is scaled to produce an 
 # image with the same aspect ratio as the original, but with dimensions which do   # image with the same aspect ratio as the original, but with dimensions which do 
Line 3937  sub userfileupload { Line 3968  sub userfileupload {
     $fname=&clean_filename($fname);      $fname=&clean_filename($fname);
     # See if there is anything left      # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }      unless ($fname) { return 'error: no uploaded file'; }
       # If filename now begins with a . prepend unix timestamp _ milliseconds
       if ($fname =~ /^\./) {
           my ($s,$usec) = &gettimeofday();
           while (length($usec) < 6) {
               $usec = '0'.$usec;
           }
           $fname = $s.'_'.substr($usec,0,3).$fname;
       }
     # Files uploaded to help request form, or uploaded to "create course" page are handled differently      # Files uploaded to help request form, or uploaded to "create course" page are handled differently
     if ((($formname eq 'screenshot') && ($subdir eq 'helprequests')) ||      if ((($formname eq 'screenshot') && ($subdir eq 'helprequests')) ||
         (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) ||          (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) ||
Line 4361  sub bubblesheet_converter { Line 4400  sub bubblesheet_converter {
     if ((&domain($cdom) ne '') &&      if ((&domain($cdom) ne '') &&
         ($fullpath =~ m{^\Q$perlvar{'lonDocRoot'}/userfiles/$cdom/\E$match_courseid/scantron_orig}) &&          ($fullpath =~ m{^\Q$perlvar{'lonDocRoot'}/userfiles/$cdom/\E$match_courseid/scantron_orig}) &&
         (-e $fullpath) && (ref($config) eq 'HASH') && ($format ne '')) {          (-e $fullpath) && (ref($config) eq 'HASH') && ($format ne '')) {
         my %csvcols = %{$config};          my (%csvcols,%csvoptions);
           if (ref($config->{'fields'}) eq 'HASH') {  
               %csvcols = %{$config->{'fields'}};
           }
           if (ref($config->{'options'}) eq 'HASH') {
               %csvoptions = %{$config->{'options'}};
           }
         my %csvbynum = reverse(%csvcols);          my %csvbynum = reverse(%csvcols);
         my %scantronconf = &get_scantron_config($format,$cdom);          my %scantronconf = &get_scantron_config($format,$cdom);
         if (keys(%scantronconf)) {          if (keys(%scantronconf)) {
Line 4397  sub bubblesheet_converter { Line 4442  sub bubblesheet_converter {
                 my %lettdig = &letter_to_digits();                  my %lettdig = &letter_to_digits();
                 my %diglett = reverse(%lettdig);                  my %diglett = reverse(%lettdig);
                 my $numletts = scalar(keys(%lettdig));                  my $numletts = scalar(keys(%lettdig));
                   my $num = 0;
                 while (my $line=<$fh>) {                  while (my $line=<$fh>) {
                       $num ++;
                       next if (($num == 1) && ($csvoptions{'hdr'} == 1));
                     $line =~ s{[\r\n]+$}{};                      $line =~ s{[\r\n]+$}{};
                     my %found;                      my %found;
                     my @values = split(/,/,$line);                      my @values = split(/,/,$line);
Line 4454  sub bubblesheet_converter { Line 4502  sub bubblesheet_converter {
                                 $found{'FirstQuestion'} .= $values[$i];                                  $found{'FirstQuestion'} .= $values[$i];
                             }                              }
                         } elsif (exists($csvbynum{$i})) {                          } elsif (exists($csvbynum{$i})) {
                             $values[$i] =~ s/^\s+//;                              if ($csvoptions{'rem'}) {
                             if ($csvbynum{$i} eq 'PaperID') {                                  $values[$i] =~ s/^\s+//;
                               }
                               if (($csvbynum{$i} eq 'PaperID') && ($csvoptions{'pad'})) {
                                 while (length($values[$i]) < $scantronconf{$maplength{$csvbynum{$i}}}) {                                  while (length($values[$i]) < $scantronconf{$maplength{$csvbynum{$i}}}) {
                                     $values[$i] = '0'.$values[$i];                                      $values[$i] = '0'.$values[$i];
                                 }                                  }
Line 14800  BEGIN { Line 14850  BEGIN {
   
 }  }
   
   # ------------- set default texengine (domain default overrides this)
   {
       $deftex = LONCAPA::texengine();
   }
   
 $memcache=new Cache::Memcached({'servers'           => ['127.0.0.1:11211'],  $memcache=new Cache::Memcached({'servers'           => ['127.0.0.1:11211'],
  'compress_threshold'=> 20_000,   'compress_threshold'=> 20_000,
          });           });
Line 15525  Returns: Line 15580  Returns:
                       for the sheet of paper                        for the sheet of paper
       FirstName   - column that the first name starts in        FirstName   - column that the first name starts in
       FirstNameLength - number of columns that the first name spans        FirstNameLength - number of columns that the first name spans
   
       LastName    - column that the last name starts in        LastName    - column that the last name starts in
       LastNameLength - number of columns that the last name spans        LastNameLength - number of columns that the last name spans
       BubblesPerRow - number of bubbles available in each row used to        BubblesPerRow - number of bubbles available in each row used to
Removed from v.1.1403  
changed lines
  Added in v.1.1408

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