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

#  This file is part of Open Admin for Schools.

# Query School Identities
# Find blank provincial number student and push into blank hash.
# Roll through Sask Ed records and find possible matches based on name and bdate.
# remove matches from blank hash.
# Once done SaskEd records, display remaining students w/o identity.


my $self = 'qryschident.pl';

use DBI;
use CGI;
use XML::Writer;
use XML::Writer::String;
use Data::UUID;
use HTTP::Request::Common qw(POST); 
use HTTP::Headers; 
use LWP::UserAgent; 
use XML::LibXML;
use Time::JulianDay;


my %lex = ( 'Main' => 'Main',
	    'Error' => 'Error',

    );


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

eval require "slxmllibNew.pl";
if ( $@ ) {
    print $lex{Error}. " $@<br>\n";
    die $lex{Error}. " $@\n";
}


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


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

my $debug;
if ( $arr{debug} ) {
    $debug = 1;
    delete $arr{debug};
}


my $title = qq{SDS Query: Identity};
print qq{$doctype\n<html><head><title>$title</title>\n};
print qq{<link rel="stylesheet" href="$css" type="text/css">\n};
print qq{<style type="text/css">\n};
print qq{body { padding: 1em 3em; }</style>\n};
print qq{$chartype\n</head>\n};
print qq{<body>[ <a href="$homepage">Main</a> | <a href="$exppage">Export</a> ]\n};
print qq{<h1>$title</h1>\n};


# Start Page.
if ( $arr{updateflag} ) {
    delete $arr{updateflag};
    activateTransfer();
}


print qq{<div style="width:60%;border:1px solid black;padding:1em;">\n};
print qq{Query Sask Ed's records of student enrollment to locate };
print qq{student information \n for local students <b>without</b> provincial };
print qq{student numbers.</div>\n};


my @tim = localtime(time);
my $year = $tim[5] + 1900;
$tim[4]++;
for (0..4){if (length($tim[$_]) == 1){ $tim[$_] = '0'.$tim[$_];}}
my $currdate = "$year-$tim[4]-$tim[3]";
my $currtime = "$tim[2]:$tim[1]:$tim[0]";
my $currjd = julian_day($year,$tim[4],$tim[3]);


# First run a duplicate provnum check
my $sth = $dbh->prepare("select studnum, lastname, firstname, provnum 
from student where provnum != '' order by provnum");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;}

my $currstud = '-1';
my $currname = '';

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

    $oldstud = $currstud;
    $currstud = $provnum;

    $oldlocal = $currlocal;
    $currlocal = $studnum;

    $oldname = $currname;
    $currname = "$firstname $lastname";

    if ($currstud == $oldstud) { # Ack! We have a duplicate!
	print qq{<div style="border:1px solid black;padding:1em;">};
	print qq{Duplicate for provincial student number: $currstud<br>\n};
	print qq{<b>$currname</b> and <b>$oldname</b> are duplicated!</div>\n};
	# print qq{$currlocal - $oldlocal<br>\n};
    }
}



# Find blank kids and push studnum into %noProvnum hash.
my %noProvnum;
my  $sth = $dbh->prepare("select studnum from student
  where provnum = '' or provnum is null");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while ( my $studnum = $sth->fetchrow ) {
    $noProvnum{$studnum} = 1;
}
if ( not %noProvnum ) { # No kids found...
    print qq{<p><b>All students have provincial numbers.</b></p>\n};
    print qq{</body></html>\n};
    exit;
}


# Create a new user agent
my $ua = LWP::UserAgent->new();
$ua->agent("OpenAdmin");

# Grade and Provincial Number passed
$count=1;
mkQueryString($count); # Generate $output string

# DEBUG Data Errors
if ($debug){
    print qq{<div style="color: blue;">\n};
    print qq{<h1>DEBUG - Request sent to Sask ED</h1>\n};
    my $temp = $output->value;
    $temp =~ s/</&lt;/g;
    $temp =~ s/>/&gt;/g;
    print qq{<pre>",$temp,"</pre></div><p></p>\n};
}

# Create the https post request 
my $req = POST $url, [ XML=>$output->value ];

$req->content_type('application/xml;charset="utf-8"');
$req->authorization_basic($sds_userid, $sds_password); 

# Issue the request and receive a response
my $res = $ua->request($req);

# Check the status of the response
if ($res->is_success) {

    # For Debugging Data Errors
    if ($debug){
	print qq{<h1>DEBUG - Sask Ed XML Response</h1>\n};
	print qq{<div style="color:green;">\n};
	my $temp = $res->content;
	$temp =~ s/</&lt;/g;
	$temp =~ s/>/&gt;/g;
	print qq{<pre>",$temp,"</pre></div>\n};
    }

    my $response = $res->content;
    $response =~ s/\xE9/\x65/g;

    # Parse the response.
    my $parser = XML::LibXML->new();
    
    eval {$doc = $parser->parse_string($response)};
    if ($@){
	print qq{Error: $@<br>\n};
	$response =~ s/</&lt;/g;
	$response =~ s/>/&gt;/g;
	print qq{<pre>Sask Ed Error:\n",$response,"</pre><br>\n};
	print qq{</body></html>\n}; die;
    }

    $doc->setEncoding('UTF-8');
    $root = $doc->getDocumentElement;
    $root->setNamespace($xmlns,'sl',1);

    # find Status
    $status = $root->findvalue('//sl:SL_Status/sl:SL_StatusCode');
    if ($status eq 'Errors' or $status eq 'Invalid'){ 
	# Print out error and add to errorlog.
	prErr("$lastname, $firstname ($studnum)");
    } elsif ($status eq 'Successful'){ 

	parseStudentPersonal();

    } else { # print warnings... ($status eq 'Warnings')
	print qq{There were warnings...\n};
    }
    
}  else { # Transfer Error!
    my $err = $res->status_line;
    print qq{<h1>Transfer Error: $err</h1>\n};
}

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


# Functions =============================

#----------------
sub mkQueryString {  # StudentPersonal
#----------------

    my ($grade, $provnum, $idcount) = @_;
    # Date and schoolnumber are globals.

    # Create Writer Instance
    $output = new XML::Writer::String;
    my $datamode = 0;
    if ($debug){ $datamode = 1;} # pretty print xml output
    $wr = new XML::Writer(OUTPUT => $output, 
			  DATA_MODE => $datamode, 
			  DATA_INDENT => '2');

    # Set XML Header and write Root Element
    $wr->xmlDecl("UTF-8");
    $wr->startTag('SL_Message','xmlns' =>$xmlns, 
		  'xmlns:xsi' =>$xmlnsxsi, 
		  'xsi:schemaLocation' => $xsischemaLocation);

    $wr->startTag('SL_Request');

    # library call
    mkSL_Header($currdate, $currtime, $schoolnumber, $idcount);

    $wr->startTag('SL_Query');

    $wr->startTag('QueryBySchool',
		  'RefId' => "$schoolnumber",
		  'ObjectName' => 'StudentPersonal',
		  'ScopeCode' => 'Current'
	);

    $wr->dataElement('SchoolId',$schoolnumber); 

    my ($tyear,$tmon,$tday) = inverse_julian_day( $currjd + 1 );
    if ( length($tmon) == 1 ) { $tmon = '0'. $tmon; } 
    if ( length($tday) == 1 ) { $tday = '0'. $tday; } 
    my $tomorrow = $tyear. $tmon. $tday;
    $wr->dataElement('FromDate', $tomorrow ); 	
    $wr->dataElement('ToDate', $tomorrow );
    # Format is: '20051201';

    #$wr->startTag('FromGrade', 'Code' => 'PK');
    #$wr->characters(' ');
    #$wr->endTag('FromGrade');

    #$wr->startTag('ToGrade', 'Code' => '12'); 	
    #$wr->endTag('ToGrade');

    $wr->endTag('QueryBySchool');

    $wr->endTag('SL_Query');
    $wr->endTag('SL_Request');
    $wr->endTag('SL_Message');
    $wr->end();
    
}



#---------
sub prErr {  # Print Errors to Screen
#---------

    my $name = shift;

    my @errors = $root->findnodes('//sl:SL_Error');
    foreach my $error (@errors){
	# Get Error Elements
	my $objectname = $error->getAttribute('ObjectName');
	my $errmsg = $error->findvalue('./sl:SL_ErrorMsg');
	$errmsg =~ s/[\r|\n]/ /g;
	my $errcode = $error->findvalue('./sl:SL_ErrorCode');
	
	print qq{<p style="color:red;">$errmsg ($errcode)</p>\n};
    }
    
}



#-----------------------
sub parseStudentPersonal { # passed document root object.
#-----------------------
    my @studinfo = $root->findnodes('//sl:StudentPersonal');

    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="updateflag" value="1">\n};
    if ( $debug ) {
	print qq{<input type="hidden" name="debug" value="1">\n};
    }

    print qq{<input type="submit" value="Update Enrollments">\n};
    my $first = 1;

STUDENT:
    foreach my $student ( @studinfo ){
	my $provnum = $student->findvalue('sl:StudentIdentification/sl:DeptAssignedPersonId');
	my $birthdate = $student->findvalue('sl:StudentIdentification/sl:BirthDate');
	my $firstname = $student->findvalue('sl:StudentInfo/sl:Name/sl:FirstName');
	my $lastname = $student->findvalue('sl:StudentInfo/sl:Name/sl:LastName');
	my $middlename = $student->findvalue('sl:StudentInfo/sl:Name/sl:MiddleName');
	my $phone = $student->findvalue('sl:StudentInfo/sl:PhoneNumber');

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

	# Get student record w/o provnum
	my  $sth = $dbh->prepare("select studid, lastname, firstname, initial, 
          studnum, birthdate, hphone1 from studentall 
          where provnum = '' and birthdate = ? and lastname = ? and firstname = ?");
	$sth->execute( $birthdate, $lastname, $firstname);
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $matchcount = $sth->rows;
	if ( $matchcount < 1 ) { next STUDENT; }
	if ( $matchcount > 1 ) {
	    print qq{$lex{Error}: More than 1 student with same firstname, lastname and birthdate!<br>\n};
	    print qq{ $firstname $lastname - $birthdate. Dying!<br>\n};
	    print qq{</body></html>\n};
	    die "Multiple student records with same name and birthdate!\n";
	}

	if ( $first ) {
	    print qq{<h1>Students with No Provincial Number, Enrolled by Sask Ed</h1>\n};
	    print qq{<div style="padding:1em;">};
	    print qq{<input type="submit" value="Update Enrollments">\n};
	    print qq{</div>\n};

	    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
	    print qq{<caption>[ <b>White</b> - Sask Ed record |};
	    print qq{<b>Gray</b> - Local Record | <span style="color:red;">WD</span> };
	    print qq{= Withdrawn ]</caption>\n};
	    print qq{<tr><th>Lastname</th><th>Firstname</th><th>Middlename</th>};
	    print qq{<th>Birthdate</th><th>Phone</th><th>Sask Lrn #</th></tr>\n};
	    $first = 0;
	}

	my $sth1 = $dbh->prepare("select count(*) from student where studnum = ?");
	my $sth2 = $dbh->prepare("update ? set provnum = ? where studnum = ?");
	my $sth3 = $dbh->prepare("select id from transfer where studnum = ? and 
         type = 'withdraw' order by date desc");

	# Print Sask Ed Record and then matches locally.
	print qq{<tr><td>$lastname</td><td>$firstname</td><td>$middlename</td>\n};
	print qq{<td>$birthdate</td><td>$phone</td><td>$provnum</td></tr>\n};

	while (my ($id, $localLastname, $localFirstname,$localMiddlename,
		   $studnum, $localBirthdate, $localPhone) = $sth->fetchrow) {

            # Get rid of noProvnum record
            delete $noProvnum{$studnum};


	    # Check to see if student is withdrawn (ie. present in student table?)
	    $sth1->execute($studnum);
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my $reccount = $sth1->fetchrow;
	    my ($wd, $tb);
	    my $table = 'student';
	    if ($reccount < 1){ 
		$wd = qq{<span style="color:red;">WD</span>}; 
		$tb = "&tb=wd";
		$table = 'studentwd';
            }

	    # Now update the provnumber in the table (student or studentwd)
	    my $sth2 = $dbh->prepare("update $table set provnum = ? where studnum = ?");
	    $sth2->execute($provnum, $studnum);

	    if ($DBI::errstr){ print qq{Error line 352: $DBI::errstr}; die $DBI::errstr; }

	    # Now look for transfer records in order to get date and entry/exit code.
	    $sth3->execute($studnum);
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    my $transid = $sth3->fetchrow;

    	    print qq{<tr style="background-color:#DDD;">};
	    print qq{<td>$wd <a href="$cgiurl/studed.pl?id=$id$tb">};
            print qq{$localLastname</a></td><td>$localFirstname</td><td>$localMiddlename</td>};
	    print qq{<td>$localBirthdate</td><td>$localPhone</td>\n};

            if ($reccount < 1) { # withdrawn, so update Sask Ed.
		print qq{<td class="cn"><input type="checkbox" };
		if ($transid) { # we have a transfer record with wd info.
		    print qq{name="WD:TR:$transid" value="1"></td></tr>\n};

		} else { # no transfer rec; use PN approach... all data available.
		    print qq{name="WD:PN:$provnum:$lastname:$firstname:$middlename:$birthdate" };
		    print qq{value="1"></td></tr>\n};
		}
	    } else { # do nothing... provnum already updated.
		print qq{<td></td></tr>\n};
	    }


	} # Single Student Loop

    }  # Overall Student Loop

    if (not $first) {
	#print qq{<tr><td colspan="6" class="cn">};
	#print qq{<input type="submit" value="Update Enrollments">\n};
	#print qq{</td></tr>\n};
	print qq{</table>\n};
    }
    
    
    # Now do students not enrolled with Sask ED (and no provnum as a result)
    print qq{<h1>Students with No Provincial Number, and not Enrolled by Sask Ed</h1>\n};
    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
    print qq{<tr><th>Name</th><th>Birthdate</th><th>Enrol</th></tr>\n};

    my $count = 1;

    my $sth3 = $dbh->prepare("select id from transfer where studnum = ? and 
         type = 'enrol' order by date desc");

    foreach my $studnum (keys %noProvnum) {

	# Load values from student table; 
	my $sth = $dbh->prepare("select studid,lastname, firstname, initial, birthdate 
           from student where studnum = ?");
	$sth->execute($studnum);
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my ($id,$lastname, $firstname, $middlename, $birthdate) = $sth->fetchrow;

    
	if ( $birthdate eq '0000-00-00' or not $birthdate ) {
	    print qq{<span>No Birthdate - <b>$firstname $lastname</b> / </span>\n};
	    next;
	}

	my $res = checkDate( $birthdate );
	if ( $res == 255 ) { 
	    print qq{<div><b>Birthdate Format Error</b> - <b>$firstname $lastname</b> / </div>\n};
	    next;
	}

	
	# Now look for transfer records in order to get date and entry/exit code.
	$sth3->execute($studnum);
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $transid = $sth3->fetchrow;

	# print start of this record
	print qq{<tr><td>$wd <a href="$cgiurl/studed.pl?id=$id">};
	print qq{$lastname</a>, $firstname $middlename</td><td>$birthdate</td>\n};

	# now the selection checkbox for enrollment.
	print qq{<td class="center"><input type="checkbox" };
	if ($transid) { # we have a transfer record with wd info.
	    print qq{name="EN:TR:$transid" value="1"></td></tr>\n};
	} else { # no transfer rec; use SN approach... all data available.
	    print qq{name="EN:SN:$studnum:$lastname:$firstname:$middlename:$birthdate" };
	    print qq{value="1"></td></tr>\n};
	}

        $count++;
    }

    print qq{</table>\n};
    print qq{<div style="padding:1em;"><input type="submit" value="Update Enrollments">\n};
    print qq{</div></form>\n};



} # End of Sub parseStudentPersonal



#-------------------
sub activateTransfer { # passed list of transfer recs to setup date/code selects.
#-------------------

    require "$globdir/global.conf" or die "Cannot open global.conf!\n";

    print qq{<h3>Student Withdrawals / Enrollments</h3>\n};
    delete $arr{transferflag};

    # Now run external and use existing updatetransfer.pl
    print qq{<form action="updatexfer.pl" method="post">\n};
    if ( $debug ) {
	print qq{<input type="hidden" name="debug" value="1">\n};
    }

    print qq{<div style="width:40%;border:1px solid black;padding:0.4em;text-align:center;};
    print qq{font-size:130%;margin:0 3em;">\n};
    print qq{Create <b>Batch File</b> for Upload to Sask Ed ? \n};
    print qq{<input type="checkbox" name="filemode" value="1">\n};
    print qq{<br>No Real Time Transfers will be done.</div>\n};


    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
    print qq{<tr><th>Name</th><th>Number</th><th>Type</th>};
    print qq{<th>Date<br>yyyy-mm-dd</th><th>Reason</th></tr>\n};

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


    my $reccount = 1; 
    my $enrolflag = 1;

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

	my ($EnWd, $rectype, @value) = split ':', $key;
	my (@tr, $date, $code, $type, $firstname, $lastname, $birthdate, $provnum);

#	if ( $birthdate eq '0000-00-00' or not $birthdate ) {
#	    print qq{<div>Birthdate Error for: $firstname $lastname</div>\n};
#	    next;
#	}
	

	if ($EnWd eq 'EN') { 
	    $type = 'enroll';
	} else { 
	    $type = 'withdraw'; 
	    # print qq{<tr style="background-color:#CCC;height:0.4em;">};
	    # print qq{<td colspan="5"></td></tr>\n};
	}

	if ( $rectype eq 'TR' ) { # we have a TR (transfer record), read the record...
	    my $id = $value[0];

	    my $sth = $dbh->prepare("select * from transfer where id = ?");
	    $sth->execute($id);
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    @tr = $sth->fetchrow;
	    $num = $tr[1]; # student number used after this section....
	    $date = $tr[2];
	    if ( $EnWd eq 'EN' ) { $code = $tr[5]; } else { $code = $tr[6]; }
	    if ( $tr[14] ) { 
		$provnum = $tr[14];
	    } else {  # get provincial number
		my $sth3 = $dbh->prepare("select provnum from studentall where studnum = ?");
		$sth3->execute($tr[1]);
		if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
		$provnum = $sth3->fetchrow;
		#print qq{PN:$provnum SN:$tr[1]<br>\n};
		
	    }

	    # Get name; tr[1] is studnum;
	    if ($tr[10]) { # we have a name in the transfer record...
		$lastname = $tr[10];
		$firstname = $tr[11];
	    } else {
		$sth1->execute($tr[1]);
		if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
		($lastname, $firstname) = $sth1->fetchrow;
	    }

	    
	} else { # Method is SN or PN (Local Studnum or Provnum)

	    # values in $rectype is PN or SN, $values[0] is number,
	    # rest of @values are name and birthdate.
	    
	    ($num, $lastname, $firstname, $middlename, $birthdate) = @value;
	    my $fieldname;
	    if ($rectype eq 'PN'){ $fieldname = 'provnum'; } else { $fieldname = 'studnum'; }
	    if (not $lastname) { # We only have the provincial number for a local record...
		my $sth = $dbh->prepare("select lastname, firstname, initial, birthdate 
                 from studentall where $fieldname = ?");
		$sth->execute($num);
		if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
		($lastname, $firstname, $middlename, $birthdate) = $sth->fetchrow;
	    }
	}

	if ( not $provnum ) { $provnum = "S$num"; }

	print qq{<tr><td>$reccount. <b>$lastname</b>, $firstname $middlename};
	if ( $birthdate ) { print qq{ ($birthdate) }; }
	$reccount++;

#	$date = '2019-09-03';
#	$code = '05';
	
	print qq{</td><td>$provnum</td><td>$type</td>\n<td>};
	print qq{<input type="text" name="D:$provnum" value="$date" size="12">};
	print qq{<input type="hidden" name="B:$provnum" value="$birthdate"></td>\n};

	print qq{<td><select name="C:$provnum:$type">};
	if ( $type eq 'enroll' ) {
	    print qq{<option value="$code">$g_enrol{$code}};
	    if ($code) { print qq{ ($code)};}
	    print qq{</option>\n};
	    foreach my $key (sort keys %g_enrol) {
		print qq{<option value="$key">$g_enrol{$key} ($key)</option>\n};
	    }
	} else {
	    print qq{<option value="$code">$g_wdraw{$code}};
	    if ($code) { print qq{ ($code)}; }
	    print qq{</option>\n};
	    foreach my $key (sort keys %g_wdraw) {
		print qq{<option value="$key">$g_wdraw{$key} ($key)</option>\n};
	    }
	}
	print qq{</select></td></tr>\n};
	
    }

    print qq{</table><input type="submit" value="Update Student Enrollments">\n};
    print qq{</form></body></html>\n};

    exit;

} # End of activateTransfer




#------------
sub checkDate {
#------------

#    use Time::JulianDay;
    
    my $date = shift;

    my ($y,$m,$d) = split('-',$date);
    
    if ( not $d ) { return 255; }  # wrong format.
    if ( $m > 12 or $m < 1 ) { return 255; }
    if ( $d > 31 or $d < 1 ) { return 255; }

#    my $datejd = julian_day( $y, $m, $d );

#    my $startjd = julian_day( split('-', $schoolstart ));
#    my $endjd = julian_day( split('-', $schoolend ));
    
#    print "DATE:$date - $datejd Start:$schoolstart - $startjd  End:$schoolend - $endjd<br>\n";

#    if ( $datejd > $endjd  or $datejd < $startjd ) {
#	return 1; # different code for date outside of current year;
#    }
    
    return 0;

}
