#!/usr/bin/perl # Copyright 2001-2009 Leslie Richardson # This file is part of Open Admin for Schools. # Open Admin for Schools is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. my %lex = ('Main' => 'Main', 'Report Card' => 'Report Card', 'Transcript Post' => 'Transcript Post', 'Select Posting Term' => 'Select Posting Term', 'Select Term' => 'Select Term', 'Select Subjects to Post to Transcript System' => 'Select Subjects to Post to Transcript System', 'Select Subjects' => 'Select Subjects', 'Check Subjects' => 'Check Subjects', 'Posting to Transcript System' => 'Posting to Transcript System', 'Mark' => 'Mark', 'Student' => 'Student', 'Subject' => 'Subject', 'Post more Subjects' => 'Post more Subjects', 'Duplicate' => 'Duplicate', 'Error' => 'Error', 'Identity Mismatch for' => 'Identity Mismatch for', 'Replace existing records?' => 'Replace existing records?', 'Updating Record for' => 'Updating Record for', 'Skipping' => 'Skipping', ); # rounding precsion of mark. my $precision = 1; my $self = 'tscpost.pl'; my $idfield = 'provnum'; # change to suit the field for state/provincial id or SSN, etc. use DBI; use CGI; use Number::Format qw(:subs); eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my $q = CGI->new; print $q->header( -charset, $charset ); my %arr = $q->Vars; my $fmt = new Number::Format(-decimal_fill => '1', -decimal_digits => '2'); my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); # Page Header print "$doctype\n". $lex{'Transcript Post'}. " $chartype\n\n"; print "[ ". $lex{Main}. " |\n"; print "". $lex{'Report Card'}. " ]\n"; if ( not $arr{flag} ) { # We have a selected student. selectTerm(); } elsif ( $arr{flag} == 1 ) { delete $arr{flag}; selectSubjects(); } elsif ( $arr{flag} == 2 ) { delete $arr{flag}; postSubjects(); } #------------- sub selectTerm { #------------- # Term Selection my $sth = $dbh->prepare("select distinct term from eval where term != '' and term is not null order by term"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my $trm = $sth->fetchrow ) { push @terms, $trm; } # Print Start of Selection. print "

". $lex{'Select Posting Term'}. "

\n"; print "
\n"; print "\n"; print "\n"; print "
\n"; print $lex{'Check Subjects'}; print "\n \n"; print "
\n"; exit; } #----------------- sub selectSubjects { #----------------- #foreach my $key (keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Subject Selection - first subjects with this term my $sth = $dbh->prepare("select distinct subjcode from eval where term = ? and subjcode != '' and subjcode is not null"); $sth->execute( $arr{term} ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my $subj = $sth->fetchrow ) { $subjects{$subj} = 1; } $sth1 = $dbh->prepare("select endrptperiod, description from subject where subjsec = ?"); foreach my $subjsec ( keys %subjects ) { $sth1->execute( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($endrptperiod, $description) = $sth1->fetchrow; if ( $endrptperiod == $arr{term} ) { # the subject ends this term... $subjects{$subjsec} = $description; } else { # no match; remove value; delete $subjects{$subjsec}; } } # At this point %subjects hash only contains subjects that have # endrptperiod in the selected term. # Print Start of Selection. print "

". $lex{'Select Subjects to Post to Transcript System'}. "

\n"; print "
\n"; print "\n"; print "\n"; print "
"; print $lex{'Replace existing records?'}. q{ }; print "
\n"; print "\n"; print "\n"; foreach my $subjsec ( keys %subjects ) { print "\n"; print "\n"; } print "
$subjects{$subjsec} ($subjsec)"; print ""; print "
\n"; print "\n"; print "
\n"; exit; } #---------------------- sub postSubjects { #---------------------- #foreach my $key (keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $term = $arr{term}; # the term we are posting.... delete $arr{term}; my $replacemode; if ( $arr{replacemode} ) { $replacemode = $arr{replacemode}; } delete $arr{replacemode}; # Load transcript conf; defines markToLetter; eval require "../../etc/transcript.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } # SQL Selections my $sth1 = $dbh->prepare("select lastname, firstname, initial, birthdate, $idfield, graddate from studentall where studnum = ?"); my $sth2 = $dbh->prepare("select count(*) from tscriptident where studnum = ?"); my $sth3 = $dbh->prepare("select lastname, firstname, birthdate from tscriptident where studnum = ?"); # Get the subject fields my $sth4 = $dbh->prepare("select description, credit, difficulty, area, calcavg from subject where subjsec = ?"); my $sth5 = $dbh->prepare("select id, a1 from eval where subjcode = ? and studnum = ? order by term"); # Print heading Section print "

". $lex{'Posting to Transcript System'}. "

\n"; print "\n"; print "\n"; foreach my $subjsec ( keys %arr ) { # Get the subject information $sth4->execute ( $subjsec ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $description, $credit, $difficulty, $area, $calcavg ) = $sth4->fetchrow; # select each student record in turn and post. my $sth = $dbh->prepare("select a1 , studnum from eval #~~ change the a1 to markfield where term = ? and subjcode = ? order by studnum"); $sth->execute( $term, $subjsec ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } STUDENT: while ( my ($mark, $studnum) = $sth->fetchrow ) { # Skip NULL values in mark if ( not defined $mark ) { # NULL in field value print "\n"; print "\n"; print "\n"; next STUDENT; } # Check to see if mark contains letters my $markContainsLetters; if ( $mark =~ m/[a-zA-Z]/ ) { $markContainsLetters = 1; #print "Mark Contains Letters: $mark
\n"; } # Get full name and birthdate from studentall $sth1->execute( $studnum ); if ( $DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($lastname,$firstname,$middlename,$birthdate,$studentid,$graddate)=$sth1->fetchrow; # $studentid field is configurable at top of script. # Check for existing ident record, and match; fail on error; otherwise create. $sth2->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth2->fetchrow; if ( $count > 1 ) { print "Fatal Error: more than 1 student ident record with same studnum!
\n"; print "for student number: $studnum. Contact Administrator!
\n"; die "Student Number duplicate in tscriptident: $studnum\n"; } elsif ( $count < 1 ) { # add a new ident record. $lastname = $dbh->quote( $lastname ); $firstname = $dbh->quote( $firstname ); $middlename = $dbh->quote( $middlename ); $birthdate= $dbh->quote( $birthdate ); $studentid = $dbh->quote( $studentid ); if ( not $graddate or $graddate eq '0000-00-00' ) { $graddate = 'NULL'; } else { $graddate = $dbh->quote( $graddate ); } my $sth6 = $dbh->prepare("insert into tscriptident values ( $sql{default}, '$studnum', $lastname , $firstname, $middlename, $birthdate, $studentid, $graddate )"); $sth6->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } } else { # we have an existing record. Check for a full match; $sth3->execute( $studnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($testlastname, $testfirstname, $testbirthdate) = $sth3->fetchrow; if ( $lastname ne $testlastname or $firstname ne $testfirstname or $birthdate ne $testbirthdate) { # We have a problem print "
". $lex{Student}. "". $lex{Subject}. ""; print $lex{Mark}. "
". $lex{Skipping}. " NULL - "; print "$firstname $lastname$description ($subjsec)NULL
\n"; print $lex{'Identity Mismatch for'}. " $firstname $lastname ($studnum)"; print "
\n"; die "Transcript Identity Mismatch for $firstname $lastname ($studnum)\n"; } } # Now done with updating tscriptident records, if required. # If using average method for mark, calculate it now and replace previous mark value. if ( $calcavg eq 'Y' and not $markContainsLetters ) { $sth5->execute( $subjsec, $studnum ); # Get all mark field values. if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $markcount, $marktotal ); while ( my ( $id, $tmpmark ) = $sth5->fetchrow ) { $markcount++; $marktotal += $tmpmark; } if ( $markcount ) { $mark = $fmt->format_number( $marktotal / $markcount ); } else { $mark = 0; } } my $letter; # letter grade. if ( $markContainsLetters ) { # We have a 'letter' mark, copy into $letter $letter = $mark; } else { # find the matching letter for this numeric value.. foreach my $threshold (reverse sort keys %markToLetter ) { # from large to small... if ( $mark >= $threshold ) { $letter = $markToLetter{$threshold}; last; } } } # Check for duplicate course records - same studnum, same # subjsec, same year, same term. Skip if duplicate $sth6 = $dbh->prepare("select count(*) from tscriptdata where subjectcode = ? and studnum = ? and schoolyear = ? and term = ?"); $sth6->execute( $subjsec, $studnum, $schoolyear, $term ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth6->fetchrow; # Setup the Term Description info from the tscript.conf. my $term_desc = $term_desc{ $term_key{$term} }; if ( $count > 0 ) { if ( not $replacemode ) { # skip this student/subject; already done. print "". $lex{Duplicate}. "! "; print $lex{'Skipping'}; print " $firstname $lastname$description$mark\n"; next STUDENT; # skip to next record! } else { # replace existing record print "". $lex{'Updating Record for'}. ""; print " $firstname $lastname$description$mark\n"; my $sth6 = $dbh->prepare("update tscriptdata set studnum = '$studnum', subjectcode = '$subjsec', subjecttext = '$description', subjectarea = '$area', score_mark = '$mark', score_letter = '$letter', score_diff = '$difficulty', schoolyear = '$schoolyear', crdate = now(), credit = '$credit', term = '$term', term_desc = '$term_desc' where id = ?"); $sth6->execute( $id ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } } else { # no record found; insert one. # add the data record $sth6 = $dbh->prepare("insert into tscriptdata values ( $sql{default}, '$studnum','$subjsec','$description','$area','$mark', '$letter','$difficulty','$schoolyear', now(), '$credit','$term','$term_desc')"); $sth6->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print "$firstname $lastname$description\n"; print "$mark ($letter)\n"; } } # End of this student / subject posting. } # End of this subject print "\n"; print "

[ ". $lex{'Post more Subjects'}. " |\n"; print " ". $lex{'Report Card'}. " ]\n"; print "\n"; exit; }