#! /usr/bin/perl
# Copyright 2001-2022 Leslie Richardson
# This file is part of Open Admin for Schools.
# Absent strings for matching set in admin.conf; Comparison at line
# 305 in this file.
my $self = 'rptPresent.pl';
my %lex = ('Main' => 'Main',
'Error' => 'Error',
'Month' => 'Month',
'Select' => 'Select',
'Attendance' => 'Attendance',
);
use DBI;
use CGI;
use Time::JulianDay;
use Number::Format qw(:all);
use Cwd;
# Get current dir so know what path for config files.
my $configpath;
my $teachermode;
if ( getcwd() =~ /tcgi/ ){ # we are in tcgi
$teachermode = 1;
$configpath = '..'; # go back one to get to etc.
} else {
$configpath = '../..'; # go back two to get to etc.
}
# only load passwords and users
eval require "$configpath/etc/admin.conf.root";
if ( $@ ) {
print $lex{Error}. " $@ \n";
die $lex{Error}. " $@\n";
}
eval require "$configpath/lib/libattend.pl";
if ( $@ ) {
print $lex{Error}. " $@ \n";
die $lex{Error}. " $@\n";
}
my $dbtype = 'mysql';
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
$dbh->{mysql_enable_utf8} = 1;
# Load Configuration Variables;
my $sth = $dbh->prepare("select id, datavalue from conf_system where filename = 'admin'");
$sth->execute;
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my ($id, $datavalue) = $sth->fetchrow ) {
eval $datavalue;
if ( $@ ) {
print "$lex{Error}: $@ \n";
die "$lex{Error}: $@\n";
}
}
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 $currdate = "$year-$month-$day";
my $currjd = julian_day(split('-', $currdate));
# Teachermode
if ( $teachermode ) { # running on teacher site
$css = $tchcss;
$homepage = $tchpage;
$downloaddir = $tchdownloaddir;
$webdownloaddir = $tchwebdownloaddir;
}
my $q = new CGI;
print $q->header( -charset, $charset );
my %arr = $q->Vars;
# Page Header
my $title = "Students Present Report";
print qq{$doctype\n
\n};
# Show Start Page, if necessary.
if ( not $arr{page} ) {
showStartPage();
} else {
delete $arr{page};
showPresent();
}
#--------------
sub showPresent {
#--------------
# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key} \n}; }
# Passed: month in yyyy-mo format.
my ($y,$m) = split('-',$arr{month});
my $startjd = julian_day($y,$m,1);
my $startdate = qq{$y-$m-01};
print qq{
$month[$m] $y
\n};
# Find end date of the month by going to next month start and backing up 1 day.
my ( $nextyr,$nextmo );
if ( $m == 12 ) {
$nextmo = 1; # reset month to 1
$nextyr = $y + 1; # bump year
} else {
$nextmo = $m + 1;
$nextyr = $y; # no year change;
}
my $nextjd = julian_day($nextyr,$nextmo,1);
my $endjd = $nextjd - 1;
# Check if in current month
if ($currjd < $endjd ) {
$endjd = $currjd - 1; # minus one, since we want previous day only
}
# We can now loop from startjd to endjd for the month selected.
# Testing
# my ($yr,$mon,$day) = inverse_julian_day($startjd);
# print qq{START:$yr $mon $day \n};
# my ($yr,$mon,$day) = inverse_julian_day($endjd);
# print qq{END:$yr $mon $day \n};
# Find the homerooms
my (%homerooms,%ppd); # periods per day for each homeroom.
my $sth = $dbh->prepare("select distinct homeroom, grade from student
where homeroom is not NULL and homeroom != '' and
grade is not NULL and grade != ''");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my ($hr,$gr) = $sth->fetchrow ) {
$homerooms{$hr} = 1;
$ppd{$hr} = $g_ppd{$gr}; # don't care currently if more than 1 grade in homeroom.
if ( not $ppd{$hr} ) {
print qq{
Error: Missing Attendance Periods Per Day for HR:$hr GR:$gr
\n};
print qq{\n};
exit;
}
# print "HR:$hr GR:$gr PPD:$ppd{$hr} \n";
}
my %students; # {studnum};
# We now have to find the Starting Students - school wide is likely the best approach.
# a) Get current students and add.
# b) All students with transfer during this school year are added
# as well. Gives us a complete list.
# c) We will then eliminate those students withdrawn before a
# particular month, to get a monthly starting list.
# d) Any enrollment changes during the month will be done as we go
# through the days of the month.
my $sth = $dbh->prepare("select studnum, homeroom from student");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my ($studnum, $hr) = $sth->fetchrow ) {
$students{$studnum} = 1;
}
# Now back up from current date, adding and removing students until we get to the month of interest.
my %enrolchg;
my $sth = $dbh->prepare("select * from transfer where to_days(date) >= to_days('$startdate')
order by date desc");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $ref = $sth->fetchrow_hashref ) {
my %r = %$ref;
my $tempjd = julian_day( split(':', $r{date}) );
if ( $tempjd >= $startjd and $tempjd <= $enddate ) { # within the month of interest
# add info studnum, type, date
$enrolchg{ $r{date} }{ $r{studnum} } = $r{type};
}
# Update %studStart;
if ( $r{type} eq 'enrol' ) { # then withdraw/remove student.
delete $studStart{ $r{studnum} };
} elsif ( $r{type} eq 'withdraw' ) { # then add them
$students{ $r{studnum} } = 1;
} else {
print qq{
Error! transfer type is incorrect! $r{studnum} - $r{date} - $r{type}
\n};
}
}
# %students now has students at start of month; %enrolchg has list
# of enrollment changes during the month of interst.
# now add homeroom information (or could be grade if required on rewrite)
my %studHR; # could be studGR
my $sth = $dbh->prepare("select homeroom from studentall where studnum = ?");
foreach my $studnum ( keys %students ) {
$sth->execute($studnum);
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $hr = $sth->fetchrow;
$studHR{$hr}{$studnum} = 1;
}
# Dates closed in month.
my %closed;
my $sth = $dbh->prepare("select date from dates where dayfraction > 0.99 and
month(date) = '$m' and year(date) = '$y'");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $date = $sth->fetchrow ) { # Note will have leading zeros!
# print "Date Closed: $date \n";
$closed{$date} = 1;
}
my $sth1 = $dbh->prepare("select lastname, firstname from staff s, staff_multi m where
m.field_name = 'homeroom' and s.userid = m.userid and m.field_value = ?");
my $sth = $dbh->prepare("select count(*) from attend a, studentall s where s.homeroom = ?
and s.studnum = a.studentid and absdate = ? and
a.reason like '%Absent%' ");
# Table Start
print qq{
\n};
print qq{
};
print qq{Counts,Homerooms are Hoverable Ⓗ
\n};
# Days Row
print qq{
HRoom
\n};
foreach my $jd ( $startjd .. $endjd ) {
my ($yr,$mon,$day) = inverse_julian_day($jd);
my $dow = day_of_week($jd);
if ( $dow == 0 or $dow == 6 ) { next; } # skip weekend.
print qq{
$dowstd[$dow] $s_month[$mon] $day
\n};
}
print qq{
\n};
my $rowcount = 1;
my (%totalenrol, %totalpresent); # key is date.
foreach my $hr ( sort {$a <=> $b} keys %homerooms ) {
# Get Teacher
$sth1->execute($hr);
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my ($lastname, $firstname) = $sth1->fetchrow;
if ( $rowcount % 2 == 0 ) { # make it gray
print qq{
$hr
\n};
} else {
print qq{
$hr
\n};
}
foreach my $jd ( $startjd .. $endjd ) {
my $dow = day_of_week($jd);
if ( $dow == 0 or $dow == 6 ) { next; } # skip weekend.
my ($yr,$mon,$day) = inverse_julian_day($jd);
if ( length $day == 1 ) { $day = '0'. $day; }
if ( length $mon == 1 ) { $mon = '0'. $mon; }
my $date = qq{$yr-$mon-$day};
# print "Date:$date \n";
if ( $closed{$date} ) {
print qq{
Closed
\n};
next;
} else { # find absences;
$sth->execute($hr,$date);
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $abscount = $sth->fetchrow;
my $absent = round($abscount / $ppd{$hr}, 1);
my $studcount = scalar %{ $studHR{$hr} }; # students in the room today
my $present = $studcount - $absent;
$totalpresent{$date} += $present;
$totalenrol{$date} += $studcount;
print qq{
$present / $studcount
};
}
} # end of HR loop for month
print qq{
\n\n};
$rowcount++;
}
# Totals Line
print qq{
Total
\n};
foreach my $jd ( $startjd .. $endjd ) {
my $dow = day_of_week($jd);
if ( $dow == 0 or $dow == 6 ) { next; } # skip weekend.
my ($yr,$mon,$day) = inverse_julian_day($jd);
if ( length $day == 1 ) { $day = '0'. $day; }
if ( length $mon == 1 ) { $mon = '0'. $mon; }
my $date = qq{$yr-$mon-$day};
if ( $closed{$date} ) {
print qq{
Closed
\n};
next;
} else {
my $percent = '0';
if ( $totalenrol{$date} ) { # if non-zero
$percent = round( $totalpresent{$date} / $totalenrol{$date} * 100, 1);
}
print qq{