You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

290 lines
7.2 KiB

#!/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 = <TESTFILE>;
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
}
}