#! /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$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"; } 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{\n}; # Days Row print qq{\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{\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{\n}; } else { print qq{\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{\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{}; } } # end of HR loop for month print qq{\n\n}; $rowcount++; } # Totals Line print qq{\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{\n}; next; } else { my $percent = '0'; if ( $totalenrol{$date} ) { # if non-zero $percent = round( $totalpresent{$date} / $totalenrol{$date} * 100, 1); } print qq{}; } } print qq{\n\n}; # end of Totals Line print qq{
}; print qq{Counts,Homerooms are Hoverable Ⓗ
HRoom$dowstd[$dow]
$s_month[$mon] $day
$hr
$hrClosed$present / $studcount
TotalClosed}; print qq{$totalpresent{$date}/$totalenrol{$date}
$percent%
\n}; exit; } #---------------- sub showStartPage { #---------------- # Setup Year-Months. my @months; my %months; my ($cyear,$cmonth,$cday) = split('-',$currdate); my ($sy, $sm, $sd) = split('-', $schoolstart); # schoolstart is global var from config. my $yrmo = "$sy-$sm"; push @months, $yrmo; $months{$yrmo} = "$s_month[$sm]-$sy"; for my $i (1..10) { my $mo = $sm + $i; my $yr = $sy; if ( $mo > 12 ) { $mo = $mo - 12; $yr++; } if ( length $mo == 1 ) { $mo = '0'. $mo; } my $yrmo = "$yr-$mo"; push @months, $yrmo; $months{$yrmo} = "$s_month[$mo]-$yr"; if ( $yr == $cyear and $mo == $cmonth ) { # done last; } } # Months print qq{

$lex{Select} $lex{Month}

}; foreach my $mo ( @months ) { print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; } print qq{\n}; exit; }