#! /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 $@
\n}; die qq{Error $@\n}; } eval require "./slxmllibNew.pl"; if ( $@ ) { print qq{Error $@
\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\nSDS Query: School Enrollment $chartype\n[ Main | Export ]

Query School Enrollment

$currlongdate

\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{\n}; } $foundmissing = 1; print qq{\n}; push @noprovnum, "$lastname:$firstname:$studnum"; # used to NOT withdraw them. next; } $localStudent{$provnum} = 1; $masterList{$provnum} = 1; } if ( $foundmissing ) { print qq{
Missing Provincial Number for: }; print qq{$firstname $lastname ($studnum)
\n}; print qq{

}; print qq{Run Identity Script (qryschident.pl)

\n}; print qq{

 

\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{
\n}; print qq{

DEBUG - Request sent to Sask Ed

\n}; my $temp = $output->value; $temp =~ s//>/g; print qq{
$temp

\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{

DEBUG - Sask Ed XML Response

\n}; print qq{
\n}; my $temp = $res->content; $temp =~ s//>/g; print qq{
$temp
\n}; } my $response = $res->content; # Parse the response. my $parser = XML::LibXML->new(); eval {$doc = $parser->parse_string($response)}; if ($@){ print qq{
Sask Ed Error:\n $@\n$response

\n}; print qq{\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{

Transfer Error: $err

}; 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{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
Local School Enrollment: (from local records)$studcount
Sask Ed Enrollment: (from SaskEd records)$skcount

 

\n}; # Start Form print qq{
\n}; print qq{\n}; if ( $debug ) { print qq{\n}; } # Submit Button print qq{\n}; # Withdraw List print qq{

Students to be Withdrawn from Sask Ed

\n}; my $studcount = scalar keys %saskStudent; if ( not $studcount ) { print qq{No students to withdraw.\n}; } else { print qq{\n}; print qq{}; print qq{\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{\n}; $count++; } print qq{
Name / ProvNum / BdateLocal NumActivate
Withdrawal
$count: $lastname, $firstname ($key) $birthdate\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{Not Found\n}; print qq{ Withdraw?\n}; } else { # student found my $studnum = $sth->fetchrow; print qq{$studnum}; 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{Withdraw?\n}; } else { # we have records... $first = 1; while ( my ( $id,$date ) = $sth1->fetchrow ) { if ( not $first ) { print '| '; } else { $first = 0; } print qq{$date}; } } } print qq{
\n}; } # students found print qq{

\n}; # Outstanding enrollments - Local but not Sask MOE. print qq{

Local Students to Enrol with Sask Ed

\n}; my $studcount = scalar keys (%localStudent); if (not $studcount){ print qq{No students to enrol.\n}; } else { print qq{\n}; print qq{\n}; print qq{\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{\n}; $count++; } print qq{
NameWDLocal NumEnrollment
$count: $lastname, $firstname ($key) }; print qq{$birthdate$wd\n}; if ($studnum) { print qq{$studnum}; } else { print qq{Not Found\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{Enrol?\n}; } else { # we have records... my $first = 1; while ( my ($id,$date) = $sth2->fetchrow ) { if ( not $first ) { print '| '; } else { $first = 0; } print qq{$date}; } } print qq{
WD = Withdrawn?

\n}; print qq{\n}; } # end of student display/no display print qq{
\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{

$errmsg ($errcode)

\n}; } print qq{\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}
\n}; } require "$globdir/global.conf" or die "Cannot open global.conf!\n"; # to get the reasons for enrollment / withdrawal. print qq{

Student Withdrawals / Enrollments

\n}; delete $arr{transferflag}; # Form - call updatetransfer.pl script (as does the qryschident.pl script ) print qq{
\n}; if ( $debug ) { print qq{\n}; } # Continuing Enrollment codes print qq{
\n}; print qq{Add Continuing Enrollment Records? \n}; print qq{
\n}; # Batch File / Real Time setting. # print qq{
\n}; # print qq{Create Batch File for Upload to Sask Ed ? \n}; # print qq{\n}; # print qq{
No Real Time Transfers will be done.
\n}; # Table Header. print qq{\n}; print qq{}; print qq{\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}
\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{\n\n}; print qq{\n}; } print qq{
NameProvNumTypeDate
yyyy-mm-dd		Reason
$reccount. $lastname, $firstname }; if ( $birthdate ) { print qq{($birthdate)}; } $reccount++; print qq{$provnum$type}; print qq{}; print qq{
\n}; print qq{
\n}; exit; } # End of activateTransfer