#!/usr/bin/perl
#  Copyright 2001-2021 Leslie Richardson

#  This file is part of Open Admin for Schools.

#  Open Admin for Schools is free software; you can redistribute it 
#  and/or modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2 of 
#  the License, or (at your option) any later version.

my %lex = ('Main' => 'Main',
	   'Enrol' => 'Enrol',
	   'Student' => 'Student',
	   'No Student(s) Found' => 'No Student(s) Found',
	   'Name' => 'Name',
	   'Last' => 'Last',
	   'First' => 'First',
	   'Birthdate' => 'Birthdate',
	   'Treaty' => 'Treaty',
	   'Number' => 'Number',
	   'Continue' => 'Continue',
	   'Optional' => 'Optional',
	   'Provincial' => 'Provincial',
	   'Education' => 'Education',
	   'yymmdd' => 'yymmdd',
	   'or' => 'or',
	   'yyyy-mm-dd' => 'yyyy-mm-dd',
	   'Missing' => 'Missing',
	   'ProvNum' => 'ProvNum',
	   'Contact' => 'Contact',
	   'Error' => 'Error',
	   'Name' => 'Name',
	   'Birthdate' => 'Birthdate',
	   'Grade' => 'Grade',
	   'Homeroom' => 'Homeroom',
	   'Province' => 'Province',
	   'Country' => 'Country',
	   'Description' => 'Description',
	   'Reason' => 'Reason',
	   'Code' => 'Code',
	   'Transfer' => 'Transfer',
	   'Date' => 'Date',
	   'Yes' => 'Yes',
	   'Delete' => 'Delete',
	   'Insert' => 'Insert',
	   'Source' => 'Source',
	   'Withdrawn' => 'Withdrawn',
	   'New Student' => 'New Student',
	   'Entry' => 'Entry',
	   'Waiting List' => 'Waiting List',
	   'Pre-Registration' => 'Pre-Registration',
	   'Clone' => 'Clone',
	   'Last,First/Last/Initials/Studnum' => 'Last,First/Last/Initials/Studnum',
	   'Other' => 'Other',
	   'School' => 'School',
	   'Cannot open' => 'Cannot open',
	   'Template' => 'Template',
	   'Waiting List' => 'Waiting List',
	   'Pre-Registration' => 'Pre-Registration',
	   'Required' => 'Required',
	   'Fields' => 'Fields',
	   'Student Number' => 'Student Number',
	   'Exists' => 'Exists',
	   'Add' => 'Add',
	   'Bold' => 'Bold',
	   'Enrollment' => 'Enrollment',
	   'Export' => 'Export',
	   'Next Field' => 'Next Field',
	   'Previous Field' => 'Previous Field',
	   'Record(s) Stored' => 'Record(s) Stored',
	   'Required Field' => 'Required Field',
	   'Tab Key' => 'Tab Key',
	   'Shift+Tab' => 'Shift+Tab',
	   'Table' => 'Table',
	   'Initial Enrollment' => 'Initial Enrollment',
	   'Space Bar' => 'Space Bar',
	   'Select' => 'Select',
	   'Record' => 'Record',
	   'Save' => 'Save',
	   'Current' => 'Current',
	   'Students' => 'Students',
	   'Enrolled' => 'Enrolled',
	   'Duplicate Check' => 'Duplicate Check',
	   'Edit' => 'Edit'

	   );

use DBI;
use CGI;
use Fcntl qw(:DEFAULT :flock);
use Data::Password qw(:all);  # for password checking...
use Crypt::GeneratePassword qw(:all); # password generation.

my $self = 'enrol.pl';


my $q = new CGI;
print $q->header( -charset, $charset ); 
my %arr = $q->Vars;


eval require "../../etc/admin.conf";
if ( $@ ) {
    print $lex{Error}. ": $@<br>\n";
    die $lex{Error}. ": $@\n";
}

if ( not -e "$globdir/global.conf" ) {
    print $lex{'Cannot open'}. " global.conf file!";
    print "</body></html>\n";
    die;
}


# Read database names and also the global enrol/withdraw reasons.
eval { require "$globdir/global.conf"; };
if ( $@ ) {
    print "<h3>". $lex{'Cannot open'}. " global.conf:\n $@</h3>\n";
    die $lex{'Cannot open'}. " global.conf: $@\n";
}


my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
$dbh->{mysql_enable_utf8} = 1;


# Page Header.
print qq{$doctype\n<html><head><title>$lex{Enrol} $lex{Student}</title>
<link rel="stylesheet" href="$css" type="text/css">\n};

if ( $arr{page} == 2 ) { # calendar popup.
    print qq{<link rel="stylesheet" type="text/css" media="all" };
    print qq{href="/js/calendar-blue.css" title="blue">\n};
    print qq{<script type="text/javascript" src="/js/calendar.js"></script>\n};
    print qq{<script type="text/javascript" src="/js/lang/calendar-en.js"></script>\n};
    print qq{<script type="text/javascript" src="/js/calendar-setup.js"></script>\n};
}

if ( $arr{page} == 4 ) { # load jQuery
    print qq{<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.7.2/jquery.min.js"></script>\n};
}

# Set Focus to Last Name field.
print qq{$chartype\n</head>};
if ( not $arr{page} ) {
    print qq{<body onload="document.forms[0].elements[1].focus()">\n};
} else {
    print qq{<body>\n};
}


print qq{<div>[ <a href="$homepage">$lex{Main}</a> ]</div>\n};
print qq{<h1>$lex{Enrol} $lex{Student}</h1>\n};


if ( not $arr{page} ) {
    showStartPage();

} elsif ( $arr{page} == 1 ) {
    delete $arr{page};
    findStudent();

} elsif ( $arr{page} == 2 ) {
    delete $arr{page};
    confirmEnrol();

} elsif ( $arr{page} == 3 ) {
    delete $arr{page};
    enrolStudent();  # withdrawn student; end of script for previous student

} elsif ( $arr{page} == 4 ) {
    delete $arr{page};
    newStudent();

} elsif ( $arr{page} == 5 ) {
    delete $arr{page};
    saveNewStudent();
}


#-----------------
sub saveNewStudent { 
#-----------------

    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }

    if ( $arr{description} ) { # We have a description for the transfer
	$description = $arr{description};
    } else {
	$description = $lex{'Initial Enrollment'};
    }

    my $prereg = $arr{prereg};
    my $waitlist = $arr{waitlist};

    # Check for required fields
    my $sth = $dbh->prepare("select fieldid from meta 
       where tableid = 'student' and required != ''");
    $sth->execute;
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
    my ($requiredflag, @errorfld);
    while ( my $fieldid = $sth->fetchrow ) {
	if ( not $arr{$fieldid} ){
	    $requiredflag = 1;
	    push @errorfld,$fieldid;
	}
    }

    if ( $requiredflag ){ # we have missed some required fields
	print qq{<p style="font-size: 150%;font-weight:bold;">\n};
	print qq{$lex{Missing} $lex{Required} $lex{Fields}:<ul>\n};
	foreach my $fail ( @errorfld ){
	    print qq{<li>$fail</li>\n};
	}
	print qq{</ul></p>\n</body></html>\n};
	exit;
    }

    # Extract Any Medical Fields passed form
    my %medical; # medical{counter}{type} = value;
    foreach my $key ( keys %arr ) {
	my ($medval,$type,$counter) = split(':', $key);
	if ( $medval eq 'med') { # we have a medical field.
	    if ( $arr{$key} ) { # and we have a value!
		$medical{$counter}{$type} = $arr{$key};
	    }
	    delete $arr{$key}; # remove medical field from %arr hash.
	}
    } # done with medical field extraction.

    
    # update for any leading/trailing spaces in name, hsn, psn, and treaty.
    foreach my $field ( 'lastname', 'firstname', 'initial', 'treaty','provnum' ) {
	
	if ( $arr{$field} =~ m/^\s+/ ) { # leading spaces.
	    print qq{<div>Leading Space Found in $field. Removing.</div>\n};
	    $arr{$field} =~ s/^\s+//;
	    
	}
	
	if ( $arr{$field} =~ m/\s+$/ ) { # trailing spaces.
	    print qq{<div>Trailing Space Found in $field. Removing.</div>\n};
	    $arr{$field} =~ s/\s+$//;
	}
    }


    # Get Student number and update file.
    sysopen (SNUM, "../../etc/studentnumber", O_RDWR | O_CREAT) or 
	die "$lex{'Cannot open'} student number file\n";

    flock(SNUM,LOCK_EX);

    $studentnum = <SNUM> || 0;
    chomp $studentnum;
    seek(SNUM,0,0) or die "Cannot rewind student number file: $!\n";
    truncate(SNUM,0) or die "Cannot truncate student number file'}: $!\n";


    $newstudentnum = $studentnum + 1;
    print SNUM $newstudentnum or die "Cannot write to student number file: $!\n";
    close SNUM or die "Cannot close student number file: $! \n";


    # Check for duplicate student number
    $sth = $dbh->prepare("select count(*) from student where studnum = ?");
    $sth->execute( $studentnum );
    if ($DBI::errstr){ print $DBI::errstr; die "$DBI::errstr \n";}
    my $count = $sth->fetchrow;

    if ( $count ) { # we have an existing record with this studnum
	print qq{<h3>Duplicate Student Number. Contact Les Richardson</h3>\n};
	print qq{</body></html>\n};
	exit;
    }


    # Check for an existing student with same name and birthdate
    # (caused by a back button edit). Won't catch errors where name or
    # birthdate changed, of course.
    $sth = $dbh->prepare("select studid from student where lastname = ? and firstname = ? 
       and birthdate = ?");
    $sth->execute( $arr{lastname}, $arr{firstname}, $arr{birthdate} );
    if ($DBI::errstr){ print $DBI::errstr; die "$DBI::errstr \n";}
    my $studid = $sth->fetchrow;
    if ( $studid ) {
	print qq{<h3>$lex{Error} $lex{Student} $lex{Exists}: };
	print qq{$arr{firstname} $arr{lastname} ($arr{birthdate})</h3>};
	print qq{<form action="../studed.pl?id=$studid" method="post">\n};
	print qq{<input type="hidden" name="id" value="$studid">\n};
	print qq{<input type="submit" value="$lex{Edit} $arr{firstname} $arr{lastname}">\n};
	print qq{</form></body></html>\n};
	exit;
    }


    my $table;
    if ( $prereg or $waitlist ) {
	$table = "prereg";
    } else {
	$table = "student";
    }

    # Create array called "@fields" storing fieldid values.
    my @fields;
    $sth = $dbh->prepare("select fieldid from meta
      where tableid = 'student' order by arrayidx");
    $sth->execute;
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
    while (my $fld = $sth->fetchrow){
	push @fields,$fld;
    }


    # Add a Password ... (already set in previous sub)
    if ( not $arr{password} ) { # add a password if not populated.
	my $password = word( $g_studentpwd_minlen, $g_studentpwd_maxlen,
			  $g_studentpwd_lang, $g_studentpwd_signs,
			  $g_studentpwd_caps, $g_studentpwd_minfreq,
			  $g_studentpwd_avgfreq );
	$arr{password} = $password;
    }

    $arr{studnum} = $studentnum;

    # Now run through @fields array and populate arrays.
    my @values;
    my @fieldnames;

    foreach my $fld ( @fields ) {
	if ( $arr{$fld} ) { # if matching hash value exists, use it.
	    push @fieldnames, $fld;
	    push @values, $dbh->quote( $arr{$fld} );
	}
    }

    my $fields = join(',', @fieldnames );
    my $values = join(',', @values );

    # print qq{Insert Fields: $fields  Values: $values<br>\n};


    my $sth = $dbh->prepare("insert into $table ( $fields ) values( $values )");
    $sth->execute;
    if ($DBI::errstr){ print qq{$lex{Error}: $DBI::errstr; $!\n}; die $DBI::errstr; }

    
    # Insert the medical information into the student_medical table.
    my $sth = $dbh->prepare("insert into student_medical (studnum, category, description ) 
      values(?,?,?)");

    foreach my $count ( sort keys %medical ) {
	my $category;
	if ( $medical{$count}{'n'} ) {
	    $category = $medical{$count}{n};
	} else {
	    $category = $medical{$count}{c};
	}
	my $description = $medical{$count}{d};
    
	$sth->execute($studentnum, $category, $description);
	if ($DBI::errstr){ print qq{$lex{Error}: $DBI::errstr; $!\n}; die $DBI::errstr; }
    }	

    
    # If not prereg / waiting list, put in the transfer data also.
    if ( not $prereg and not $waitlist ) {  # Don't enter record for pre-registration.
	
	my $sth = $dbh->prepare("insert into transfer 
         ( studnum, date, type, description, entrytype, prov, country, 
          lastname, firstname, middlename, birthdate, provnum ) 
         values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )");

	$sth->execute( $arr{studnum}, $arr{enroldate}, 'enrol', $arr{description},
		       $arr{entrytype}, $arr{prov}, $arr{country},
		       $arr{lastname}, $arr{firstname}, $arr{initial}, 
		       $arr{birthdate}, $arr{provnum} );

	if ($DBI::errstr) { print qq{$DBI::errstr\n}; die $DBI::errstr; }
    }

    # Put in waiting list values...
    if ( $waitlist ) {

	my $sth = $dbh->prepare("select max(waitnumber) from prereg_waitlist");
	$sth->execute;
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
	my $maxnum = $sth->fetchrow;
	$maxnum += 10;

	$sth = $dbh->prepare("insert into prereg_waitlist 
          ( studnum, enroldate, waitnumber, description ) values (?, ?, ?, ? )");
	$sth->execute( $studentnum, $arr{enroldate}, $maxnum, $arr{description} );
	if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }

    }

    
    if ( not $DBI::errstr ) {

	print qq{<h3>$lex{'Record(s) Stored'} - $lex{'Student Number'}};
	print qq{ $studentnum</h3>};
	if ( $prereg ) {
	    print qq{<h3> => $lex{'Pre-Registration'}</h3>\n};
	}

    } else {
	print qq{<p><b>$lex{Error}: $DBI::errstr</b><br>\n};
	print qq{$lex{Contact}:$adminname [ <a href="mailto:$adminemail">};
	print qq{$adminemail</a> ]</p>\n};
    }

    print qq{<p>[ <a href="$self">$lex{Add} $lex{Student}</a> |\n};
    print qq{ <a href="$homepage">$lex{Main}</a> | \n};
    print qq{ <a href="$exppage">$lex{Export}</a> ]</p>\n};
    print qq{</body></html>\n};

    exit;

} # end of saveNewStudent



#-------------
sub newStudent { 
#-------------

    # foreach my $key (keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }

    # Check for weekend enrollment date, and fail if so.
    use Time::JulianDay;
    my $jd = julian_day( split('-', $arr{date}));
    my $dow = day_of_week($jd);
    if ( $dow == 0 or $dow == 6 ) { # Sunday=0, Sat=6, Error
	print qq{<h3>Enrollment on a weekend not allowed!</h3>\n};
	print qq{</body></html>\n};
	exit;
    }
    # Check for closed date.
    my $sth = $dbh->prepare("select * from dates where date = ?");
    $sth->execute( $arr{date} );
    my $ref = $sth->fetchrow_hashref;
    my %d = %$ref;
    if ( $d{dayfraction} > 0.99 ) {
	print qq{<h3>Enrollment on a closed date not allowed!</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    
    # load Meta Library
    eval require "../../lib/libmeta.pl";
    if ( $@ ) {
	print $lex{Error}. ": $@<br>\n";
	die $lex{Error}. ": $@\n";
    }

    # Load Medical Categories
    my @medcategory;
    my $sth = $dbh->prepare("select distinct category from student_medical order by category");
    $sth->execute;
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    while ( my $cat = $sth->fetchrow ) {
	push @medcategory, $cat
    }

    
    # Password config; rest in admin.conf
    $g_studentpwd_minfreq = .001;
    $g_studentpwd_avgfreq = .001;
    $g_studentpwd_lang = 'en'; # only en or de available.

    # For Checking
    my $g_studentpwd_groups = 0; # turn off character group (uppercase, lowercase, symbols) checking
    my $g_studentpwd_following = 0; # turn off following character checking (keyboard, same)
    my $maxuidnumber = 10000; # just in case nothing yet in system.

    if ( $arr{clone} ) {
	showCloneResults( $arr{clone} );
    }

    # Nag for use of keyboard shortcuts
    # print qq{<div style="position:absolute;top:0;right:0;width:60%;">\n};
    print qq{<div style="font-weight:500;font-style:italic;padding: 0 0 0.6em 0;">\n};
    print qq{<span style="margin:0 1em;">$lex{'Tab Key'}=$lex{'Next Field'}</span>\n};
    print qq{<span style="margin:0 1em;">$lex{'Shift+Tab'}=$lex{'Previous Field'}</span>\n};
    print qq{$lex{'Space Bar'}=$lex{'Select'}\n};
    print qq{</div>\n};


    # Start Form
    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="5">\n};

    print qq{<input type="hidden" name="prereg" value="$arr{prereg}">\n};
    print qq{<input type="hidden" name="description" value="$arr{description}">\n};
    print qq{<input type="hidden" name="entrytype" value="$arr{entrytype}">\n};
    print qq{<input type="hidden" name="prov" value="$arr{prov}">\n};
    print qq{<input type="hidden" name="country" value="$arr{country}">\n};
    print qq{<input type="hidden" name="waitlist" value="$arr{waitlist}">\n};

    if ( $arr{waitlist} ) {
	print qq{<div><input type="submit" };
	print qq{value="$lex{Save} $lex{Record} - $lex{'Waiting List'}"></div>\n};
    } elsif ( $arr{prereg} ) {
	print qq{<div><input type="submit" };
	print qq{value="$lex{Save} $lex{Record} - $lex{'Pre-Registration'}"></div>\n};
    } else {
	print qq{<div><input type="submit" value="$lex{Save} $lex{Record} - };
	print qq{$lex{Student} $lex{Table}"></div>\n};
    }


    print qq{<div style="background-color:#D8D8D8;border:1px solid black;};
    print qq{padding:0.5em;margin:0.3em;width:60ch;">\n};
    print qq{<b>$lex{Enrollment} $lex{Date}</b>\n};
    print qq{<input style="width:12ch;" type="text" name="enroldate" value="$arr{date}">\n};
    print qq{<span style="font-weight:bold;margin:0 1em;">};
    print qq{[ $lex{Bold} = $lex{'Required Field'} ]</span></div>\n};
    
    print qq{<!-- Template Should Begin Here -->\n};

   

    # Read in Template
    unless (open ( FH,"<../../template/student.tpl")) {
	print qq{$lex{'Cannot open'} $lex{Template}: $!\n};
	die "$lex{'Cannot open'} $lex{Template}: $!\n";
    }
    my $formtext;
    { local $/; $formtext = <FH>; close FH;}


    # Create meta hash - %fields fieldid => fieldname
    my $sth = $dbh->prepare("select fieldid, fieldname, required from meta
     where tableid = 'student'"); # order doesn't matter.
    $sth->execute;
    if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }

    my %fieldnames;
    while ( my ( $fieldid, $fieldname, $required ) = $sth->fetchrow ) {
	if ( $required ) { # has any value
	    $fieldname = qq{<span style="font-weight:bold;">$fieldname</span>};
	}
	$fieldnames{$fieldid} = $fieldname;
    }


    # Now put replacement fieldnames back in.
    $formtext =~ s{\<\*(.*?)\*\>}
    { exists( $fieldnames{$1} ) 
	  ? $fieldnames{$1} 
          : $1
    }gsex;


    # Find all fields , so we only wrap forms around them (typically
    # faster than doing all fields in the table )
    my @fields;
    while ( $formtext =~ m/\<\@(.*)\@\>/g){
	push @fields, $1;
    }


    # Now find the table to pull values out of, if cloning.
    my %rec;
    if ( $arr{clonestudnum} ) { # get the table to clone
	foreach my $tab ('student','studentwd','prereg') {
	    $sth = $dbh->prepare("select * from $tab where studnum = ?");
	    $sth->execute( $arr{clonestudnum} );
	    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	    my $hashref = $sth->fetchrow_hashref;
	    if ( $hashref ) { %rec = %$hashref; last }
	}
	$rec{studnum} = '';
	$rec{password} = '';
	$rec{healthid} = '';
    }

    # Put in passed values.
    $rec{treaty} = $arr{treaty};
    $rec{provnum} = $arr{provnum};
    $rec{lastname} = $arr{lastname};
    $rec{firstname} = $arr{firstname};
    $rec{birthdate} = $arr{birthdate};
    # we now have any field values in %rec hash.

    # Now set password using config values at top of script, and admin.conf
    my $pwd = word( $g_studentpwd_minlen, $g_studentpwd_maxlen,
		    $g_studentpwd_lang, $g_studentpwd_signs,
		    $g_studentpwd_caps, $g_studentpwd_minfreq,
		    $g_studentpwd_avgfreq );

    $rec{password} = $pwd;


    # get replacement values for fields, %rec holds values
    my %values;
    foreach my $fieldid ( @fields ) {
	$values{$fieldid} = metaInputField(
	    'student', $fieldid, $rec{ $fieldid }, $dbh,'' );
    }

    # now put field values back into $text variable...
    $formtext =~ s{ \<\@(.*?)\@\> }
    { exists($values{$1}) 
	  ? $values{$1} 
          : "$values{$1}-$1"
    }gsex;


    print $formtext, qq{\n};

    # Add Medical Options here....extract these fields before saving
    print qq{<table cellpadding="3" cellspacing="0" border="1" };
    print qq{style="float:left;margin:0.5em;background-color:#D8D8D8;">\n};
    print qq{<caption style="font-size:120%;font-weight:bold;">Medical Information</caption>\n};

    foreach my $medcount (1..3) {

	print qq{<tr><td>};
	
    	# Show Category
	print qq{<div style="font-weight:bold;">$medcount. Medical Category</div>\n};
	print qq{<select name="med:c:$medcount"><option>$category</option>\n};
	foreach my $cat ( @medcategory ) {
	    print qq{<option>$cat</option>};
	}
	print qq{</select>\n};

	# New Category
	print qq{ $lex{or} New Category };
	print qq{<input type="text" name="med:n:$medcount" size="20"><br>\n};

	# Get Description
	print qq{<div style="font-weight:bold;">Description</div>\n};
	print qq{<textarea rows="4" cols="80" name="med:d:$medcount">};
	print qq{$description</textarea></td></tr>\n};
    }
    # Close medical table
    print qq{</table>\n\n};
    

    if ( $arr{waitlist} ) {
	print qq{<br clear="left">\n};
	print qq{<input type="submit" };
	print qq{value="$lex{Save} $lex{Record} - $lex{'Waiting List'}">\n};
	
    } elsif ( $arr{prereg} ) {
	print qq{<br clear="left">\n};
	print qq{<input type="submit" };
	print qq{value="$lex{Save} $lex{Record} - $lex{'Pre-Registration'}">\n};
	
    } else {
	print qq{<br clear="left">\n};
	print qq{<input type="submit" value="$lex{Save} $lex{Record} - $lex{Student} $lex{Table}">\n};
    }

    print qq{</form>\n};

    print qq{<script type="text/javascript">
    \$('form').submit( function(){
      \$(':submit',this).attr('disabled','disabled' );
    });
    </script>\n};

    print qq{</body></html>\n};

    exit;

} # end of newStudent



#-------------------
sub showCloneResults {
#-------------------

    my $student = shift;
    my @tables = qw( student studentwd prereg );
    my @students = ();
    my $sth;

    foreach my $table ( @tables ) {

	# Setup the Search
	if ($student =~ /\d+/) {  # we have a student number
	    $sth = $dbh->prepare("select studnum, lastname, firstname from $table
              where studnum = ?");
	    $sth->execute( $student );
	} else { # we have words hopefully with a comma
	    ($lastname,$firstname)  = split(/\,/, $student);
	    $firstname =~ s/^\s*//;
	    $lastname =~ s/^\s*//;
	    if ($lastname and $firstname){ # both entered.
		$sth = $dbh->prepare("select studnum, lastname, firstname from $table
                  where lastname = ? and firstname = ?");
		$sth->execute( $lastname, $firstname );

	    } elsif ( $lastname and not $firstname ){ # only lastname (no comma)

		if (length($lastname) == 2){ # search by initials: fi, li.
		    $fi = substr($lastname,0,1). '%'; 
		    $li = substr($lastname,1,1). '%';
		    $sth = $dbh->prepare("select studnum, lastname, firstname from $table
                      where lastname $sql{like} ? and firstname $sql{like} ?");
		    $sth->execute( $li, $fi );

		} else {
		    $sth = $dbh->prepare("select studnum, lastname, firstname from $table 
                      where lastname = ? order by firstname");
		    $sth->execute( $lastname );
		}
	    } 

	} # End of Words

	while ( my ( $studnum, $lastname, $firstname ) = $sth->fetchrow ) {
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	    push @students, "$studnum:$table";
	}

    } # next table.


    if ( not @students ) { 
	print qq{<h3>$lex{'No Student(s) Found'}</h3>\n};
	# No closing body since this goes right on to input form. 
	return; 
    } 


    delete $arr{clone}; # remove so will correctly load on looping...
    print qq{<table border="1" cellspacing="0" cellpadding="3">\n};

    # Loop through and display all records.
    for my $rec ( @students ) {

	my ( $studnum, $table ) = split(/:/, $rec );
	$sth = $dbh->prepare("select lastname, firstname from $table where studnum = ?");
	$sth->execute( $studnum );
	if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	my ( $lastname, $firstname ) = $sth->fetchrow;

	print qq{<tr><td>};
	print qq{<form action="$self" method="post">\n};
	print qq{<input type="hidden" name="page" value="4">\n};
	print qq{<input type="hidden" name="clonestudnum" value="$studnum">\n};

	foreach my $key (keys %arr) {
	    print qq{<input type="hidden" name="$key" value="$arr{$key}">\n};
	    #print qq{K:$key V:$arr{$key}<br>\n};
	}
	print qq{$firstname $lastname ($studnum)\n};
	print qq{<input type="submit" value="$lex{Clone} $lex{Record}">\n};
	print qq{</form></td></tr>\n};

    } # End of Loop

    print qq{</table></body></html>\n};

    exit;

} # end of showCloneResults



#---------------
sub enrolStudent { 
#---------------
    # called by page == 3, in withdrawal table at some school (or here).
    # Previously enrolled.
    
    # a) check transfer for existing transfer on this same day error.
    # b) check for duplicate student number and use next available one.
    # c) Check that enrollment date is not on a weekend.
    
    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }

    # Check for weekend enrollment date, and fail if so.
    use Time::JulianDay;
    my $jd = julian_day( split('-', $arr{date}));
    my $dow = day_of_week($jd);
    if ( $dow == 0 or $dow == 6 ) { # Sunday=0, Sat=6, Error
	print qq{<h3>Enrollment on a weekend not allowed!</h3>\n};
	print qq{</body></html>\n};
	exit;
    }
    # Check for closed date.
    my $sth = $dbh->prepare("select * from dates where date = ?");
    $sth->execute( $arr{date} );
    my $ref = $sth->fetchrow_hashref;
    my %d = %$ref;
    if ( $d{dayfraction} > 0.99 ) {
	print qq{<h3>Enrollment on a closed date not allowed!</h3>\n};
	print qq{</body></html>\n};
	exit;
    }
    
    
    my ($db, $studnum ) = split(':', $arr{studkey} );
    my %student;
    my $rows;

    if ( $db eq 'wd' ) { # get student from studentwd table

	my $sth = $dbh->prepare("select * from studentwd where studnum = ?"); 
	$sth->execute( $studnum );
	$rows = $sth->rows;
	my $ref = $sth->fetchrow_hashref;
	%student = %$ref;

    } else { # get student from other school database

	my $dsn1 = "DBI:$dbtype:dbname=$db";
	my $dbh1 = DBI->connect($dsn1,$guser,$gpassword);
	my $sth = $dbh1->prepare("select * from studentwd where studnum = ?"); 
	$sth->execute( $studnum );
	$rows = $sth->rows;
	my $ref = $sth->fetchrow_hashref;
	%student = %$ref;

    }

    if ( $rows < 1 ) { #Error!
	print qq{<h2>$lex{'No Student(s) Found'}!</h1>\n};
	print qq{</body></html>\n};
	exit;
    }

    delete $student{studid}; # not wanted in new table


    # Check for an existing student number and use next available number if found.
    my $currstudnum = $student{studnum};

    # LOGIC: If student is currently in withdrawn, we check student
    # table only for duplicates (since record is IN
    # withdrawn). Otherwise we check for duplicates in studentall
    my $table = 'studentall';
    if ( $db eq 'wd' ) { $table = 'student'; }

    $sth = $dbh->prepare("select count(*) from $table where studnum = ?"); 
    $sth->execute( $currstudnum );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
    my $studcount = $sth->fetchrow;

    if ( $studcount > 0 ) { # we have an existing local student number, get a new number from file.

	# Get Student number and update file.
	sysopen (SNUM, "../../etc/studentnumber", O_RDWR | O_CREAT) or 
	    die "$lex{'Cannot open'} student number file\n";

	flock(SNUM,LOCK_EX);

	$studentnum = <SNUM> || 0;
	chomp $studentnum;
	seek(SNUM,0,0) or die "Cannot rewind student number file: $!\n";
	truncate(SNUM,0) or die "Cannot truncate student number file'}: $!\n";

	my $newstudentnum = $studentnum + 1;
	print SNUM $newstudentnum or die "Cannot write to student number file: $!\n";
	close SNUM or die "Cannot close student number file: $! \n";

	my $sth = $dbh->prepare("select count(*) from student where studnum = ?");
	$sth->execute( $studentnum );
	if ($DBI::errstr){ print $DBI::errstr; die "$DBI::errstr \n";}
	my $count = $sth->fetchrow;

	if ( $count ) { # we have an existing record with this studnum
	    print qq{<h3>Duplicate Student Number. Contact Les Richardson</h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}


	# Add new, nonduplicate number to the student hash.
	$student{studnum} = $studentnum;
	$studnum = $studentnum; # needed for transfer record

    }


    # Create @fields storing fieldid values.
    my @fields;
    $sth = $dbh->prepare("select fieldid from meta
      where tableid = 'student' order by arrayidx");
    $sth->execute;
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
    while (my $fld = $sth->fetchrow){
	push @fields,$fld;
    }


    my @values;
    my @fieldnames;

    foreach my $fld ( @fields ) {
	if ( $student{$fld} ) { # if we have a value
	    push @fieldnames, $fld;
	    push @values, $dbh->quote( $student{$fld} );
	}
    }

    my $fields = join(',', @fieldnames );
    my $values = join(',', @values );

    # print qq{Insert Fields: $fields  Values: $values<br>\n};

    my $sth = $dbh->prepare("insert into student ( $fields ) values( $values )");
    $sth->execute;


    if ( $DBI::errstr) {
	print qq{<h3>$lex{Insert} $lex{Student} $lex{Error}:};
	print qq{$lex{Contact} $adminname };
	print qq{[ <a href="mailto:$adminemail">$adminemail</a><br>\n};
	print qq{$lex{Error}:$DBI::errstr</h3>\n};
	die "$lex{Error}:$self: $DBI::errstr\n";
    }

    print qq{<h3>$lex{Withdrawn} $lex{Student} ->  $lex{Student}</h3>\n};

     
    # Now remove record from withdrawn student table (if local enrollment)
    if ( $db eq 'wd' ) {
	$sth = $dbh->prepare("delete from studentwd where studnum = ?"); 
	$sth->execute( $studnum );
	
	if ( $DBI::errstr) {
	    print qq{<h3>$lex{Delete} $lex{Withdrawn} $lex{Student} $lex{Error}:};
	    print qq{$lex{Contact} $adminname };
	    print qq{[ <a href="mailto:$adminemail">$adminemail</a><br>\n};
	    print qq{$lex{Error}:$DBI::errstr</h3>\n};
	    die "$lex{Delete} $lex{Withdrawn} $lex{Student} $lex{Error}:$self: $DBI::errstr\n";
	}

    }


    # Now Add the Transfer Record
    # First, get student info from normal student table.
    $sth = $dbh->prepare("select * from student where studnum = ?");
    $sth->execute( $studnum );
    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    my $ref = $sth->fetchrow_hashref;
    my %stud = %$ref;

    $sth = $dbh->prepare("insert into transfer 
      ( studnum, date, type, description, entrytype, prov, country, 
        lastname, firstname, middlename, birthdate, provnum ) 
      values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )");

    $sth->execute( $studnum, $arr{date}, 'enrol', $arr{description},
		   $arr{entrytype}, $arr{prov}, $arr{country},
		   $stud{lastname}, $stud{firstname}, $stud{initial}, 
		   $stud{birthdate}, $stud{provnum} ); 


    if ( $DBI::errstr ) {
	print qq{<h3>$lex{Insert} $lex{Transfer} $lex{Error}:};
	print qq{$lex{Contact} $adminname };
	print qq{[ <a href="mailto:$adminemail">$adminemail</a><br>\n};
	print qq{$lex{Error}:$DBI::errstr</h3>\n};
	die "$lex{Insert} $lex{Transfer} $lex{Error}:$self: $DBI::errstr\n";
    }


    # Get studid field from student table.

    
    # Link to Edit Student Record
    print qq{<form action="../studed.pl" method="post">\n};
    print qq{<input type="hidden" name="id" value="$stud{studid}">\n};
    print qq{<input type="submit" value="$lex{Edit} $lex{Student}">\n};
    print qq{</form>\n};

    # Link to Main Page
    print qq{<p>[ <a href="$homepage">$lex{Main}</a> ]</p>\n};
    print qq{</body></html>\n};
    
    exit;

} # end of enrolStudent  (previously enrolled here or another school).




#----------------
sub showStartPage {
#----------------

    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="1">\n};

    print qq{<table cellpadding="3" cellspacing="0" border="0" };
    print qq{style="padding:0.5em;border:1px solid gray;">\n};

    # Lastname
    print qq{<tr><td class="bra">$lex{Last} $lex{Name}</td>\n};
    print qq{<td class="la"><input type="text" name="lastname" style="width:12em;"></td></tr>\n};
    print qq{<tr><td colspan="2" class="bra">Or local student number ONLY</td></tr>\n};
    
    # Firstname
    print qq{<tr><td class="bra">$lex{First} $lex{Name}</td>\n};
    print qq{<td class="la"><input type="text" name="firstname" style="width:12em;"></td></tr>\n};

    # Birthdate
    print qq{<tr><td class="bra">$lex{Birthdate}</td>\n};
    print qq{<td class="la"><input type="text" name="birthdate" style="width:6em;"></td></tr>\n};
    print qq{<tr><td></td><td class="la">$lex{yymmdd} $lex{or} $lex{'yyyy-mm-dd'}</td></tr>\n};

    # Provincial Number
    print qq{<tr><td class="bra">$lex{Provincial} $lex{Number} ($lex{Optional})</td>\n};
    print qq{<td class="la"><input type="text" name="provnum" style="width:8em;"></td></tr>\n};

    # Treaty Number
    print qq{<tr><td class="bra">$lex{Treaty} (IRS) $lex{Number} ($lex{Optional})</td>\n};
    print qq{<td class="la"><input type="text" name="treaty" style="width:8em;"></td></tr>\n};


    print qq{<tr><td></td><td class="la"><input type="submit" value="$lex{Continue}"></td></tr>\n};
    print qq{</table></form></body></html>\n};

    exit;

} # end of showStartPage



#--------------
sub findStudent {  # called by page == 1
#--------------

    my $studnum;
    if ( $arr{lastname} =~ m/^\d+$/ ) { # it matches digits only
       $studnum = $arr{lastname};
       
        # Search Local Withdrawn only
        my $sth = $dbh->prepare("select lastname, firstname, birthdate 
          from studentwd where studnum = ?");
        $sth->execute( $studnum );
        if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
        my ( $lastname, $firstname, $birthdate ) = $sth->fetchrow;

        $arr{lastname} = $lastname;
        $arr{firstname} = $firstname;
        $arr{birthdate} = $birthdate;
    }


    # Check for filled in values
    if ( not $arr{lastname} ) {
	print qq{<h3>$lex{Missing} $lex{Last} $lex{Name}</h3>\n};
	print qq{</body></html>\n};
	exit;
    } elsif ( not $arr{firstname} ) {
	print qq{<h3>$lex{Missing} $lex{First} $lex{Name}</h3>\n};
	print qq{</body></html>\n};
	exit;
    } elsif ( not $arr{birthdate} ) {
	print qq{<h3>$lex{Missing} $lex{Birthdate}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    # Parse birthdate
    my $birthdate;
    if ( length( $arr{birthdate} ) == 6 ) { #yymmdd format.
	my $yr = substr( $arr{birthdate},0,2);
	if ( $yr > 50 ) { $yr = '19'. $yr; } else { $year = '20' .$yr;}
	my $mo = substr( $arr{birthdate},2,2);
	my $da = substr( $arr{birthdate},4,2);
	$birthdate = "$yr-$mo-$da";
	#print qq{$arr{birthdate} - Y:$yr M:$mo D:$da<br>\n};

    } else {
	my ( $yr, $mo, $da ) = split(/-/, $arr{birthdate});
	if ( length($yr) == 2 ) { #fix it
	    if ( $yr > 50 ) { $yr = '19'. $yr; } else { $year = '20' .$yr; }
	}
	$birthdate = "$yr-$mo-$da";
	#print qq{$arr{birthdate} - Y:$yr M:$mo D:$da<br>\n};
    }

    my $firstname = $arr{firstname};
    my $lastname = $arr{lastname};
    my $provnum = $arr{provnum};
    my $treaty = $arr{treaty};


    # print qq{LN:$lastname FN:$firstname BD:$birthdate<br>\n};

    # Setup the selects
    my @select;
    $select[1] = 'where lastname = ? and firstname = ?';
    $select[2] = 'where lastname = ? and birthdate = ?';
    $select[3] = 'where firstname = ? and birthdate = ?';
    $select[4] = 'where provnum = ?';
    $select[5] = 'where treaty = ?';

    # Prepare Name, etc. search
    my $sth1 = $dbh->prepare("select lastname, firstname
     from studentall where studnum = ?");

    # Check the current and withdrawn student table
    my %wdstudents;
    my %currstudents;
    for my $idx ( 1 .. 5 ) {
	
	my $sth = $dbh->prepare("select studnum from studentwd $select[$idx] ");
	my $sth2 = $dbh->prepare("select studnum from student $select[$idx] ");
	if ( $idx == 1 ){
	    $sth->execute( $lastname, $firstname );
	    $sth2->execute( $lastname, $firstname );
	} elsif ( $idx == 2 ){
	    $sth->execute( $lastname, $birthdate );
	    $sth2->execute( $lastname, $birthdate );
	} elsif ( $idx == 3 ){
	    $sth->execute( $firstname, $birthdate );
	    $sth2->execute( $firstname, $birthdate );
	} elsif ( $idx == 4 ){
	    if ( not $provnum ) { next; }
	    $sth->execute( $provnum );
	    $sth2->execute( $provnum );
	} elsif ( $idx == 5 ){
	    if ( not $treaty ) { next; }
	    $sth->execute( $treaty );
	    $sth2->execute( $treaty );
	}

	# Withdrawn Students
	while ( my $studnum = $sth->fetchrow ) {
	    $sth1->execute( $studnum );
	    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	    my ( $lastname, $firstname ) = $sth1->fetchrow;

	    $wdstudents{"$lastname$firstname$studnum"} = $studnum;
	}

	# Current Students
	while ( my $studnum = $sth2->fetchrow ) {
	    $sth1->execute( $studnum );
	    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	    my ( $lastname, $firstname ) = $sth1->fetchrow;
	    $currstudents{"$lastname$firstname$studnum"} = $studnum;
	}

    }

    # reset this for more fields.
    $sth1 = $dbh->prepare("select lastname, firstname, birthdate, 
      provnum, treaty, grade, homeroom from studentall where studnum = ?");

    # Print Current Students, if any
    print qq{<h1>$lex{Current} $lex{Students}</h1>\n};

    if ( %currstudents ) { # print table header.
	print qq{<table cellspacing="0" cellpadding="3" border="1">\n};
	print qq{<tr><th>$lex{Name}</th><th>$lex{Birthdate}</th><th>$lex{ProvNum}</th>\n};
	print qq{<th>$lex{Grade}</th><th>$lex{Homeroom}</th>\n};
	print qq{<th>$lex{Treaty}</th><th>$lex{Source}</th></tr>\n};
       
    } else {
	print qq{<h3>$lex{'No Student(s) Found'}</h3>\n};
    }

    # Print Current Students Found.
    foreach my $key ( sort keys %currstudents ) {

	my $studnum = $currstudents{ $key };

	$sth1->execute( $studnum );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my ( $lastname, $firstname, $birthdate, $provnum, $treaty, $grade, $homeroom ) =
	    $sth1->fetchrow;

	print qq{<tr><td class="la">$firstname $lastname ($studnum)</td>\n};
	print qq{<td class="la">$birthdate</td><td class="la">$provnum</td>\n};
	print qq{<td class="la">$grade</td><td class="la">$homeroom</td>\n};
	print qq{<td class="la">$treaty</td><td class="la">$lex{Enrolled}</td></tr>\n};

    }

    # close tables, and stop if found
    if ( %currstudents ) {
	print qq{</table>\n};
	print qq{</body></html>\n};
	exit; # stop here for current students
    }



    print qq{<p style="margin:2em;"></p>\n};




    # Withdrawn Students Section
    print qq{<h1>$lex{Withdrawn} $lex{Students}</h1>\n};

    if ( %wdstudents ) { # Print Table Header.
	print qq{<table cellspacing="0" cellpadding="3" border="1">\n};
	print qq{<tr><th>$lex{Name}</th><th>$lex{Birthdate}</th><th>$lex{ProvNum}</th>\n};
	print qq{<th>$lex{Grade}</th><th>$lex{Homeroom}</th>\n};
	print qq{<th>$lex{Treaty}</th><th>$lex{Source}</th><th></th></tr>\n};
    } else {
	print qq{<h3>$lex{'No Student(s) Found'}</h3>\n};
    }

    # Print Withdrawn Students Found.
    foreach my $key ( sort keys %wdstudents ) {

	my $studnum = $wdstudents{ $key };

	$sth1->execute( $studnum );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my ( $lastname, $firstname, $birthdate, $provnum, $treaty, $grade, $homeroom )
	    = $sth1->fetchrow;

	print qq{<tr><td class="la">$firstname $lastname ($studnum)</td>\n};
	print qq{<td class="la">$birthdate</td><td class="la">$provnum</td>\n};
	print qq{<td class="la">$grade</td><td class="la">$homeroom</td>\n};
	print qq{<td class="la">$treaty</td><td class="la">$lex{Withdrawn}</td><td class="la">\n};

	print qq{<form action="$self" method="post">\n};
	print qq{<input type="hidden" name="page" value="2">\n};
	print qq{<input type="hidden" name="studkey" value="wd:$studnum">\n};
	print qq{<input type="submit" value="$lex{Continue}"></form>\n};

	print qq{</td></tr>\n};

    }

    my $wdfound; # found withdrawn students flag;
    if ( %wdstudents ) {
	print qq{</table>\n};
	$wdfound = 1;

    }

    print qq{<p style="margin:2em;"></p>\n};


    # Remote Student Search
    my %otherstudents;
    foreach $database ( keys %dbase ) { #defined in global config file.

	if ( $database eq $dbase ) { next; } # skip current database.

	my $dsn1 = "DBI:$dbtype:dbname=$database";
	my $dbh1 = DBI->connect($dsn1,$guser,$gpassword);

	my $sth1 = $dbh1->prepare("select lastname, firstname from studentall where studnum = ?");

	for my $idx ( 1 .. 5 ) {
	    # print qq{Database:$database IDX:$idx Select:$select[$idx]<br>\n};
	
	    my $sth = $dbh1->prepare("select studnum from studentwd $select[$idx] ");
	    if ( $idx == 1 ){
		$sth->execute( $lastname, $firstname );
	    } elsif ( $idx == 2 ){
		$sth->execute( $lastname, $birthdate );
	    } elsif ( $idx == 3 ){
		$sth->execute( $firstname, $birthdate );
	    } elsif ( $idx == 4 ){
		if ( not $provnum ) { next; }
		$sth->execute( $provnum );
	    } elsif ( $idx == 5 ){
		if ( not $treaty ) { next; }
		$sth->execute( $treaty );
	    } else { #error!
		print qq{<h3>Error: Missing Database Execute. Contact Les Richardson\n};
		print qq{IDX:$idx</h3>\n};
		print qq{</body></html>\n};
		exit;
	    }
		

	    while ( my $studnum = $sth->fetchrow ) {

		$sth1->execute( $studnum );
		if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
		my ( $lastname, $firstname ) = $sth1->fetchrow;

		# print qq{$firstname $lastname ( $studnum ) Select:$select[$idx]<br>\n};

		$otherstudents{"$lastname$firstname$database$studnum"} = "$database:$studnum";
	    }
	}
    } # end of database loop


    print qq{<h1>$lex{Other} $lex{School}</h1>\n};

    if ( %otherstudents ) { # print table heading
	print qq{<table cellspacing="0" cellpadding="3" border="1">\n};
	print qq{<tr><th>$lex{Name}</th><th>$lex{Birthdate}</th><th>$lex{ProvNum}</th>\n};
	print qq{<th>$lex{Treaty}</th><th>$lex{Source}</th><th></th></tr>\n};
    } else {
	print qq{<h3>$lex{'No Student(s) Found'}</h3>\n};
    }

    foreach my $key ( sort keys %otherstudents ) {

	my ($db, $studnum) = split(/:/, $otherstudents{ $key });

	my $dsn1 = "DBI:$dbtype:dbname=$db";
	my $dbh1 = DBI->connect($dsn1,$guser,$gpassword);

	my $sth1 = $dbh1->prepare("select lastname, firstname, birthdate, 
         provnum, treaty from studentall where studnum = ?");
	$sth1->execute( $studnum );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my ( $lastname, $firstname, $birthdate, $provnum, $treaty ) = $sth1->fetchrow;

	print qq{<tr><td class="la">$firstname $lastname ($studnum)</td>\n};
	print qq{<td class="la">$birthdate</td><td class="la">$provnum</td>\n};
	print qq{<td class="la">$treaty</td><td class="la">$db</td><td class="la">\n};
    
	print qq{<form action="$self" method="post">\n};
	print qq{<input type="hidden" name="page" value="2">\n};

	#foreach my $key ( sort keys %arr ) {
	#    print qq{<input type="hidden" name="$key" value="$arr{$key}">\n};
	#}

	print qq{<input type="hidden" name="studkey" value="$db:$studnum">\n};
	print qq{<input type="submit" value="$lex{Enrol}"></form>\n};

	print qq{</td></tr>\n};
	
    }

    # Table footer.
    my $otherfound;
    if ( %otherstudents ) { # other students found
	print qq{</table>\n};
	$otherfound = 1;
    }
    print qq{<p style="margin:2em;"></p>\n};
    # End of remote student search.

    # Stop here if found in withdrawn....
    # if ( $otherfound or $wdfound ) { # stop if either local or other students found.
    if ( $wdfound ) { # stop if either local or other students found.
	print qq{</body></html>\n};
	exit;
    }


    # New Student Entry
    print qq{<h1>$lex{'New Student'}</h1>\n};
    print qq{<table cellspacing="0" cellpadding="3" border="1">\n};
    print qq{<tr><th>$lex{Name}</th><th>$lex{Birthdate}</th><th>$lex{ProvNum}</th>\n};
    print qq{<th>$lex{Treaty}</th><th>$lex{Source}</th><th></th></tr>\n};

    print qq{<tr><td class="la">$firstname $lastname </td>\n};
    print qq{<td class="la">$birthdate</td><td class="la">$provnum</td>\n};
    print qq{<td class="la">$treaty</td><td class="la">New</td><td class="la">\n};

    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="2">\n};
    print qq{<input type="hidden" name="studkey" value="new">\n};

    print qq{<input type="hidden" name="lastname" value="$lastname">\n};
    print qq{<input type="hidden" name="firstname" value="$firstname">\n};
    print qq{<input type="hidden" name="birthdate" value="$birthdate">\n};
    print qq{<input type="hidden" name="provnum" value="$provnum">\n};
    print qq{<input type="hidden" name="treaty" value="$treaty">\n};

    print qq{<input type="submit" value="$lex{Enrol}"></form>\n};
    print qq{</td></tr></table>\n};

    print qq{</body></html>\n};
    
    exit;
    
}



#---------------
sub confirmEnrol { # called by page == 2
#---------------

    # foreach my $key (keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }

    my ($mode, $studnum) = split(':', $arr{studkey});
    my ($lastname, $firstname, $birthdate, $grade, $homeroom );
     my $db;

    if ( $mode eq 'new' ) {
	$firstname = $arr{firstname};
	$lastname = $arr{lastname};
	$birthdate = $arr{birthdate};

    } elsif ( $mode eq 'wd' ) {
	# print qq{Mode:wd<br>\n};

    } else { # a different school
	$db = $mode;
	$mode = 'other';
	# print qq{Mode:$mode<br>\n};
    }


    # Get current date
    my @tim = localtime(time);
    my $year = @tim[5] + 1900;
    my $month = @tim[4] + 1;
    my $day = @tim[3];
    my $currdate = "$year-$month-$day";

    
    # Load global codes
    if ( not -e "$globdir/global.conf" ) {
	print qq{<h3>$lex{'Cannot open'} global.conf file!};
	print qq{</body></html>\n};
	exit;
    }

    # Read the global enrol/withdraw reasons.
    eval { require "$globdir/global.conf"; };
    if ( $@ ) {
	print qq{<h3>$lex{'Cannot open'} global.conf:\n $@</h3>\n};
	die $lex{'Cannot open'}. " global.conf: $@\n";
    }


    # If wd mode, read the student data.
    if ( $mode eq 'wd' ) {

	$sth = $dbh->prepare("select lastname, firstname, birthdate, grade, homeroom
         from studentwd where studnum = ?"); 
	$sth->execute( $studnum );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	($lastname, $firstname, $birthdate, $grade, $homeroom ) = $sth->fetchrow;

    } elsif ( $mode eq 'other' ) {

	my $dsn1 = "DBI:$dbtype:dbname=$db";
	my $dbh1 = DBI->connect($dsn1,$guser,$gpassword);
	my $sth = $dbh1->prepare("select lastname, firstname, birthdate, grade, homeroom
         from studentwd where studnum = ?"); 
	$sth->execute( $studnum );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	($lastname, $firstname, $birthdate, $grade, $homeroom ) = $sth->fetchrow;
    }


    # Start Form
    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="studkey" value="$arr{studkey}">\n};

    my $page;
    if ( $mode eq 'new' ) { 
	$page = 4;  # new Student Entry page (also prereg/clone)
	print qq{<input type="hidden" name="lastname" value="$lastname">\n};
	print qq{<input type="hidden" name="firstname" value="$firstname">\n};
	print qq{<input type="hidden" name="birthdate" value="$birthdate">\n};
	print qq{<input type="hidden" name="provnum" value="$arr{provnum}">\n};
	print qq{<input type="hidden" name="treaty" value="$arr{treaty}">\n};

    } else { 
	$page = 3;  # enrolStudent (ie. Done!) save previous enrolled student from wd or other school. 
    }
    print qq{<input type="hidden" name="page" value="$page">\n};

    
    # Start Table
    print qq{<table cellspacing="0" cellpadding="3" border="0">\n};
    print qq{<tr><td class="bra">$lex{Name}</td><td class="la">$firstname $lastname</td></tr>\n};
    print qq{<tr><td class="bra">$lex{Birthdate}</td><td class="la">$birthdate</td></tr>\n};
    
    if ( $mode ne 'new' ) { # then we have this data too.
	print qq{<tr><td class="bra">$lex{Grade}</td><td class="la">$grade</td></tr>\n};
	print qq{<tr><td class="bra">$lex{Homeroom}</td><td class="la">$homeroom</td></tr>\n};
    }

    
    # Enrol Date
    print qq{<tr><td class="bra">$lex{Enrol} $lex{Date}</td>\n<td class="la">};
    print qq{<input type="text" };
    print qq{name="date" id="date" size="10" value="$currdate">\n};
    print qq{<button type="reset" id="start_trigger">...</button>\n};
    print qq{</td></tr>\n};

    # Enrol Reason
    print qq{<tr><td class="bra">$lex{Enrol} $lex{Reason}</td>\n};
    print qq{<td class="la"><select name="entrytype"><option></option>\n};
    foreach my $type ( @g_enrol ){
        print qq{<option value="$type">$g_enrol{$type}</option>\n};
    }
    print qq{</select></td></tr>\n};


    print qq{<tr><td class="bra">$lex{Province} $lex{Code}</td>};
    print qq{<td class="la"><input type="text" name="prov" size="4">};
    print qq{ $lex{Transfer} -> $lex{Province}</td></tr>\n};

    print qq{<tr><td class="bra">$lex{Country} $lex{Code}</td>\n};
    print qq{<td class="la"><input type="text" name="country" size="4">};
    print qq{ $lex{Transfer} -> $lex{Country}</td></tr>\n};

    print qq{<tr><td class="bra">$lex{Description}</td>\n<td class="la">};
    print qq{<textarea name="description" rows="3" cols="50"></textarea></td></tr>\n};

    if ( $mode eq 'new' ) { # add in preregistration or clone option.
	print qq{<tr><td class="bra">$lex{'Pre-Registration'} $lex{Entry}</td>\n};
	print qq{<td><input type="checkbox" name="prereg" value="1"></td></tr>\n};

	print qq{<tr><td class="bra">$lex{'Waiting List'} $lex{Entry}</td>\n};
	print qq{<td><input type="checkbox" name="waitlist" value="1"></td></tr>\n};

	print qq{<tr><td class="bra">$lex{Clone} $lex{Student}</td>\n};
	print qq{<td class="la"><input type="text" name="clone" size="30">\n};    
	print qq{$lex{'Last,First/Last/Initials/Studnum'} };

	print qq{</td></tr>\n};

    }

    print qq{<tr><td colspan="2" class="cn"><input type="submit" value="};
    print qq{$lex{Yes}, $lex{Enrol} $firstname $lastname"></td></tr>\n};
    print qq{</table></form>\n};

    print qq{<script type="text/javascript">
     Calendar.setup({
        inputField     :    "date", 
        ifFormat       :    "%Y-%m-%d",
        button         :    "start_trigger",
        singleClick    :    false,
        step           :    1
    });
    </script>\n};

    print qq{</body></html>\n};

    exit;

} # end of confirmEnrol
