################################################################################
# WeBWorK Online Homework Delivery System
# Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
# $CVSHeader$
# 
# This program is free software; you can redistribute it and/or modify it under
# the terms of either: (a) the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any later
# version, or (b) the "Artistic License" which comes with this package.
# 
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
# Artistic License for more details.
################################################################################

package WeBWorK::File::Classlist;
use base qw/Exporter/;

=head1 NAME

WeBWorK::File::Classlist - parse and write classlist files.

=cut

use strict;
use warnings;
use IO::File;

our $MIN_FIELDS = 9;
our $MAX_FIELDS = 11;

our @FIELD_ORDER = qw/student_id last_name first_name status comment
section recitation email_address user_id password permission/;

our @EXPORT = qw/parse_classlist write_classlist/;

sub parse_classlist($) {
	my ($file) = @_;
	
	my $fh = new IO::File($file, "<")
		or die "Failed to open classlist '$file' for reading: $!\n";
	
	my (@records);
	
	while (<$fh>) {
		chomp;
		next if /^#/;
		next unless /\S/;
		s/^\s*//;
		s/\s*$//;
		
		my @fields = split /\s*,\s*/, $_, -1; # -1 == don't delete empty trailing fields
		my $fields = @fields;
		if ($fields < $MIN_FIELDS) {
			warn "Skipped invalid line $. of classlist '$file': expected at least $MIN_FIELDS fields, got $fields fields.\n";
			next;
		}
		
		if ($fields > $MAX_FIELDS) {
			my $extra = $fields - $MAX_FIELDS;
			warn "$extra extra fields in line $. of classlist '$file' ignored.\n";
			$fields = $MAX_FIELDS;
		}
		
		my @fields_in_this_record = @FIELD_ORDER[0 .. $fields-1];
		my @data_in_this_record = @fields[0 .. $fields-1];
		
		my %record;
		@record{@fields_in_this_record} = @data_in_this_record;
		
		push @records, \%record;
	}
	
	$fh->close;
	
	return @records;
}

sub write_classlist($@) {
	my ($file, @records) = @_;
	
	my $fh = new IO::File($file, ">")
		or die "Failed to open classist '$file' for writing: $!\n";
	
	print $fh '# Generated by $Id$', "\n";
	print $fh "# Field order: ", join(",", @FIELD_ORDER), "\n";
	
	foreach my $i (0 .. $#records) {
		my $record = $records[$i];
		unless (ref $record eq "HASH") {
			warn "Skipping record $i: not a reference to a hash.\n";
			next;
		}
		
		my %record = %$record;
		my @fields = @record{@FIELD_ORDER};
		
		my $string = join ",", @fields;
		
		print $fh "$string\n";
	}
	
	$fh->close;
}

1;