#!/usr/bin/perl
# Copyright 2001-2024 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.
#### transchk.pl - check transfer table for several kinds of mistakes.
my %lex = (
'Transfer' => 'Transfer',
'Check' => 'Check',
'Main' => 'Main',
'Error' => 'Error',
'Name' => 'Name',
'Current' => 'Current',
'Duplicate' => 'Duplicate',
'Student Number' => 'Student Number',
'Previous' => 'Previous',
'Update' => 'Update',
'Record(s) Updated' => 'Record(s) Updated',
'Continue' => 'Continue',
'Not Found' => 'Not Found',
);
my $self = 'transchk.pl';
use DBI;
use CGI;
# Read config variables
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my $q = new CGI;
print $q->header( -charset, $charset );
%arr = $q->Vars;
$dsn = "DBI:$dbtype:dbname=$dbase";
$dbh = DBI->connect($dsn,$user,$password);
# Page Head Section.
my $title = qq{$lex{Transfer} $lex{Check}};
print qq{$doctype\n$title\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} ]\n};
print qq{
\n};
# Duplicates: Same last name, first name, different studnum.
my $sth = $dbh->prepare("select distinct studnum, lastname, firstname, birthdate, date
from transfer order by lastname, firstname");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $sth1 = $dbh->prepare("select count(*) from studentall where studnum = ?");
my $sth2 = $dbh->prepare("select count(*) from student where studnum = ?");
# Start Form
print qq{\n};
} else {
print qq{
$lex{Duplicate} $lex{'Student Number'} - OK
\n};
}
#-------------------------- Next Test -----------------------
print qq{
Transfer Record Count Check
\n};
# Now check for numbers of records, and ordering
$sth = $dbh->prepare("select distinct studnum from transfer order by lastname, firstname");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
$sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
$sth2 = $dbh->prepare("select count(*) from student where studnum = ?");
$sth3 = $dbh->prepare("select count(*) from transfer where studnum = ?");
$sth4 = $dbh->prepare("select id, date, type from transfer where studnum = ? order by date ");
my %hasStudRec = (); # track studnums in transfer that Have matching student records.
# Then later find those who don't... (and remove?)
my $count = 1;
while ( my $studnum = $sth->fetchrow ) {
# Find if active (ie. current student )
$sth2->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $active = $sth2->fetchrow;
# Find out if any student records ($hasStudRec) (and get name, if possible )
$sth1->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my ($lastname, $firstname ) = $sth1->fetchrow;
if ( $lastname ) {
$hasStudRec{$studnum} = 1;
} else { # try a transfer record for a name
my $sth5 = $dbh->prepare("select lastname, firstname from transfer where studnum = ?");
$sth5->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while (($lastname, $firstname ) = $sth5->fetchrow ) {
if ( $lastname ) { last; }
}
if ( not $lastname ) { $lastname = qq{$lex{'Not Found'}}; }
}
# Check for number of enrollment records (even for withdrawn studs; odd for active)
$sth3->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $transcount = $sth3->fetchrow;
if ( $transcount % 2 == 0 and $active ) { # even num; mistake
print qq{$count. $lex{Error}: Transfers Uneven: };
print qq{$transcount - Active:$active $firstname $lastname ($studnum) \n};
$count++;
}
if ( $transcount % 2 == 1 and not $active ) { # odd num; mistake
print qq{$count. $lex{Error}: Transfers Uneven: $transcount };
print qq{- Active:$active $firstname $lastname ($studnum) \n};
$count++;
}
}
# ----------- Test for WD students having transfer records
print qq{
Withdrawn Student without Transfer Records
\n};
$first = 1;
# Now check for numbers of records, and ordering
$sth = $dbh->prepare("select studnum from studentall order by lastname, firstname");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
$sth1 = $dbh->prepare("select count(*) from transfer where studnum = ?");
$sth3 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
while ( my $studnum = $sth->fetchrow ) {
$sth1->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $transcount = $sth1->fetchrow;
if ( not $transcount ) {
$first = 0;
$sth3->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my ($lastname, $firstname) = $sth3->fetchrow;
print qq{Missing Transfer records for: $firstname $lastname ($studnum) \n};
}
}
if ( $first ) { print qq{
No Students without Transfer Records
\n}; }
#------- Test for Initial / Final Transfer Record Error
print qq{
Initial / Final Transfer Check
\n};
my $first = 1;
# Now check for numbers of records, and ordering
$sth = $dbh->prepare("select distinct studnum from transfer order by lastname, firstname");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
$sth1 = $dbh->prepare("select type from transfer where studnum = ? order by date");
$sth2 = $dbh->prepare("select type from transfer where studnum = ? order by date desc");
$sth3 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
$sth4 = $dbh->prepare("select count(*) from student where studnum = ?");
my $count = 1;
while ( my $studnum = $sth->fetchrow ) {
# Get First Record
$sth1->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $firsttranstype = $sth1->fetchrow;
if ( $firsttranstype eq 'withdraw' ) { # Error
$first = 0;
$sth3->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my ($lastname, $firstname) = $sth3->fetchrow;
print qq{Initial Transfer Record for: $firstname $lastname ($studnum) is a withdrawal! \n};
}
# Get Last Record
$sth2->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $lasttranstype = $sth2->fetchrow;
# Find if active (ie. current student )
$sth4->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $active = $sth4->fetchrow;
if ( ( $active and $lasttranstype eq 'withdraw' ) or
( not $active and $lasttranstype ne 'withdraw' )) {
$first = 0;
$sth3->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my ($lastname, $firstname) = $sth3->fetchrow;
print qq{Current Enrollment Error for: $firstname $lastname ($studnum) \n};
}
}
if ( $first ) { print qq{
First / Last Transfers OK
\n}; }
#--------- Test for Doublet Transfers (2 in 1 day).
print qq{
Transfer Doublet Error Check
\n};
$sth = $dbh->prepare("select distinct studnum from transfer order by lastname, firstname");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
$sth1 = $dbh->prepare("select distinct date, count(*) from transfer where studnum = ? group by date");
$sth3 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
my $count = 1;
while ( my $studnum = $sth->fetchrow ) {
# Transfer Doublet Check
$sth1->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while ( my ($date, $trcount ) = $sth1->fetchrow ) {
if ( $trcount > 1 ) {
$sth3->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my ($lastname, $firstname) = $sth3->fetchrow;
$first = 0;
print qq{Double Transfer Record for: $firstname $lastname ($studnum) - $date - $trcount \n};
}
}
}
if ( $first ) { print qq{
Double Record Checks - OK
\n}; }
print qq{\n};
#----------------------
sub updateStudentNumber { # Update Student Numbers
#----------------------
#foreach my $key (sort keys %arr){ print qq{K:$key V:$arr{$key} \n}; }
my $sth = $dbh->prepare("update transfer set studnum = ? where studnum = ?");
foreach my $key (keys %arr){
my ( $toStudnum, $fromStudnum ) = split /:/, $key;
if ( not $toStudnum or not $fromStudnum ) {
print qq{Missing Error! \n};
next;
}
$sth->execute( $toStudnum, $fromStudnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
}
print qq{