--- loncom/lonnet/perl/lonnet.pm 2019/01/27 16:02:58 1.1402 +++ loncom/lonnet/perl/lonnet.pm 2019/02/26 14:42:27 1.1406 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1402 2019/01/27 16:02:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.1406 2019/02/26 14:42:27 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -77,7 +77,7 @@ use CGI::Cookie; 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 %managerstab); @@ -101,6 +101,7 @@ use LONCAPA::Configuration; use LONCAPA::lonmetadata; use LONCAPA::Lond; use LONCAPA::LWPReq; +use LONCAPA::transliterate; use File::Copy; @@ -3856,6 +3857,9 @@ sub clean_filename { } # Replace spaces by underscores $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 $fname=~s{[^/\w\.\-]}{}g; # Replace all .\d. sequences with _\d. so they no longer look like version @@ -3863,6 +3867,7 @@ sub clean_filename { $fname=~s/\.(\d+)(?=\.)/_$1/g; return $fname; } + # 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 # image with the same aspect ratio as the original, but with dimensions which do @@ -3937,6 +3942,14 @@ sub userfileupload { $fname=&clean_filename($fname); # See if there is anything left 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 if ((($formname eq 'screenshot') && ($subdir eq 'helprequests')) || (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) || @@ -4359,9 +4372,15 @@ sub embedded_dependency { sub bubblesheet_converter { my ($cdom,$fullpath,$config,$format) = @_; 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 '')) { - 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 %scantronconf = &get_scantron_config($format,$cdom); if (keys(%scantronconf)) { @@ -4375,7 +4394,7 @@ sub bubblesheet_converter { ); my @ordered; foreach my $item (sort { $a <=> $b } keys(%bynum)) { - push (@ordered,$bynum{$item})); + push(@ordered,$bynum{$item}); } my %mapstart = ( CODEstart => 'CODE', @@ -4394,23 +4413,75 @@ sub bubblesheet_converter { ); if (open(my $fh,'<',$fullpath)) { my $output; + my %lettdig = &letter_to_digits(); + my %diglett = reverse(%lettdig); + my $numletts = scalar(keys(%lettdig)); + my $num = 0; while (my $line=<$fh>) { + $num ++; + next if (($num == 1) && ($csvoptions{'hdr'} == 1)); $line =~ s{[\r\n]+$}{}; my %found; my @values = split(/,/,$line); my ($qstart,$record); for (my $i=0; $i<@values; $i++) { - if (($qstart ne '') && ($i > $qstart)) { - $found{'FirstQuestion'} .= $values[$i]; - } elsif (exists($csvbynum{$i})) { + if ((($qstart ne '') && ($i > $qstart)) || + ($csvbynum{$i} eq 'FirstQuestion')) { + 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') { $qstart = $i; + $found{$csvbynum{$i}} = $values[$i]; } else { + $found{'FirstQuestion'} .= $values[$i]; + } + } elsif (exists($csvbynum{$i})) { + if ($csvoptions{'rem'}) { $values[$i] =~ s/^\s+//; - if ($csvbynum{$i} eq 'PaperID') { - while (length($values[$i]) < $scantronconf{$maplength{$csvbynum{$i}}}) { - $values[$i] = '0'.$values[$i]; - } + } + if (($csvbynum{$i} eq 'PaperID') && ($csvoptions{'pad'})) { + while (length($values[$i]) < $scantronconf{$maplength{$csvbynum{$i}}}) { + $values[$i] = '0'.$values[$i]; } } $found{$csvbynum{$i}} = $values[$i]; @@ -4446,6 +4517,22 @@ 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 { my ($which,$cdom) = @_; my @lines = &get_scantronformat_file($cdom); @@ -4511,7 +4598,7 @@ sub get_scantronformat_file { if (open(my $fh,'<',$perlvar{'lonTabDir'}.'/scantronformat.tab')) { @lines = <$fh>; close($fh); - } + } } else { if (open(my $fh,'<',$perlvar{'lonTabDir'}.'/default_scantronformat.tab')) { @lines = <$fh>; @@ -14737,6 +14824,11 @@ BEGIN { } +# ------------- set default texengine (domain default overrides this) +{ + $deftex = LONCAPA::texengine(); +} + $memcache=new Cache::Memcached({'servers' => ['127.0.0.1:11211'], 'compress_threshold'=> 20_000, }); @@ -15462,7 +15554,6 @@ Returns: for the sheet of paper FirstName - column that the first name starts in FirstNameLength - number of columns that the first name spans - LastName - column that the last name starts in LastNameLength - number of columns that the last name spans BubblesPerRow - number of bubbles available in each row used to