#!C:/perl/bin/perl.exe
use CGI::Carp qw(fatalsToBrowser);
use CGI;
$query = new CGI;

$pass= $query->param('pass');
$v1= $query->param('v1');
$v2= $query->param('v2');
$v3= $query->param('v3');
$v4= $query->param('v4');
$comments= $query->param('comments');

if($pass < 1){
	$pass = 0;
}

print $query->header;
print $query->start_html(-title=>'Subroutines');

print "<style type='text/css'>	body{ font-size: 90%; font-family: verdana; }</style>";


if($pass == 1){

	print "Numbers = $v1, $v2, $v3, and $v4 <BR>";
	$average = &averageScores($v1,$v2,&revKey(6,$v3),$v4);
	print "The average  is $average.";

	
	# find the sample mean for esteem (composite for each person is the 7th element in data row)
	$esteemMean = &sampleMean("form3.txt",7);

	print "The sample mean for self-esteem is $esteemMean.";


	# remove funny characters
	$comments = &cleanData($comments);
	print "The cleaned comments are $comments.";

}

if($pass == 0){

	print "<FORM ACTION = '/cgi-bin/P593/sub4.pl' METHOD = 'post'>";

	print "Type 4 numbers ranging from 1 to 5 below and click the button to find their average.<BR>";
	
	print "<INPUT TYPE=textbox NAME=v1 SIZE=2 MAXSIZE=2><BR>";
	print "<INPUT TYPE=textbox NAME=v2 SIZE=2 MAXSIZE=2><BR>";
	print "<INPUT TYPE=textbox NAME=v3 SIZE=2 MAXSIZE=2> (This one will be reverse keyed)<BR>";
	print "<INPUT TYPE=textbox NAME=v4 SIZE=2 MAXSIZE=2><BR>";
	print "<TEXTAREA NAME=comments ROWS=5 COLS=20 WRAP=virtual></TEXTAREA><BR>";

	print "<INPUT TYPE=submit VALUE='average'>";
	print "<INPUT TYPE=hidden NAME=pass VALUE=1>";

	print "</FORM>";



}

print $query->end_html;



# ----------------- Subroutines -----------------------------
# for a good tutorial/overview of Perl subroutines, see
# http://www.comp.leeds.ac.uk/Perl/subroutines.html
#------------------------------------------------------------

#-------------------------------------------------------------------------
# Subroutines - you shouldn't need to modify anything beyond this point
#-------------------------------------------------------------------------

sub averageScores {

	# Function for averaging scores and adjusting denom for missing cases
	# Assumes 0 is not a legit response
	# R. Chris Fraley March 26 2005
	# Returns the mean, takes as param an array or seq of values
	# Returns zero if no valid cases
	
	$nSUB = @_;
	$validnSUB = 0;
	$sumSUB = 0;
	for($iSUB=0;$iSUB<=($nSUB-1);++$iSUB){
		if($_[$iSUB] > 0){
			$sumSUB = $sumSUB + $_[$iSUB];
			$validnSUB = $validnSUB + 1;
		}
	}
	$mean = 0;
	if($validnSUB > 0){
		$mean = $sumSUB/$validnSUB;
	}
    return $mean;
} 

sub revKey {
	# Assumes a 1 to X scale
	# First (0th) parameter should be max + 1 value
	# Second (1st) element is value to reverse key

	$highSUB = $_[0];
	$valueSUB = $_[1];

	$newValue = 0;
	if($valueSUB > 0){
		$newValue = $highSUB-$valueSUB;
	}
	return $newValue;

} 

sub sampleMean {

	# The first [0th] element, $filename, will be the name of the data file (e.g., self-esteem.txt)
	# The second [1st] element, $index, will be a number indicating which variable number (i.e., column number in a data matrix, with 0 being the first) should be averaged

	$filename = $_[0];
	$index = $_[1];

	$thisSum= 0;
	$thisN= 0;

	$fullfilename = "$ENV{'DOCUMENT_ROOT'}/P593/" . $filename;

	open(INFO, $fullfilename);
	 @data = <INFO>;
	close(INFO);

	foreach $key (@data)
	{
	@a=split(/,/,$key);
		if($a[$index] > 0){
			$thisSum= $thisSum + $a[$index];
			$thisN= $thisN + 1;
		}
	}
	
	if($thisN > 0){
		$thisMean= sprintf("%.3f",$thisSum/$thisN);
	} else {
		$thisMean = "Average cannot be computed--too few cases";
	}

	return $thisMean;
}

sub cleanData {

	# This function removes commas and hard linebreaks from the input.  It also replaces carriage returns with <BR>--the HTML code for a linebreak.  This function should be run for all text-based data.  
	# We're using Perl for "search and replace" functions here.
	# General expression is $newvariable =~ s/ <search item> / <replace item>/g
	# You will need to "escape" special characters so Perl doesn't interpret them literally.
	#  Example: \n = \\n  or \r = \r or , = \,  or : = \:

	$thisVar = $_[0];

	$thisVar =~ s/\\n/<BR>/g;
	$thisVar =~ s/\\r//g;
	$thisVar =~ s/\,/COMMA/g;
	$thisVar =~ s/\;/SEMICOLON /g;
	$thisVar =~ s/\:/COLON /g;
	$thisVar =~ s/\[/OPENBRACE /g;
	$thisVar =~ s/\]/CLOSEBRACE /g;

	return $thisVar;
}


sub passHidden {

	# This subroutine passes along all information (collected or not) in the form of hidden tags.  This allows the information to be carried from one page to the next, despite the fact that the relationship between the subject and the server is "stateless."  Instead of writing this out separately for each section of the code in which an item/stimulus is presented, we place the code in a subroutine and call this subroutine at each step along the way.  
	# To customize: Create a hidden tag for each response in question.  In the example, we have reponses to 5 self-esteem questions and some demographic items.

	# Note: An array cannot be passed forward via a hidden tag using the common sense way of HTML. Instead, you must use a cgi.pm expression
	#    Will NOT work: print "<INPUT TYPE='hidden' NAME=varlistRandom VALUE=@varlistRandom>";
	#    Will work: print $query->hidden('varlistRandom',@varlistRandom);

	print $query->hidden('varlistRandom',@varlistRandom);
	print "<INPUT TYPE='hidden' NAME=v01 VALUE=$v01>";
	print "<INPUT TYPE='hidden' NAME=v02 VALUE=$v02>";
	print "<INPUT TYPE='hidden' NAME=v03 VALUE=$v03>";
	print "<INPUT TYPE='hidden' NAME=v04 VALUE=$v04>";
	print "<INPUT TYPE='hidden' NAME=v05 VALUE=$v05>";
	print "<INPUT TYPE='hidden' NAME=pass VALUE=$pass>";

	print "<INPUT TYPE='hidden' NAME=age VALUE=$age>";
	print "<INPUT TYPE='hidden' NAME=ethnicity VALUE=$ethnicity>";
	print "<INPUT TYPE='hidden' NAME=box1 VALUE=$box1>";
	print "<INPUT TYPE='hidden' NAME=box2 VALUE=$box2>";
	print "<INPUT TYPE='hidden' NAME=box3 VALUE=$box3>";
	print "<INPUT TYPE='hidden' NAME=box4 VALUE=$box4>";
	print $query->hidden('comments',$comments);

}