#!/usr/bin/perl
# Copyright 2001-2022 Leslie Richardson
# This file is part of Open Admin for Schools.
# Attcheck.pl - check attendance table (attend) for duplicate
# records, blank dates, and blank reasons. Link to something that
# will allow it to be fixed...
my %lex = ('Check' => 'Check',
'Main' => 'Main',
'Attendance' => 'Attendance',
'Duplicate Records' => 'Duplicate Records',
'Name' => 'Name',
'Date' => 'Date',
'Period' => 'Period',
'Reason' => 'Reason',
'Delete' => 'Delete',
'Empty' => 'Empty',
'Reasons' => 'Reasons',
'Edit' => 'Edit',
'Not Found' => 'Not Found',
'Back to Top' => 'Back to Top',
'Dates' => 'Dates',
'Record(s) Updated' => 'Record(s) Updated',
'Record(s) Deleted' => 'Record(s) Deleted',
'Subject' => 'Subject',
'Update' => 'Update',
'Error' => 'Error',
);
use DBI;
use CGI;
my $self = 'attcheck.pl';
# Read config variables
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
# Load libDate library to parse the grades field of dates_periods
eval require "../../lib/libDate.pl";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my $q = new CGI;
print $q->header( -charset, $charset );
my %arr = $q->Vars;
$dsn = "DBI:$dbtype:dbname=$dbase";
$dbh = DBI->connect($dsn,$user,$password);
# Page Head Section.
my $title = "$lex{Attendance} $lex{Check}";
print qq{$doctype\n$title
$chartype\n\n};
print qq{[ $lex{Main} | \n};
print qq{$lex{Attendance} ]\n};
print qq{
$title
\n};
if ($arr{updateflag} == 2){ # We want to delete duplicates...
delDuplicates();
}
if ($arr{updateflag} == 3){ # We want to edit reasons
edReasons();
}
if ($arr{updateflag} == 4){ # We want to edit dates
edDates();
}
if ($arr{updateflag} == 5){ # We want to update reasons
updateReasons();
}
if ($arr{updateflag} == 6){ # We want to update dates
updateDates();
}
if ($arr{updateflag} == 7){ # Delete School closed errors
delClosureErrors();
}
# First... Find Duplicates.
$sth = $dbh->prepare("select attid, absdate, studentid, subjsec, period, reason
from attend order by absdate, studentid, period");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die;}
$firstflag = 1;
while ( my ($id, $absdate, $studnum, $subjsec, $period,
$reason) = $sth->fetchrow){
if ($prevdate eq $absdate and
$prevstud == $studnum and
$prevper == $period){ # We have a duplicate
$sth1 = $dbh->prepare("select lastname, firstname from studentall
where studnum = '$studnum'");
$sth1->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
my ($lastname, $firstname) = $sth1->fetchrow;
if (not $lastname){ $lastname = 'Not Found';}
if ($firstflag){
print qq{
\n};
#============
# Find School Closure Errors (Attendance done while school closed
my (%closed, %closedGR, %closedHR);
# Load Closure Data
my $sth = $dbh->prepare("select * from dates");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die;}
while ( my $ref = $sth->fetchrow_hashref ) {
$closed{$ref->{date}}{$ref->{dayfraction}} = 1;
}
#foreach my $date ( sort keys %closed ) {
# foreach my $frac ( sort keys %{ $closed{$date} } ) {
# print qq{
Date:$date Fraction:$frac
\n};
# }
#}
my $sth = $dbh->prepare("select * from dates_homeroom");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die;}
while ( my $ref = $sth->fetchrow_hashref ) {
my %d = %$ref;
$closedHR{ $d{date} }{ $d{homeroom} }{ $d{period} } = 1;
}
# CHECK %closedHR
=head
foreach my $date ( sort keys %closedHR ) {
foreach my $homeroom ( sort keys %{ $closedHR{$date} } ) {
foreach my $period ( sort keys %{ $closedHR{$date}{$homeroom} } ) {
print qq{
Date:$date Homeroom:$homeroom Period:$period
\n};
}
}
}
=cut
my $sth = $dbh->prepare("select * from dates_periods");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die;}
while ( my $ref = $sth->fetchrow_hashref ) {
my %d = %$ref;
my $date = $d{date};
# Extract individual grades
my $dref = parseGradesPeriod( $date, $dbh);
my %r = %$dref;
foreach my $gr ( keys %r ) {
foreach my $per ( keys %{ $r{$gr} } ) {
$closedGR{ $d{date} }{ $gr }{ $per } = 1; # date,grade,period
# print qq{Date:$d{date} GR:$gr PER:$per \n};
}
}
}
# CHECK %closedGR
#foreach my $date ( sort keys %closedGR ) {
# foreach my $grade ( sort keys %{ $closedGR{$date} } ) {
# foreach my $period ( sort keys %{ $closedGR{$date}{$grade} } ) {
# print qq{
Date:$date Grade:$grade Period:$period
\n};
# }
# }
#}
#use Data::Dumper;
#print Dumper
# Now loop through all records looking for errors.
# Get student HR and GR.
my $sth2 = $dbh->prepare("select grade, homeroom from studentall where studnum = ?");
my $sth = $dbh->prepare("select * from attend order by absdate");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die;}
$firstflag = 1;
my $count = 0;
while ( my $ref = $sth->fetchrow_hashref ){
my %r = %$ref;
my $deleteflag;
# Check for a full day closure
if ( $closed{ $r{absdate} }{'1.000'} ) { # day fully closed.
$deleteflag = 1;
}
# Get Student Grade and Homeroom
$sth2->execute( $r{studentid} ); # studnum
if ($DBI::errstr){ print $DBI::errstr; die;}
my ( $grade, $homeroom ) = $sth2->fetchrow;
# Check for Grade/Homeroom Closure
if ( $closedGR{ $r{absdate} }{ $grade }{ $r{period} } ) { # closed this period
$deleteflag = 1;
}
if ( $closedHR{ $r{absdate} }{ $homeroom }{ $r{period} } ) { # closed this period
$deleteflag = 1;
}
# Print Current Record
if ( $deleteflag ) {
if ($firstflag){
print qq{
\n};
# End of Find Closure Errors
#==============
# Now look for blank reasons....
$sth = $dbh->prepare("select * from attend where reason is null or reason = ''
order by absdate, period");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
my $firstblankflag = 1;
while (my ($id, $studnum,$absdate,$reason,$period,$subjsec) = $sth->fetchrow){
if ($firstblankflag){ # write the table head section...
print qq{
\n};
#----------------------
# Now find blank dates.
#----------------------
$sth = $dbh->prepare("select * from attend where absdate = '' order by absdate, period");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
$firstflag = 1;
while (my ($id, $studnum,$absdate,$reason,$period,$subjsec) = $sth->fetchrow){
if ($firstflag){ # write the table head section...
print qq{