#! /usr/bin/perl
#  Copyright 2001-2021 Leslie Richardson
#  This file is part of Open Admin for Schools.

# Query Function for StudentPersonal Objects
# Passed Values: none.

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;

my $self = 'syncenrol.pl';

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

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


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

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

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

# Setup Date and Times
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 $currlongdate = "$month[$tim[4]] $tim[3], $year";

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



# This shows the records to update....(and select)
if ( $arr{page} ) { # Activate/Create Transfer records
    delete $arr{page};
    activateTransfer();
}


# Find all local kids and push studnum into hash, display any blank provnum
my  $sth = $dbh->prepare("select studnum, provnum, lastname, firstname 
  from student order by provnum");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
my $studcount = $sth->rows;

# Note any missing provincial numbers...
my $foundmissing = 0;
my %localStudent = ();
my %masterList = ();

while ( my ( $studnum,$provnum,$lastname, $firstname ) = $sth->fetchrow ) {
    if ( not $provnum ) { 
	if ($foundmissing == 0){ # print the table heading, once.
	    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
	}
	$foundmissing = 1;
	print qq{<tr><td>Missing Provincial Number for: };
	print qq{<b>$firstname $lastname</b> ($studnum)</td></tr>\n}; 
	push @noprovnum, "$lastname:$firstname:$studnum"; # used to NOT withdraw them.
	next;
    }
    $localStudent{$provnum} = 1;
    $masterList{$provnum} = 1;
}

if ( $foundmissing ) {
    print qq{</table>\n};
    print qq{<p><a href="qryschident.pl" class="button">};
    print qq{Run Identity Script (qryschident.pl)</a></p>\n};
    print qq{<p>&nbsp;</p>\n};
}


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

my $count++;

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;

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

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

    my $mastermsgid = $root->findvalue('//sl:SL_MsgId');
    my $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($mastermsgid,"$lastname, $firstname ($studnum)");

    } elsif ( $status eq 'Successful' ){ 

	my $ref = parseSPLite( $root ); # main thing... get their list of kids.
	@slprovnums = @$ref;

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


# Now create a master list from both lists.
my %saskStudent = ();
my $skcount = $#slprovnums + 1;
foreach my $pn ( @slprovnums ) { 
    $masterList{$pn} = 1;
    $saskStudent{$pn} = 1;
}

#other hash is: $localStudent{$provnum} = 1;

foreach my $pn ( keys %masterList ) { # go through all students (on both lists)
    # Delete them if we have a match (they're registered in both systems)
    if ( $saskStudent{$pn} == $localStudent{$pn} and $localStudent{$pn} == 1 ) {
	delete $saskStudent{$pn};
	delete $localStudent{$pn};
    }
}

# Display Enrollments - Sask Ed and Local
print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
print qq{<tr><td><b>Local School Enrollment: (from local records)</b></td>\n};
print qq{<td><b>$studcount</b></td></tr>\n};
print qq{<tr><td><b>Sask Ed Enrollment: (from SaskEd records)</b></td>\n};
print qq{<td><b>$skcount</b></td></tr></table><p>&nbsp;</p>\n};


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

# Submit Button
print qq{<input type="submit" value="Continue">\n};


# Withdraw List
print qq{<h1>Students to be Withdrawn from Sask Ed</h1>\n};
my $studcount = scalar keys %saskStudent;
if ( not $studcount ) {
    print qq{<b>No students to withdraw.</b>\n}; 
} else {
    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
    print qq{<tr><th>Name / ProvNum / Bdate</th><th>Local Num</th>};
    print qq{<th>Activate<br>Withdrawal</th></tr>\n};

    my $count = 1;

    foreach my $key ( sort keys %saskStudent ) { # key is provnum

	my $studnum;
	my ($lastname,$firstname,$middlename,$birthdate) = split /:/, $slname{$key};
	($firstname, $rest) = split /\s/,$firstname;
	print qq{<tr><td>$count: <b>$lastname</b>, $firstname ($key) $birthdate</td><td>\n};

	my $sth = $dbh->prepare("select studnum from studentall where provnum = ?");
	$sth->execute( $key ) ;
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
	my $rows = $sth->rows;

	my $transrows; # count of transfer records...
	if ($rows < 1){ # student not found...
	    print qq{<font color=red>Not Found</font></td><td>\n}; 
	    print qq{<input type="checkbox" name="WD:PN:$key:$slname{$key}" };
	    print qq{value="1"> Withdraw?\n};
	} else { # student found
	    my $studnum = $sth->fetchrow;
	    print qq{$studnum</td><td>};

	    my $sth1 = $dbh->prepare("select id, date from transfer
             where studnum = ? and type = ? order by date desc");
	    $sth1->execute( $studnum, 'withdraw' );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
	    $transrows = $sth1->rows;

	    if ( $transrows < 1 ){ # student transfers not found...
		print qq{<input type="checkbox" name="WD:PN:$key" };
		print qq{value="1">Withdraw?\n};

	    } else { # we have records...
		$first = 1;
		while ( my ( $id,$date ) = $sth1->fetchrow ) {
		    if ( not $first ) { print '| '; } else { $first = 0; }
		    print qq{<input type="checkbox" name="WD:TR:$id" };
		    print qq{value="1">$date}; 
		}
	    }
	}

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

    print qq{</table>\n};
} # students found

print qq{<p></p>\n};


# Outstanding enrollments - Local but not Sask MOE.
print qq{<h1><b>Local Students to Enrol with Sask Ed</b></h1>\n};

my $studcount = scalar keys (%localStudent);
if (not $studcount){ 
    print qq{<b>No students to enrol.</b>\n}; 
} else {

    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
    print qq{<tr><th>Name</th><th>WD</th>\n};
    print qq{<th>Local Num</th><th>Enrollment</th></tr>\n};

    my $count = 1;
    foreach my $key (keys %localStudent) {

	# Get studnum from provnum $key
	my $sth1 = $dbh->prepare("select studnum, birthdate from studentall
        where provnum = ?");
	$sth1->execute( $key );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
	my ($studnum, $birthdate) = $sth1->fetchrow;
	my $rows = $sth1->rows;

	my ($lastname, $firstname, $wd, $trn) = split ':', findStudent($key);
	if ($wd == 1) { $wd = 'Y'; } else { $wd = 'N'; }

	print qq{<tr><td>$count: <b>$lastname</b>, $firstname ($key) };
	print qq{$birthdate</td><td>$wd</td><td>\n};

	if ($studnum) {
	    print qq{$studnum</td><td>};
	} else {
	    print qq{<font color=red>Not Found</font></td><td>\n};
	}

	my $sth2 = $dbh->prepare("select id, date from transfer
         where studnum = '$studnum' and (type = 'enrol' or type = 'reenrol' or type = 're-enrol')
         order by date desc");
	$sth2->execute;
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $transrows = $sth2->rows;

	if ( $transrows < 1 ){ # student transfers not found...
	    print qq{<input type="checkbox" name="EN:PN:$key" };
	    print qq{value="1">Enrol?\n};

	} else { # we have records...
	    my $first = 1;
	    while ( my ($id,$date) = $sth2->fetchrow ) {
		if ( not $first ) { print '| '; } else { $first = 0; }
		print qq{<input type="checkbox" name="EN:TR:$id" };
		print qq{value="1">$date}; 
	    }
	}

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

    }

    print qq{</table>WD = Withdrawn? <p></p>\n};
    print qq{<input type="submit" };
    print qq{value="Update Selected Students">\n};
    
} # end of student display/no display

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



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

#----------------
sub mkQueryString {  # QryBySchool for StudentPersonal objects.
#----------------

    my $idcount = shift;

    # 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');
    &mkSL_Header($currdate, $currtime, $schoolnumber,$idcount);

    $wr->startTag('SL_Query');

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

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

    my $cdate = $currdate;
    $cdate =~ s/-//g; # strip hyphens
    $wr->dataElement('FromDate',$cdate); 	
    $wr->dataElement('ToDate',$cdate); 	

    $wr->endTag('QueryBySchool');

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



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

    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; font-size:120%">$errmsg ($errcode)</p>\n};
    }

    print qq{</table>\n};

}

#--------------
sub findStudent {
#--------------

    # Passed prov number... return data
    my $provnum = shift;

    # Get student record
    my  $sth = $dbh->prepare("select lastname, firstname, initial, studnum
      from studentall where provnum = ?");
    $sth->execute( $provnum );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my ($lastname, $firstname,$middlename,$studnum) = $sth->fetchrow;
    if ( not $lastname ) { $lastname = 'Not Found'; return $lastname; }
    

    # Check whether current or withdrawn.
    my $wd;
    $sth = $dbh->prepare("select count(*) from student
      where provnum = ?");
    $sth->execute($provnum);
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
    my $idcount = $sth->fetchrow;
    if ($idcount == 1){ $wd = 0 } else { $wd = 1; }


    # Check if records in transfer table (if missing...)
    $sth = $dbh->prepare("select count(*) from transfer where studnum = ?");
    $sth->execute( $studnum );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
    my $transcount = $sth->fetchrow;
 
    return "$lastname:$firstname:$wd:$transcount";

}


#--------------
sub parseSPLite { # parse only for provnum 
#--------------

    my $root = shift;

    my @studinfo = $root->findnodes('//sl:StudentPersonal');
    my @slprovnums = ();

    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');
	$slname{$provnum} = "$lastname:$firstname:$middlename:$birthdate";
        
	push @slprovnums, $provnum;
    }

    return \@slprovnums; # return ref to list of kids in Sask Ed enrollment list.

} # End of parseSPLite;




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

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

    require "$globdir/global.conf" or die "Cannot open global.conf!\n";
    # to get the reasons for enrollment / withdrawal.


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

    # Form - call updatetransfer.pl script (as does the qryschident.pl script )
    print qq{<form action="updatexfer.pl" method="post">\n};

    if ( $debug ) {
	print qq{<input type="hidden" name="debug" value="1">\n};
    }

    # Continuing Enrollment codes
    print qq{<div style="width:50%;border:1px solid black;padding:0.4em;text-align:center;};
    print qq{font-size:100%;margin:1em 0.4em;">\n};
    print qq{Add Continuing Enrollment Records? \n};
    print qq{<input type="checkbox" name="sync" value="1"></div>\n};


    # Batch File / Real Time setting.
    #    print qq{<div style="width:50%;border:1px solid black;padding:0.4em;text-align:center;};
    # print qq{font-size:130%;margin:1em 0.4em;">\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};

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

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


    my $reccount = 1; # a counter for those without a provincial number....
    my $enrolflag = 1;

    # Loop through all passed records.
    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 ($EnWd eq 'EN') { 
	    $type = 'enroll';
	} else { 
	    $type = 'withdraw'; 
	}

	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;

	    # Get Date
	    $date = $tr[2];

	    # Get Code
	    if ( $EnWd eq 'EN' ) { $code = $tr[5]; } else { $code = $tr[6]; }

	    # Get provnum, name, and birthdate
	    $sth = $dbh->prepare("select lastname, firstname, birthdate, provnum from studentall 
              where studnum = ?");
	    $sth->execute( $tr[1] );
	    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	    ( $lastname, $firstname, $birthdate, $provnum ) = $sth->fetchrow;

	    
	} else { # we have a PN - prov number data in the name, birthdate values in @values

	    ($provnum, $lastname, $firstname, $middlename, $birthdate) = @value;

	    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 provnum = ?");
		$sth->execute($provnum);
		if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
		($lastname, $firstname, $middlename, $birthdate) = $sth->fetchrow;
	    }

	}


	if (not $provnum) { $provnum = $tempcount; }
	$tempcount++;

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

	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 ( @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 ( @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
