#!C:/perl/bin/perl.exe
use CGI::Carp qw(fatalsToBrowser);
use CGI;
$query = new CGI;
# Read in the variables
$pass= $query->param('pass');
$pin= $query->param('pin');
$password= $query->param('password');
$r0= $query->param('r0');
$r1= $query->param('r1');
$r2= $query->param('r2');
$r3= $query->param('r3');
$r4= $query->param('r4');
$r5= $query->param('r5');
$FNL= $query->param('FNL');
$Castle= $query->param('Castle');
$Modfam= $query->param('Modfam');
@itemIndex= $query->param('itemIndex');
print $query->header;
print $query->start_html(-title=>'Login');
print " \n\n";
#-----------------------------------
# Check login status
#-----------------------------------
# Open the txt file containing the usernames and passwords and dump those data to
# @passdata
open(INFO, "$ENV{'DOCUMENT_ROOT_OLD'}/www/relationshipsresearch.com/P593/data/userlist.txt");
@passdata = ;
close(INFO);
# Sort through each line of @passdata until we find a match between both the username and password
# If a match is found, change the value of $match to 1. It is set to 0 by default.
$match = 0;
foreach $key (@passdata){
@a=split(/,/,$key);
if($a[0] eq $pin && $a[1] eq $password){
$match=1;
}
}
# If no match was found, provide an error msg.
if($match !=1){
print "We cannot find a record of either that user name ($pin) or password.
";
print "If you think you may have made a typo, please click your browser's Back button and try again.
";
}
# If the username/password match those stored on the master list on the server,
# move forward and present the survey and do other things.
if($match == 1){
# Set pass = 0
if($pass < 1){
$pass = 0;
}
#-----------
# pass = 1
#-----------
if($pass == 1){
print "";
#-----------
# pass = 0
#-----------
if($pass == 0){
print "";
} # end pass = 0
} # end match == 1
#----------------------
# SUBROUTINES
#----------------------
#-----------------------
# passHidden Subroutine
#-----------------------
sub passHidden {
print $query->hidden(itemIndex, @itemIndex);
print "";
print "";
print "";
print "";
print "";
print "";
print "";
print "";
print "";
print "";
print "";
print "";
}
#-----------------------
# randomize Subroutine
#-----------------------
sub randomize {
# this subroutine randomizes the elements of an array and returns the new array
srand;
my(@new) = ();
while (@_){
push(@new, splice(@_, rand @_,1));
}
return @new;
}
#-----------------------
# printLikert5 Subroutine
#-----------------------
sub printLikert5 {
# Subroutine by Jenn Smith
print " Strongly Disagree \n
Disagree \n
Neutral \n
Agree \n
Strongly Agree
\n\n";
}
#-----------------------
# averageScores Subroutine
#-----------------------
sub averageScores {
# sub for averaging scores and adjusting denom for missing cases
# fraley march 26 2005
# returns 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;
} # end sub
print $query->end_html;