#! /usr/bin/perl
# Copyright 2001-2022 Leslie Richardson
# This file is part of Open Admin for Schools.
# Subject/Summary Attendance Report
# Get Start date of current term. Calculate all student's attendance
# per subject (and grand total). Display descending list by all students
# per class or per total. Data comes first from attendance linked to other
# tables. Attend is definitive, not eval (which may change).
# Note: $lateUnexcused and $absentUnexcused (line 206) are loaded from admin.conf
# and MUST be set correctly for this to work...
my %lex = ('Attendance' => 'Attendance',
'Not Found' => 'Not Found',
'Student' => 'Student',
'Course' => 'Course',
'Absent' => 'Absent',
'Unexcused' => 'Unexcused',
'Other' => 'Other',
'Lates' => 'Lates',
'Red' => 'Red',
'Withdrawn' => 'Withdrawn',
'Days' => 'Days',
'Periods' => 'Periods',
'Error' => 'Error',
'WD' => 'WD',
'Terms' => 'Terms',
'Continue' => 'Continue',
'Main' => 'Main',
);
use DBI;
use CGI;
use Number::Format qw{round};
my $self = 'rptattstudsubj.pl';
# Ratio of Lates Equivalent to 1 Absence.
my $latesEquiv = 3; # 3 Late = 1 Absence
# Read config variables
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my $q = new CGI;
my %arr = $q->Vars;
print $q->header( -charset, $charset );
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
# Get Additional Comment values from configuration system, in order to skip...
my $sth = $dbh->prepare("select datavalue from conf_system
where dataname = 'r_AdditionalComments'");
$sth->execute;
my $datavalue = $sth->fetchrow;
eval $datavalue;
if ( $@ ) {
print "$lex{Error}: $@ \n";
die "$lex{Error}: $@\n";
}
my $title = "$lex{Course} $lex{Attendance} - $lex{Student}";
print qq{$doctype\n$title\n};
print qq{\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{$lex{Main} |\n};
print qq{$lex{Attendance} ]\n};
print qq{
$title
\n};
if ( not $arr{page} ) {
showStartPage();
}
# Setup Attendance Reasons and Matching Points
my %attendPoints = ();
for my $idx ( 1..@attend ) {
$attendPoints{"$attend[$idx]"} = $points[$idx];
}
my ($sterm, $eterm) = split('-', $arr{term});
print qq{
\n};
# First find subjects in this term or term block.
my (@subjects, %subjects);
my $sth = $dbh->prepare("select subjsec, description from subject where
startrptperiod = ? and endrptperiod = ? order by description");
$sth->execute($sterm, $eterm);
if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; }
while ( my ( $subjsec, $desc) = $sth->fetchrow ) {
my ( $subjcode, $dud ) = split(/-/, $subjsec);
# skip if member of %r_AdditionalComments hash - NEW
if ( $r_AdditionalComments{$subjsec} or $r_AdditionalComments{$subjcode} ) {
next;
}
push @subjects, $subjsec; # @subjects gives us sort order
$subjects{$subjsec} = $desc;
}
# Now find students in those subjects
my $sth1 = $dbh->prepare("select lastname, firstname, grade from student where studnum = ?");
my $sth2 = $dbh->prepare("select lastname, firstname, grade from studentwd where studnum = ?");
foreach my $subjsec ( @subjects ) {
my $sth = $dbh->prepare("select distinct studnum from eval where subjcode = ?");
$sth->execute( $subjsec );
if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; }
while ( my $studnum = $sth->fetchrow ) {
# Get name
$sth1->execute( $studnum );
my ($lastname, $firstname, $grade ) = $sth1->fetchrow;
my $wdflag;
if ( not $lastname ) { # check in withdrawn.
$sth2->execute( $studnum );
if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; }
( $lastname, $firstname, $grade ) = $sth2->fetchrow;
$wdflag = 1;
if ( not $lastname ) {
$lastname = $lex{'Not Found'};
}
}
push @students, "$lastname:$firstname:$studnum:$subjsec:$wdflag:$grade";
}
}
# now have all students in @students array.
print qq{
\n};
print qq{
$lex{Course}
$lex{Absent} $lex{Unexcused}
};
print qq{
$lex{Absent} $lex{Other}
$lex{Lates}
};
print qq{
$lex{Periods}
$lex{Days}
\n};
my ($currstud, $prevstud, $totalDays);
$currstud = -1;
my $sth3 = $dbh->prepare("select description, smdesc from subject where subjsec = ?");
# Now loop through all students, printing classes and number missed.
foreach my $stud ( sort @students ) {
my ($lastname, $firstname, $studnum, $subjsec, $wdflag, $grade) = split(':', $stud);
my $ppd = $g_ppd{ $grade };
if ( not $ppd ) { $ppd = 1; }
# Get Subject Name
my $description;
$sth3->execute( $subjsec );
my ($desc, $smdesc) = $sth3->fetchrow;
if (not $smdesc) {
$description = substr($desc, 0, 10);
} else {
$description = $smdesc;
}
if ( $wdflag ){ # withdrawn students
$lastname = qq{$lastname};
$firstname = qq{($lex{WD}) $firstname};
}
$prevstud = $currstud;
$currstud = $studnum;
if ( $currstud != $prevstud ) { # New student...
print qq{
$firstname $lastname ($studnum)
\n};
}
# Get attendance reasons and count;
my $sth= $dbh->prepare("select distinct reason, count(reason) from attend
where subjsec = ? and studentid = ? group by reason");
$sth->execute( $subjsec, $studnum );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my ($totalCount, $absentCount, $lateCount, $otherCount);
while ( my ($reason, $count) = $sth->fetchrow ) {
if ( $reason eq $absentUnexcused ) {
$absentCount = $count;
} elsif ( $reason eq $lateUnexcused ) {
$lateCount = $count;
} elsif ( $reason =~ $absentString ) { # one of the other absences.
$otherCount += $count;
}
}
$totalCount = $otherCount + int( $lateCount / $latesEquiv ) + $absentCount;
my $dayCount;
$dayCount = $totalCount / $ppd;
$dayCount = round( $dayCount, 2);
# print stuff
print qq{
$description ($subjsec)
$absentCount
$otherCount
\n};
print qq{
$lateCount
$totalCount
$dayCount
\n};
}
# Print last of last record
print qq{$totalDays\n};
print qq{
\n};
print qq{\n};
#----------------
sub showStartPage {
#----------------
# Find all of the term patterns.
my $sth = $dbh->prepare("select distinct startrptperiod, endrptperiod from subject
order by startrptperiod, endrptperiod");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
print qq{