#!/usr/bin/perl
# Copyright 2001-2024 Leslie Richardson
# This file is part of Open Admin for Schools.
my %lex = ('Add Transcript Records' => 'Add Transcript Records',
'Report Card' => 'Report Card',
'Main' => 'Main',
'Save Transcript Records' => 'Save Transcript Records',
'Student' => 'Student',
'Search' => 'Search',
'Student (Last,First/Last/Initials/Studnum)' =>
'Student (Last,First/Last/Initials/Studnum)',
'No Student(s) Found' => 'No Student(s) Found',
'Please search again' => 'Please search again',
'Action' => 'Action',
'Add Record' => 'Add Record',
'Subject Code' => 'Subject Code',
'Subject Name' => 'Subject Name',
'Subject Area' => 'Subject Area',
'Mark' => 'Mark',
'Letter Grade' => 'Letter Grade',
'Difficulty' => 'Difficulty',
'School Year' => 'School Year',
'Credits' => 'Credits',
'Term' => 'Term',
'Term Description' => 'Term Description',
'Transcript Record Added' => 'Transcript Record Added',
'Add More Transcript Records' => 'Add More Transcript Records',
'Missing Information' => 'Missing Information',
'Override' => 'Override',
'Error' => 'Error',
);
my $idfield = 'provnum'; # change to suit the fields using for state/provincial education #
my $self = 'tscadd.pl';
my $maxRecords = 6; # Number of entry forms for courses for this student...
my $maxyears = 6; # maximum number of school years to go back.
use DBI;
use CGI;
# Read config variables; normally runs in /cgi/repcard
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
eval require "../../etc/transcript.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my $q = new CGI;
print $q->header( -charset, $charset );
my %arr = $q->Vars;
# Open Database
my $dsn = "DBI:$dbtype:$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
# Print Page Header
my $title = $lex{'Add Transcript Records'};
print qq{$doctype\n$title\n};
print qq{\n
$chartype\n\n};
print qq{[ $lex{Main} |\n};
print qq{$lex{'Report Card'} ]\n};
print qq{
$title
\n};
if ( not $arr{page} ) {
showSearchForm();
} elsif ( $arr{page} == 1 ) {
selectStudent( $arr{student} );
} elsif ( $arr{page} == 2 ) {
enterRecord( $arr{studnum} );
} elsif ( $arr{page} == 3 ) {
delete $arr{page};
addRecord();
}
#--------------
sub enterRecord {
#--------------
my $studnum = shift;
#foreach my $key (keys %arr) { print qq{K: $key V: $arr{$key} \n}; }
# Get the student name
my $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
$sth->execute( $studnum );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my ($lastname, $firstname) = $sth->fetchrow;
# Get the terms
my @terms;
my $sth = $dbh->prepare("select distinct term from tscriptdata
where term is not null and term != ''");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while (my $trm = $sth->fetchrow ) {
push @terms, $trm;
}
# Get the credits
my @credits;
my $sth = $dbh->prepare("select distinct credit from tscriptdata
where credit is not null and credit != ''");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while (my $cred = $sth->fetchrow ) {
push @credits, $cred;
}
# Do the school years
my @years;
my ($prevyear, $curryear) = split /-/, $schoolyear; # defined in admin.conf
foreach (1..$maxyears) {
$tmp = $prevyear--;
my $year = $prevyear. '-'. $tmp;
push @years, $year;
}
# Start the form.
print qq{\n};
exit;
}
#------------
sub addRecord {
#------------
# Exit if missing data
if (not $arr{subjectcode} or (not $arr{score_mark} and not $arr{score_letter}) ) {
print qq{
$lex{'Missing Information'}
\n};
exit;
}
# Update letter score from mark
my ($score_flag, $letter);
if ( not $arr{score_letter} ) {
if ( $arr{score_mark} =~ /[a-zA-Z]/ ) { # if it's a letter
$letter = $arr{score_mark};
} else { # we have a number
foreach my $threshold (reverse sort keys %markToLetter ) {
# from large to small...
if ( $arr{score_mark} >= $threshold ) {
$letter = $markToLetter{$threshold};
last;
}
}
}
$arr{score_letter} = $letter;
$score_flag = 1;
}
# Check for an existing ident record...add one if not present...
my $sth = $dbh->prepare("select count(*) from tscriptident where studnum = ?");
$sth->execute( $arr{studnum} );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $count = $sth->fetchrow;
my ( $lastname, $firstname, $middlename, $birthdate);
if ( $count < 1 ) { # add a new ident record.
my $sth2 = $dbh->prepare("select lastname,firstname, initial, birthdate, $idfield
from studentall where studnum = ?");
$sth2->execute( $arr{studnum} );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
($lastname, $firstname, $middlename, $birthdate, $idfield ) = $sth2->fetchrow;
my $sth2 = $dbh->prepare("insert into tscriptident values (
$sql{default}, '$arr{studnum}','$lastname','$firstname','$middlename',
'$birthdate','$idfield','$graddate')");
$sth2->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
}
# Check for overrides for term and credit
if ( $arr{overcredit} ) {
$arr{credit} = $arr{overcredit};
}
if ( $arr{overterm} ) {
$arr{term} = $arr{overterm};
}
# Quote all passed fields.
foreach my $key ( keys %arr ) {
if ( $arr{$key} ) {
$arr{$key} = $dbh->quote( $arr{$key} );
} else {
$arr{$key} = $sql{default};
}
}
#foreach my $key (keys %arr) { print qq{K: $key V: $arr{$key} \n}; }
my $sth = $dbh->prepare("insert into tscriptdata values ( $sql{default}, $arr{studnum},
$arr{subjectcode}, $arr{subjecttext}, $arr{subjectarea}, $arr{score_mark}, $arr{score_letter},
$arr{score_diff}, $arr{schoolyear}, now(), $arr{credit}, $arr{term}, $arr{term_desc} ) ");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
print qq{