Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1402 and 1.1405

version 1.1402, 2019/01/27 16:02:58 version 1.1405, 2019/02/15 20:56:18
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 4359  sub embedded_dependency { Line 4359  sub embedded_dependency {
 sub bubblesheet_converter {  sub bubblesheet_converter {
     my ($cdom,$fullpath,$config,$format) = @_;      my ($cdom,$fullpath,$config,$format) = @_;
     if ((&domain($cdom) ne '') &&      if ((&domain($cdom) ne '') &&
         ($fullpath =~ m{^\Q$perlvar{'lonDocRoot'}/userfiles/$cdom/$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 4375  sub bubblesheet_converter { Line 4381  sub bubblesheet_converter {
                         );                          );
             my @ordered;              my @ordered;
             foreach my $item (sort { $a <=> $b } keys(%bynum)) {              foreach my $item (sort { $a <=> $b } keys(%bynum)) {
                 push (@ordered,$bynum{$item}));                  push(@ordered,$bynum{$item});
             }              }
             my %mapstart = (              my %mapstart = (
                               CODEstart => 'CODE',                                CODEstart => 'CODE',
Line 4394  sub bubblesheet_converter { Line 4400  sub bubblesheet_converter {
             );              );
             if (open(my $fh,'<',$fullpath)) {              if (open(my $fh,'<',$fullpath)) {
                 my $output;                  my $output;
                   my %lettdig = &letter_to_digits();
                   my %diglett = reverse(%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);
                     my ($qstart,$record);                      my ($qstart,$record);
                     for (my $i=0; $i<@values; $i++) {                      for (my $i=0; $i<@values; $i++) {
                         if (($qstart ne '') && ($i > $qstart)) {                          if ((($qstart ne '') && ($i > $qstart)) ||
                             $found{'FirstQuestion'} .= $values[$i];                              ($csvbynum{$i} eq 'FirstQuestion')) {
                         } elsif (exists($csvbynum{$i})) {                              if ($values[$i] eq '') {
                                   $values[$i] = $scantronconf{'Qoff'};
                               } elsif ($scantronconf{'Qon'} eq 'number') {
                                   if ($values[$i] =~ /^[A-Ja-j]$/) {
                                       $values[$i] = $lettdig{uc($values[$i])};
                                   }
                               } elsif ($scantronconf{'Qon'} eq 'letter') {
                                   if ($values[$i] =~ /^[0-9]$/) {
                                       $values[$i] = $diglett{$values[$i]};
                                   }
                               } else {
                                   if ($values[$i] =~ /^[0-9A-Ja-j]$/) {
                                       my $digit;
                                       if ($values[$i] =~ /^[A-Ja-j]$/) {
                                           $digit = $lettdig{uc($values[$i])}-1;
                                           if ($values[$i] eq 'J') {
                                               $digit += $numletts;
                                           }
                                       } elsif ($values[$i] =~ /^[0-9]$/) {
                                           $digit = $values[$i]-1;
                                           if ($values[$i] eq '0') {
                                               $digit += $numletts;
                                           }
                                       }
                                       my $qval='';
                                       for (my $j=0; $j<$scantronconf{'Qlength'}; $j++) {
                                           if ($j == $digit) {
                                               $qval .= $scantronconf{'Qon'};
                                           } else {
                                               $qval .= $scantronconf{'Qoff'};
                                           }
                                       }
                                       $values[$i] = $qval;
                                   }
                               }
                               if (length($values[$i]) > $scantronconf{'Qlength'}) {
                                   $values[$i] = substr($values[$i],0,$scantronconf{'Qlength'});
                               }
                               my $numblank = $scantronconf{'Qlength'} - length($values[$i]);
                               if ($numblank > 0) {
                                    $values[$i] .= ($scantronconf{'Qoff'} x $numblank);
                               }
                             if ($csvbynum{$i} eq 'FirstQuestion') {                              if ($csvbynum{$i} eq 'FirstQuestion') {
                                 $qstart = $i;                                  $qstart = $i;
                                   $found{$csvbynum{$i}} = $values[$i];
                             } else {                              } else {
                                   $found{'FirstQuestion'} .= $values[$i];
                               }
                           } elsif (exists($csvbynum{$i})) {
                               if ($csvoptions{'rem'}) {
                                 $values[$i] =~ s/^\s+//;                                  $values[$i] =~ s/^\s+//;
                                 if ($csvbynum{$i} eq 'PaperID') {                              }
                                     while (length($values[$i]) < $scantronconf{$maplength{$csvbynum{$i}}}) {                              if (($csvbynum{$i} eq 'PaperID') && ($csvoptions{'pad'})) {
                                         $values[$i] = '0'.$values[$i];                                  while (length($values[$i]) < $scantronconf{$maplength{$csvbynum{$i}}}) {
                                     }                                      $values[$i] = '0'.$values[$i];
                                 }                                  }
                             }                              }
                             $found{$csvbynum{$i}} = $values[$i];                              $found{$csvbynum{$i}} = $values[$i];
Line 4446  sub bubblesheet_converter { Line 4504  sub bubblesheet_converter {
     }      }
 }  }
   
   sub letter_to_digits {
       my %lettdig = (
                       A => 1,
                       B => 2,
                       C => 3,
                       D => 4,
                       E => 5,
                       F => 6,
                       G => 7,
                       H => 8,
                       I => 9,
                       J => 0,
                     );
       return %lettdig;
   }
   
 sub get_scantron_config {  sub get_scantron_config {
     my ($which,$cdom) = @_;      my ($which,$cdom) = @_;
     my @lines = &get_scantronformat_file($cdom);      my @lines = &get_scantronformat_file($cdom);
Line 4511  sub get_scantronformat_file { Line 4585  sub get_scantronformat_file {
             if (open(my $fh,'<',$perlvar{'lonTabDir'}.'/scantronformat.tab')) {              if (open(my $fh,'<',$perlvar{'lonTabDir'}.'/scantronformat.tab')) {
                 @lines = <$fh>;                  @lines = <$fh>;
                 close($fh);                  close($fh);
             }                }
         } else {          } else {
             if (open(my $fh,'<',$perlvar{'lonTabDir'}.'/default_scantronformat.tab')) {              if (open(my $fh,'<',$perlvar{'lonTabDir'}.'/default_scantronformat.tab')) {
                 @lines = <$fh>;                  @lines = <$fh>;
Line 14737  BEGIN { Line 14811  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 15462  Returns: Line 15541  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.1402  
changed lines
  Added in v.1.1405


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