#!/usr/bin/perl # Copyright 2001-2019 Leslie Richardson # Based on: rptmonthsummary.pl on central site. # This file is part of Open Admin for Schools. # Open Admin for Schools is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. my %lex = ('School Events' => 'School Events', 'Main' => 'Main', 'Enrollment' => 'Enrollment', 'Current Date' => 'Current Date', 'Aging Date' => 'Aging Date', 'Current Enrollment' => 'Current Enrollment', 'Student' => 'Student', 'Grade' => 'Grade', 'Date' => 'Date', 'Type' => 'Type', 'Description' => 'Description', 'Enrolled' => 'Enrolled', 'Not Found' => 'Not Found', 'Error' => 'Error', 'Continue' => 'Continue', 'Teacher' => 'Teacher', 'Walkthrough' => 'Walkthrough', 'Curr' => 'Curr', 'Prev' => 'Prev', 'Staff' => 'Staff', 'Day Fraction' => 'Day Fraction', 'Days Closed' => 'Days Closed', 'Report' => 'Report', 'Select Month' => 'Select Month', 'Missing' => 'Missing', 'Periods per Day' => 'Periods per Day', 'Community Events' => 'Community Events', 'Upcoming Events' => 'Upcoming Events', 'Data Updates' => 'Data Updates', 'Resource Spending' => 'Resource Spending', 'Facility Updates' => 'Facility Updates', 'Other Updates' => 'Other Updates', 'Staff Updates' => 'Staff Updates', 'Land Based Learning' => 'Land Based Learning', ); use DBI; use CGI; use Time::JulianDay; use Number::Format qw(:all); my $self = 'rptmonthevent.pl'; eval require "../../etc/admin.conf.root"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } my $q = new CGI; print $q->header(-charset, $charset ); my %arr = $q->Vars; 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 $title = "$lex{'School Events'} $lex{Report}"; print qq{$doctype\n$title\n}; print qq{\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} ]\n}; print qq{

$title

\n}; #foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Values passed: page, date, and then any school databases; if ( not $arr{page} ) { showStartPage(); } delete $arr{page}; my ($currmonthstart, $currmonthend, $prevmonthstart, $prevmonthend, $prevym, $nextym); my ($y,$m) = split('-', $arr{month}); delete $arr{month}; if ( $m == 12 ) { my $nextyear = $y + 1; $nextym = $nextyear. '-01'; } else { my $nextmonth = $m + 1; $nextym = $y. "-$nextmonth"; } if ( $m == 1 ) { my $prevyear = $y - 1; $prevym = $prevyear. '-12'; } else { my $prevmonth = $m - 1; $prevym = $y. '-', $prevmonth; } # Now get actual dates. my $cmstartjd = julian_day($y,$m, '01'); $currmonthstart = "$y-$m-01"; my $nmstartjd = julian_day( split('-',$nextym), '01'); my $cmendjd = $nmstartjd - 1; $currmonthend = join('-',inverse_julian_day($cmendjd)); my $cmonth = $month[$m]; print qq{

$cmonth $y

\n}; # print qq{$currmonthstart to $currmonthend\n}; print qq{

$schoolname

\n}; my ($curref,$eomref, $somref, $snref) = getEnrollments( $dbh, $dbase, $currmonthend ); my %enrolCUR = %$curref; my %enrolEOM = %$eomref; my %enrolSOM = %$somref; my %students = %$snref; # reference to enrollment hash and student number hash; $studnum -> grade # Enrollment hash is: {grade} = count; # print "Start:$currmonthstart End:$currmonthend
\n"; # print "Students:
\n"; # foreach my $key ( sort {$a <=> $b} keys %students ) { print "K:$key V:$students{$key}
\n"; } my $aref = getAttendance( $dbh, $dbase, $currmonthstart, $currmonthend, $snref ); my %att = %$aref; # Enrollment/Attendance by grade print qq{\n}; print qq{\n}; print qq{\n}; # print qq{\n}; my ($ectotal, $estotal, $eetotal, $echange); my ($totalenrol, $totalattend); my ($pwcurrtotal, $pwprevtotal); # Stats by Grade foreach my $grade ( sort {$a <=> $b} keys %enrolCUR ) { # print "Grade:$grade Attend:$att{$grade}{'attend'} Enrol:$att{$grade}{'enrol'}
\n"; my $diff = $enrolEOM{$grade} - $enrolSOM{$grade}; my $attend = 0; if ( $att{$grade}{'enrol'} ) { $attend = round( $att{$grade}{'attend'} / $att{$grade}{'enrol'} * 100, 0); } if ( not $pwcurr{$grade} ) { $pwcurr{$grade} = '0'; } if ( not $pwprev{$grade} ) { $pwprev{$grade} = '0'; } $pwcurrtotal += $pwcurr{$grade}; $pwprevtotal += $pwprev{$grade}; print qq{}; print qq{\n}; $ectotal += $enrolCUR{$grade}; $eetotal += $enrolEOM{$grade}; $estotal += $enrolSOM{$grade}; $totalenrol += $att{$grade}{'enrol'}; $totalattend += $att{$grade}{'attend'}; } $echange = $eetotal - $estotal; my $totalattendance = 0; if ( $totalenrol ) { $totalattendance = round( $totalattend / $totalenrol * 100, 0); } print qq{}; print qq{\n}; print qq{

$lex{Grade}	Curr Enrol	Starting Enrol	Ending Enrol	Enrol Change	Attendance
Walkthroughs Curr/Prev
$grade	$enrolCUR{$grade}	$enrolSOM{$grade}	$enrolEOM{$grade}	$diff	$attend%
Total	$ectotal	$estotal	$eetotal	$echange	$totalattendance%

\n}; # Completed Enrollment/Attendance table. # Get Staff Names my %staffname; my $sth = $dbh->prepare("select lastname, firstname, userid from staff"); $sth->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } while (my ($lastname, $firstname, $userid) = $sth->fetchrow ) { $staffname{$userid} = "$lastname, $firstname"; } # Principal Walkthrough my ($pwcurr, $pwprev, $pwtch ) = getPwalk( $dbh, $dbase, $currmonthstart, $currmonthend ); my %pwcurr = %$pwcurr; my %pwprev = %$pwprev; my %pwtch = %$pwtch; # teacher list # use Data::Dumper; # print Dumper %pwcurr; # print Dumper %pwprev; # Get Staff Absence my ($abscurr, $absprev, $staffref) = getStaffAbsence( $dbh, $dbase, $currmonthstart, $currmonthend ); my %staffabscurr = %$abscurr; my %staffabsprev = %$absprev; my %stafflist = %$staffref; # Staff Walkthrough / Absences print qq{\n}; print qq{}; print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; my %temp = (%stafflist, %pwtch ); # join 2 staff lists foreach my $userid ( sort keys %temp ) { my $name; if ( $staffname{$userid} ) { $name = $staffname{$userid}; } elsif ( $stafflist{$userid} ) { $name = $stafflist{$userid}; $staffname{$userid} = $stafflist{$userid}; } else { $name = $userid; } $sort{"$name$userid"} = $userid; } my $firstflag = 1; foreach my $key ( sort keys %sort ) { $firstflag = 0; my $userid = $sort{$key}; my $curr = $pwtch{$userid}{'curr'}; my $prev = $pwtch{$userid}{prev}; if ( not $curr ) { $curr = '0'; } if ( not $prev ) { $prev = '0'; } my $name = $staffname{$userid}; if ( not $name ) { $name = $userid; } # Add zero to blank values if (not $staffabscurr{$userid}{absent} ) { $staffabscurr{$userid}{absent} = '0'; } if (not $staffabsprev{$userid}{absent} ) { $staffabsprev{$userid}{absent} = '0'; } if (not $staffabscurr{$userid}{late} ) { $staffabscurr{$userid}{late} = '0'; } if (not $staffabsprev{$userid}{late} ) { $staffabsprev{$userid}{late} = '0'; } print qq{}; print qq{\n}; print qq{\n}; } if ( $firstflag ) { print qq{\n}; } print qq{

$lex{Staff}	$lex{Walkthrough}		Absent		Late (min)
	$lex{Curr}	$lex{Prev}	$lex{Curr}	Prev	$lex{Curr}	$lex{Prev}
$name	$curr	$prev	$staffabscurr{$userid}{absent}	$staffabsprev{$userid}{absent}	$staffabscurr{$userid}{late}	$staffabsprev{$userid}{late}
No Records Found

\n}; print qq{
\n}; # print "Month Start:$currmonthstart
\n"; # Get Closures for the Month print qq{\n}; print qq{\n}; print qq{\n}; my $sth = $dbh->prepare("select * from dates where month(date) = ? and year(date) = ? order by date"); $sth->execute ($m,$y); if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } while (my $dref = $sth->fetchrow_hashref ) { my %d = %$dref; print qq{\n}; } print qq{

$lex{'Days Closed'}
$lex{Date}	$lex{Type}	$lex{Description}	$lex{'Day Fraction'}
$d{date}	$d{type}	$d{desc1}	$d{dayfraction}

\n}; print qq{
\n}; # Now Get School Events info for this month. my $sth = $dbh->prepare("select * from schoolevent where date = ?"); $sth->execute ($currmonthstart); if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } my $eventref = $sth->fetchrow_hashref; my %e = %$eventref; # foreach my $key ( sort keys %e ) { print "K:$key V:$e{$key}
\n"; } print qq{

$lex{'Community Events'}
```
$e{communityevents}
```
$lex{'Upcoming Events'}
```
$e{upcomingevents}
```
$lex{'Land Based Learning'}
```
$e{landedu}
```
$lex{'Resource Spending'}
```
$e{resourcespending}
```
$lex{'Staff Updates'}
```
$e{staffupdates}
```
$lex{'Facility Updates'}
```
$e{facilityupdates}
```
$lex{'Data Updates'}
```
$e{dataupdates}
```
$lex{'Other Updates'}
```
$e{otherupdates}
```

\n}; print qq{\n}; #------------------ sub getStaffAbsence { # get Staff Absence #------------------ # Passed dbh, dbase, start date, end date. my ($dbh, $dbase, $startdate, $enddate ) = @_; my ($curryear, $currmonth, $startday) = split('-', $startdate); my (%curr, %prev, %staff); # current and previous absences $curr{userid}{late or absent}; my $sth = $dbh->prepare("select * from staff_absent"); $sth->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth->fetchrow_hashref ) { my %r = %$ref; my $currjd = julian_day(split($r{adate})); my $dayfraction; if ( $r{daypart} eq 'All Day' ) { $dayfraction = 1; } else { $dayfraction = 0.5; } my $userid = $r{userid}; $staff{$userid} = qq{$r{lastname}, $r{firstname}}; # list of userid's to return if ( $currjd >= $cmstartjd and $currjd <= $cmendjd ) { # it's current $curr{$userid}{absent} += $dayfraction; $curr{$userid}{late} += $r{late}; } else { $prev{$userid}{absent} += $dayfraction; $prev{$userid}{late} += $r{late}; } } # print "Current", %prev, "
\n"; # use Data::Dumper; # print Dumper %prev; return \%curr, \%prev, \%staff; } #------------ sub getPwalk { # get principal Walkthrough values #------------ # Passed dbh, dbase, start date, end date. my ($dbh, $dbase, $startdate, $enddate ) = @_; my ($curryear, $currmonth, $startday) = split('-', $startdate); my (%currwalk, %prevwalk); # current and previous walkthroughs {grade} = count; # Get staff grades, if any my %staff; my $sth = $dbh->prepare("select userid, field_value from staff_multi where field_name = 'grade'"); $sth->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } while ( my ($userid, $grade ) = $sth->fetchrow ) { $staff{$userid} = $grade; } # get all principal walkthroughs, for this school year. my %teacherwalk; # store info on per teacher basis. my $sth = $dbh->prepare("select tuserid, subject, adatetime from pwalk_eval where to_days(adatetime) > to_days('$schoolstart')"); $sth->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } while ( my ($userid,$subjsec, $datetime ) = $sth->fetchrow ) { my ($date,$time) = split(/\s+/, $datetime); my ($y,$m,$d) = split('-', $date); my $grade = $staff{$userid}; if ( $y == $curryear and $m == $currmonth ) { $teacherwalk{$userid}{'curr'}++; $currwalk{$grade}++; } else { $teacherwalk{$userid}{'prev'}++; $prevwalk{$grade}++; } } # pwalk loop return \%currwalk, \%prevwalk, \%teacherwalk; } # end of getPwalk #---------------- sub getAttendance { #---------------- # Based on mkHTMLReport sub from rptatt2global.pl file # Passed dbh, dbase, start date, end date. my ($dbh, $dbase, $startdate, $enddate, $snref) = @_; my %students = %$snref; # list of student numbers to check attendance for. studnum->grade eval require "../../lib/libattend.pl"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } my %schooldays = mkSchoolDays( $startdate, $enddate, $dbh ); # returns hash of schooldays in month. key is yyyy-mm and value is schooldays in month # print "School Days", %schooldays, "
\n"; my @keys = keys %schooldays; my $schooldays = $schooldays{$keys[0]}; print "School Days:$schooldays
\n"; # Populate student grade $studgrade{grade} = studnum list. my %studgrade; foreach my $studnum ( keys %students ) { my $grade = $students{$studnum}; # if ( not $studgrade{$grade} ) { $studgrade{$grade} = []; } push @{ $studgrade{$grade} }, $studnum; } #use Data::Dumper; # print Dumper %studgrade; my %lexi = ('Absent' => 'Absent', 'Late' => 'Late'); # Now Loop through all grades my %attend; my $failflag; # fail before printing. foreach my $grade ( sort {$a <=> $b} keys %studgrade ) { my $ppd = $g_ppd{ $grade }; if ( not $ppd ) { print "$lex{Missing} $lex{'Periods per Day'} - $lex{Grade} $grade
\n"; $failflag = 1; # fail before output. } # Students in this grade foreach my $studnum ( @{ $studgrade{$grade} } ) { 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, $ppd, '',\%lexi, $dbh ); my ($absent, $late) = split(':', $result); my $enrolled = $enrolYM{$ym}->{days}; my $present = $enrolled - $absent; $attend{$grade}{$ym}->{attend} += $present; $attend{$grade}{$ym}->{enrol} += $enrolled; } } } # use Data::Dumper; # print Dumper %attend; # print "

\n"; if ( $failflag ) { print "\n"; exit; } my %tmpattend; foreach my $gr ( keys %attend ) { foreach my $ym ( keys %{ $attend{$gr}} ) { $tmpattend{$gr}{attend} = $attend{$gr}{$ym}{attend}; $tmpattend{$gr}{enrol} = $attend{$gr}{$ym}{enrol}; } } # use Data::Dumper; # print Dumper %tmpattend; return \%tmpattend; } #----------------- sub getEnrollments { #----------------- # Passed dbh, dbase, date. my ($dbh, $dbase, $date) = @_; # date will be end of month. # First count how many currently enrolled (in student table), and their student numbers; my (%enrollments, %students); my $sth = $dbh->prepare("select studnum, grade from student where grade is not NULL and grade != ''"); if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } $sth->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } while ( my ($studnum, $grade) = $sth->fetchrow ) { $enrollments{$grade}++; $students{$studnum} = $grade; } my %enrolCUR = %enrollments; # store current enrollment # Now count backwards through entry records until we reach date of interest; get records after date. my $sth1 = $dbh->prepare("select * from transfer where to_days(date) >= to_days('$date') order by date desc"); $sth1->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } # Setup query to get grade my $sth2 = $dbh->prepare("select grade from studentall where studnum = ?"); while ( my $ref = $sth1->fetchrow_hashref ) { my %tr = %$ref; $sth2->execute( $tr{studnum} ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $grade = $sth2->fetchrow; if ( not $grade ) { print "

$lex{Error}: $tr{studnum} $lex{'Not Found'}: $tr{date} - $tr{type}

\n"; next; } $students{$tr{studnum}} = $grade; # print "

$tr{date} - $tr{type} - $tr{studnum} - $grade

\n"; # Change Enrollment Numbers, and %students if ( $tr{type} ne 'withdraw' ) { # then was an enrol $enrollments{$grade}--; } else { # withdraw $enrollments{$grade}++; delete $students{$tr{studnum}}; } } my %enrolEOM = %enrollments; # EOM - End of Month # Now find enrollment changes during the month. # Get Year-Month value from date; my ($y,$m,$d) = split('-', $date); $sth = $dbh->prepare("select * from transfer where year(date) = '$y' and month(date) = '$m'"); $sth->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth->fetchrow_hashref ) { my %tr = %$ref; $sth2->execute( $tr{studnum} ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $grade = $sth2->fetchrow; if ( not $grade ) { print "

$lex{Error}: $tr{studnum} $lex{'Not Found'}: $tr{date} - $tr{type}

\n"; next; } $students{$tr{studnum}} = $grade; if ( $tr{type} ne 'withdraw' ) { # then was an enrol $enrollments{$grade}--; } else { # withdraw $enrollments{$grade}++; } } my %enrolSOM = %enrollments; # SOM - Start of Month return \%enrolCUR, \%enrolEOM, \%enrolSOM, \%students; } # end of getEnrollments #---------------- sub showStartPage { #---------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Setup Year-Months. my @months; my %months; 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++; } my $yrmo = "$yr-$mo"; push @months, $yrmo; $months{$yrmo} = "$s_month[$mo]-$yr"; } =head my @tim = localtime(time); my $year = @tim[5] + 1900; my $month = @tim[4] + 1; if ( $month == 1 ) { $year--; $month = 12; } else { $month--; } my $prevdate = "$year-$month-01"; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; =cut print qq{\n}; print qq{\n}; foreach my $mo ( @months ) { print qq{\n}; } # print qq{\n}; # print qq{\n}; print qq{

$lex{'Select Month'}
\n}; print qq{ \n}; print qq{\n}; print qq{\n}; print qq{ \n}; print qq{
Date in Month	\n}; # print qq{\n}; # print qq{

\n}; =head print qq{\n}; =cut print qq{\n}; exit; }