#! /usr/bin/perl # Copyright 2001-2019 Leslie Richardson # This file is part of Open Admin for Schools. # Synchronize School Courses # Display courses by start and endterm, select those to synchronize. # Get course enrollment data from SaskEd. # Find the differences between the two for each course in turn. # Do the course enrollments to get synchronized. # Rerun Query to check synchronization. # Passed Values: none. # Notes: the dates in doEnrollments are not passed from previous page, # but rather are the values from config files. Might be better to use # SaskEd date values from query... later. my $self = 'synccourses.pl'; my $additionalcomments = 'Additional Comments'; my $version = '2019-12-06'; 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 Number::Format qw(round); 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); # Date Stuff setup; required for the SDS transfers header also # $sec, $min, $hour, $mday, $mon, # $year, $wday, $yday, $isdst ) = localtime(time); my @tim = localtime(time); $year = $tim[5] + 1900; $tim[4]++; for (0..4){ if (length($tim[$_]) == 1){ $tim[$_] = '0'.$tim[$_];}} $currdate = "$year-$tim[4]-$tim[3]"; $currtime = "$tim[2]:$tim[1]:$tim[0]"; # Print Page Header print qq{$doctype\nCourse Enrollment Synchronization\n}; print qq{\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ Main |\n}; print qq{Export ]\n}; print qq{

Course Enrollment Synchronization
}; print qq{Version $version

\n}; if ( not $arr{page} ) { showTerms(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectSubjects(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; syncSubjects(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; doEnrollments(); } #---------------- sub mkQueryString { # for Course Enrollments #---------------- my ( $startdate, $enddate, $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'); mkSL_Header($currdate, $currtime, $schoolnumber,$idcount); $wr->startTag('SL_Query'); $wr->startTag('QueryBySchool', 'RefId' => "$schoolnumber", 'ObjectName' => 'StudentCourseEnrollments', 'ScopeCode' => 'All' ); # Changed from above'ScopeCode' => 'Current' $wr->dataElement('SchoolId',$schoolnumber); my $sdate = $startdate; $sdate =~ s/\-//g; my $edate = $enddate; $edate =~ s/\-//g; $wr->dataElement('FromDate',$sdate); $wr->dataElement('ToDate',$edate); $wr->endTag('QueryBySchool'); $wr->endTag('SL_Query'); $wr->endTag('SL_Request'); $wr->endTag('SL_Message'); $wr->end(); } #----------------- sub querySLCourses { #----------------- my ($startdate, $enddate, $debug) = @_; # Query Sask Ed for a list of current course enrollments # Uses other subs: mkQueryString, parseSCEbyClass (makes object) # Create a new user agent my $ua = LWP::UserAgent->new(); $ua->agent("OpenAdmin"); $count=1; mkQueryString( $startdate, $enddate, $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}; } # Parse the response. my $parser = XML::LibXML->new(); eval {$doc = $parser->parse_string($res->content)}; if ($@){ print qq{Error: $@
\n}; print qq{
Sask Ed Error:\n},$res->content,qq{

\n}; print qq{\n}; die; } $doc->setEncoding('UTF-8'); $root = $doc->getDocumentElement; $root->setNamespace($xmlns,'sl',1); $status = $root->findvalue('//sl:SL_Status/sl:SL_StatusCode'); # We are now setup to parse the root element. } else { # Transfer Error! my $err = $res->status_line; print qq{

Transfer Error: $err

}; die qq{Transfer Error\n}; } my $course_ref = parseSCEbyClass(); return $course_ref; } #-------------------------------- sub parseStudentCourseEnrollments { # passed document root object. #-------------------------------- # This does a printout of the structure.... next sub creates object. my @studinfo = $root->findnodes('//sl:StudentCourseEnrollments'); my $count = 1; my $sth = $dbh->prepare("select lastname, firstname from student where provnum = ? "); foreach my $student (@studinfo){ my $provnum = $student->findvalue('sl:StudentIdentification/sl:DeptAssignedPersonId'); my $birthdate = $student->findvalue('sl:StudentIdentification/sl:BirthDate'); $sth->execute($provnum); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my ($lastname, $firstname) = $sth->fetchrow; print "

$firstname $lastname ( $provnum - $birthdate )

\n"; print "\n"; print ""; print "\n"; my @classes = $student->findnodes('sl:StudentSchoolClasses/sl:StudentTermClasses'); foreach my $class (@classes) { my $schoolyear = $class->findvalue('sl:TermInfo/@SchoolYear'); my $termstart = $class->findvalue('sl:TermInfo/sl:StartDate'); my $termend = $class->findvalue('sl:TermInfo/sl:EndDate'); my @sections = $class->findnodes('sl:StudentClass'); foreach my $section (@sections) { my $classid = $section->findvalue('sl:ClassId'); my $mode = $section->find('sl:ModeOfInstruction/@Code'); my $marksource = $section->findvalue('sl:MarkSource/@Code'); print "\n"; print "\n"; } } print "
SchoolyearTermstartTermendClassIdModeMark Src
$schoolyear$termstart$termend$classid$mode$marksource
\n"; } } # End of Sub #---------------------- sub parseSCEbyClass { #---------------------- # passed document root object. # Parse SchoolCourseEnrollments, and return a reference to a courses # hash containing refs to a list (array) of provincial numbers. my @studinfo = $root->findnodes('//sl:StudentCourseEnrollments'); my $count = 1; my %courses; foreach my $student (@studinfo){ my $provnum = $student->findvalue('sl:StudentIdentification/sl:DeptAssignedPersonId'); # my $birthdate = $student->findvalue('sl:StudentIdentification/sl:BirthDate'); my @classes = $student->findnodes('sl:StudentSchoolClasses/sl:StudentTermClasses'); foreach my $class (@classes) { #my $schoolyear = $class->findvalue('sl:TermInfo/@SchoolYear'); my $termstart = $class->findvalue('sl:TermInfo/sl:StartDate'); my $termend = $class->findvalue('sl:TermInfo/sl:EndDate'); my @sections = $class->findnodes('sl:StudentClass'); foreach my $section (@sections) { my $classid = $section->findvalue('sl:ClassId'); my $mode = $section->find('sl:ModeOfInstruction/@Code'); my $marksource = $section->findvalue('sl:MarkSource/@Code'); $coursedata{"$classid:$termstart:$termend"} = "$mode:$marksource"; if (not defined $courses{"$classid:$termstart:$termend"}) { $courses{"$classid:$termstart:$termend"} = [ $provnum ]; } else { push @{$courses{"$classid:$termstart:$termend"}},$provnum; } } } # End of StudentSchoolClasses } # End of student loop return \%courses; } # End of parseSCEbyCourse #------------ sub showTerms { #------------ print qq{
\n}; print qq{Select a start term / end term combination
\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Show the Start/End terms for choosing subjsec's. my $sth1 = $dbh->prepare("select distinct startrptperiod, endrptperiod from subject where grade = 10 or grade = 11 or grade = 12 group by startrptperiod, endrptperiod order by startrptperiod, endrptperiod"); $sth1->execute; if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr;} while ( my ( $startterm, $endterm ) = $sth1->fetchrow ) { print qq{}; print qq{\n}; } print qq{\n}; print qq{
Start TermEnd TermSelect
$startterm$endterm
\n}; print qq{ Chk \n}; print qq{ Debug }; print qq{
\n}; exit; } # end of showTerms #----------------- sub selectSubjects { #----------------- # foreach my $key (keys %arr) { print "K: $key V:$arr{$key}
\n"; } my ( $check,$debug ); if ( $arr{check} ) { $check = 'CHECKED'; delete $arr{check}; } if ( $arr{debug} ) { $debug = 1; delete $arr{debug}; } my ($startterm, $endterm) = split(':', $arr{terms}); print qq{\n}; print qq{\n}; print qq{\n}; print qq{
Start Term$startterm
End Term$endterm
\n}; print qq{

Select subjects to synchronize with Sask Ed

\n}; # Start Form print qq{
\n}; print qq{\n}; print qq{\n}; if ( $debug ) { print qq{\n}; } # Table print qq{\n}; print qq{\n}; print qq{\n}; # Get Subjects for these terms. my $sth = $dbh->prepare("select subjsec, description, teacher, grade from subject where startrptperiod = ? and endrptperiod = ? and description != '$additionalcomments' order by grade, description"); $sth->execute( $startterm, $endterm ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr;} my $sth1 = $dbh->prepare("select certification1, lastname, firstname from staff where userid = ?"); my $sth2 = $dbh->prepare("select count(*) from eval where subjcode = ?"); while ( my ( $subjsec, $description, $tch, $grade ) = $sth->fetchrow ) { # skip lower grades if ( $grade < 10 ) { next; } # Get Teacher Certification $sth1->execute( $tch ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my ($cert, $lastname, $firstname) = $sth1->fetchrow; # Get Enrollment my $termduration = $endterm - $startterm + 1; if ( not $termduration ) { $termduration = 1; } # just in case $sth2 ->execute( $subjsec ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my $count = $sth2->fetchrow; my $enrollment = $count / $termduration; # divide by # of terms. print qq{}; print qq{}; my $track = $g_MTrackTermType{$grade}; # use grade 12's values my $startdate = $g_MTrackTerm{$track}{$startterm}{'start'}; my $enddate = $g_MTrackTerm{$track}{$endterm}{'end'}; #print qq{

Track:$track Start:$startdate End:$enddate Term:$startterm - $endterm

\n}; # Fix any short values in month or day. my @sd = split(/-/, $startdate); for (1..2){ if (length($sd[$_]) == 1){ $sd[$_] = '0'.$sd[$_];}} $startdate = join('-', @sd); my @ed = split(/-/, $enddate); for (1..2){ if (length($ed[$_]) == 1){ $ed[$_] = '0'.$ed[$_];}} $enddate = join('-', @ed); # print qq{Start:$startdate End:$enddate
\n}; if ( $cert ) { my $localcheck; if ( $enrollment ) { $localcheck = $check; # have to have students! print qq{\n}; } else { # no enrollments print qq{\n}; } } else { print qq{}; print qq{\n}; } } print qq{\n}; print qq{
SubjectTeacherCodeGradeEnrolSelect
}; print qq{}; print qq{ Chk
}; print qq{Please wait while we query Sask Ed before the next page appears.\n}; print qq{
$description$lastname, $firstname$subjsec$grade$enrollment}; print qq{
No Certification Number: $firstname $lastname
}; print qq{}; print qq{ Chk }; print qq{
\n}; print qq{

Please wait while we query Sask Ed before the }; print qq{next page appears.

\n}; print qq{\n}; exit; } #--------------- sub syncSubjects { #--------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $debug = $arr{debug}; delete $arr{debug}; # Get the Dates for this block of courses. my ($startterm, $endterm) = split(':', $arr{terms}); delete $arr{terms}; my $track = $g_MTrackTermType{'12'}; # use grade 12's values my $startdate = $g_MTrackTerm{$track}{$startterm}{'start'}; my $enddate = $g_MTrackTerm{$track}{$endterm}{'end'}; # Fix any short values in month or day. my @sd = split('-', $startdate); for (1..2){ if (length($sd[$_]) == 1){ $sd[$_] = '0'.$sd[$_];}} $startdate = join('-', @sd); my @ed = split('-', $enddate); for (1..2){ if (length($ed[$_]) == 1){ $ed[$_] = '0'.$ed[$_];}} $enddate = join('-', @ed); print qq{
Start Date: $startdate End Date: $enddate
\n}; print qq{

Querying Sask Ed

\n}; querySLCourses( $startdate, $enddate, $debug ); # can pass $debug for more info. if ( $debug ) { parseStudentCourseEnrollments(); # show results of SL query. } my $course_ref = parseSCEbyClass(); # Test to view components of the data struct. # foreach my $key ( sort keys %$course_ref ) { # print qq{K:$key V:$$course_ref{$key}
\n}; # my $studref = $$course_ref{$key}; # foreach my $val ( @$studref ) { # print qq{ $val }; # } # } # checkbox select for everyone my $check; if ($arr{check}) { $check = 'CHECKED'; delete $arr{check}; } #foreach my $key (keys %arr) { print qq{K:$key V:$arr{$key}
\n}; } # Start the form print qq{

\n}; print qq{
\n}; print qq{\n}; print qq{\n}; # pass debug mode to next screen. if ($debug) { print qq{\n}; } # Override Term End Date print qq{
}; print qq{Override Term End Date (yyyy-mm-dd):
\n}; # Setup Prepare statements for common queries. my $sth = $dbh->prepare("select distinct studnum from eval where subjcode = ?"); my $sth1 = $dbh->prepare("select provnum from studentall where studnum = ?"); my $sth2 = $dbh->prepare("select description from subject where subjsec = ?"); my $sth3 = $dbh->prepare("select lastname, firstname from studentall where provnum = ?"); my $sth4 = $dbh->prepare("select count(*) from studentwd where provnum = ?"); foreach my $cl ( keys %arr ) { # loop through each subject. my ($subjsec, $startdate, $enddate) = split(/:/, $cl); # Fix any short values in month or date. my @sd = split(/-/, $startdate); for (1..2){ if (length($sd[$_]) == 1){ $sd[$_] = '0'.$sd[$_];}} $startdate = join('-', @sd); my @ed = split(/-/, $enddate); for (1..2){ if (length($ed[$_]) == 1){ $ed[$_] = '0'.$ed[$_];}} $enddate = join('-', @ed); # print qq{Start:$startdate End:$enddate
\n}; # get subjsec description $sth2->execute($subjsec); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my $desc = $sth2->fetchrow; # start table print qq{

$desc ($subjsec)

\n}; print qq{\n}; print qq{\n}; my (%slstuds, %localstuds); # set Sask Ed students (prov nums) for this class. # Create a total studs hash to hold all pn's from both local and prov. my @slstuds = @{$course_ref->{$cl}}; # print qq{

Class:$cl }; foreach my $tmp ( @slstuds ) { # now make a hash. $sth3->execute( $tmp ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname) = $sth3->fetchrow; # print qq{ $firstname $lastname ($tmp)\n}; $slstuds{$tmp} = 1; $totalstuds{$tmp} = 1; } # print qq{

\n}; # Now make the local hash and add these kids to totalstuds, too. $sth->execute($subjsec); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} while ( my $sn = $sth->fetchrow ) { $sth1->execute($sn); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my $pn = $sth1->fetchrow; if (not $pn) { $sth3->execute($sn); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname) = $sth3->fetchrow; print qq{No Provincial Number for student }; print qq{$firstname $lastname ($sn). Skipping!
\n}; next; } $localstuds{$pn} = 1; $totalstuds{$pn} = 1; } # Now compare the %localstuds and %slstuds by looking at # combined hash %totalstuds and removing matches in both local # and Sask Ed arrays. foreach my $pn ( keys %totalstuds ) { # Go through all students (on both lists) # Delete them if we have a match if ($localstuds{$pn} == $slstuds{$pn} and $localstuds{$pn} == 1) { delete $slstuds{$pn}; delete $localstuds{$pn}; } } # Any slstuds left should be withdrawn. foreach my $pn ( sort keys %slstuds ) { $sth3->execute($pn); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my ($lastname, $firstname) = $sth3->fetchrow; print qq{\n}; print qq{\n}; } # Any localstuds left should be enrolled. foreach my $pn ( sort keys %localstuds) { $sth3->execute( $pn ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my ($lastname, $firstname) = $sth3->fetchrow; # Show if Withdrawn. $sth4->execute( $pn ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my $wdcount = $sth4->fetchrow; my $wd; if ( $wdcount ) { $wd = qq{WD:}; } print qq{\n}; } if ( not %slstuds and not %localstuds ) { #nothing to be done... enrol OR withdraw. print qq{\n}; } print qq{
StudentSelect
$firstname $lastname ($pn)Withdraw
$wd $lastname, $firstname ($pn)\n}; # if ( not $wdcount ) { # allow to enrol... don't do this... they may enrol them late and HAVE a mark. print qq{Enrol }; # } print qq{
Class is synchronized!

\n}; } # End of Subject Loop print qq{\n}; print qq{
\n}; exit; } #---------------- sub doEnrollments { #---------------- # foreach my $key (keys %arr) { print "K:$key V:$arr{$key}
\n"; } my $debug; if ( $arr{debug} ) { $debug = 1; } delete $arr{debug}; my $newenddate; if ( $arr{newenddate} ) { $newenddate = $arr{newenddate}; }; delete $arr{newenddate}; # Send records to SaskEd to do class enrollments/withdrawals; passed a # list of students in subjsec:type:provnum format. # get the date,time for header sections. @tim = localtime(time); $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]"; # Setup Prepare statements for common queries. my $sth = $dbh->prepare("select description, subjcode, startrptperiod, endrptperiod, teacher, exammix, instmode, grade from subject where subjsec = ?"); my $sth1 = $dbh->prepare("select lastname, firstname, studnum, birthdate from studentall where provnum = ?"); #~~ changed from student table to studentall table. my $donecount = 1; my $reccount = keys %arr; my $xfercount = 1; while ( $donecount <= $reccount ) { # go through all records. # start table print qq{\n}; print qq{\n}; # Create a new user agent my $ua = LWP::UserAgent->new(); $ua->agent("OpenAdmin"); # Create Writer String Object / Set Data mode. $output = XML::Writer::String->new(); my $datamode = 1; if ( $debug ){$datamode = 1;} # Create new writer instance $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 # Version 1 ! interface... $wr->xmlDecl("UTF-8"); $wr->startTag('SL_Message','xmlns' =>$xmlns, 'xmlns:xsi' =>$xmlnsxsi, 'xsi:schemaLocation' => $xsischemaLocation); $wr->startTag('SL_Event'); $xfercount++; # increment for next header. if ($xfercount > 98){ $xfercount = 1;} mkSL_Header($currdate,$currtime, $schoolnumber,$xfercount); $wr->startTag('SL_ObjectData'); my $first = 1; foreach my $rec ( sort keys %arr ) { # loop through all records in the %arr hash my ($subjsec, $type, $provnum) = split(/:/,$rec); # $type = E for enrol or W for withdraw. # Get student name, studnum, birthdate $sth1->execute($provnum); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my ($lastname, $firstname, $studnum, $birthdate) = $sth1->fetchrow; # Get enrollment type information if ($type eq 'E'){ $enroltype = 'Add'; $enrolmsg = 'Enrol'; $dropped = ''; } else { # its a withdraw $enroltype = 'Change'; $dropped = 'Yes'; $enrolmsg = 'Withdraw'; # to get correct exit date look in evaljrl first; otherwise use current date. # my $sth2 = $dbh->prepare("select tdate from evaljrl where studnum = ? # and subjsec = ? and type = 'withdraw' order by tdate desc"); # $sth2->execute( $studnum, $subjsec ); # if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} # my $exitdate = $sth2->fetchrow; if (not $exitdate) { $exitdate = $currdate; } } # Get Subject description, subjcode, startterm, endterm, teacher; $sth->execute($subjsec); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my ($desc, $courseid, $startterm, $endterm,$teacher, $exammix, $instmode, $grade) = $sth->fetchrow; # courseid is dept number; classid is subjsec. my ($startdate, $enddate); # older stuff # if ( $coursedates{$subjsec} ) { # ($startdate, $enddate) = split(/:/,$coursedates{$subjsec}); # } else { my $track = $g_MTrackTermType{$grade}; # use grade 12's values $startdate = $g_MTrackTerm{$track}{$startterm}{'start'}; $enddate = $g_MTrackTerm{$track}{$endterm}{'end'}; # Use Newenddate to override end date for dept exams if necessary. # print "New End Date:$newenddate
\n"; if ( $newenddate ) { $enddate = $newenddate; } # Fix any short values in month or date. my @sd = split(/-/, $startdate); for (1..2){ if (length($sd[$_]) == 1){ $sd[$_] = '0'.$sd[$_];}} $startdate = join('-', @sd); my @ed = split(/-/, $enddate); for (1..2){ if (length($ed[$_]) == 1){ $ed[$_] = '0'.$ed[$_];}} $enddate = join('-', @ed); # print "Start:$startdate End:$enddate
\n"; print "\n"; $oldclass = $currclass; $currclass = $subjsec; # Write SchoolClass if new StudentClassEnrollment if ( ( $first or $oldclass ne $currclass ) and ( $enroltype eq 'Add' )){ # Find Teacher ID (teaching certificate #) # Not any more... my ($tname,$userid) = split /\(/,$teacher; $userid = $teacher; $sth3 = $dbh->prepare("select certification1 from staff where userid = ?"); $sth3->execute( $userid ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my $teachid = $sth3->fetchrow; my $mode = ''; # defaults to classroom instruction. my $refid = $subjsec; my $classid = $subjsec; # Write SchoolClass object wrSchoolClass($refid, $classid, $startdate, $enddate, $courseid, $teachid, $instmode); } $first = 0; # Now write the student class enrollment record $wr->startTag('SL_EventObject', 'ObjectName' => 'StudentClassEnrollment', 'Action' => $enroltype); my $refid = "$subjsec-$studnum"; # to give unique id for student enrolling in class. my $classid = $subjsec; mkStudentClassEnrollment( $schoolnumber, $refid, $provnum, $birthdate, $classid, $startdate, $enddate,'', $exammix, $dropped, $exitdate); # no override - still blank above # Now filled in: source, dropped, exitdate $wr->endTag('SL_EventObject'); $donecount++; $filesize = length($output->value); # Get the new larger size. if ( $filesize >= $maxfilesize ) { last; } } # End of Record Assembly Loop # Finish the XML object $wr->endTag('SL_ObjectData'); $wr->endTag('SL_Event'); $wr->endTag('SL_Message'); $wr->end(); print "
StudentSubjectType
$firstname $lastname ($provnum)$desc ($subjsec)$enrolmsg
\n"; if ( $debug ) { print qq{

DEBUG - XML Sent TO Sask Ed

\n}; print qq{
\n}; my $temp = $output->value; $temp =~ s//>/g; print "
",$temp,"
\n"; } $filesize = length($output->value); # Get Final Filesize. $filesize = $filesize/1000; 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 qq{

DEBUG - Sask Ed XML Response

\n}; print qq{
\n}; my $temp = $res->content; $temp =~ s//>/g; print qq{
$temp
\n}; } parseResponse(); # response results } else { my $err = $res->status_line; print qq{

Transfer Error: $err

}; print qq{
},$res->content,qq{
\n}; exit; } print qq{
\n}; } # end of all records loop print qq{\n}; exit; } # End of doEnrollments #----------------- sub wrSchoolClass { #----------------- # Write the SchoolClass object. my ($refid, $classid, $startdate, $enddate, $courseid, $teachid, $mode) = @_; $wr->startTag('SL_EventObject', 'ObjectName' => 'SchoolClass', 'Action' => 'Add'); # Subject-Section is the refid, same as classid. mkSchoolClass( $schoolnumber, $refid, $classid, $startdate, $enddate, $courseid, $teachid, $mode); $wr->endTag('SL_EventObject'); } #---------------- sub parseResponse { #---------------- # parse response from SaskEd, display all results # Parse the response. my $parser = XML::LibXML->new(); my $sdsString = $res->content; # Strip the leading commented out HTML crud in the response. $sdsString =~ s///msg; $sdsString =~ s/^\s+//msg; # print "Content:
$sdsString
\n"; eval {$doc = $parser->parse_string( $sdsString )}; # eval {$doc = $parser->parse_string($res->content)}; if ($@){ my $error = $res->content; $error =~ s/\