#! /usr/bin/perl # Copyright 2001-2020 Leslie Richardson # This file is part of Open Admin for Schools. # accepts input from other scripts ( button 1 and 2) qryschident.pl and # syncenrol.pl. The passed values include date (D:provnum = date) and # code, type "C:provnum:type = code" B:provnum = birthdate # or D:'S'localnum format. # Record is a StudentSchoolEnrollment object. Update the # provincial number (if not present and returned via XML). # If Withdrawal, generate a StudentSchoolEnrollment object with exit reason. # Configuration Values my $studentrecords = 'Student.Records@k12.gov.sk.ca'; # Student Records email address. # my $g_mailserver # from admin.conf # my $returnaddress # from admin.conf my $self = 'updatexfer.pl'; # Used for Filename Date my @smonth = ('', 'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC'); 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 MIME::Base64; use Number::Format qw(round); # use Mail::Sender; # use NEWER Email::Sender instead. my %lex = ( 'Main' => 'Main', 'Error' => 'Error', 'Enrollment File' => 'Enrollment File', 'View/Download' => 'View/Download', ); 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 $q = new CGI; print $q->header( -charset, $charset); my %arr = $q->Vars; #foreach my $key ( sort keys %arr) { print "K:$key V:$arr{$key}
\n"; } # cleanup any other passed values my $debug = $arr{debug}; # $debug = 1; delete $arr{debug}; my $filemode = $arr{filemode}; delete $arr{filemode}; if ( $filemode ) { $maxfilesize = '1000000'; } # if called via syncenrol.pl my $sync = $arr{sync}; delete $arr{sync}; # $sync = 0; # turn off for now. my $title = qq{SDS Enrollment Update}; print qq{$doctype\n$title\n}; print qq{\n $chartype\n\n}; print qq{[ Main | Export | }; print qq{View Transfers ]\n}; # Process Mail for Sask Ed. if ( $arr{domail} ) { delete $arr{domail}; # postEmail(); # not anymore } if ( $debug and not $filemode ) { $maxfilesize = 3000; # change xml file transfer size } print qq{

$title

\n}; #print "Debug: $debug\n"; my @tim = localtime(time); my $year = $tim[5] + 1900; $tim[4]++; # For Filename my $fyear = $year - 2000; my $filecurrdate = $tim[3]. $smonth[ $tim[4] ]. $fyear; my $filecurrtime = $tim[2]. $tim[1]; # Time goes on.... 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 $dsn = "DBI:$dbtype:dbname=$dbase"; $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; my %studrec = (); # holds enrollment change data. my %enrol = (); # hold continuing enrollment data. foreach my $key ( keys %arr ) { my ($t, $provnum, $type) = split ':', $key; if ($t eq 'D' or $t eq 'B') { next; } # skip the date (D) values and birthdate my $date = $arr{"D:$provnum"}; my $birthdate = $arr{"B:$provnum"}; my $code; if ( length $arr{$key} < 3 ) { # we have a code value without text desc; $code = $arr{$key}; } else { # must have both; split out code (my $text, $code) = split '\(', $arr{$key}; $code =~ s/\)//; } # print "PN:$provnum C:$code D:$date T:$type B:$birthdate
\n"; $studrec{$provnum} = "$date:$code:$type:$birthdate"; push @provnums, $provnum; if ( $type eq 'enroll' or type eq 'enrol' ) { # continuing enrollment $enrol{$provnum} = 1; } } if ( $sync ) { # loop through all current students and add continuing recs. my $sth = $dbh->prepare("select provnum, birthdate from student order by lastname, firstname"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} while ( my ( $provnum, $birthdate ) = $sth->fetchrow ) { if ( $enrol{$provnum} ) { next; } # skip if ( not $provnum ) { next; } # skip if no province number push @provnums, $provnum; $studrec{$provnum} = "$schoolstart:15:enroll:$birthdate"; # school start date, code 15 } } my $rows = keys( %studrec ); # number of enrollment changes if ( $rows < 1 ){ print "

Nothing to Report.

\n"; exit; } # print Sask Ed Student Transfer Header. print "

Sask Ed Update - $rows Transfer Records

\n"; my $donecount = 1; my $reccount = $rows; my $xfercount = 1; # Counter for message headers (to make unique). my $filename; if ( $filemode ) { # open the file for writing. $filename = 'ENROL_'. $schoolnumber. '_'. $filecurrdate. '_'. $filecurrtime. '.xml'; open(FH,">$filename") or die "Cannot Open XML file\n"; } while ( $donecount <= $reccount ) { # Start New Table for Student Records print "\n"; # Create a new user agent my $ua = LWP::UserAgent->new(); $ua->agent("OpenAdmin"); $ua->timeout(300); # Create Writer Instance my $output = XML::Writer::String->new(); my $datamode = 0; if ( $debug ){ $datamode = 1; } # override datamode since required for email mailbacks. # $datamode = 1; $wr = new XML::Writer(OUTPUT => $output, DATA_MODE => $datamode, DATA_INDENT => '2'); # Data Mode 1 turns on pretty output, Data Mode 0 is more condensed. # 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_Event'); mkSL_Header($currdate,$currtime, $schoolnumber,$xfercount); $xfercount++; # increment for next header. $wr->startTag('SL_ObjectData'); # prep for retrieving from student data $sth1 = $dbh->prepare("select * from studentall where provnum = ?"); my $filesize = 0; # Loop through students while smaller than maxfilesize. while ( my $provnum = shift @provnums ){ my %sr; # Some may be local studnums since no provnum... if ( $provnum =~ m/^S/ ) { $studnum = $provnum; $studnum =~ s/^S//; # strip leading S #print "Yes, a local number!: $studnum"; my $sth2 = $dbh->prepare("select * from studentall where studnum = ?"); $sth2->execute( $studnum ); if ( $DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth2->fetchrow_hashref; # %sr = student record %sr = %$ref; } else { # we have provnum; # Pull in matching student data $sth1->execute( $provnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth1->fetchrow_hashref; # %sr = student record %sr = %$ref; } my ($date, $code, $type, $bdate) = split ':', $studrec{$provnum}; # print "PN:$provnum D:$date C:$code T:$type B:$bdate SR:",@sr,":Done
\n"; prRecord( $provnum, $date, $code, $type, $bdate, \%sr ); # print the record of this student into data object. $donecount++; # increment counter for all utagged records $filesize = length( $output->value ); # Get the new larger size. if ( $filesize >= $maxfilesize ){ last;} # break out of loop. #print "$donecount:", $filesize,"
\n"; } # End of Record Assembly Loop # Finish the XML object $wr->endTag('SL_ObjectData'); $wr->endTag('SL_Event'); $wr->endTag('SL_Message'); $wr->end(); # close table started as students read in. print "
Student TransferringTypeDate
\n"; my $temp = $output->value; if ( $filemode ) { print FH $temp; } # set hash storing StudentSchoolEnrollment records sent to Sask Ed; used by Emailback. while ( $temp =~ m{\}xmsg) { push(@xmlrecs,$1); }; foreach my $rec (@xmlrecs) { my $refid = $1 if $rec =~ m/RefId="(.*?)"\>/; $xmlrecs{$refid} = ''; } # View the xmlrecs hash #foreach my $key (keys %xmlrecs) { print "K:$key V:$xmlrecs{$key}
\n"; } # show output sent to Sask Ed if set via debug mode if ( $debug ){ $temp =~ s//>/g; print "
\n"; print "

DEBUG - Request sent to Sask Ed

\n"; print "
",$temp,"

\n"; } if ( not $filemode ) { my $filesize = length($output->value)/1000; # Get Final Filesize. print "

The filesize is ", round( $filesize, 1), "KB (Limit: 32KB)

\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 $res = $ua->request($req); # Check the status of the transfer... (NOT result of xml transactions) if ($res->is_success) { # For Debugging .... if ($debug){ print "

DEBUG - Sask Ed XML Response

\n"; print "
\n"; my $temp = $res->content; $temp =~ s//>/g; print "
",$temp,"
\n"; } # Parse returned XML. # This does most of the screen printing. parseResponse(); # response results if errors, update student provnum } else { my $err = $res->status_line; print "

Transfer Error: $err

"; print "
",$res->content,"
\n"; exit; } } # end of not $filemode } # End of the Counted loop for all records. if ( $filemode ) { # Filemode here (ie. file upload ) close FH; # File upload stuff here. system("mv $filename $downloaddir"); print "

". $lex{'View/Download'}. ' '. $lex{'Enrollment File'}; print "

\n

[ "; print "$filename ]

\n"; } print "\n"; #----------- sub prRecord { # print student record to output #----------- # last ref is student record hash my ( $provnum, $date, $code, $type, $birthdate, $ref ) = @_; my %sr = %$ref; # populate sr hash. if (not $birthdate) { $birthdate = $sr{birthdate}; } if ($provnum =~ m/^S/) { # a local student number, actually... $studnum = $provnum; $studnum =~ s/^S//; $provnum = undef; } #print "PN:$provnum D:$date C:$code T:$type
\n"; my $refid; if ( $sr{studnum} ) { # we have a record in the system $refid = $sr{studnum}; } else { $refid = $provnum; } # no record in studentall table if ($type eq 'withdraw'){ # ==== WITHDRAW STUDENT ======= if ( $sr{studnum} ) { # we have a student record. print qq{$donecount. $sr{lastname}, $sr{firstname} ($sr{studnum})\n}; } else { print qq{$donecount. No Local Student Record\n}; } print qq{withdraw$date\n}; $studtrans{ $sr{studnum} } = 1; # now has student number, not transfer table id $wr->startTag('SL_EventObject', 'ObjectName' => 'StudentSchoolEnrollment', 'Action' => 'Change'); # Build StudentEnrollmentInfo (sei) Hash $seiRef = {'MembershipType' => '', 'EntryDate' => '', 'Grade' => '', 'PrevProv' => '', 'PrevCountry' => '', 'ExitType' => $code, 'ExitDate' => $date, 'ImmersionType' => $sr{immersion_type}, 'TuitionType' => $sr{tuition_status}, 'TuitionLength' => $sr{tuition_duration}, 'TuitionCollected' => $sr{tuition_collect}, 'TuitionExchangeProgram' => $sr{tuition_program} }; $wr->startTag('StudentSchoolEnrollment', RefId=>$refid); mkStudentIdentification( $provnum, $birthdate ); # pass provnum and bdate ($sr[8], too) $wr->dataElement('SchoolId',$schoolnumber); # from admin.conf file. mkSchoolEnrollmentInfo($seiRef); $wr->endTag('StudentSchoolEnrollment'); $wr->endTag('SL_EventObject'); } elsif ( $type eq 'enroll' ) { # STUDENT ENROLLMENT if ( not $sr{lastname} ){ $sr{lastname} = qq{Not Found}; } print "$donecount:$sr{lastname}, $sr{firstname} ($sr{studnum})\n"; print "enrol$date\n"; $studtrans{$refid} = 1; $wr->startTag('SL_EventObject', 'ObjectName' => 'StudentSchoolEnrollment', 'Action' => 'Add'); $seiHashRef = {'MembershipType' => 'Base', 'EntryType' => $code, 'EntryDate' => $date, 'Grade' => $sr{grade}, 'PrevProv' => '', 'PrevCountry' => '', 'ExitType' => '', 'ExitDate' => '', 'ImmersionType' => "$sr{immersion_type}", 'TuitionType' => $sr{tuition_status}, 'TuitionLength' => $sr{tuition_duration}, 'TuitionCollected' => $sr{tuition_collect}, 'TuitionExchangeProgram' => $sr{tuition_program} }; $refid = $sr{studnum}; # Student # $wr->startTag('StudentSchoolEnrollment', RefId=>$refid); mkStudentIdentification($provnum, $sr{birthdate} ); # pass provnum and bdate mkStudentInfo( $ref ); # ref to %sr $wr->dataElement('SchoolId',$schoolnumber); # from admin.conf file. mkSchoolEnrollmentInfo( $seiHashRef ); if ( not $sr{program} ){ # program field empty $myprog = $program; # from admin.conf } else { $myprog = $sr{program}; } $wr->dataElement('DeptAssignedProgramId',$myprog); mkProgramEnrollmentInfo("$currdate"); $wr->endTag('StudentSchoolEnrollment'); $wr->endTag('SL_EventObject'); } else { print "Error in record! Not withdraw or enroll!\n"; die "Error in record! Not withdraw or enroll!\n"; } } # End of prRecord #---------------- sub parseResponse { #---------------- # parse response from Sask Ed, display errors (if any), update provnum in # student table, print to error logs. # Parse the response. my $parser = XML::LibXML->new(); eval {$doc = $parser->parse_string($res->content)}; if ($@){ print "Sask Ed Error:\n
$@
",$res->content,"

\n"; print "\n"; die; } #print "XMLns:",$xmlns,"
\n"; $doc->setEncoding('UTF-8'); my $root = $doc->getDocumentElement; $root->setNamespace($xmlns,'sl',1); # Parse Message ID. $mastermsgid = $root->findvalue('//sl:SL_MsgId'); #print "MSG: $mastermsgid
\n"; $status = $root->findvalue('//sl:SL_Status/sl:SL_StatusCode'); # print "Response Status: $status
\n"; if ($status eq 'Errors' or $status eq 'Successful' or $status eq 'Warnings'){ print "Click on Qry to Query Sask Ed "; print "for Student Data.
Click on Trn to Edit a "; print "local Transfer record.
\n"; print "Select records to email to Student Records for "; print "Identity Resolution.\n"; print "
\n"; print "\n"; print "\n"; print ""; print "\n"; my @errors = $root->findnodes('//sl:SL_Error'); my %studtrans; # make local hash to store results. foreach my $error ( @errors ){ # loop through all student transfers my $refid = $error->getAttribute('RefId'); # RefId is now the student number... # RefId WAS the actual record id number of the transfer record. my $errcode = $error->findvalue('sl:SL_ErrorCode'); if ($errcode == 0){ # if zero, success $studtrans{$refid} = 1; # is student number. } my $sth1 = $dbh->prepare("select lastname, firstname, studnum, studid, provnum from studentall where studnum = ?"); $sth1->execute( $refid ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my ($lastname, $firstname, $studnum,$studid, $provnum) = $sth1->fetchrow; #print "$lastname, $firstname :$errcode:$studtrans{$refid}:
\n"; # Check that the studid field is for the student table not the # studentwd (withdrawn student) table. my $studcount; $sth1 = $dbh->prepare("select count(*) from student where studnum = ?"); if ( $studnum ) { $sth1->execute( $studnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } $studcount = $sth1->fetchrow; } else { $studcount = -1; } # no student record to read. # Count should be 1 if in normal table; 0 if withdrawn, -1 if no studentall record # Get Error Elements my $objectname = $error->getAttribute('ObjectName'); my $errmsg = $error->findvalue('sl:SL_ErrorMsg'); $errmsg =~ s/[\r|\n]/ /g; my $emailmsg = "\n===========================\nStudent: ". "$firstname $lastname\n\n". "RECEIVED:\n Errcode: $errcode\n Error Message: $errmsg\n\n". "SENT:\n".$xmlrecs{$refid}."\n\n"; # start table row and print name, etc. print ""; my $xmlrec_64 = encode_base64($emailmsg); if ( $errcode != 0 ) { print qq{\n}; } else { print ""; } print ""; #print ""; print "\n"; } # End of printing of response loop print "
SelectStudent Name | XferProv NumMessage
"; if ($studcount > 0 ){ # Either edit normal student table or studentwd print ""; } elsif ( $studcount < 0 ) { # no student record. } else { # no studcount value print "WD:"; } if ( $lastname ) { print "$lastname, $firstname ($studnum) | "; } else { print "No Student Record"; } if ( $refid and length($refid) != 9 ) { print"Trn "; } if ($provnum){ print "Qry"; } print "$provnum$studentrefid ($objectname)$errmsg
\n

Note to Sask Ed:
\n"; print "
\n"; print ""; print "

\n"; } elsif ( $status eq 'Invalid' ) { # Print out errors print "
"; my @errors = $root->findnodes('//sl:SL_Error'); foreach my $error ( @errors ){ my $refid = $error->getAttribute('RefId'); my $errcode = $error->findvalue('sl:SL_ErrorCode'); my $errmsg = $error->findvalue('sl:SL_ErrorMsg'); print "Error: $errmsg ($errcode) "; } print "
\n"; } else { print "

Weird result - Status: $status

\n"; die; } # Update transfer records to clear based on values in studtrans #foreach my $key (keys %studtrans){ # Loop through all student transfers # print "K: $key VAL: $studtrans{$key}
\n"; #} foreach my $key (keys %studtrans){ # Loop through all student transfers if ($studtrans{$key}){ # all '1' keys (successful updates) #print "K:$key V:$studtrans{$key}
\n"; # Get Student Transfer Data my $sth1 = $dbh->prepare("select s.lastname, s.firstname, s.studnum, s.provnum, t.date, t.type,s.birthdate from studentall as s ,transfer as t where s.studnum = t.studnum and t.id = ?"); $sth1->execute( $key ); if ($DBI::errstr) { print $DBI::errstr; die ;} my ( $lastname, $firstname, $studnum,$provnum, $date, $type,$bdate) = $sth1->fetchrow; # Now clear the utag and update the provnum in the transfer record. $result = $dbh->do("update transfer set utag = NULL, provnum = '$provnum', birthdate = '$bdate' where id = '$key'"); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } } else { print "Student Transfer invalid K:$key VAL:$studtrans{$key}
\n"; } } # Now look for returned student numbers. (in StudentPersonal objects) # and update prov nums in Student table if not found. my @students = $root->findnodes('//sl:StudentPersonal'); if (not @students){ print "

No Student Numbers returned.

\n"; } else { # We have students to print. print "

Returned Student Numbers

\n"; print "\n"; print ""; foreach my $student ( @students ) { my $studnum = $student->getAttribute('RefId'); my $provnum = $student->findvalue('sl:StudentIdentification/sl:DeptAssignedPersonId'); my $bdate = $student->findvalue('sl:StudentIdentification/sl:BirthDate'); # Now read the student table for the name and provnum # Get Student Name, number $sth1 = $dbh->prepare("select lastname, firstname, provnum from studentall where studnum = ?"); $sth1->execute($studnum); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname, $localprovnum ) = $sth1->fetchrow; print ""; print "\n"; if ( $provnum != $localprovnum and $localprovnum ) { # Error print "Error: $firstname $lastname ($studnum) - Local Prov Num: $localprovnum NOT EQUAL TO "; print "returned Prov Num: $provnum
\n"; } # Update the prov student number. if ( $provnum and not $localprovnum ) { $result = $dbh->do("update student set provnum = '$provnum' where studnum = '$studnum'"); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } } } # End of Student Loop print "
Student NameBirthDateProv#
$lastname, $firstname ($studnum)$bdate$provnum

\n"; } } # End of parseResponse =head #------------ sub postEmail { #------------ #foreach my $key ( sort keys %arr) { print "K:$key V:$arr{$key}
\n"; } if ( not $returnaddress ) { print "Please set your return address in the admin.conf file!
\n"; print "\n"; exit; } my $note = $arr{note}; delete $arr{note}; my $message = "Schoolname: $schoolname ($schoolnumber)\nNote: $note\n"; print "

Schoolname: $schoolname ($schoolnumber)

\n"; print "

Note: $note

\n"; foreach my $key (keys %arr) { my $decoded = decode_base64($arr{$key}); $decoded =~ s//>/g; $message .= $decoded; print "
\n";
	print $decoded;
	print "
\n"; } #print "Message: $message
\n"; my $subject = "Open Admin: $schoolname ($schoolnumber)"; my @lines = split /\n/, $message; if ( not $g_mailserver ) { if ( $mailserver ) { $g_mailserver = $mailserver; } else { print "

Mailserver not configured!

\n"; print "\n"; exit; } } # Setup to send mail. my $sender = new Mail::Sender { from => $returnaddress, smtp => $g_mailserver, subject => $subject, keepconnection => 1, on_errors => 'code' }; # Die if error if ( not ref $sender ) { print $lex{Error}. ": $Mail::Sender::Error\n"; die $lex{Error}. ": $Mail::Sender::Error\n"; } my $emailaddress = $studentrecords; # for clarity. $sender->Open({ to => $emailaddress, encoding => 'Quoted-printable' }); $sender->SendEnc( @lines ); if ( not $sender->Close ) { print "Close Failure: $sender->{'error_msg'}\n"; print "\n"; die "Close Failure: $sender->{'error_msg'}\n"; } $sender->Close(1); # full close to object. print "

". $lex{'Email Sent'}. "

\n"; print "

[ ". $lex{Main}. " ]

\n"; print "\n"; exit; } # End of postMail =cut