#! /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);
# 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$title\n};
print qq{\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} \n};
if ( not $teachermode ) {
print qq{| $lex{Attendance} };
}
print qq{]\n};
print qq{
$title
\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";
}
# 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.
# now add homeroom information (or could be grade if required on rewrite)
my %studHR; # could be studGR $studHR{hr}{studnum};
my %students; # {studnum};
# 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;
# }
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 ) {
if (not $hr) {
print qq{
Missing Homeroom for student $studnum
\n};
next;
} # skip any without a homeroom.
$students{$studnum} = $hr;
$studHR{$hr}{$studnum} = 1;
}
=head
# Data Test for studHR hash
print qq{
Start of Month Counts
\n};
my $total;
foreach my $hr ( sort {$a <=> $b} keys %studHR ) {
my $count;
print qq{
\n};
=cut
# Now back up from current date, adding and removing students until we get to the month of interest.
my %enrolchg;
my $sth1 = $dbh->prepare("select homeroom from studentall where studnum = ?");
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}) );
# my $diff = $startjd - $tempjd;
# print qq{Temp:$tempjd Start:$startjd End:$endjd Diff:$diff \n};
# my $sd = join('-', inverse_julian_day($startjd));
# my $ed = join('-', inverse_julian_day($endjd));
# print "Start:$sd End:$ed \n";
if ( $tempjd >= $startjd and $tempjd <= $endjd ) { # within the month of interest
# add info studnum, type, date
# print "ECH:$r{date} / $r{studnum} / $r{type} \n";
$enrolchg{ $r{date} }{ $r{studnum} } = $r{type};
}
# Update %students, studHR;
if ( $r{type} eq 'enrol' ) { # then withdraw/remove student.
my $hr = $students{$r{studnum}};
delete $students{ $r{studnum} };
delete $studHR{$hr}{$r{studnum}};
} elsif ( $r{type} eq 'withdraw' ) { # then add them
# Get Homeroom
$sth1->execute( $r{studnum} );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $hr = $sth1->fetchrow;
if ( not $hr ) {
print qq{
\n};
# }
# }
# %students now has students at start of month; %enrolchg has list
# of enrollment changes during the month of interst.
# 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;
}
# Get Teacher Name for this homeroom
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 = ?");
# Get Homeroom
my $sth2 = $dbh->prepare("select homeroom from studentall where studnum = ?");
# Get Absence count for a homeroom on a particular date
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; # for alternating color
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;
# Color change
if ( $rowcount % 2 == 0 ) { # make it gray
print qq{
$hr
\n};
} else {
print qq{
$hr
\n};
}
# Loop through all days of the month for this homeroom
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, update totals
$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;
# update studHR for this hr for this date;
foreach my $studnum ( keys %{ $enrolchg{$date}} ) {
# Get Homeroom
$sth2->execute( $studnum );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $hr = $sth2->fetchrow;
if ( not $hr ) {
print qq{