#!/usr/bin/perl # Copyright 2001-2008 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', 'Skipping Record for' => 'Skipping Record for', ); my $self = 'tscpost.pl'; my $idfield = 'provnum'; # change to suit the field for state/provincial id or SSN, etc. use DBI; use CGI; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my $q = CGI->new; print $q->header; my %arr = $q->Vars; 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 "\n"; print "\n"; foreach my $subjsec ( keys %subjects ) { print "\n\n"; } print "
$subjects{$subjsec}"; 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}; delete $arr{term}; # Student Selection my $sth1 = $dbh->prepare("select lastname, firstname, initial, birthdate, $idfield 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 = ?"); # Print heading Section print "

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

\n"; print "\n"; print "\n"; foreach my $subjsec ( keys %arr ) { # select each student record in turn and post. my $sth = $dbh->prepare("select a1, studnum from eval where term = ? and subjcode = ? order by studnum"); $sth->execute( $term, $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my ($mark, $studnum) = $sth->fetchrow ) { # 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 ) = $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 ); my $sth4 = $dbh->prepare("insert into tscriptident values ( $sql{default}, '$studnum', $lastname , $firstname, $middlename, '$birthdate','$studentid')"); $sth4->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 "Identity Mismatch for $firstname $lastname ($studnum) with
\n"; print " Transcript Identity record. Contact Administrator.
\n"; die "Transcript Identity Mismatch for $firstname $lastname ($studnum)\n"; } } # get letter grade equivalent. eval require "../../etc/transcript.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } # defines markToLetter hash ( mark => letter) my $letter; # letter grade. if ( $mark =~ /[a-zA-Z]/ ) { # 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; } } } # Get the subject information my $sth4 = $dbh->prepare("select description, credit, difficulty, area from subject where subjsec = ?"); $sth4->execute ( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($description, $credit, $difficulty, $area) = $sth4->fetchrow; # Check for duplicate course records - same studnum, same # subjsec, same year, same term. Skip if duplicate my $sth4 = $dbh->prepare("select count(*) from tscriptdata where subjectcode = ? and studnum = ? and schoolyear = ? and term = ?"); $sth4->execute($subjsec, $studnum, $schoolyear, $term); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth4->fetchrow; if ( $count > 0 ) { # skip this student/subject; already done. print "\n"; next; # skip to next record! } # Setup the Term Description info from the tscript.conf. my $term_desc = $term_desc{ $term_key{$term} }; # add the data record $sth4 = $dbh->prepare("insert into tscriptdata values ( $sql{default}, '$studnum','$subjsec','$description','$area','$mark', '$letter','$difficulty','$schoolyear', now(), '$credit','$term','$term_desc')"); $sth4->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } print "\n"; print "\n"; } # End of this student / subject posting. } # End of this subject print "
". $lex{Student}. "". $lex{Subject}. ""; print $lex{Mark}. "
". $lex{Duplicate}. "! "; print $lex{'Skipping Record for'}; print " $firstname $lastname$description$mark
$firstname $lastname$description$mark ($letter)
\n"; print "

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