Return to parse_scantron.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

Annotation of loncom/debugging_tools/parse_scantron.pl, revision 1.1

1.1     ! albertel    1: use strict;
        !             2: use IO::File;
        !             3: 
        !             4: sub get_scantron_config {
        !             5:     my ($which) = @_;
        !             6:     my $fh=IO::File->new('scantronformat.tab');
        !             7:     my %config;
        !             8:     #FIXME probably should move to XML it has already gotten a bit much now
        !             9:     foreach my $line (<$fh>) {
        !            10: 	my ($name,$descrip)=split(/:/,$line);
        !            11: 	print ($name ."\n".$which."\n");
        !            12: 	if ($name ne $which ) { next; }
        !            13: 	chomp($line);
        !            14: 	my @config=split(/:/,$line);
        !            15: 	$config{'name'}=$config[0];
        !            16: 	$config{'description'}=$config[1];
        !            17: 	$config{'CODElocation'}=$config[2];
        !            18: 	$config{'CODEstart'}=$config[3];
        !            19: 	$config{'CODElength'}=$config[4];
        !            20: 	$config{'IDstart'}=$config[5];
        !            21: 	$config{'IDlength'}=$config[6];
        !            22: 	$config{'Qstart'}=$config[7];
        !            23: 	$config{'Qlength'}=$config[8];
        !            24: 	$config{'Qoff'}=$config[9];
        !            25: 	$config{'Qon'}=$config[10];
        !            26: 	$config{'PaperID'}=$config[11];
        !            27: 	$config{'PaperIDlength'}=$config[12];
        !            28: 	$config{'FirstName'}=$config[13];
        !            29: 	$config{'FirstNamelength'}=$config[14];
        !            30: 	$config{'LastName'}=$config[15];
        !            31: 	$config{'LastNamelength'}=$config[16];
        !            32: 	last;
        !            33:     }
        !            34:     return %config;
        !            35: }
        !            36: 
        !            37: sub scantron_parse_scanline {
        !            38:     my ($line,$whichline,$scantron_config)=@_;
        !            39:     my %record;
        !            40:     my $questions=substr($line,$$scantron_config{'Qstart'}-1);
        !            41:     my $data=substr($line,0,$$scantron_config{'Qstart'}-1);
        !            42:     if ($$scantron_config{'CODElocation'} ne 0) {
        !            43: 	if ($$scantron_config{'CODElocation'} < 0) {
        !            44: 	    $record{'scantron.CODE'}=substr($data,$$scantron_config{'CODEstart'}-1,
        !            45: 					    $$scantron_config{'CODElength'});
        !            46: 	} else {
        !            47: 	    #FIXME interpret first N questions
        !            48: 	}
        !            49:     }
        !            50:     $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
        !            51: 				  $$scantron_config{'IDlength'});
        !            52:     $record{'scantron.PaperID'}=
        !            53: 	substr($data,$$scantron_config{'PaperID'}-1,
        !            54: 	       $$scantron_config{'PaperIDlength'});
        !            55:     $record{'scantron.FirstName'}=
        !            56: 	substr($data,$$scantron_config{'FirstName'}-1,
        !            57: 	       $$scantron_config{'FirstNamelength'});
        !            58:     $record{'scantron.LastName'}=
        !            59: 	substr($data,$$scantron_config{'LastName'}-1,
        !            60: 	       $$scantron_config{'LastNamelength'});
        !            61:     my @alphabet=('A'..'Z');
        !            62:     my $questnum=0;
        !            63:     while ($questions) {
        !            64: 	$questnum++;
        !            65: 	my $currentquest=substr($questions,0,$$scantron_config{'Qlength'});
        !            66: 	substr($questions,0,$$scantron_config{'Qlength'})='';
        !            67: 	if (length($currentquest) < $$scantron_config{'Qlength'}) { next; }
        !            68: 	my @array=split($$scantron_config{'Qon'},$currentquest,-1);
        !            69: 	if (length($array[0]) eq $$scantron_config{'Qlength'}) {
        !            70: 	    $record{"scantron.$questnum.answer"}='';
        !            71: 	} else {
        !            72: 	    $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];
        !            73: 	}
        !            74:  	if (scalar(@array) gt 2) {
        !            75:  	    push(@{$record{'scantron.doubleerror'}},$questnum);
        !            76:  	    my @ans=@array;
        !            77:  	    my $i=length($ans[0]);shift(@ans);
        !            78: 	    while ($#ans) {
        !            79:  		$i+=length($ans[0])+1;
        !            80:  		$record{"scantron.$questnum.answer"}.=$alphabet[$i];
        !            81:  		shift(@ans);
        !            82:  	    }
        !            83:  	}
        !            84:     }
        !            85:     $record{'scantron.maxquest'}=$questnum;
        !            86:     return \%record;
        !            87: }
        !            88: 
        !            89: sub print_record {
        !            90:     my ($scan_record)=@_;
        !            91:     print "Name: ".$scan_record->{'scantron.LastName'};
        !            92:     print "  ID: ".$scan_record->{'scantron.ID'};
        !            93:     print "  Paper ID: ".$scan_record->{'scantron.PaperID'};
        !            94:     print "\n";
        !            95:     for (my $i=1;$i<100;$i++) {
        !            96: 	if (!exists($scan_record->{"scantron.$i.answer"})) {
        !            97: 	    print "\n";
        !            98: 	    return;
        !            99: 	}
        !           100: 	if ($scan_record->{"scantron.$i.answer"} eq '') {
        !           101: 	    print " ";
        !           102: 	} else {
        !           103: 	    print $scan_record->{"scantron.$i.answer"};
        !           104: 	}
        !           105:     }
        !           106: }
        !           107: 
        !           108: open(FILE,'scantron.data');
        !           109: my %scantron_config=&get_scantron_config('msunocode');
        !           110: print(join(':',%scantron_config)."\n");
        !           111: my $i=0;
        !           112: while (my $line=<FILE>) {
        !           113:     my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config);
        !           114:     $i++;
        !           115:     print_record($scan_record);
        !           116: }