#!/usr/bin/perl # # Utility to convert completed tests in old format to new "?" delimiter format # #if (! open(DBGFILE, ">>debug.txt")) { #print "Unable to open debug.txt\n"; #exit; #} #print DBGFILE "Starting...\n"; # Get config require 'sitecfg.pl'; require 'testlib.pl'; foreach $testfile (@ARGV) { if (! open(TESTFILE, "<$testfile")) { print "Unable to open $testfile\n"; } else { @lines = ; close TESTFILE; if (! open(OUTFILE, ">$testfile.new")) { print "Unable to open $testfile.new\n"; exit; } ($clid,$uid,$tid,$trash)=split(/\&/,$lines[0]); print(OUTFILE $lines[0]); # First line doesn't change if ($lines[1] ne "\n") { print "WARNING: Pre-test survey in $testfile\n"; } print(OUTFILE $lines[1]); print(OUTFILE $lines[2]); print(OUTFILE $lines[3]); print(OUTFILE $lines[4]); if ($lines[5] ne '') { @questions = &get_question_list($tid,$clid); for (1 .. $#questions) { ($id,$qtp,$qim,$qil,$qtx,$qca,$qia,$qrm) = split(/\&/, $questions[$_]); if ($qtp eq "mcs" || $qtp eq "mcm") { $qtp{$id}=$qtp; @qca=split(/\;/,$qca); @qia=split(/\;/,$qia); $numans{$id}=$#qca + $#qia + 1; if ($numans{$id} > 9) { print "WARNING: Test def for $testfile contains $id of length greater than 9!\n"; } #print "Numans: $numans{$id}\n"; } elsif ($qtp eq "mch" || $qtp eq "ord") { $qtp{$id}=$qtp; } } chomp($lines[5]); @qids=split(/\&/,$lines[5]); shift @qids; # record mch questions @mchques=(); for (0 .. $#qids) { if ($qtp{$qids[$_]} eq "mch") { push(@mchques, $_); } } # record ord questions @ordques=(); for (0 .. $#qids) { if ($qtp{$qids[$_]} eq "ord") { push(@ordques, $_); } } if (substr($lines[5],0,1) eq '&') { # insert default flags into first test line $line=join('',"0.1.o.o.o.N.0",$lines[5]); } else { $line=$lines[5]; } print OUTFILE "$line\n"; # Parse second test line (if ord or mch questions) if (($#ordques > -1) || ($#mchques > -1)) { chomp($lines[6]); $lines[6] =~ s/'//g; @fields=split(/\&/,$lines[6]); shift @fields; foreach (@ordques) { $first=substr($fields[$_],0,1); $rest=substr($fields[$_],1); if ($first ne "o") { if ($first eq ".") { $fields[$_]=join('',"o",$fields[$_]); } else { $fields[$_]=join('.',"o",$rest); } } } foreach (@mchques) { if (substr($fields[$_],0,1) eq ".") { $fields[$_]=join('',"a",$fields[$_]); } } $line=join('&',@fields,"\n"); $line=join('','&',$line); } else { $line=$lines[6]; } print(OUTFILE $line); # Parse third test line (add ? and xxx) $lines7=$lines[7]; $lines7 =~ s/\&//g; if ($lines7 ne "\n") { chomp($lines[7]); $lines[7] =~ s/'//g; @fields=split(/\&/,$lines[7]); shift @fields; $line=""; for (0 .. $#fields) { # Split fields ($resp,$cmnt)=split(/::/,$fields[$_]); # Parse fields if ($qtp{$qids[$_]} eq "mcs") { $newresp=""; for (0 .. $numans{$qids[$_]}) { if ($_ == $resp) { $newresp=join('?',$newresp,$resp); } else { $newresp=join('?',$newresp,"xxx"); } } $resp=$newresp; } elsif ($qtp{$qids[$_]} eq "mcm") { if (length($resp) > 9) { my $resplt=substr($resp,0,10); @resps = split(//, $resplt); my $resprt=substr($resp,10); $i=10; while ($resprt ne '') { #print "Resprt: $resprt\n"; if (substr($resprt,0,1) eq 'x') { $resprt = substr($resprt,1); push @resps, "x"; $i++; } else { push @resps, "$i"; if (length($resprt) > 2) { $resprt = substr($resprt,2); $i++; } else { $resprt=""; } } } } else { @resps = split(//, $resp); } $resp=""; foreach (@resps) { if ($_ eq "x") { $resp=join('?',$resp,"xxx"); } else { $resp=join('?',$resp,$_); } } } elsif ($qtp{$qids[$_]} eq "mch" || $qtp{$qids[$_]} eq "ord") { @resps = split(//, $resp); $resp=""; foreach (@resps) { if ($_ eq "x") { $resp=join('?',$resp,"xxx"); } else { $resp=join('?',$resp,$_); } } } # Rejoin fields $fields[$_]=join('::',$resp,$cmnt); $line=join('&',$line,$fields[$_]); } $line=join('',$line,"\n"); } else { $line=$lines[7] } print(OUTFILE "$line"); # Parse summary line (add ? and xxx) if ($lines[8] ne "\n" && substr($lines[8],0,3) ne "Not") { chomp($lines[8]); $lines[8] =~ s/'//g; @superfields=split(/\&/,$lines[8]); @fields=split(/\//,$superfields[5]); shift @fields; $superfields[5]=""; for (0 .. $#fields) { # Split fields ($score,$cans,$resp)=split(/\./,$fields[$_]); # Parse fields if ($qtp{$qids[$_]} eq "mcs") { $newcans=""; $newresp=""; for (0 .. $numans{$qids[$_]}) { if ($_ == $cans) { $newcans=join('?',$newcans,$cans); } else { $newcans=join('?',$newcans,"xxx"); } if ($_ == $resp) { $newresp=join('?',$newresp,$resp); } else { $newresp=join('?',$newresp,"xxx"); } } $cans=$newcans; $resp=$newresp; } elsif ($qtp{$qids[$_]} eq "mcm") { $newcans=""; $newresp=""; for (0 .. $numans{$qids[$_]}) { if ($cans =~ /$_/) { $newcans=join('?',$newcans,$_); } else { $newcans=join('?',$newcans,"xxx"); } if ($resp =~ /$_/) { $newresp=join('?',$newresp,$_); } else { $newresp=join('?',$newresp,"xxx"); } } $cans=$newcans; $resp=$newresp; } elsif ($qtp{$qids[$_]} eq "mch" || $qtp{$qids[$_]} eq "ord") { @resps = split(//, $resp); $resp=""; foreach (@resps) { if ($_ eq "x") { $resp=join('?',$resp,"xxx"); } else { $resp=join('?',$resp,$_); } } @canss = split(//, $cans); $cans=""; foreach (@canss) { if ($_ eq "x") { $cans=join('?',$cans,"xxx"); } else { $cans=join('?',$cans,$_); } } } # Rejoin fields $fields[$_]=join('.',$score,$cans,$resp); $superfields[5]=join('/',$superfields[5],$fields[$_]); } $line=join('&',@superfields, "\n"); } else { $line = $lines[8] } print OUTFILE "$line"; } else { print(OUTFILE $lines[5]); # No test definition print(OUTFILE $lines[6]); print(OUTFILE $lines[7]); print(OUTFILE $lines[8]); } # for now, dump rest of lines (change to parse later) print(OUTFILE $lines[9]); if ($lines[10] ne "\n") { print "WARNING: Post-test survey in $testfile\n"; } print(OUTFILE $lines[10]); print(OUTFILE $lines[11]); print(OUTFILE $lines[12]); print(OUTFILE $lines[13]); print(OUTFILE $lines[14]); print(OUTFILE $lines[15]); if ($lines[16] ne "\n") { print "WARNING: Post-test survey in $testfile\n"; } print(OUTFILE $lines[16]); # Rename files close OUTFILE; `mv $testfile $testfile.old`; `mv $testfile.new $testfile`; `touch -r $testfile.old $testfile`; # preserve date stamp } }