#! /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 = 'activate.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 Time::JulianDay; 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}; 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. print qq{$doctype\nSet Students Active\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ Main | Export ]\n}; if ( $debug and not $filemode ) { $maxfilesize = 3000; # change xml file transfer size } print qq{

Set Students Active

\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; if ( not $arr{page} ) { showStartPage(); } else { delete $arr{page}; } # Get Julian Start Date (school start) my ($syear, $smonth, $sday ) = split(/-/, $startdate); if ( length( $smonth ) == 1 ) { $smonth = '0'. $smonth; } if ( length( $sday ) == 1 ) { $sday = '0'. $sday; } my $schoolstartjd = julian_day($syear, $smonth, $sday); my %studrec; # holds enrollment change data. my %enrol; # hold continuing enrollment data. my @grades; foreach my $gr ( keys %arr ) { push @grades, qq{'$gr'}; } my $select = join(' or grade = ', @grades); if ( $select ) { $select = "where grade = $select"; } print qq{

Select $select

\n}; # loop through and add continuing recs. $sth = $dbh->prepare("select studnum, provnum, birthdate from student $select order by lastname, firstname"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my $sth1 = $dbh->prepare("select id, date from transfer where type != 'withdraw' and studnum = ? order by date desc"); while ( my ( $studnum, $provnum, $birthdate ) = $sth->fetchrow ) { $sth1->execute($studnum); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my ( $id, $tdate ) = $sth1->fetchrow; my ($tyear, $tmonth, $tday ) = split('-', $startdate); if ( length( $tmonth ) == 1 ) { $tmonth = '0'. $tmonth; } if ( length( $tday ) == 1 ) { $tday = '0'. $tday; } my $tdatejd = julian_day($tyear, $tmonth, $tday); my $startdate = $tdate; if ( not $tdate or $tdatejd < $schoolstartjd ) { $startdate = $schoolstart; } if ( not $provnum ) { next; } # skip if no province number push @provnums, $provnum; $studrec{$provnum} = "$startdate:15:enroll:$birthdate"; # no date, code 15 } # next current student my $donecount = 1; my $reccount = keys %studrec; my $xfercount = 1; # Counter for message headers (to make unique). my $filename; if ( $filemode ) { # open the file for writing. $filename = 'ENROL_'. $schoolcode. '_'. $filecurrdate. '_'. $filecurrtime. '.xml'; open(FH,">$filename") or die "Cannot Open XML file\n"; } my $donecount = 1; my $reccount = keys %studrec; 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 qq{\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 qq{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 qq{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 qq{$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 qq{
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 qq{K:$key V:$xmlrecs{$key}
\n}; } # show output sent to Sask Ed if set via debug mode if ( $debug ){ $temp =~ s//>/g; print qq{
\n}; print qq{

DEBUG - Request sent to Sask Ed

\n}; print qq{
}, $temp, qq{

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

The filesize is }, round( $filesize, 1), qq{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 qq{

DEBUG - Sask Ed XML Response

\n}; print qq{
\n}; my $temp = $res->content; $temp =~ s//>/g; print qq{
}, $temp, qq{
\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 qq{

Transfer Error: $err

}; print qq{
} ,$res->content, qq{
\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 qq{

$lex{'View/Download'} $lex{'Enrollment File'}

\n}; print qq{

[ }; print qq{$filename ]

\n}; } print qq{\n}; #------------------------- sub mySchoolEnrollmentInfo { #------------------------- # Needs MembershipType, EntryDate, EntryType, Grade, # PrevProv,PrevCountry, ExitDate, ExitType, my ( $sref ) = @_; # print qq{HashRef: $sref \n}; #($membershipType, $entryDate, $entryType, $grade,$prevProvState, # $prevCountry,$exitDate, $exitType) = @$SEIref; if ($$sref{MembershipType}){ $wr->startTag('SchoolEnrollmentInfo', 'MembershipType' => $$sref{MembershipType}); } else { $wr->startTag('SchoolEnrollmentInfo'); } if ($$sref{EntryDate}){ $wr->dataElement('EntryDate',$$sref{EntryDate}); } if ($$sref{EntryType}){ $wr->emptyTag('EntryType','Code' => $$sref{EntryType}); } # Grade: Must be PK,K,01,02, etc. if ($$sref{Grade}){ $grade = uc($$sref{Grade}); if (length($grade) == 1){ # Add a zero. $grade = '0'.$grade; } $wr->emptyTag('Grade','Code' => $grade); } $wr->endTag('SchoolEnrollmentInfo'); } #----------- 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 = ''; } #print qq{PN:$provnum D:$date C:$code T:$type
\n}; my $refid = $sr{studnum}; if ( not $sr{lastname} ){ $sr{lastname} = 'Not Found'; } print qq{$donecount:$sr{lastname}, $sr{firstname} ($sr{studnum})\n}; print qq{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. mySchoolEnrollmentInfo( $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'); } # 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 qq{Sask Ed Error:\n
$@
} ,$res->content, qq{

\n}; print qq{\n}; exit; } #print qq{XMLns:},$xmlns, qq{
\n}; $doc->setEncoding('UTF-8'); my $root = $doc->getDocumentElement; $root->setNamespace($xmlns,'sl',1); # Parse Message ID. $mastermsgid = $root->findvalue('//sl:SL_MsgId'); #print qq{MSG: $mastermsgid
\n}; $status = $root->findvalue('//sl:SL_Status/sl:SL_StatusCode'); # print qq{Response Status: $status
\n}; if ($status eq 'Errors' or $status eq 'Successful' or $status eq 'Warnings'){ # print qq{Click on Qry to Query Sask Ed }; # print qq{for Student Data.
Click on Trn to Edit a }; # print qq{local Transfer record.
\n}; # print qq{Select records to email to Student Records for }; # print qq{Identity Resolution.\n}; # print qq{
\n}; # print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; my @errors = $root->findnodes('//sl:SL_Error'); %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 qq{$lastname, $firstname :$errcode:$studtrans{$refid}:
\n}; # Check that the studid field is for the student table not the # studentwd (withdrawn student) table. $sth1 = $dbh->prepare("select count(*) from student where studnum = ?"); $sth1->execute( $studnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $studcount = $sth1->fetchrow; # Count should be 1 if in normal table; 0 if withdrawn. # Get Error Elements my $objectname = $error->getAttribute('ObjectName'); my $errmsg = $error->findvalue('sl:SL_ErrorMsg'); $errmsg =~ s/[\r|\n]/ /g; # start table row and print name, etc. print qq{}; my $xmlrec_64 = encode_base64($emailmsg); if ( $errcode != 0 ) { print qq{}; } else { print qq{}; } print qq{\n}; print qq{}; print qq{\n}; } # End of printing of response loop print qq{
SelectStudent Name | XferProv NumMessage
}; if ($studcount){ # Either edit normal student table or studentwd print qq{}; } else { print qq{WD:}; } print qq{$lastname, $firstname ($studnum) | }; print qq{Trn }; if ($provnum){ print qq{Qry}; } print qq{$provnum$errmsg
\n}; } elsif ( $status eq 'Invalid' ) { # Print out errors print qq{
}; 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 qq{Error: $errmsg ($errcode) }; } print qq{
\n}; } else { print qq{

Weird result - Status: $status

\n}; exit; } } # End of parseResponse #---------------- sub showStartPage { #---------------- # Get Grades my @grades; my $sth = $dbh->prepare("select distinct grade from student where grade is not NULL and grade != '' order by grade"); $sth->execute; if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr;} while ( my $grade = $sth->fetchrow ) { push @grades, $grade; } @grades = sort {$a <=> $b} @grades; print qq{
\n}; print qq{Select Grades to Activate
\n}; print qq{
You have to 'activate' students since Sask Ed will 'unenrol' students from
}; print qq{
your school each year, even if there is no enrollment change. This script will fix that
\n}; print qq{

If Sask Ed from has too many students to activate at one time, it will 'Time Out'.
\n}; print qq{Selecting only a limited number of grades will help prevent that.

\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Get Grades for my $grade ( @grades ) { print qq{\n}; } print qq{
Grade
$grade
\n}; # print qq{ Debug \n}; print qq{
\n}; exit; }