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
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
|
|
}
|
|
}
|
|
|