#! /usr/bin/perl
# Copyright 2001-2022 Leslie Richardson
# This file is part of Open Admin for Schools.
# ======= Course 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).
my %lex = ('Attendance Report' => 'Attendance Report',
'Attendance' => 'Attendance',
'Main' => 'Main',
'Not Found' => 'Not Found',
'Error' => 'Error',
'Terms' => 'Terms',
'Continue' => 'Continue',
'Red' => 'Red',
'Withdrawn' => 'Withdrawn',
'Absence' => 'Absence',
'Student' => 'Student',
'Course' => 'Course',
);
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;
my %arr = $q->Vars;
print $q->header( -charset, $charset );
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
$dbh->{mysql_enable_utf8} = 1;
# 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 Report'}";
print qq{$doctype\n$title\n};
print qq{\n};
print qq{$chartype\n};
print qq{[ $lex{Main} | \n};
print qq{$lex{Attendance} ]\n};
print qq{
$title
\n};
if ( not $arr{page} ) {
showStartPage();
}
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;
}
# Setup for each Student for this subject
my $sth1 = $dbh->prepare("select distinct a.studentid,
s.lastname, s.firstname from attend a
left outer join student s on s.studnum = a.studentid
where a.subjsec = ? order by s.lastname, s.firstname");
# Setup for Student/Subject Attendance getting reasons count.
my $sth2 = $dbh->prepare("select distinct reason, count(reason) from attend
where studentid = ? and subjsec = ? group by reason");
my $sth3 = $dbh->prepare("select distinct reason from attend where subjsec = ?");
my $sth4 = $dbh->prepare("select count(*) from eval where subjcode = ?");
my $firstflag = 1;
# Start Table
print qq{
\n};
# Now loop through all subjects, printing students and number missed.
foreach my $subjsec ( @subjects ){
my $description = $subjects{$subjsec};
# Check for enrollments.
$sth4->execute( $subjsec );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $enrolcount = $sth4->fetchrow;
if ( not $enrolcount ) { next; } # skip ths subject.
# Find reasons for this subject. (could do global, but may be smaller)
$sth3->execute( $subjsec );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my @reasons;
while ( my $reason = $sth3->fetchrow ) {
push @reasons,$reason;
}
if (not $firstflag) {
print qq{
\n};
# Get Studnum, Lastname, Firstname for this subject.
$sth1->execute( $subjsec );
if ($DBI::errstr){ print $DBI::errstr; die;}
my $studary = $sth1->fetchall_arrayref;
foreach my $studref (@$studary){ # Loop through all students.
my $studnum = $$studref[0];
my $lastname = $$studref[1];
my $firstname = $$studref[2];
if (not $lastname){ # look in withdrawn students
my $sth3 = $dbh->prepare("select lastname, firstname from studentwd
where studnum = '$studnum'");
$sth3->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
($lastname,$firstname) = $sth3->fetchrow;
if ( not $lastname ){ $lastname = $lex{'Not Found'}; }
$lastname = qq{$lastname};
$firstname = qq{$firstname};
}
# Get reasons and totals for this student
$sth2->execute($studnum,$subjsec);
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errtstr;}
my $rsnary = $sth2->fetchall_arrayref;
my %reason;
foreach my $rowref (@$rsnary){
$reason{$$rowref[0]} = $$rowref[1];
}
# Now loop through reasons (NOT from admin.conf, but attend array)
print qq{
$lastname, $firstname ($studnum)
\n};
foreach my $rsn (@reasons){
print qq{
$reason{$rsn}
\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{