#!/usr/bin/perl -w
######################################################################
# $Id$
#
# Package:    identify.cgi 
# Author:     Nicholas Studt <nstudt@angrydwarf.org>
#
# Description:
#
#
#
######################################################################
use strict;
use CGI qw(:standard);

############################################################
# Variables                                                #
############################################################
my $BASEDIR			= "/home/learningstyle.com/html/secure";
#my $BASEDIR 		= "/home/sites/site29/web/secure"; # old    
#my $BASEDIR 		= '/home/httpd/html/learningstyle/secure'; # Testing 
my $RESPONSEDATA	= 'data/orders.dat';
my $QUESTIONDATA 	= 'questions/LANG/identify.dat';
my $AREASDATA 		= 'questions/LANG/areas.dat';
my $LETTERDATA 		= 'questions/LANG/answers.dat';
my $LANGDATA 		= 'questions/LANG/static.dat';
my $LANG;

my %Cmds = (	'question'	=> \&do_question,
				'billing'	=> \&do_billing,
				'last'		=> \&do_last,
				'main'		=> \&do_first,
				'report'	=> \&do_report, 
				'resend'	=> \&do_resend );

############################################################
# Functions                                                #
############################################################

#-------------------------------------------------
# get_answers
#-------------------------------------------------
#
#-------------------------------------------------
sub get_answers {

	if ( ! open ( ANSWERS, "$BASEDIR/$AREASDATA" ) ) {
		die "Can't open $BASEDIR/$AREASDATA";
	}
	
	my $question = "0";
	my %answers = ();

	while ( defined ( my $line = <ANSWERS> ) ) {

		if ( $line =~ /^---\s\d+:.\s---/ ) {
			$line =~ s/---//g;
			$line =~ s/\s//g;
			$question = $line;
		}
		else {
			if ( $line =~ /^\s?short:/i ) {
				($answers{$question}{defn} .= $line ) =~ s/short:\s?//i
			}
			else {
				$answers{$question}{text} .= $line;
			}
		}
	}

	close ( ANSWERS );
	return ( \%answers );
} # END get_answers

#-------------------------------------------------
# get_questions
#-------------------------------------------------
#
#-------------------------------------------------
sub get_questions {

	if ( ! open( QUESTIONS, "$BASEDIR/$QUESTIONDATA" ) ) {
		die "Can't open $BASEDIR/$QUESTIONDATA";
	}

	my ( $question, $count, %info ) = ( 0, 0 );

	while ( defined( my $line = <QUESTIONS> ) ) {
		next if ( $line =~ /^\s+$/ );

		$line =~ s/\r//g;

		chomp( $line );

		if ( $line =~ /^---\s\d+:.\s---/ ) {
			$line =~ s/---//g;

			( $question = $line ) =~ s/\s//g;

			$count++ if ( $line =~ /\d+:L/ );
		}
		else {
			if ( $line =~ /^\s?picture:/i ) {
				( $info{$question}{img} .= $line ) =~ s/picture:\s?//i;
			}
			else {
				$info{$question}{text} .= $line;
			}
		}
	}

	close( QUESTIONS );

	return( $count, \%info );
} # END get_questions

#-------------------------------------------------
# get_form
#-------------------------------------------------
#
#-------------------------------------------------
sub get_form {
	if ( ! open ( FORM, "$BASEDIR/$LETTERDATA" ) ) {
		die "Can't open $BASEDIR/$LETTERDATA";
	}

	my ( $top,  @header, @footer ) = ( 1 );

	while ( defined ( my $line = <FORM> ) ) {
		chomp ( $line );

		( $top, $line ) = ( 0, "" ) if ( $line =~ /^--- SPLIT ---/ );

		if ( $top ) {
			push( @header, $line );
		}
		else {
			push( @footer, $line );
		}
	}
	close ( FORM );

	return( join( "\n", @header ), join( "\n", @footer ) );
} # END get_form

#-------------------------------------------------
# get_lang
#-------------------------------------------------
#
#-------------------------------------------------
sub get_lang {

	if ( ! open ( LANG, "$BASEDIR/$LANGDATA" ) ) {
		die "Can't open $BASEDIR/$LANGDATA";
	}
	
	my $entry 	= '~';
	my %lang 	= ();

	while ( defined ( my $line = <LANG> ) ) {
		if ( $line =~ /^---\s\w+\s---/ ) {
			$line =~ s/---//g;
			$line =~ s/\s//g;
			$entry = $line;
		}
		else {
			$lang{$entry} .= $line;
		}
	}

	close ( LANG );
	return( \%lang );
} # END get_lang

#-------------------------------------------------
# find_action
#-------------------------------------------------
#
#-------------------------------------------------
sub find_action {
	my $in = shift;

	return( 'report' ) if ( $$in{action} eq 'report' );
	return( 'resend' ) if ( $$in{action} eq 'resend' );

	if ( ( $$in{question} == 0 ) || ( ( ! defined ( $$in{name} ) ) && 
		 ( $$in{question} == 1 ) ) )
	{ 
		return( 'main' );	
	} 
	elsif ( ( $$in{question} eq ( $$in{size} + 1 ) ) && 
			( defined( $$in{creditcardnum} ) ) && 
			( $$in{creditcardnum} ne '' ) &&
			( $$in{creditcardnum} =~ /^[0-9\-\ ]{6,40}$/ ) &&

			( $$in{expdate} ne '' ) && ( $$in{nameoncard} ne '' ) && 
			( $$in{phone} ne '' ) && ( $$in{billingaddy} ne '' ) && 
			( $$in{signed} ne '' ) ) 
	{
		return( 'last' );
	} 
	elsif ( $$in{question} ==  ( $$in{size} + 1 ) ) {
		return( 'billing' );
	} 
	else {
		return( 'question' );
	}
} # END find_action

#-------------------------------------------------
# do_question( $in )
#-------------------------------------------------
#  
#-------------------------------------------------
sub do_question {
	my $in = shift;

	my $quest 	= get_questions();
	my $q 		= $$in{question};
	my $blank 	= q!<IMG SRC='/icons/blank.gif' WIDTH=1 HEIGHT=1 ALT=''>!;

	my@txt=(qq!<FORM ACTION="$ENV{SCRIPT_NAME}" METHOD="POST">!,
			qq!<INPUT TYPE=HIDDEN VALUE="$$in{past}" NAME=past>!,
			qq!<INPUT TYPE=HIDDEN VALUE="$$in{LANG}" NAME=LANG>!,
			q!<TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0 ALIGN=CENTER>!,
			q!<TR HEIGHT=1><TD HEIGHT=1 BGCOLOR=BLACK COLSPAN=3>!,
			qq!$blank</TD>!,
			qq!<TD></TD><TD HEIGHT=1 BGCOLOR=BLACK COLSPAN=3>$blank</TD>!,
			qq!</TR><TR><TD WIDTH=1 BGCOLOR=BLACK ROWSPAN=4>$blank</TD>!,
			q!<TD ALIGN=CENTER><BR>!,
			qq!<IMG SRC="../images/$$quest{"$q:L"}{img}" WIDTH=150 !,
			q! HEIGHT=150 HSPACE=20><BR></TD>!,
			qq!<TD WIDTH=1 BGCOLOR=BLACK ROWSPAN=4> $blank</TD>!,
			q!<TD><IMG SRC="/icons/blank.gif" WIDTH=60 HEIGHT=1 !,
			qq! ALT=""><BR>!,
			qq!</TD><TD WIDTH=1 BGCOLOR=BLACK ROWSPAN=4>$blank</TD>!,
			q! <TD ALIGN=CENTER><BR>!,
			qq!<IMG SRC="../images/$$quest{"$q:R"}{img}" WIDTH=150 HEIGHT=150 !,
			q! HSPACE=20><BR>!,
			qq!</TD><TD WIDTH=1 BGCOLOR=BLACK ROWSPAN=4>$blank</TD>!,
			q! </TR><TR><TD ALIGN=CENTER><FONT SIZE=3 !,
			q! FACE="Helvetica, Arial"> !,
			q!<INPUT TYPE=RADIO NAME=answer VALUE="1"></TD>!,
			q!<TD ALIGN=CENTER> !, 
			q!<FONT SIZE=3 FACE="Helvetica, Arial">!,
			q!<INPUT TYPE=RADIO NAME=answer VALUE="2"></TD>!,
			q!<TD ALIGN=CENTER>!,
			q!<FONT SIZE=3 FACE="Helvetica, Arial">!,
			q!<INPUT TYPE=RADIO NAME=answer VALUE="3"></TD></TR><TR>!,
			q!<TD ALIGN=CENTER>!,
			q!<P><FONT SIZE=3 FACE="Helvetica, Arial">!,
			$$quest{"$q:L"}{text},
			q!</P><BR>!,
			q!</TD><TD ALIGN=CENTER>!,
			q!<P><FONT SIZE=3 FACE="Helvetica, Arial">!,
			$$LANG{onenotimportant},
			q!</P><BR>!,
			q!</TD><TD ALIGN=CENTER>!,
			q!<P><FONT SIZE=3 FACE="Helvetica, Arial">!,
			$$quest{"$q:R"}{text},
			q!</P><BR>!,
			q!</TD></TR><TR HEIGHT=1><TD HEIGHT=1 !,
			qq!BGCOLOR=BLACK>$blank</TD>!,
			qq!<TD></TD><TD HEIGHT=1 BGCOLOR=BLACK>$blank</TD>!,
			q!</TR><TR><TD COLSPAN=7>!,
			q!<FONT SIZE=3 FACE="Helvetica, Arial"><BR><P>!,
			$$quest{"$q:C"}{text},
			q!</P></TD></TR><TR><TD COLSPAN=7 ALIGN=CENTER>!,
			q!<FONT SIZE=3 FACE="Helvetica, Arial"> ! );

	if ( $$in{question} == $$in{size} ) {
		my $new = $$in{question} + 1;
		push( @txt,	q!<INPUT TYPE=SUBMIT NAME="back" VALUE="Back">!,
					qq!<INPUT TYPE=HIDDEN VALUE="$new" NAME=question>!,
					qq!<INPUT TYPE=SUBMIT VALUE="$$LANG{finish}">! );
	} 
	else {
		my $new = $$in{question} + 1;
		push( @txt,	qq!<INPUT TYPE=HIDDEN VALUE="$new" NAME=question>!,
					qq!<INPUT TYPE=SUBMIT NAME="back" VALUE="$$LANG{back}">!,
					qq!<INPUT TYPE=SUBMIT NAME="forward" VALUE="$$LANG{next}">!
					);
	}

	return( @txt, '<!-- </TD></TR>--></TABLE></CENTER></FORM>' );
} # END do_question

#-------------------------------------------------
# do_billing( $in )
#-------------------------------------------------
#  
#-------------------------------------------------
sub do_billing {
	my $in = shift;

	return( qq!<FORM ACTION="$ENV{SCRIPT_NAME}" METHOD="post">!,
			qq!<INPUT TYPE=HIDDEN VALUE="$$in{past}" NAME=past>!,
			qq!<INPUT TYPE=HIDDEN VALUE="$$in{question}" NAME=question>!,
			qq!<TABLE BORDER=0 WIDTH=80% COLS=2>!,
			qq!<TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{creditcard},
			qq!</TD><TD>!,
				qq!<INPUT TYPE=TEXT SIZE=20 NAME='creditCardNum'>!,
			qq!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR='lightblue'>!,
				$$LANG{cardtype},
			q!</TD><TD>!,
				q!<SELECT NAME="creditCardType">!,
					q!<OPTION VALUE="Master">Master!,
					q!<OPTION VALUE="VISA">VISA!,
					q!<OPTION VALUE="Discover">Discover!,
					q!<OPTION VALUE="American Express">American Express!,
				q!</SELECT>!,
			q!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{expdate},
			q!</TD><TD>!,
				q!<INPUT TYPE=TEXT SIZE=20 NAME=expDate>!,
			q!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{nameoncard},
			q!</TD><TD>!,
				q!<INPUT TYPE=TEXT SIZE=20 NAME=nameOnCard>!,
			q!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{email},
			q!</TD><tD COLSPAN=3>!,
				q!<INPUT TYPE=TEXT SIZE=40 NAME=email>!,
			q!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{resultsby},
			q!</TD><TD COLSPAN=3>!,
				q!<INPUT TYPE=hidden NAME="results_by" VALUE="Email">!,
				$$LANG{email},
			q!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{phonenumber},
			q!</TD><TD>!,
				q!<INPUT TYPE=TEXT SIZE=20 NAME=phoneNo>!,
			q!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{faxnumber},
			q!</TD><TD>!,
				q!<INPUT TYPE=TEXT SIZE=20 NAME=faxNo>!,
			q!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{address},
			q!</TD><TD>!,
				q!<TEXTAREA ROWS=5 COLS=30 NAME=billingAddress !,
				q! WRAP=VIRTUAL></TEXTAREA>!,
			q!</TD></TR><TR><TD ALIGN=RIGHT BGCOLOR=lightblue>!,
				$$LANG{name},
			q!</TD><TD>!,
				q!<INPUT TYPE=TEXT SIZE=30 NAME=signed>!,
			q!</TD></TR><TR><TD COLSPAN=2 ALIGN=CENTER>!,
				qq!<INPUT TYPE=SUBMIT VALUE="$$LANG{submit}">!,
				qq!<INPUT TYPE=SUBMIT VALUE="$$LANG{clear}">!,
			q!</TD></TR></TABLE></CENTER></FORM>! );
} # END do_billing

#-------------------------------------------------
# do_last( $in )
#-------------------------------------------------
#  
#-------------------------------------------------
sub do_last {
	my $in = shift;
	
	( my $data = $$in{past} ) =~ s/\^/&nbsp;/g;
	my @results 		= split( ':', $data );
	my $orderid 		= $$in{order_id} =  time();
	$$in{past} 		=~ s/ /+/g;
	$$in{past} 		=~ s/:2$//;
	$$in{billingaddy} 	=~ s/\r//g;
	$$in{billingaddy} 	=~ s/\n/<Br>/g;

	if ( open ( OUTFILE, ">>$BASEDIR/$RESPONSEDATA" ) ) {
		print OUTFILE "--- $orderid ---\n";
		print OUTFILE "Type: TEST\n";
		print OUTFILE "Date_Submited: " . localtime( $orderid ) . "\n";
		print OUTFILE "Creditcard: $$in{creditcardnum}\n";
		print OUTFILE "CardType: $$in{creditcardtype}\n";
		print OUTFILE "ExpDate: $$in{expdate}\n";
		print OUTFILE "Nameoncard: $$in{nameoncard}\n";
		print OUTFILE "Email: $$in{email}\n";
		print OUTFILE "ResultsBy: $$in{results_by}\n";
		print OUTFILE "Phone: $$in{phone}\n";
		print OUTFILE "Fax: $$in{fax}\n";
		print OUTFILE "Address: $$in{billingaddy}\n";
		print OUTFILE "Name: $$in{signed}\n";
		print OUTFILE "Answers: $$in{past}\n";

		close ( OUTFILE );
	}
	else {
		return( "Can't open order file." );
	}

	email_report( $$in{email}, $orderid, make_report( $in ) );

	return( q!<TABLE><TR><TD>!,
			q!<FONT SIZE=3 FACE="Helvetica, Arial">!,
			qq!<P>$$LANG{pleaseprint}</P>!,
			qq!<P>$$LANG{date}: !. localtime( $orderid ). q!<BR>!,
			qq!$$LANG{yourordernumber}: $orderid!,
			qq!<bR>For: $results[0]</P>!,
			$$LANG{returnaddress},
			qq!<P>$$LANG{thankyou}<P>!,
			qq!<B>$$LANG{yourreportmail} "$$in{email}".</B>!,
			q!<BR>!,
			qq!<A HREF="../content.html"> $$LANG{returntosite} </A>!,
			q!</TD></TR></TABLE></CENTER> ! );
	
} # END do_last

#-------------------------------------------------
# do_report( $in )
#-------------------------------------------------
#
#-------------------------------------------------
sub do_report {
	my $in = shift;

	return ( "Access Denied." ) if ( ! defined( $ENV{REMOTE_USER} ) );

	my $data 		= $$in{past};
	$data 			=~ s/\^/&nbsp;/g;
	my @all 		= split( ':', $data );

	$$in{order_id} 	= param( 'id' ); 

	return( make_report ( $in ) );	

} # END do_report

#-------------------------------------------------
# do_resend 
#-------------------------------------------------
#-------------------------------------------------
sub do_resend {
	my $in = shift;

	return ( "Access Denied." ) if ( ! defined( $ENV{REMOTE_USER} ) );

	my $data 		= $$in{past};
	$data 			=~ s/\^/&nbsp;/g;
	my @all 		= split( ':', $data );
	$$in{order_id} 	= param( 'id' ); 

	email_report( $$in{email}, $$in{order_id}, make_report( $in ) );

	return( "Report Sent to: $$in{email}" );
}

#-------------------------------------------------
# email_report( $email, $orderid, $report_text )
#-------------------------------------------------
#
#-------------------------------------------------
sub email_report {
	my ( $email, $orderid, $report ) = @_;

	die "Can't send email, no address" if ( ! defined $email );
	die "Can't send email to: $email" if ( $email !~ /.*\@.*/ );

	if ( ! open(SENDMAIL, '|/usr/sbin/sendmail -oi -t' ) ) {
		die "Can't send email to: $email";
	}

	print SENDMAIL "From: Price Systems <learn\@learningstyle.com>\n";
	print SENDMAIL "To: $email\n";
	print SENDMAIL "Subject: Your learning style report ($orderid).\n";
	print SENDMAIL "Mime-Version: 1.0\n";
	print SENDMAIL qq!Content-Type: multipart/mixed; boundary="yrj/dFKFPuw6o+aM"\n!;
	print SENDMAIL "\n\n";
	print SENDMAIL "--yrj/dFKFPuw6o+aM\n";
	print SENDMAIL "Content-Type: text/plain; charset=us-ascii\n";
	print SENDMAIL "Content-Disposition: inline\n\n";
	print SENDMAIL "Your report is attached.\n\n";
	print SENDMAIL "--yrj/dFKFPuw6o+aM\n";
	print SENDMAIL "Content-Type: text/html; charset=us-ascii\n";
	print SENDMAIL q!Content-Disposition: attachment; filename="report.html"!;

	print SENDMAIL "\n\n$report";
	print SENDMAIL "\n--yrj/dFKFPuw6o+aM\n";
	
	close(SENDMAIL); 

	return();
} # END email_report

#-------------------------------------------------
# make_report( $in )
#-------------------------------------------------
#
#-------------------------------------------------
sub make_report {
	my $in = shift;

	my $today 			= localtime();
	my( $top, $bottom ) = get_form();
	$$in{past} 			=~ s/\^/&nbsp;/g;
	my @all 			= split( ':', $$in{past} );
	my $answers 		= get_answers();

	my( $name, $grade, $sex, $age ) = 
		( shift( @all ), shift( @all ), shift( @all ), shift( @all ) );

	$name =~ s/\+/ /g;
	

	my @lines=( q!<CENTER>LEARNING STYLE REPORT (LSR)<BR>!,
				q!Copyright 1982,1987,1990,1993<BR>!,
				q!-  LEARNING STYLE REPORT - WEB -<BR>INDIVIDUAL PROFILE<BR>!,
				q!<TABLE BORDER=1 WIDTH="80%">!,
				qq!<TR><TD>Name: $name</TD><TD COLSPAN=2>&nbsp;</TD></TR>!,
				qq!<TR><TD>ID. NO.: $$in{order_id}</TD>!,
				qq!<TD COLSPAN=2 ALIGN=RIGHT>Date: $today</TD><TR>!,
				qq!<TR><TD>Sex: $sex</TD><TD>Grade: $grade</TD>!,
				qq!<TD>Age: $age</TD></TR></TABLE><BR>!, 
						
				q!<TABLE BORDER=1 WIDTH="80%">!,
				q!<TR><TD COLSPAN=23 ALIGN=CENTER>Scale</TD></TR>!,
				q!<TR><TD>Score:</TD>! );
				
	for ( my $i = 1; $i < $$in{size} + 1; $i++ ) {
		push( @lines, qq!<TD>$i</TD>! );
	}

	push( @lines, q!</TR><TR><TD>Raw:</TD>! );
				
	for ( my $i = 0; $i < $$in{size} ; $i++ ) {
		push( @lines, qq!<TD>$all[$i]</TD>! );
	}

	push( @lines, 	q!</TR></TABLE><BR>!,	
					q!<TABLE BORDER=1 WIDTH="80%">!,
					q!<TR><TD ALIGN=CENTER COLSPAN=5>Prefrence Summary!,
					q!</TD></TR><TR><TD ALIGN=RIGHT>20</TD>!,
					q!<TD ALIGN=CENTER>30</TD><TD ALIGN=CENTER>50</TD>!,
					q!<TD ALIGN=CENTER>70</TD><TD ALIGN=LEFT>80</TD></TR>! );

	for ( my( $i, $j) = ( 0, 1 ); $i < $$in{size} ; $i++, $j++ ) {
		my $low 	= ( $all[$i] eq '1' );
		my $mid		= ( $all[$i] eq '2' ); 
		my $high	= ( $all[$i] eq '3' ); 

		push( @lines, 	qq!<TR><TD>$j</TD><TD ALIGN=CENTER>!,
						
						( $low ? '<B>' : '' ),
							$$answers{"$j:L"}{defn},
						( $low ? "</B>" : "" ),

						qq!</TD><TD ALIGN=CENTER>!,
						
						( $mid ? '<B>' : '' ),
							$$answers{"$j:M"}{defn},
						( $mid ? '</B>' : '' ),

						qq!</TD><TD ALIGN=CENTER>!,
						
						( $high ? '<B>' : '' ),
							$$answers{"$j:H"}{defn},
						( $high ? '</B>' : '' ),

						qq!</TD><TD ALIGN=RIGHT>$j</TD></TR> !);
	}

	push( @lines, 	q!<TR><TD ALIGN=RIGHT>20</TD><TD ALIGN=CENTER>30</TD>!,
					q!<TD ALIGN=CENTER>50</TD><TD ALIGN=CENTER>70</TD>!,
					q!<TD ALIGN=LEFT>80</TD></TR></TABLE>!,
					q!<P>Price Systems,Inc., 763 N 1750 Rd., Lawrence, Ks.!,
					q!66049 - Phone 785-843-7892</P></CENTER> !,
					$top	);

	for ( my $i = 1; $i < ( $$in{size} + 1 ) ; $i++ ) {
		if ( $all[$i - 1] < 2 ) {
			push( @lines, qq!<P>$$answers{"$i:L"}{text}</P>! );
		}
		elsif ( $all[$i - 1] > 2 ) {
			push( @lines, qq!<P>$$answers{"$i:H"}{text}</P>! );
		}
	}

	return( join( "\n", @lines, $bottom ) );
} # END make_report

#-------------------------------------------------
# do_first( $in )
#-------------------------------------------------
#  
#-------------------------------------------------
sub do_first {
	my $in = shift;

	return( q!<CENTER>!,
			qq!<FORM METHOD=POST ACTION="$ENV{SCRIPT_NAME}">!,
			qq!<INPUT TYPE=HIDDEN VALUE="$$in{LANG}" NAME=LANG>!,
			q!<TABLE BORDER=0 ALIGN=CENTER>!,
			q!<TR><TD>!,
				q!<FONT SIZE=3 FACE="Helvetica, Arial"><B>Name:</B>!,
			q!</TD><TD>!,
				q!<FONT SIZE=3 FACE="Helvetica, Arial">!,
				q!<INPUT TYPE=TEXT SIZE=20 NAME=name MAXLENGTH=20>!,
			q!</TD></TR><TR><TD>!,
				q!<FONT SIZE=3 FACE="Helvetica, Arial"><B>Your gender:</B>!,
			q!</TD><TD ALIGN=LEFT>!,
				q!<FONT SIZE=3 FACE="Helvetica, Arial">!,
				q!<INPUT TYPE=RADIO NAME=gen VALUE="M">Male!,
				q!&nbsp;&nbsp;&nbsp;!,
				q!<INPUT TYPE=RADIO NAME=gen VALUE="F">Female!,
			q!</TD></TR><TR><TD>!,
				q!<FONT SIZE=3 FACE="Helvetica, Arial"><B>Grade:</B>!,
			q!</TD><TD>!,
				q!<FONT SIZE=3 FACE="Helvetica, Arial">!,
				q!<INPUT TYPE=TEXT SIZE=2 NAME=grade MAXLENGTH=2>!,
			q!</TD></TR><TR><TD>!,
				q!<FONT SIZE=3 FACE="Helvetica, Arial">!,
				q!<B>Your age:</B>!,
			q!</TD><TD>!,
				q!<FONT SIZE=3 FACE="Helvetica, Arial">!,
				q!<INPUT TYPE=TEXT NAME=age SIZE=2 MAXLENGTH=2>!,
			q!</TD></TR><TR><TD COLSPAN=2 ALIGN=CENTER>!,
				q!<INPUT TYPE=HIDDEN NAME=question VALUE=1>!,
				q!<INPUT TYPE=SUBMIT VALUE="Next">!,
			q!</TD></TR></TABLE></FORM>! );
} # END do_first

#-------------------------------------------------
# do_prep( )
#-------------------------------------------------
#  
#-------------------------------------------------
sub do_prep {

	my %in = ();

	
	# GET the right language.
	$in{LANG} 		= param('LANG') || 'en';
	$QUESTIONDATA 	=~ s/LANG/$in{LANG}/;
	$AREASDATA		=~ s/LANG/$in{LANG}/;
	$LETTERDATA		=~ s/LANG/$in{LANG}/;
	$LANGDATA		=~ s/LANG/$in{LANG}/;
	$LANG 			= get_lang();

	( $in{size}, $in{info_ref} ) = get_questions();

	$in{question} 	= param('question') || 0;
	$in{action} 	= param('action') || param('back') || 
					  param('forward') || 'main';

	$in{past} 		= param('past') || '';
	$in{answer} 	= param('answer') || 2;
	$in{name} 		= param('name');
	$in{grade} 		= param('grade');
	$in{age} 		= param("age");
	$in{gen} 		= param("gen");

	# stuff from the final order form.
	$in{creditcardnum} 	= param('creditCardNum');
	$in{creditcardtype} = param('creditCardType');
	$in{expdate} 		= param('expDate');
	$in{nameoncard} 	= param('nameOnCard');
	$in{email} 			= param('email');
	$in{phone} 			= param('phoneNo');
	$in{fax} 			= param('faxNo');
	$in{billingaddy} 	= param('billingAddress');
	$in{shippingaddy} 	= param('shippingAddress'); 
	$in{signed} 		= param('signed');
	$in{results_by} 	= param('results_by');

	# THIS IS PREP FOR ALL.
	return ( \%in ) if ( $in{action} eq 'first' || $in{action} eq 'report' );

	if ( $in{action} eq 'Back' ) {
		$in{question} -= 2;
		my @all = split( ':', $in{past} );
		pop( @all );
		$in{past} = join( ':', @all );
	}
	elsif ( $in{question} eq '1' )  {
		$in{name} .= ( length( $in{name} ) < 20) ? 
					 '^' x ( 20 - length( $in{name} ) ) : '';
		$in{age} .= ( length( $in{age} ) < 2) ? 
					 '^' x ( 2 - length( $in{age} ) ) : '';
		$in{grade} .= ( length( $in{grade} ) < 2) ? 
					  '^' x ( 2 - length( $in{grade} ) ) : '';
		$in{gen} 	= '' if ( ! defined $in{gen} );
		$in{past} = "$in{name}:$in{grade}:$in{gen}:$in{age}";
	} 
	else {
		$in{past} = "$in{past}:$in{answer}";
	}

	return( \%in );
} #  do_prep 

######################################################################
# Main Execution Begins Here                                         #
######################################################################
{
	my @txt;

	eval {
		my $in 		= do_prep(); 
		my $action 	= find_action( $in ); 

		if ( my $function = $Cmds{$action} ) {
			push( @txt, &$function( $in ) );
		}
		else {
			push( @txt, '<B>Page does not exist</B>' );
		}
	};

	push( @txt, "<B>Error:</B><BR> $@" ) if ( $@ );

	eval {
		print 	header(),
				q!<HTML><HEAD><TITLE>Learning Survey</TITLE></HEAD>!,
				q!<BODY BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0000FF" !,
				q! ALINK="#0000FF">!,
				join( "\n", @txt ),
			  	q!</BODY></HTML>!;
	};

	print ( "Printing Error: $@" ) if ( $@ );

} # END main

# EOF
1;