View of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::ContentGenerator::Instructor::Scoring;
    7 use base qw(WeBWorK::ContentGenerator::Instructor);
    8 
    9 =head1 NAME
   10 
   11 WeBWorK::ContentGenerator::Instructor::Scoring - Generate scoring data files
   12 
   13 =cut
   14 
   15 use strict;
   16 use warnings;
   17 use CGI qw();
   18 use WeBWorK::Utils qw(readFile);
   19 
   20 # Reads a CSV file and returns an array of arrayrefs, each containing a
   21 # column of data:
   22 # (["c1r1", "c1r2", "c1r3"], ["c2r1", "c2r2", "c2r3"])
   23 sub readCSV {
   24   my ($self, $filename) = @_;
   25   my @result = ();
   26   my @columns = split m/\n/, readFile($fileName);
   27   foreach my $column (@columns) {
   28     push @result, [split m/\s*,\s*/, $column];
   29   }
   30   return @result;
   31 }
   32 
   33 # Write a CSV file from an array in the same format that readCSV produces
   34 sub writeCSV {
   35   my ($self, $filename, @csv) = @_;
   36   open my $fh, ">", $filename;
   37   foreach my $column (@csv) {
   38     my $maxLength = $self->maxLength($column);
   39     print (join ",", map {$self->pad($_, $maxLength)} $@column);
   40     print "\n";
   41   }
   42   close $fh;
   43 }
   44 
   45 # As soon as backwards compatability is no longer a concern and we don't expect to have
   46 # to use old ww1.x code to read the output anymore, I recommend switching to using
   47 # these routines, which are more versatile and compatable with other programs which
   48 # deal with CSV files.
   49 sub readStandardCSV {
   50   my ($self, $filename) = @_;
   51   my @result = ();
   52   my @colunms = split m/\n/, readFile($fileName);
   53   foreach my $column (@columns) {
   54     push @result, [$self->splitQuote($column)];
   55   }
   56   return @result;
   57 }
   58 
   59 sub writeStandardCSV {
   60   my ($self, $filename, @csv) = @_;
   61   open my $fh, ">", $filename;
   62   foreach my $column (@csv) {
   63     print (join ",", map {$self->quote} $@column);
   64     print "\n";
   65   }
   66   close $fh;
   67 }
   68 
   69 ###
   70 
   71 # This particular unquote method unquotes (optionally) quoted strings in the
   72 # traditional CSV style (double-quote for literal quote, etc.)
   73 sub unquote {
   74   my ($self, $string) = @_;
   75   if ($string =~ m/^"(.*)"$/) {
   76     $string = $1;
   77     $string =~ s/""/"/;
   78   }
   79   return $string;
   80 }
   81 
   82 # Should you wish to treat whitespace differently, this routine has been designed
   83 # to make it easy to do so.
   84 sub splitQuoted {
   85   my ($self, $string) = @_;
   86   my ($leadingSpace, $preText, $quoted, $postText, $trailingSpace, $result);
   87   my @result = ();
   88   my $continue = 1
   89   while ($continue) {
   90     $string =~ m/\G(\s*)/;
   91     $leadingSpace = $1;
   92     $string =~ m/\G([^",]*)/;
   93     $preText = $1;
   94     if ($string =~ m/\G"((?:[^"]|"")*)"/) {
   95       $quoted = $1;
   96     }
   97     $string =~ m/\G([^,]*?)(\s*)(,?)/;
   98     $postText, $trailingSpace, $continue = ($1, $2, $3);
   99     if (defined $quoted and (not defined $preText and not defined $postText)) {
  100         $quoted = s/""/"/;
  101         $result = $quoted;
  102     } else {
  103       $preText = "" unless defined $preText;
  104       $postText = "" unless defined $postText;
  105       $quoted = "" unless defined $quoted;
  106       $result = "$preText$quoted$postText";
  107     }
  108     push @result, $result;
  109   }
  110   return @result;
  111 }
  112 
  113 # This particular quoting method does CSV-style (double a quote to escape it) quoting when necessary.
  114 sub quote {
  115   my ($self, $string) = @_;
  116   if ($string =~ m/[", ]/) {
  117     $string =~ s/"/""/;
  118     $string =~ "\"$string\"";
  119     return $string;
  120   }
  121 }
  122 
  123 sub pad {
  124   my ($self, $string, $padTo) = @_;
  125   my $spaces = $padTo - length $string;
  126   return $string . " "x$spaces;
  127 }
  128 
  129 sub maxLength {
  130   my ($self, $arrayRef) = @_;
  131   my $max = 0;
  132   foreach my $cell (@$arrayRef) {
  133     $max = length $cell unless length $cell < $max;
  134   }
  135   return $max;
  136 }