View of /branches/rel-2-3-dev/webwork2/lib/WeBWorK/File/Classlist.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader$
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::File::Classlist;
   18 use base qw/Exporter/;
   19 
   20 =head1 NAME
   21 
   22 WeBWorK::File::Classlist - parse and write classlist files.
   23 
   24 =cut
   25 
   26 use strict;
   27 use warnings;
   28 use IO::File;
   29 
   30 our $MIN_FIELDS = 9;
   31 our $MAX_FIELDS = 11;
   32 
   33 our @FIELD_ORDER = qw/student_id last_name first_name status comment
   34 section recitation email_address user_id password permission/;
   35 
   36 our @EXPORT = qw/parse_classlist write_classlist/;
   37 
   38 sub parse_classlist($) {
   39   my ($file) = @_;
   40 
   41   my $fh = new IO::File($file, "<")
   42     or die "Failed to open classlist '$file' for reading: $!\n";
   43 
   44   my (@records);
   45 
   46   while (<$fh>) {
   47     chomp;
   48     next if /^#/;
   49     next unless /\S/;
   50     s/^\s*//;
   51     s/\s*$//;
   52 
   53     my @fields = split /\s*,\s*/, $_, -1; # -1 == don't delete empty trailing fields
   54     my $fields = @fields;
   55     if ($fields < $MIN_FIELDS) {
   56       warn "Skipped invalid line $. of classlist '$file': expected at least $MIN_FIELDS fields, got $fields fields.\n";
   57       next;
   58     }
   59 
   60     if ($fields > $MAX_FIELDS) {
   61       my $extra = $fields - $MAX_FIELDS;
   62       warn "$extra extra fields in line $. of classlist '$file' ignored.\n";
   63       $fields = $MAX_FIELDS;
   64     }
   65 
   66     my @fields_in_this_record = @FIELD_ORDER[0 .. $fields-1];
   67     my @data_in_this_record = @fields[0 .. $fields-1];
   68 
   69     my %record;
   70     @record{@fields_in_this_record} = @data_in_this_record;
   71 
   72     push @records, \%record;
   73   }
   74 
   75   $fh->close;
   76 
   77   return @records;
   78 }
   79 
   80 sub write_classlist($@) {
   81   my ($file, @records) = @_;
   82 
   83   my $fh = new IO::File($file, ">")
   84     or die "Failed to open classist '$file' for writing: $!\n";
   85 
   86   print $fh '# Generated by $Id$', "\n";
   87   print $fh "# Field order: ", join(",", @FIELD_ORDER), "\n";
   88 
   89   foreach my $i (0 .. $#records) {
   90     my $record = $records[$i];
   91     unless (ref $record eq "HASH") {
   92       warn "Skipping record $i: not a reference to a hash.\n";
   93       next;
   94     }
   95 
   96     my %record = %$record;
   97     my @fields = @record{@FIELD_ORDER};
   98 
   99     my $string = join ",", @fields;
  100 
  101     print $fh "$string\n";
  102   }
  103 
  104   $fh->close;
  105 }
  106 
  107 1;