#!/usr/bin/perl # Copyright 2001-2022 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' => 'Transcript', 'Post' => 'Post', 'Mark' => 'Mark', 'Student' => 'Student', 'Course' => 'Course', 'Courses' => 'Courses', 'Duplicate' => 'Duplicate', 'Error' => 'Error', 'Replace Existing' => 'Replace Existing', 'Record' => 'Record', 'Update Record' => 'Update Record', 'Skipping' => 'Skipping', 'Check' => 'Check', 'Select' => 'Select', 'Identity Mismatch' => 'Identity Mismatch', 'Edit' => 'Edit', 'Term' => 'Term', 'Skip' => 'Skip', 'Blank Marks' => 'Blank Marks', 'Average Mode' => 'Average Mode', 'Continue' => 'Continue', ); # rounding precision 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); $dbh->{mysql_enable_utf8} = 1; # Page Header my $title = qq{$lex{Transcript} $lex{Post}}; print qq{$doctype\n$title $chartype\n\n}; print qq{[ $lex{Main} |\n}; print qq{$lex{'Report Card'} ]\n}; print qq{

$title

\n}; if ( not $arr{page} ) { # We have a selected student. showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectSubjects(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; postSubjects(); } #---------------- sub showStartPage { #---------------- # Grade Selection my @grades; my $sth = $dbh->prepare("select distinct grade from student where grade != '' and grade is not null"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my $grade = $sth->fetchrow ) { push @grades, $grade; } @grades = sort {$a <=> $b} @grades; # Term Selection my @terms; my $sth = $dbh->prepare("select distinct endrptperiod from subject where endrptperiod != '' and endrptperiod is not null order by endrptperiod"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my $trm = $sth->fetchrow ) { push @terms, $trm; } print qq{
\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; foreach my $grade ( @grades ) { print qq{\n}; } print qq{
$lex{Select} $lex{Term}
$lex{Check} $lex{Courses}
$lex{Skip} $lex{'Blank Marks'}
($lex{'Average Mode'})
Select Grades to Post
Grade $grade }; print qq{
\n}; print qq{\n}; print qq{
\n}; exit; } #----------------- sub selectSubjects { #----------------- # foreach my $key (keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $skipblanks = $arr{'skipblanks'}; delete $arr{'skipblanks'}; my $term = $arr{term}; delete $arr{term}; if (not $term ) { print qq{

Missing Term

\n}; print qq{\n}; exit; } my $checked; if ( $arr{checked} ) { $checked = qq{checked="checked"}; delete $arr{checked}; } # remaining values will be grades. my %grades; foreach my $key (keys %arr ) { $grades{$key} = 1; } if ( not %grades ) { print qq{

Missing Grades

\n}; print qq{\n}; exit; } # Check Values # print qq{Grades
}; # foreach my $key ( sort keys %grades ) { # print qq{K:$key VAL:$grades{$key}
\n}; # } # Get values for supression from configuration system my @fieldnames = qw( r_SupressSubject r_AdditionalComments ); my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); foreach my $var ( @fieldnames ) { $sth->execute( $var ); my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print qq{$lex{Error}: $@
\n}; exit qq{$lex{Error}: $@\n}; } } # Course Selection - find courses with this term in eval (containing marks) my $sth = $dbh->prepare("select distinct e.subjcode from eval e, subject s where term = ? and grade = ? and e.subjcode = s.subjsec"); my %crs; foreach my $grade ( sort keys %grades ) { $sth->execute( $term, $grade ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my $subjsec = $sth->fetchrow ) { # skip if member of %r_SupressSubject or AdditionalComments my ($tsubjcode, $dud) = split('-', $subjsec ); if ( $r_SupressSubject{$tsubjcode} or $r_SupressSubject{$subjsec} or $r_AdditionalComments{$tsubjcode} or $r_AdditionalComments{$subjsec} ) { next; } $crs{$subjsec} = 1; } } # end of grade loop # Find Description, Grade for course my (%sort, %desc, %gr); $sth1 = $dbh->prepare("select endrptperiod, description, grade from subject where subjsec = ?"); foreach my $subjsec ( keys %crs ) { $sth1->execute( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ( $endterm, $description,$grade ) = $sth1->fetchrow; if ( $endterm == $term ) { # the subject ends this term... $desc{$subjsec} = qq{$description Gr $grade ($subjsec) }; $sort{"$grade$description$subjsec"} = $subjsec; $gr{$subjsec} = $grade; } } # At this point hashes only contains subjects that have # endterm in the selected term. # Print Start of Selection. print qq{

$lex{Select} $lex{Courses}

\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
}; print qq{ \n}; print qq{$lex{'Replace Existing'} $lex{Record}?
}; print qq{\n}; print qq{\n}; my ($currgrade,$prevgrade); my $backgroundcolor = "#FFF"; foreach my $key ( sort keys %sort ) { my $subjsec = $sort{ $key }; $prevgrade = $currgrade; $currgrade = $gr{$subjsec}; if ( $currgrade ne $prevgrade and $prevgrade ){ # toggle color if ( $backgroundcolor eq '#FFF' ) { $backgroundcolor = '#DDD'; } else { $backgroundcolor = '#FFF'; } } print qq{\n}; } print qq{
}; print qq{}; print qq{ $desc{$subjsec}
\n}; print qq{\n}; print qq{
\n}; exit; } #--------------- sub postSubjects { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Get the r_MarkField value and others from configuration system my @fieldnames = qw( markToLetter term_desc term_key r_MarkField r_AverageWeight ); my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); foreach my $var ( @fieldnames ) { $sth->execute( $var ); my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print qq{$lex{Error}: $@
\n}; exit qq{$lex{Error}: $@\n}; } } my $term = $arr{term}; # the term we are posting.... delete $arr{term}; my $replacemode = $arr{replacemode}; # may not exist in %arr hash. delete $arr{replacemode}; my $skipblanks = $arr{'skipblanks'}; delete $arr{'skipblanks'}; # 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,studentid 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, $r_MarkField, term from eval where subjcode = ? and studnum = ? order by term"); # Print heading Section print qq{\n}; print qq{\n}; foreach my $subjsec ( sort 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; # print qq{Sub:$description - $subjsec
\n}; # select each student record in turn and post. my $sth = $dbh->prepare("select $r_MarkField , studnum from eval 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 ) { # print qq{Mark:$mark Stud:$studnum
\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. # Skip NULL/Blank values in mark, if not in calcavg mode if ( $calcavg eq 'N' or not $calcavg ) { if ( not defined $mark or $mark eq "" ) { # skip NULLs/Blanks print qq{\n}; print qq{\n}; print qq{\n}; next STUDENT; } } # Check to see if mark contains letters my $markContainsLetters; if ( $mark =~ m/[a-zA-Z]/ ) { $markContainsLetters = 1; print qq{Mark Contains Letters: $mark
\n}; } # 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 qq{
Fatal Error: more than 1 student ident record with same studnum!
\n}; print qq{for student number: $studnum. Contact Administrator!
\n}; exit; } elsif ( $count < 1 ) { # add a new ident record. my $sth6 = $dbh->prepare("insert into tscriptident ( studnum, lastname, firstname, middlename, birthdate,studentid, graddate ) values ( ?, ?, ?, ?, ?, ?, ? )"); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } $sth6->execute($studnum, $lastname , $firstname, $middlename, $birthdate, $studentid, $graddate ); 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 qq{
$lex{Student}$lex{Subject}$lex{Mark}
$lex{Skipping} Blank - }; print qq{$firstname $lastname$description ($subjsec)NULL
\n}; my ($extraurl, $table, $id); foreach my $tbl ( qw( student studentwd )) { my $sth6 = $dbh->prepare("select studid from $tbl where studnum = ?"); $sth6->execute( $studnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } $id = $sth6->fetchrow; if ( $id ) { if ( $tbl eq 'studentwd' ) { $extraurl = '&tbl=wd';} last; } } print $lex{'Identity Mismatch'}; print qq{:$firstname|$lastname|$birthdate|($studnum) }; print qq{$lex{Transcript}:$testfirstname|$testlastname|($testbirthdate)|\n}; print qq{[ $lex{Edit} $lex{Student} |\n}; print qq{ $lex{Edit} $lex{Transcript} ]\n}; print qq{
\n}; exit; } } # 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' or $calcavg == 1 ) and not $markContainsLetters ) { $sth5->execute( $subjsec, $studnum ); # Get all mark field values. if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $totalscore, $totalweight); while ( my ( $id, $score, $term ) = $sth5->fetchrow ) { if ( $skipblanks ) { # normally ON; skip students with ANY blank marks if ( not defined $score ) { print qq{$lex{Skipping} Blank - }; print qq{$firstname $lastname\n}; print qq{$description ($subjsec)\n}; print qq{$lex{Term} $term\n}; next STUDENT; } } # NULL or empty strings are skipped; redundant from above? if ( not defined $score or $score eq "" ) { next; } if ( $score =~ m/\d/){ # if a digit... if ( not $r_AverageWeight{$term} ) { # Error print qq{

No Average Weight (r_AverageWeight) defined }; print qq{for this term $term

\n}; print qq{\n}; exit; } my $wt = $r_AverageWeight{$term}; #The weight for this term $totalscore += ( $wt * $score ); $totalweight += $wt; } } # end of looping over course marks if ( $totalweight ){ # We have some tests. $testavg = $totalscore / $totalweight; $testavg = format_number( $testavg, $precision,$precision); # set at to of script } else { $testavg = 0; } $mark = $testavg; } # end of calcavg 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 id 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 $id = $sth6->fetchrow; # Setup the Term Description info from the tscript.conf. my $term_desc = $term_desc{ $term_key{$term} }; if ( $id > 0 ) { if ( not $replacemode ) { # skip this student/subject; already done. print qq{$lex{Duplicate}! }; print $lex{'Skipping'}; print qq{ $firstname $lastname$description$mark\n}; next STUDENT; # skip to next record! } else { # replace existing record print qq{$lex{'Update Record'}:}; print qq{ $firstname $lastname$description$mark\n}; my $sth6 = $dbh->prepare("update tscriptdata set studnum = ?, subjectcode = ?, subjecttext = ?, subjectarea = ?, score_mark = ?, score_letter = ?, score_diff = ?, schoolyear = ?, crdate = now(), credit = ?, term = ?, term_desc = ? where id = ?"); $sth6->execute( $studnum, $subjsec, $description, $area, $mark, $letter, $difficulty, $schoolyear, $credit, $term, $term_desc, $id ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } } else { # no record found; insert one. # add the data record my $sth6 = $dbh->prepare("insert into tscriptdata (studnum, subjectcode, subjecttext, subjectarea, score_mark, score_letter, score_diff, schoolyear, crdate, credit, term, term_desc ) values (?,?,?,?,?,?,?,?,now(),?,?,?)"); $sth6->execute( $studnum, $subjsec, $description, $area, $mark, $letter, $difficulty, $schoolyear, $credit, $term, $term_desc); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print qq{$firstname $lastname$description\n}; print qq{$mark ($letter)\n}; } } # End of this student / course posting. } # End of this course print qq{\n}; print qq{

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