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

version 1.1402, 2019/01/27 16:02:58 version 1.1403, 2019/01/27 23:16:36
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 = %{$config};
         my %csvbynum = reverse(%csvcols);          my %csvbynum = reverse(%csvcols);
Line 4375  sub bubblesheet_converter { Line 4375  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 4394  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));
                 while (my $line=<$fh>) {                  while (my $line=<$fh>) {
                     $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 {
                                 $values[$i] =~ s/^\s+//;                                  $found{'FirstQuestion'} .= $values[$i];
                                 if ($csvbynum{$i} eq 'PaperID') {                              }
                                     while (length($values[$i]) < $scantronconf{$maplength{$csvbynum{$i}}}) {                          } elsif (exists($csvbynum{$i})) {
                                         $values[$i] = '0'.$values[$i];                              $values[$i] =~ s/^\s+//;
                                     }                              if ($csvbynum{$i} eq 'PaperID') {
                                   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 4493  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 4574  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>;

Removed from v.1.1402  
changed lines
  Added in v.1.1403


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