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

#!/usr/bin/perl
#
# $Id: tdef.pl,v 1.11 2006/05/22 16:06:41 psims Exp $
#
# Source File: tdef.pl

# Get config
use CGI qw/:standard/;

require 'sitecfg.pl';
require 'ui.pl';
require 'sbalib.pl';

use POSIX;

if ( ! &go() ) {
	&logger::logerr("Unable to successfully serve page");
}

sub go {
	&app_initialize;
	print "Content-Type: text/html\n\n";
	if (&get_session($FORM{'tid'})) {
		&LanguageSupportInit();

		### DED 8/27/02 Preview CFA
		if (($FORM{'cfa'} ne '') && ($FORM{'preview'} eq "Preview")) {
			&preview_cfa();
			return;
		}
		my ($ok, $msg) = &setAvailableDatetimes( \%FORM );
		$FORM{'respmsg'} = "";
		if ( ! $ok ) {
			$FORM{'respmsg'} = &errorformat($msg);
			$FORM{'savechanges'} = 'N';
			$FORM{'frm'} = 1;
		}
		if ($FORM{'tstid'} eq '') { $FORM{'tstid'} = $FORM{'id'}; }
		if ($FORM{'id'} eq '') { $FORM{'id'} = $FORM{'tstid'}; }
		if ($FORM{'UploadImages'} ne '') {
			&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Test Image Upload $FORM{'tstid'}");
			&show_upload_form;
			return 1;
		} else {
			if ($FORM{'savechanges'} eq 'Y' ) {

				if ( defined($FORM{'newtest'}) && ($FORM{'newtest'} eq 'Y') && &is_duplicate_test_id($FORM{'tstid'}, $SESSION{'clid'})) {

					#
					# Disallow duplicates on new test defns ...
					#
					$msg = GetLanguageElement($SESSION{lang}, 552);
					$msg .= qq{ "$FORM{'tstid'}" (};
					$msg .= GetLanguageElement($SESSION{lang}, 553);
					$msg .= qq{ "$FORM{'desc'}") };
					$msg .= GetLanguageElement($SESSION{lang}, 554);
					$FORM{'respmsg'} .= &errorformat($msg);
					&logger::loguerr($msg);

				} elsif ( defined($FORM{'newtest'}) && 
				          ($FORM{'newtest'} eq 'Y') &&
					 	  $FORM{'tstid'} =~ /\s/ ) {

					#
					# Disallow spaces in new test IDs ...
					#
					$msg = GetLanguageElement($SESSION{lang}, 555);
					$FORM{'respmsg'} .= &errorformat($msg);
					&logger::loguerr($msg);

				} else {
					if ($FORM{'flags'} ne '' || $FORM{'group'} ne '' || $FORM{'tstalwrotip'} ne '') {
						@flags = split(/\./, $FORM{'flags'});
						$flags[4] = $FORM{'group'};
						$flags[5] = $FORM{'tstalwrotip'};
						$FORM{'flags'} = join('.',@flags);
					}
					### DED 6/22/04 For Custom fields
					### Not yet implemented
					#$FORM{'showsubj'} .= ".$FORM{'showques1'}.$FORM{'lblques1'}.$FORM{'showques2'}.$FORM{'lblques2'}";

					&put_test_profile($SESSION{'clid'}, $FORM{'id'}, \%FORM, $FORM{newtest});
					if ($FORM{'seq'} eq 'std') {
						&put_test_saskmatrix($SESSION{'clid'}, $FORM{'id'}, \%FORM);
					}

					&put_test_logo($SESSION{'clid'},$FORM{'id'}, \%UPLOADED_FILES);
					&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "Saved Test Definition $FORM{'id'}");
					if ($FORM{'newtest'} eq 'Y') {
						&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Question File Created $FORM{'id'}");
						&create_question_file($SESSION{'clid'}, $FORM{'id'});
						$FORM{'newtest'} = "N";
					}
					$FORM{'frm'} = 1;
#					$FORM{'respmsg'} .= GetLanguageElement($SESSION{lang}, 556);

					#
					#  Create an Instance of this test?
					#
					if ( ($FORM{instanceit} eq 'Y' || $FORM{instanceit} eq 'on') ) {
					
						$FORM{instancename} = strip_blanks($FORM{instancename});
					       	$FORM{desc} = $FORM{instancedesc};
						my ($rc, $msg) = &instance_test($SESSION{'clid'}, $FORM{'tstid'}, $FORM{instancename}, \%FORM);
						if ( ! $rc ) {

							&logger::logerr("&instance_test($SESSION{'clid'}, $FORM{'tstid'}, $FORM{instancename}) FAILED;");
#hkh bug#157 delete any new files due to incomplete cloning
						} else {
							log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2",
							          "Created an Instance of  test '$FORM{instancename}' from test/survey '$FORM{'tstid'}'");
						}
						$FORM{'respmsg'} .= $msg;
					}

					#
					#  Clone this test?
					#
					if ( ($FORM{cloneit} eq 'Y' || $FORM{cloneit} eq 'on') ) {
					
						$FORM{clonename} = strip_blanks($FORM{clonename});
					       	$FORM{desc} = $FORM{clonedesc};
						my ($rc, $msg) = &clone_test($SESSION{'clid'}, $FORM{'tstid'}, $FORM{clonename}, \%FORM);
						if ( ! $rc ) {

							&logger::logerr("&clone_test($SESSION{'clid'}, $FORM{'tstid'}, $FORM{clonename}) FAILED;");
#hkh bug#157 delete any new files due to incomplete cloning
						} else {
							log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2",
							          "Cloned test/survey '$FORM{clonename}' from test/survey '$FORM{'tstid'}'");
						}
						$FORM{'respmsg'} .= $msg;
					}
				}
				$TEST{'reload'}="Y";
			} else {
				$FORM{'respmsg'} .= GetLanguageElement($SESSION{lang}, 557);
			}

			push @templates, (tdefund, tdef, tdefstd, tdefadp);

			if ($FORM{'newtest'} ne 'Y') {
				&get_test_profile($SESSION{'clid'}, $FORM{'tstid'});
				if ($FORM{'frm'} eq 0) {
					$FORM{'frm'} = ($TEST{'seq'} eq 'std') ? 2 : 3;
				}
				# added for subject area support
			}
			$SUBJAREA{'subjskillcgt'}=&get_subjskill_cntgrdtbl($SESSION{'clid'}, $FORM{'tstid'}, "");
			# FIXME:  This needs to go thru the language support facilities.
			if ($FORM{'respmsg'} eq "") {
 				$FORM{'respmsg'} .= GetLanguageElement($SESSION{lang}, 556);
			} 
			print $FORM{respmsg} if ( $FORM{respmsg} );
			&get_client_profile($SESSION{'clid'});
			&show_template($templates[$FORM{'frm'}]);
			return 1;
		}
	}
}


sub setAvailableDatetimes {
	my ($form) = @_;

	$form->{availonminute}      ||= $UI{DEFAULT_AVAILON_MIN};
	$form->{availonhour}        ||= $UI{DEFAULT_AVAILON_HR};
	$form->{availthruminute}    ||= $UI{DEFAULT_AVAILTHRU_MIN};
	$form->{availthruhour}      ||= $UI{DEFAULT_AVAILTHRU_HR};


	if ( ! defined($form->{availonminute})   ||
	     ! defined($form->{availonhour})     ||
	     ! defined($form->{availonpmoffset}) ||
	     ! defined($form->{availthruminute}) ||
	     ! defined($form->{availthruhour})   ||
	     ! defined($form->{availthrupmoffset}) ) {
		logger::logerr("One of the 'availon...' or 'availthru...' form fields is undefined...aborting setAvailableDatetimes()");
		return (0, GetLanguageElement($SESSION{lang}, 565));
	}

	if ( $form->{availonminute}     !~ /^\d+$/ ) {
		logger::logerr("form field 'availonminute' is not of the expected integer format...aborting setAvailableDatetimes().  availonminute = $form->{availonminute}");
		return (0, GetLanguageElement($SESSION{lang}, 565));
	}

	if ( $form->{availonhour}       !~ /^\d+$/ ) {
		logger::logerr("form field 'availonhour' is not of the expected integer format...aborting setAvailableDatetimes()");
		return (0, GetLanguageElement($SESSION{lang}, 565));
	}

	$form->{availonpmoffset} ||= 0;
	$form->{availthrupmoffset} ||= 0;
	if ( $form->{availonpmoffset}   !~ /^\d+$/ ) {
		logger::logerr("form field 'availonpmoffset' [$form->{availonpmoffset}] is not of the expected integer format...aborting setAvailableDatetimes()");
		return (0, GetLanguageElement($SESSION{lang}, 565));
	}

	if ( $form->{availthruminute}   !~ /^\d+$/ ) {
		logger::logerr("form field 'availthruminute' is not of the expected integer format...aborting setAvailableDatetimes()");
		return (0, GetLanguageElement($SESSION{lang}, 565));
	}

	if ( $form->{availthruhour}     !~ /^\d+$/ ) {
		logger::logerr("form field 'availthruhour' is not of the expected integer format...aborting setAvailableDatetimes()");
		return (0, GetLanguageElement($SESSION{lang}, 565));
	}

	if ( $form->{availthrupmoffset} !~ /^\d+$/ ) {
		logger::logerr("form field 'availthrupmoffset' is not of the expected integer format...aborting setAvailableDatetimes()");
		return (0, GetLanguageElement($SESSION{lang}, 565));
	}

	if ( $form->{availonhour} < 12 ) {
		$form->{availonhour} += $form->{availonpmoffset};
	} elsif ( $form->{availonpmoffset} == 0 ) {
		$form->{availonhour} -= 12;
	}

	if ( $form->{availthruhour} < 12 ) {
		$form->{availthruhour} += $form->{availthrupmoffset};
	} elsif ( $form->{availthrupmoffset} == 0 ) {
		$form->{availthruhour} -= 12;
	}

	$form->{availon} = sprintf("%02d/%02d/%04d-%02d:%02d",
	                                $form->{availonmonth},
	                                $form->{availonday},
	                                $form->{availonyear},
	                                $form->{availonhour},
	                                $form->{availonminute});

	$form->{availthru} = sprintf("%02d/%02d/%04d-%02d:%02d",
	                                $form->{availthrumonth},
	                                $form->{availthruday},
	                                $form->{availthruyear},
	                                $form->{availthruhour},
	                                $form->{availthruminute});

	my $on = POSIX::strftime("%s", 0, $form->{availonminute}, 
	                                  $form->{availonhour}, 
									  $form->{availonday}, 
									  $form->{availonmonth} - 1, 
									  $form->{availonyear} - 1900);

	my $to = POSIX::strftime("%s", 0, $form->{availthruminute}, 
	                                  $form->{availthruhour}, 
									  $form->{availthruday}, 
									  $form->{availthrumonth} - 1, 
									  $form->{availthruyear} - 1900);

	if ( ! valid_date( $form->{availonyear}, 
	                   $form->{availonmonth}, 
					   $form->{availonday}) ) {
		&logger::loguerr("Bogus availability start date/time:  [$form->{availon}]");
		return (0, GetLanguageElement($SESSION{lang}, 577));
	}

	if ( ! valid_date( $form->{availthruyear}, 
	                   $form->{availthrumonth}, 
					   $form->{availthruday}) ) {
		&logger::loguerr("Bogus availability end date/time:  [$form->{availthru}]");
		return (0, GetLanguageElement($SESSION{lang}, 577));
	}

	if ( $to <= $on ) {
		&logger::loguerr("Test/survey starting time ($form->{availon}) later than ending time ($form->{availthru})");
		return (0, GetLanguageElement($SESSION{lang}, 576));
	}


	return (1, "");
}

sub valid_test_id_syntax( $ ) {
	my ($testid) = @_;

	# No spaces allowed in test names...
	if ( $testid =~ /\s/ ) {
		return (0, GetLanguageElement($SESSION{lang}, 555)); #No spaces
	}

	if ( $testid !~ /\S/ ) {
		return (0, GetLanguageElement($SESSION{lang}, 567)); #At least 1 char
	}

	return (1, GetLanguageElement($SESSION{lang}, 566)); #OK
}

# Return 1 if the test already exists, 0 if it does not.
sub is_duplicate_test_id {
	($id,$clid) = @_;

	# FIXME:  Handle undefined test ID/description

	@test_list = &get_test_list($clid);

	foreach ( @test_list ) {

		($this_id, $this_desc) = split(/&/, $_);
		if ( $this_id eq $id ) {
			return 1;
		}
	}

	return 0;
}

#
# Copy/duplicate the test $tstid and name the new cloned test $newtestid for 
# client $clid.
#
sub instance_test( $ $ $ $ ) {
	my ($clid, $oldtestid, $newtestid, $params) = @_;

	my ($rc, $msg) = valid_test_id_syntax($newtestid);
	if ( ! $rc ) {
		&logger::loguerr("Invalid test ID syntax:  '$newtestid'");
		return (0, errorformat($msg));
	}

	if ( &is_duplicate_test_id($newtestid, $SESSION{'clid'}) ) {
		&logger::loguerr("The test ID '$newtestid' already exists and cannot serve as a test ID for a new instance test for client '$clid'.");
		my $msg = GetLanguageElement($SESSION{lang}, 936);
		$msg .= "  ".GetLanguageElement($SESSION{lang}, 564);
		$msg .= "  ".GetLanguageElement($SESSION{lang}, 552);
		$msg .= qq{ "$newtestid" };
		$msg .= GetLanguageElement($SESSION{lang}, 554);
		return (0, errorformat($msg));
	}

	if ( ! $params || ref($params) ne 'HASH' ) {
		&logger::logerr("Missing new test parameters for Instance test ID '$newtestid', client '$clid'.");
		return 0;
		my $msg = GetLanguageElement($SESSION{lang}, 936);
		$msg .= "  ".GetLanguageElement($SESSION{lang}, 564);
		$msg .= "  ".GetLanguageElement($SESSION{lang}, 565);
		return (0, errorformat($msg));
	}


	my $newtest = 'Y';

	if ( ! &put_test_profile($clid, $newtestid, $params, $newtest, $oldtestid) ) {
		&logger::logerr("put_test_profile($clid,$newtestid,$params,$newtest) FAILED");
		my $msg = GetLanguageElement($SESSION{lang}, 936);
		return (0, errorformat($msg));
	}
	if ( ! &link_question_file($clid, $oldtestid, $newtestid) ) {
		&remove_created_test_file($clid, $newtestid);
		&logger::logerr("link_question_file($clid, $oldtestid, $newtestid) FAILED");
		my $msg = GetLanguageElement($SESSION{lang}, 937);
		return (0, errorformat($msg));
	}

	if ( ! &link_sbacustom_files($clid, $oldtestid, $newtestid) ) {
		&remove_created_test_file($clid, $newtestid);
		&remove_created_question_file($clid, $newtestid);
		&logger::logerr("link_sbacustom_files($clid, $oldtestid, $newtestid) FAILED");
		my $msg = GetLanguageElement($SESSION{lang}, 938);
		return (0, errorformat($msg));
	}

	if ( ! &link_test_logos($clid, $oldtestid, $newtestid) ) {
		&remove_created_test_file($clid, $newtestid);
		&remove_created_question_file($clid, $newtestid);
		&remove_created_sbacustom_files($clid, $newtestid);
		&logger::logerr("link_test_logos($clid, $oldtestid, $newtestid) FAILED");
		my $msg = GetLanguageElement($SESSION{lang}, 939);
		return (0, errorformat($msg));
	}

	my $msg = GetLanguageElement($SESSION{lang}, 940);
	$msg .= "'$oldtestid'";
	$msg .= GetLanguageElement($SESSION{lang}, 569);
	$msg .= "'$newtestid'";

	return (1, okformat($msg));
}

sub link_test_logos {
	my ($clid, $srctestid, $newtestid) = @_;

	if ( ! opendir(DIR, $testgraphic) ) {
		&logger::logerr("Unable to opendir $testgraphic:  $!");
		return 0;
	}
	@filenames = readdir(DIR);
	closedir(DIR);

#	my $regex = "^$clid".'\.'."$srctestid".'(.*)$';

	foreach my $srcfile ( @filenames ) {

		if ( $srcfile =~ /^$clid.$srctestid.0(.*)$/ ) {
			my $newfile = join($pathsep, $testgraphic, "$clid.$newtestid.0$1");
			my $oldfile = join($pathsep, $testgraphic, $srcfile);
			if (! symlink($oldfile, $newfile)) {
				&remove_created_logo_files($clid, $newtestid);
				return 0;
			}

		}
	}

	return 1;
}

sub link_question_file {
	my ($clid, $oldtestid, $newtestid) = @_;
	my $oldfile = join($pathsep, $questionroot, "$oldtestid.$clid");
	my $newfile = join($pathsep, $questionroot, "$newtestid.$clid");
	if (! symlink($oldfile, $newfile)) {
		&remove_created_question_file($clid, $newtestid);
		return 0;
	}
	return 1;
}

sub link_sbacustom_files {
	my ($clid, $oldtestid, $newtestid) = @_;
	if ( ! opendir(DIR, $questionroot) ) {
		&logger::logerr("Unable to opendir $questionroot:  $!");
		return 0;
	}
	@filenames = readdir(DIR);
	closedir(DIR);

	#my $regex = "^$oldtestid".'\.'."$clid".'\.'.'(.*)$';
	foreach my $srcfile ( @filenames ) {

		if ( $srcfile =~ /^$oldtestid\.$clid\.(.*)$/ ) {
			my $newfile = join($pathsep, $questionroot, "$newtestid.$clid.$1");
			my $oldfile = join($pathsep, $questionroot, $srcfile);
			if ( ! symlink($oldfile, $newfile)) {
				&remove_created_sbacustom_files($clid, $newtestid);
				return 0;
			}
		}
	}

	return 1;
}

#
# Copy/duplicate the test $tstid and name the new cloned test $newtestid for 
# client $clid.
#
sub clone_test( $ $ $ $ ) {
	my ($clid, $oldtestid, $newtestid, $params) = @_;

	my ($rc, $msg) = valid_test_id_syntax($newtestid);
	if ( ! $rc ) {
		&logger::loguerr("Invalid test ID syntax:  '$newtestid'");
		return (0, errorformat($msg));
	}

	if ( &is_duplicate_test_id($newtestid, $SESSION{'clid'}) ) {
		&logger::loguerr("The test ID '$newtestid' already exists and cannot serve as a test ID for a newly cloned test for client '$clid'.");
		my $msg = GetLanguageElement($SESSION{lang}, 563);
		$msg .= "  ".GetLanguageElement($SESSION{lang}, 564);
		$msg .= "  ".GetLanguageElement($SESSION{lang}, 552);
		$msg .= qq{ "$newtestid" };
		$msg .= GetLanguageElement($SESSION{lang}, 554);
		return (0, errorformat($msg));
	}

	if ( ! $params || ref($params) ne 'HASH' ) {
		&logger::logerr("Missing new test parameters for clone test ID '$newtestid', client '$clid'.");
		return 0;
		my $msg = GetLanguageElement($SESSION{lang}, 563);
		$msg .= "  ".GetLanguageElement($SESSION{lang}, 564);
		$msg .= "  ".GetLanguageElement($SESSION{lang}, 565);
		return (0, errorformat($msg));
	}


	my $newtest = 'Y';

	if ( ! &put_test_profile($clid, $newtestid, $params, $newtest) ) {
		&logger::logerr("put_test_profile($clid,$newtestid,$params,$newtest) FAILED");
		my $msg = GetLanguageElement($SESSION{lang}, 563);
		return (0, errorformat($msg));
	}

	if ( ! &clone_question_file($clid, $oldtestid, $newtestid) ) {
		&remove_created_test_file($clid, $newtestid);
		&logger::logerr("clone_question_file($clid, $oldtestid, $newtestid) FAILED");
		my $msg = GetLanguageElement($SESSION{lang}, 731);
		return (0, errorformat($msg));
	}

# hkh 01/04 clone mtx & custom files
	if ( ! &clone_sbacustom_files($clid, $oldtestid, $newtestid) ) {
		&remove_created_test_file($clid, $newtestid);
		&remove_created_question_file($clid, $newtestid);
		&logger::logerr("clone_sbacustom_files($clid, $oldtestid, $newtestid) FAILED");
		my $msg = GetLanguageElement($SESSION{lang}, 733);
		return (0, errorformat($msg));
	}

	if ( ! &clone_test_logos($clid, $oldtestid, $newtestid) ) {
		&remove_created_test_file($clid, $newtestid);
		&remove_created_question_file($clid, $newtestid);
		&remove_created_sbacustom_files($clid, $newtestid);
		&logger::logerr("clone_test_logos($clid, $oldtestid, $newtestid) FAILED");
		my $msg = GetLanguageElement($SESSION{lang}, 734);
		return (0, errorformat($msg));
	}

	my $msg = GetLanguageElement($SESSION{lang}, 568);
	$msg .= "'$oldtestid'";
	$msg .= GetLanguageElement($SESSION{lang}, 569);
	$msg .= "'$newtestid'";

	return (1, okformat($msg));
}


sub reassignifduplicate {
	$vid = $_[1];
	@vtrecs = &get_test_list($_[0]);
	while (&test_exists($vid)) {
			$vid++;
	}
	return $vid;
}

sub put_test_logo {
	my ($clid, $testid) = @_;
	my $upfile;
	my $msg;
	my $chmodok; my @suexts = () ;
	my $testimg = upload('testimg');
	my @fileparts = split(/\./, param('testimg'));
        my $test_logo_ext = $fileparts[$#fileparts];
        @fileparts = ();
	my $supportedmedia = join (";", $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'});
	# if ($SYSTEM{'supportedimagemedia'} =~ /$test_logo_ext/i ) 
		# @suexts = split(/\;/, $SYSTEM{'supportedimagemedia'});
	if ($supportedmedia =~ /$test_logo_ext/i ) {
		@suexts = split(/\;/, $supportedmedia);
		# remove any old logos for this test
		foreach $suext (@suexts) {
			$prefile = join($pathsep, $pubroot, "graphic", "$clid.$testid");
			$existingfile=&file_exists_with_extension($prefile, $suext);
			if ($existingfile ne '') {
				$cnt = unlink $existingfile;
			}
		}
		# write the uploaded file
		$upfile = join($pathsep, $pubroot, "graphic", "$clid.$testid.$test_logo_ext");
		open (OUTFILE, ">$upfile") or $msg="failed";
		if ($msg ne "failed") {
			binmode(OUTFILE);
			while ($bytesread=read($testimg,$buffer,1024)) {
                           print OUTFILE $buffer;
                        }
			close OUTFILE;
			$chmodok = chmod 0666, $upfile;
		}
	}
}


sub clone_test_logos {
	my ($clid, $srctestid, $newtestid) = @_;

	if ( ! opendir(DIR, $testgraphic) ) {
		&logger::logerr("Unable to opendir $testgraphic:  $!");
		return 0;
	}
    @filenames = readdir(DIR);
	closedir(DIR);

#	my $regex = "^$clid".'\.'."$srctestid".'(.*)$';

	foreach my $srcfile ( @filenames ) {

		if ( $srcfile =~ /^$clid.$srctestid.0(.*)$/ ) {
			my $newfile = join($pathsep, $testgraphic, "$clid.$newtestid.0$1");
			my $oldfile = join($pathsep, $testgraphic, $srcfile);
#hkh bug#58		cpbin("$oldfile", "$newfile", 1);
			if (! &get_io_file($oldfile, $newfile)) {
				&remove_created_logo_files($clid, $newtestid);
				return 0;
			}

#			if ( ! cpbin("$oldfile", "$newfile") ) {
#				&logger::logerr("cpbin($oldfile, $newfile) FAILED");
#				if ( scalar(@copied) ) {
#					&logger::logwarn("DUE cpbin() FAILURE, THERE ARE NOW ORPHANED IMAGE FILES IN $testgraphic: @copied");
					# NOTE:  We *could* delete the files we just copied,
					# NOTE:  but that just seems like a bad idea given
					# NOTE:  we could end-up deleting some original 
					# NOTE:  graphics files accidentally if they were
					# NOTE:  already there and thus caused cpbin() to fail.
#				}
#				return 0;
#			} else {
#				push( @copied, $newfile );
#			}
		}
	}

	return 1;
}

sub remove_created_test_file {
	my ($clid, $newtestid) = @_;
	@trecs = &get_test_list($clid);
	foreach $trec (@trecs) {
		chop ($trec);
		($id, $trash) = split(/\&/, $trec);
		if ($newtestid ne $id) {
			push @newtests, $trec;
		}
	}
	@trecs = @newtests;
	&save_test_list($clid);
}

#hkh bug#157 delete new logofiles if clonning is not successful
sub remove_created_logo_files {
	my ($clid, $newtestid) = @_;
	opendir(DIR, $testgraphic); 
        @filenames = readdir(DIR);
	closedir(DIR);
	foreach my $srcfile ( @filenames ) {
		if ( $srcfile =~ /^$clid.$newtestid.0(.*)$/ ) {
			$ulinkfile = join($pathsep, $testgraphic, $srcfile);
			$cnt = unlink $ulinkfile;
		}
	}
}

sub test_exists {
	foreach $vtrec (@vtrecs) {
		($vid, $vmore) = split(/&/, $vtrec);
		if ($vid eq $_[0]) {
			return 1;
		}
	}
	return 0;
}

sub create_question_file {
	my ($clid, $testid) = @_;
	@lines = &get_question_list("default", "std");
	$trash = join($pathsep, $questionroot, "$testid.$clid");
	open (TMPFILE, ">$trash");
	foreach $line (@lines) {
		print TMPFILE "$line";
	}
	close TMPFILE;
	$chmodok = chmod 0666, $trash;
}


sub clone_question_file {
	my ($clid, $oldtestid, $newtestid) = @_;
	@lines = &get_question_list($oldtestid, $clid);
	$new_question_file = join($pathsep, $questionroot, "$newtestid.$clid");
	if ( ! open (TMPFILE, ">$new_question_file") ) {
		&logger::logerr("Unable to write to $new_question_file:  $!");
		return undef;
	}
	$line1 = '0';
	foreach $line (@lines) {
#hkh bug#19 if oldtestid is diff. from question-id, replace q-id with newtestid
		if ($line1 eq '0') {
			$line1 = '1';
			print TMPFILE "$line";
		} else {
	  		@fields = split /&/, $line;	
 			$_ = shift(@fields);
			s/.*\./$newtestid./;
			unshift(@fields, $_);
			$line = join "&", @fields;
#hkh bug#19		$line =~ s/^$oldtestid/$newtestid/;
			print TMPFILE "$line";
		}
	}
	close TMPFILE;
	$chmodok = chmod 0666, $new_question_file;
}

sub remove_created_question_file {
	my ($clid, $newtestid) = @_;
	$ulinkfile = join($pathsep, $questionroot, "$newtestid.$clid");
	$cnt = unlink $ulinkfile;	
}

# hkh 01/04 
sub clone_sbacustom_files {
	my ($clid, $oldtestid, $newtestid) = @_;
	if ( ! opendir(DIR, $questionroot) ) {
		&logger::logerr("Unable to opendir $questionroot:  $!");
		return 0;
	}
    @filenames = readdir(DIR);
	closedir(DIR);

	#my $regex = "^$oldtestid".'\.'."$clid".'\.'.'(.*)$';
	foreach my $srcfile ( @filenames ) {

		if ( $srcfile =~ /^$oldtestid\.$clid\.(.*)$/ ) {
			my $newfile = join($pathsep, $questionroot, "$newtestid.$clid.$1");
			my $oldfile = join($pathsep, $questionroot, $srcfile);
#hkh bug#58		cpbin("$oldfile", "$newfile", 1) 
			if ( ! &get_io_file($oldfile, $newfile)) {
				&remove_created_sbacustom_files($clid, $newtestid);
				return 0;
			}
		}
	}

	return 1;
}

sub remove_created_sbacustom_files {
	my ($clid, $newtestid) = @_;
	opendir(DIR, $questionroot); 
        @filenames = readdir(DIR);
	closedir(DIR);
	foreach my $srcfile ( @filenames ) {
		if ( $srcfile =~ /^$newtestid.$clid.(.*)$/ ) {
			$ulinkfile = join($pathsep, $questionroot, $srcfile);
			$cnt = unlink $ulinkfile;	
		}
	}

}

sub show_upload_form {
	$iShownCount=0;
	$qreclist = "";
	&get_test_profile($SESSION{'clid'}, $FORM{'tstid'});
	&show_template("uploadpagehdr");
	print "<FORM METHOD=POST ACTION=\"$PATHS{'cgiroot'}/upimages.pl\" enctype=\"multipart/form-data\">\n";
	print "<input type=hidden name=tid value=\"$SESSION{'tid'}\">\n";
	print "<input type=hidden name=clid value=\"$SESSION{'clid'}\">\n";
	print "<TABLE cellpadding=0 cellspacing=0 border=1 width=\"100%\">\n";
	print "<TR>\n";
	print "<TD align=\"left\"><Font Size=1>\n";
	print "Upload Image\n";
	print "</font></TD>\n";
	print "<TD align=\"left\"><Font Size=1>\n";
	print "\&nbsp;\n";
	print "</font></TD>\n";
	print "<TD align=\"left\"><Font Size=1>\n";
	print "Question\n";
	print "</font></TD>\n";
	print "</TR>\n";
	@qrecs = &get_question_list($FORM{'tstid'}, $SESSION{'clid'});
	$bFirst = 1;
	foreach $qrec (@qrecs) {
		chop ($qrec);
		if ($bFirst) {
			@flds = split(/&/, $qrec);
			$bFirst = 0;
			$i = 0;
			foreach $fld (@flds) {
				if ($fld eq 'qim') {
					$iqim = $i;
				} else {
					if ($fld eq 'id') {
						$iid = $i;
					} else {
						if ($fld eq 'qtx') {
							$iqtx = $i;
						}
					}
				}
				$i++;
			}
		} else {
			@flds = split(/&/, $qrec);
			if ($flds[$iqim] ne '0') {
				$iShownCount++;
				print "<TR>\n";
				print "<TD align=\"left\"><Font Size=1>\n";
				print "<INPUT TYPE=FILE NAME=\"$SESSION{'clid'}.$flds[$iid]\" MAXLENGTH=120 SIZE=20> \n";
				$qreclist .= "$flds[$iid]::";
				print "</font></TD>\n";
				print "<TD align=\"left\"><Font Size=1>\n";
				print "\&nbsp;$flds[$iid]:\&nbsp;\n";
				print "</font></TD>\n";
				print "<TD align=\"left\"><Font Size=1>\n";
				print "$flds[$iqtx]\n";
				print "</font></TD>\n";
				print "</TR>\n";
			}
		}
	}
	$qreclist = substr($qreclist,0,-2);
	unless ($iShownCount) {
		print "<TR>\n";
		print "<TD colspan=\"3\" align=\"left\">\n";
		print "No questions were tagged as having images.\n";
		print "</TD>\n";
		print "</TR>\n";
	}
	print "<TR>\n";
	print "<TD colspan=\"3\" align=\"center\">\n";
	print "<INPUT TYPE=HIDDEN NAME=\"path\" VALUE=\"$testgraphic\">\n";
	print "<INPUT TYPE=HIDDEN NAME=\"fieldlist\" VALUE=\"$qreclist\">\n";
	print "<INPUT TYPE=SUBMIT VALUE=\"$xlatphrase[512]\">\n";
	print "</TD>\n";
	print "</TR>\n";
	print "</TABLE>\n";
	print "</FORM>\n";
	print "</BODY>\n</HTML>\n";
}

sub preview_cfa {
print "
<HTML>
<HEAD>
<!-- Based on agreement.htt,v 1.2 2002/02/14 21:02:55 ed Exp $ -->
<TITLE>Confidentiality Agreement</TITLE>
</HEAD>
<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\" LINK=\"#0000FF\" VLINK=\"#800080\">
<TABLE CELLSPACING=0 CELLPADDING=0 BORDER=0 width=\"100%\">
	<TR>
		<td align=\"left\">
			<FONT SIZE=4>
			&nbsp;<BR>
			</FONT>
		</td>
	</TR>
	<TR>
		<td align=\"left\">
			$FORM{'cfa'} <BR>
			&nbsp;<BR>
		</td>
	</TR>
	<TR>
		<td align=\"center\">
			<INPUT TYPE=BUTTON NAME=submit VALUE=\"$xlatphrase[487]\" onClick=window.close()>&nbsp;
			<INPUT TYPE=BUTTON NAME=submit VALUE=\"$xlatphrase[488]\" onClick=window.close()>
			</form>
		</td>
	</TR>
</TABLE>
</BODY>
</HTML>\n";
}