#! /usr/bin/perl
# Copyright 2001-2022 Leslie Richardson
# This file is part of Open Admin for Schools.
# Report attendance by Homeroom
# We will have to find all students enrolled at some time during this
# school year. So the approach is:
# a) Find all students with enrollment changes (ie. transfer records) this year
# b) and get their enrollment blocks for this year.
# c) Put those students into a data structure indexed by homeroom. If no homeroom, ignore them.
my %lex = ('Attendance Report' => 'Attendance Report',
'Attendance' => 'Attendance',
'Average' => 'Average',
'Days Open' => 'Days Open',
'Error' => 'Error',
'Homeroom' => 'Homeroom',
'Main' => 'Main',
'Missing' => 'Missing',
'Month' => 'Month',
'Periods Per Day' => 'Periods Per Day',
'Total' => 'Total',
);
my $self = 'rptAttHomeroom.pl';
use DBI;
use CGI;
use Number::Format qw(:all);
# Constants
my $group = 'homeroom';
# Read config variables
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
eval require "../../lib/libattend.pl";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my $dsn = "DBI:mysql:$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
$dbh->{mysql_enable_utf8} = 1;
my @tim = localtime(time);
my $year = $tim[5] + 1900;
my $month = $tim[4] + 1;
my $day = $tim[3];
if (length($month) == 1){ $month = "0".$month;}
if (length($day) == 1){ $day = "0".$day;}
my $currsdate = "$year-$month-$day";
my $currdate = "$month[$month] $day, $year";
my $q = new CGI;
my %arr = $q->Vars;
print $q->header( -charset, $charset );
# HTML Header
my $title = qq{$lex{Homeroom} $lex{'Attendance Report'}};
print qq{$doctype\n$title\n};
print qq{\n};
print qq{
\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} | $lex{Attendance} ]\n};
print qq{\n};
print qq{
$title
\n};
my $enddate;
if ($arr{date}){
$enddate = $arr{date};
} else {
$enddate = $currsdate;
}
print qq{
$schoolstart - $currdate
\n};
# Functions from LibAttend
%schooldays = mkSchoolDays( $schoolstart, $enddate, $dbh );
# returns hash of schooldays in month. key is yyyy-mm and value is schooldays in month
#~~ print qq{School Days", %schooldays, " \n};
# Find the homerooms
my %homerooms;
my $sth = $dbh->prepare("select distinct homeroom from student
where homeroom is not NULL and homeroom != ''");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $hr = $sth->fetchrow ) {
$homerooms{$hr} = 1;
}
# Find students with enrollment changes this year, if currently
# withdrawn. Students who are still enrolled in school are ok. Just
# need the currently withdrawn.
my %wdstudent;
my $sth1 = $dbh->prepare("select studid, homeroom from studentwd where studnum = ?");
my $sth = $dbh->prepare("select distinct studnum from transfer
where to_days(date) > to_days('$startdate')"); # no need for end date.
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $studnum = $sth->fetchrow ) {
# are they current or withdrawn?
$sth1->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my ($wd,$hr) = $sth1->fetchrow;
if ( $wd ) {
$wdstudent{$hr}{$studnum} = 1;
}
}
my %lexi = ('Absent' => 'Absent',
'Late' => 'Late');
# Now Loop through all homerooms
# find grades for each homeroom in order to find ppd.
my $sth = $dbh->prepare("select studnum from student where homeroom = ? order by lastname, firstname");
my $sth1 = $dbh->prepare("select distinct grade from student where homeroom = ?");
my %attend;
# my %genderatt;
foreach my $homeroom ( sort {$a <=> $b} keys %homerooms ) {
# get grade(s) and then the attendance periods per day (ppd).
$sth1->execute($homeroom);
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $hrppd; # homeroom periods per day;
my @ppd;
my $startdate;
while ( my $gr = $sth1->fetchrow ) {
my $track = $g_MTrackTermType{ $gr };
$startdate = $g_MTrackTerm{$track}{'1'}{'start'};
# print "HR:$homeroom Start Date: $startdate - GR:$gr \n";
my $ppd = $g_ppd{ $gr };
# print qq{HR:$homeroom Grade:$gr PPD: $ppd \n};
push @ppd, $ppd;
}
$hrppd = $ppd[0]; # first element in array; typically only 1 grade per homeroom.
if ($ppd[1]) { # we have more than one grade in this homeroom; find the largest ppd.
foreach my $ppd ( @ppd ) {
if ( $ppd != $hrppd and $hrppd ) { # we have different values
print qq{
Attendance Periods per Day Differ - Current $hrppd vs New $ppd
\n};
if ( $ppd > $hrppd ) { $hrppd = $ppd; }
}
}
}
if ( not $hrppd ) {
print qq{$lex{Missing} $lex{'Periods Per Day'} for $lex{Homeroom} $homeroom \n};
} else {
# print qq{
Attendance Periods per Day $hrppd
\n};
}
# Students in this homeroom
my @students;
$sth->execute($homeroom);
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $studnum = $sth->fetchrow ) {
push @students, $studnum;
}
# now withdrawn students, not sorted.
foreach my $studnum ( keys %{ $wdstudent{$homeroom} } ) {
push @students, $studnum;
}
foreach my $studnum ( @students ) {
# my $sex = lc( $gender{$studnum});
my $ref = calcMonthlyEnrollment( $studnum, $startdate, $enddate, $dbh );
my %enrolYM = %$ref;
# format: $enrolYM{yearmonth}-> start, end, days.
foreach my $ym ( sort keys %enrolYM ) {
my $result = calcMonthlyAttendance( $studnum, $ym, $hrppd, '',\%lexi, $dbh );
# no end date req'd.
my ($absent, $late) = split(':', $result);
my $enrolled = $enrolYM{$ym}->{days};
my $present = $enrolled - $absent;
# print "Enrolled:$enrolled Present:$present\n";
$attend{$homeroom}{$ym}->{attend} += $present;
$attend{$homeroom}{$ym}->{enrol} += $enrolled;
# $genderatt{$grade}{$ym}{$sex}->{attend} += $present;
# $genderatt{$grade}{$ym}{$sex}->{enrol} += $enrolled;
}
}
}
#use Data::Dumper;
#print Dumper %attend;
#print qq{\n};
# print it out
# First Row: Days Open, Then each grade for each month; Year:Month along the top.
print qq{
\n};
print qq{
Hover to see more details Ⓗ
\n};
print qq{
};
foreach my $yrmo ( sort keys %schooldays ) {
my ($y,$m) = split('-', $yrmo);
print qq{
$s_month[$m] $y
};
}
print qq{
$lex{Total}
\n};
# Days Open
print qq{
$lex{'Days Open'}
};
my $totaldays;
foreach my $yrmo ( sort keys %schooldays ) {
print qq{
$schooldays{$yrmo}
};
$totaldays += $schooldays{$yrmo};
}
print qq{
$totaldays
\n};
# Homerooms
my (%monthAtt, %monthEn);
foreach my $homeroom ( sort {$a <=> $b} keys %homerooms ) {
my ($totalAttend, $totalEnrolled);
print qq{
$lex{Homeroom} $homeroom
};
foreach my $yrmo ( sort keys %schooldays ) {
my $attend = $attend{$homeroom}{$yrmo}->{attend};
my $enrolled = $attend{$homeroom}{$yrmo}->{enrol};
$totalAttend += $attend;
$totalEnrolled += $enrolled;
$monthAtt{$yrmo} += $attend;
$monthEn{$yrmo} += $enrolled;
my $average;
if ( $enrolled ) {
$average = format_number( $attend / $enrolled * 100, 1,1);
}
my $days = $schooldays{$yrmo};
my $avgdays = format_number( $days * $average / 100,1,1);
print qq{