#!/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 = ('Withdraw' => 'Withdraw',
	   'Student' => 'Student',
	   'No Student(s) Found' => 'No Student(s) Found',
	   'Withdrawn' => 'Withdrawn',
	   'Contact' => 'Contact',
	   'Main' => 'Main',
	   'Error' => 'Error',
	   'Last,First/Last/Initials/Studnum' => 'Last,First/Last/Initials/Studnum',
	   'Search' => 'Search',
	   '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',
	   'Cannot open' => 'Cannot open',
	   'Student Number' => 'Student Number',

	   );

use DBI;
use CGI;
use Time::JulianDay;


my $self = 'withdraw.pl';

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

# Load audit write function
eval require "../../lib/libaudit.pl";
if ( $@ ) {
    print $lex{Error}. ": $@<br>\n";
    die $lex{Error}. ": $@\n";
}


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

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


# Page Header.
my $title = qq{$lex{Withdraw} $lex{Student}};
print qq{$doctype\n<html><head><title>$title</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};
}
print qq{$chartype\n</head>\n};

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>$title</h1>\n};


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

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

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

}  elsif ( $arr{page} == 3 ) {
    delete $arr{page};
    withdrawStudent();
}




#----------------
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};
    
    print qq{<tr><td class="ra">$lex{Student} ($lex{'Last,First/Last/Initials/Studnum'})</td>\n};
    print qq{<td class="la"><input type="text" name="student" style="width:30ch;"></td></tr>\n};

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

    exit;

} # end of showStartPage


#----------------
sub selectStudent {
#----------------

    my $student = $arr{student};

    # Setup the Search
    if ($student =~ /\d+/) {  # we have a student number
	$studnum = $student;
	$sth = $dbh->prepare("select lastname, firstname, studnum from student
           where studnum = ?");
	$sth->execute( $studnum );

    } 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 lastname, firstname, studnum 
              from student where lastname = ? and firstname = ?
              order by lastname, 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);
		$fi .= '%';
		$li .= '%';
		$sth = $dbh->prepare("select lastname,firstname, studnum from student
                   where lastname $sql{like} ? and firstname $sql{like} ?
                   order by lastname, firstname");
		$sth->execute( $li, $fi );
	    } else {
		$sth = $dbh->prepare("select lastname, firstname, studnum 
                 from student where lastname = ? 
                 order by lastname, firstname");
		$sth->execute( $lastname );
	    }
	} else {
	    $sth = $dbh->prepare("select lastname, firstname, studnum 
              from student order by lastname, firstname");
	}
    } # Last Else

    if ( $DBI::errstr ) { print $lex{Error}. ": $DBI::errstr"; die $DBI::errstr; }
    my $first = 1;

    # print table heading.
    print qq{<table cellpadding="3" cellspacing="0" border="0">\n};

    # Loop through each found student.

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

	print qq{<tr><td>};
	print qq{<form action="$self" method="post">\n};
	print qq{<input type="hidden" name="page" value="2">\n};
	print qq{<input type="hidden" name="studnum" value="$studnum">\n};
	print qq{<input type="submit" value="$lex{Withdraw} $firstname $lastname ($studnum)">\n};
	print qq{</form></td></tr>\n};
	$first = 0;

    }

    if ( $first ) { # no students
	print qq{<tr><td style="font-size:120%;font-weight:bold;">};
	print qq{$lex{'No Student(s) Found'}</td></tr>\n};
	print qq{</table></div><p></p>\n};
	showStartPage();
    } else {
	print qq{</table></body></html>\n};
    }

    exit;

} # end of selectStudent


#------------------
sub confirmWithdraw {
#------------------

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

    my $studnum = $arr{studnum};

    # Set current time
    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";
    }

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

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

    # Start Table
    print qq{<table cellspacing="0" cellpadding="3" border="0">\n};
    print qq{<tr><td class="bra">$lex{Name}</td><td class="bla" style="font-size:120%;">};
    print qq{$firstname $lastname</td></tr>\n};
    print qq{<tr><td class="bra">$lex{'Student Number'}</td><td class="la">$studnum</td></tr>\n};
    print qq{<tr><td class="bra">$lex{Birthdate}</td><td class="la">$birthdate</td></tr>\n};
    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};

    # Blank row
    # print qq{<tr><td class="bra">&nbsp;</td><td class="la"></td></tr>\n};


    # Withdraw Date
    print qq{<tr><td class="bra">$lex{Withdraw} $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};

    # Withdraw Reason
    print qq{<tr><td class="bra">$lex{Withdraw} $lex{Reason}</td>\n};
    print qq{<td class="la"><select name="exittype"><option></option>\n};
    foreach my $type ( @g_wdraw ){
        print qq{<option value="$type">$g_wdraw{$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" value="SK">};
    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" value="CA">};
    print qq{ $lex{Transfer} -> $lex{Country}</td></tr>\n};

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

    print qq{<tr><td></td><td class="la">};
    print qq{<input type="submit" value="$lex{Yes}, $lex{Withdraw} $firstname $lastname">};
    print qq{</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;
}


#------------------
sub withdrawStudent {
#------------------

    # foreach my $key (keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }
    # Passed 6 fields: studnum, exittype, date, description, prov, country.

    # Check for blank values.... date, reason. If so fail.
    if ( not $arr{date} or not $arr{exittype} ) {
	print qq{<h3>Missing Exit Reason or Date</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    # check that exit date is after (or equal) enrollment date and within school year.
    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>Withdrawal 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>Withdrawal on a closed date not allowed!</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    my $endjd = julian_day( split('-', $schoolend));
    
        
    # Get Previous Enrollment record; verify that's it an enrollment.
    my $sth = $dbh->prepare("select * from transfer where studnum = ? order by date desc"); 
    $sth->execute( $arr{studnum} );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my $tref = $sth->fetchrow_hashref;
    my %t = %$tref; # latest record; we had better have an enrollment, NOT a withdrawal
    # Allow for the fact that some students have no enrollment info, but are current.
    if ( $t{type} and $t{type} ne 'enrol' ) { # Error. Provide a link to view/edit records.ew.pl)
	print qq{<h3>Error - Last transfer record is not an enrollment.</h3>\n};
	print qq{<form action="./transview.pl" method="post" target="_blank">\n};
	print qq{<input type="hidden" name="page" value="1">\n};
	print qq{<input type="hidden" name="studnum" value="$arr{studnum}">\n};
	print qq{<input type="submit" value="View Transfer Records };
	print qq{$t{firstname} $t{lastname} ($t{studnum}) - New Tab">\n};
	print qq{</form>\n};
	print qq{</body></html>\n};
	exit;
    }
    my $enroljd = julian_day( split('-', $t{date}));

    # check that withdrawal date is >= enroldate (enroljd) and before year end (endjd)
    if ( $jd < $enroljd ) {
	print qq{<h3>Error: Withdrawal date ($arr{date}) is earlier than };
	print qq{Enrollment Date ($t{date})</h3>\n};
	
	print qq{<form action="./transview.pl" method="post" target="_blank">\n};
	print qq{<input type="hidden" name="page" value="1">\n};
	print qq{<input type="hidden" name="studnum" value="$arr{studnum}">\n};
	print qq{<input type="submit" value="View Transfer Records };
	print qq{$t{firstname} $t{lastname} ($t{studnum}) - New Tab">\n};
	print qq{</form>\n};

	print qq{</body></html>\n};
	exit;
    } elsif ( $jd > $endjd ) {
	print qq{<h3>Error: Withdrawal date ($arr{date}) is after };
	print qq{the End of the School Year ($schoolend)</h3>\n};
	print qq{</body></html>\n};
	exit;
    }	
    
        
    # Check that the student IS a current student.
    # Shouldn't be necessary, since we only search current students at the start.
    my $sth = $dbh->prepare("select * from student where studnum = ?"); # not studentwd/studentall
    $sth->execute( $arr{studnum} );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my $ref = $sth->fetchrow_hashref; # use this for transfer records.

    $sth->execute( $arr{studnum} );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my @student = $sth->fetchrow;
    if ( not $student[0] ) { # not a current student.
	print qq{<h3>$lex{Error}: You cannot withdraw a student who is already withdrawn!</h3>\n};
	print qq{</body></html>\n};
	exit;
    }


    # Add Audit record.
    my %audit;
    $audit{userid} = $ENV{REMOTE_USER};
    $audit{ipaddr} = $ENV{REMOTE_ADDR};
    $audit{scriptname} = $self;
    $audit{tablename} = 'transfer';
    $audit{tableid} = $id;
    $audit{startval} = $tref; 
    $audit{endval} = \%arr;

    addAudit( \%audit, $dbh );

    
    # Insert Student Record into WD student table
    foreach my $studfld ( @student ){ 
	$studfld = $dbh->quote( $studfld );
    }
    $student[0] = $sql{default};  # reset the studid/id to NULL.
    my $studentstr = join(', ', @student);

    $sth = $dbh->prepare("insert into studentwd values ( $studentstr )");
    $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 qq{$lex{Error}:$self: $DBI::errstr\n};
    }
    print qq{<h3>$lex{Student} -> $lex{Withdrawn} $lex{Student}</h3>\n};


    # Delete Original Student Record from student table
    $sth = $dbh->prepare("delete from student where studnum = ?"); 
    $sth->execute( $arr{studnum} );

    if ( $DBI::errstr) {
	print qq{<h3>$lex{Delete} $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 qq{$lex{Delete} $lex{Student} $lex{Error}:$self: $DBI::errstr\n};
    }

    
    # Insert a transfer record.
    # Get student record, now in studentwd
    #$sth = $dbh->prepare("select * from studentwd where studnum = ?");
    #$sth->execute( $arr{studnum} );
    #if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    #my $ref = $sth->fetchrow_hashref;
    # $ref is defined above line ~339
    my %stud = %$ref;

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

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

    if ($DBI::errstr) {
	print qq{<h3>$lex{Insert} $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 qq{$lex{Insert} $lex{Error}:$self: $DBI::errstr\n};
    }


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

} # end of withdrawStudent
