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

$title

\n}; # Start Page. if ( $arr{updateflag} ) { delete $arr{updateflag}; activateTransfer(); } print qq{
\n}; print qq{Query Sask Ed's records of student enrollment to locate }; print qq{student information \n for local students without provincial }; print qq{student numbers.
\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{
}; print qq{Duplicate for provincial student number: $currstud
\n}; print qq{$currname and $oldname are duplicated!
\n}; # print qq{$currlocal - $oldlocal
\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{

All students have provincial numbers.

\n}; print qq{\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{
\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; $response =~ s/\xE9/\x65/g; # Parse the response. my $parser = XML::LibXML->new(); eval {$doc = $parser->parse_string($response)}; if ($@){ print qq{Error: $@
\n}; $response =~ s//>/g; print qq{
Sask Ed Error:\n",$response,"

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

Transfer Error: $err

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

$errmsg ($errcode)

\n}; } } #----------------------- sub parseStudentPersonal { # passed document root object. #----------------------- my @studinfo = $root->findnodes('//sl:StudentPersonal'); print qq{
\n}; print qq{\n}; if ( $debug ) { print qq{\n}; } print qq{\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
\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!
\n}; print qq{ $firstname $lastname - $birthdate. Dying!
\n}; print qq{\n}; die "Multiple student records with same name and birthdate!\n"; } if ( $first ) { print qq{

Students with No Provincial Number, Enrolled by Sask Ed

\n}; print qq{
}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{\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{\n}; print qq{\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{WD}; $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{}; print qq{}; print qq{\n}; if ($reccount < 1) { # withdrawn, so update Sask Ed. print qq{\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">\n}; } } else { # do nothing... provnum already updated. print qq{\n}; } } # Single Student Loop } # Overall Student Loop if (not $first) { #print qq{\n}; print qq{
[ White - Sask Ed record |}; print qq{Gray - Local Record | WD }; print qq{= Withdrawn ]
LastnameFirstnameMiddlenameBirthdatePhoneSask Lrn #
$lastname$firstname$middlename$birthdate$phone$provnum
$wd }; print qq{$localLastname$localFirstname$localMiddlename$localBirthdate$localPhone
}; #print qq{\n}; #print qq{
\n}; } # Now do students not enrolled with Sask ED (and no provnum as a result) print qq{

Students with No Provincial Number, and not Enrolled by Sask Ed

\n}; print qq{\n}; print qq{\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{No Birthdate - $firstname $lastname / \n}; next; } my $res = checkDate( $birthdate ); if ( $res == 255 ) { print qq{
Birthdate Format Error - $firstname $lastname /
\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{\n}; # now the selection checkbox for enrollment. print qq{\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">\n}; } $count++; } print qq{
NameBirthdateEnrol
$wd }; print qq{$lastname, $firstname $middlename$birthdate
\n}; print qq{
\n}; print qq{
\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{

Student Withdrawals / Enrollments

\n}; delete $arr{transferflag}; # Now run external and use existing updatetransfer.pl print qq{
\n}; if ( $debug ) { print qq{\n}; } 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}; print qq{\n}; print qq{}; print qq{\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}
\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{
Birthdate Error for: $firstname $lastname
\n}; # next; # } if ($EnWd eq 'EN') { $type = 'enroll'; } else { $type = 'withdraw'; # print qq{}; # print qq{\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]
\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{\n\n}; print qq{\n}; } print qq{
NameNumberTypeDate
yyyy-mm-dd
Reason
$reccount. $lastname, $firstname $middlename}; if ( $birthdate ) { print qq{ ($birthdate) }; } $reccount++; # $date = '2019-09-03'; # $code = '05'; print qq{$provnum$type}; print qq{}; print qq{
\n}; print qq{
\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
\n"; # if ( $datejd > $endjd or $datejd < $startjd ) { # return 1; # different code for date outside of current year; # } return 0; }