survey-manager/survey-nginx/cgi-bin/convert.pl

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