#!/usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. use DBI; use CGI qw\escape unescape\; use Time::JulianDay; use Number::Format qw(round); #use strict; %lex = ('Scan' => 'Scan', 'Today' => 'Today', 'Yesterday' => 'Yesterday', 'This Week' => 'This Week', 'Last Week' => 'Last Week', 'Start Date' => 'Start Date', 'End Date' => 'End Date', 'Date' => 'Date', 'Select' => 'Select', 'Reason' => 'Reason', 'Points' => 'Points', 'Missing Date' => 'Missing Date', 'Click' => 'Click', 'Name' => 'Name', 'Discipline' => 'Discipline', 'Record Added' => 'Record Added', 'Cannot open' => 'Cannot open', 'Student' => 'Student', 'Subject' => 'Subject', 'Previous' => 'Previous', 'Current' => 'Current', 'Total' => 'Total', 'Main' => 'Main', 'Attendance' => 'Attendance', 'View Log File' => 'View Log File', 'Days' => 'Days', 'Trigger' => 'Trigger', 'Event' => 'Event', 'Discipline Record' => 'Discipline Record', 'Result' => 'Result', 'Error' => 'Error', 'Checked' => 'Checked', 'Add' => 'Add', 'Not Found' => 'Not Found', 'Form Letters' => 'Form Letters', 'Form Letter' => 'Form Letter', 'Over Limit' => 'Over Limit', 'Date(s)' => 'Date(s)', 'Next Page' => 'Next Page', ); my $self = 'attscan.pl'; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my $q = CGI->new; print $q->header( -charset, $charset ); my %arr = $q->Vars; my $checked; if ( $arr{checked} ) { delete $arr{checked}; $checked = q{checked="checked"}; } my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); # Display page header my $title = qq{$lex{Attendance} $lex{Scan}}; print qq{$doctype\n$title\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} | $lex{Attendance} ]\n}; print qq{

$title

\n}; #foreach my $key ( sort keys %arr) { print qq{K: $key V: $arr{$key}
\n}; } # Passed either $arr{date} or $arr{startdate} and $arr{enddate} # if date is could be today, yesterday, thisweek, or lastweek. # if today or yesterday, set $singleDay; other cases set startdate and enddate. # Set Dates - FIX THIS AFTER DONE; remove stuff we don't need. #($sec, $min, $hour, $mday, $mon, $year, $wday, # $yday, $iddst) = localtime(time); my @tim = localtime(time); my $year = $tim[5] + 1900; my $month = $tim[4] + 1; my $day = $tim[3]; my $jd = julian_day($year,$month,$day); if (length($month) == 1){ $month = "0".$month;} if (length($day) == 1){ $day = "0".$day;} my $today = "$year-$month-$day"; my $currdate = "$year-$month-$day"; my $currdate1 = "$month[$month] $day, $year"; my $dow = day_of_week($jd + 1); # a number from 0 (Sunday) to 6 (Saturday) # Branch to different pages if ( not $arr{page} ) { showStartPage(); } elsif ($arr{page} == 2) { delete $arr{page}; writeRecords(); } else { # and continue on below... delete $arr{page}; } # foreach my $key ( sort keys %arr) { print qq{K: $key V: $arr{$key}
\n}; } # Now setup date range values. my ($singleday, $startdate, $enddate, $prevday); if ( $arr{date} ) { if ( $arr{date} eq $lex{Today} ) { $singleday = $currdate; } elsif ( $arr{date} eq $lex{Yesterday} ) { my $prevjd; if ( $dow == 2 ) { # Monday $prevjd = $jd - 3; } else { $prevjd = $jd - 1 } $singleday = join('-', inverse_julian_day( $prevjd )); } elsif ( $arr{date} eq $lex{'This Week'} ) { # set startdate and enddate my $mondayjd = $jd - ($tim[6]-1); #This will now give Monday of this week. my $fridayjd = $mondayjd + 4; my ($y,$m,$d) = inverse_julian_day($mondayjd); if (length($m) == 1){ $m = "0".$m;} if (length($d) == 1){ $d = "0".$d;} $startdate = "$y-$m-$d"; my ($y,$m,$d) = inverse_julian_day($fridayjd); if (length($m) == 1){ $m = "0".$m;} if (length($d) == 1){ $d = "0".$d;} $enddate = "$y-$m-$d"; } elsif ($arr{date} eq $lex{'Last Week'}) { my $mondayjd = $jd - ($tim[6]-1); #This will now give Monday of this week. my $mondayjd = $mondayjd - 7; # last monday. my $fridayjd = $mondayjd + 4; # last friday. my ($y,$m,$d) = inverse_julian_day($mondayjd); if (length($m) == 1){ $m = "0".$m;} if (length($d) == 1){ $d = "0".$d;} $startdate = "$y-$m-$d"; my ($y,$m,$d) = inverse_julian_day($fridayjd); if (length($m) == 1){ $m = "0".$m;} if (length($d) == 1){ $d = "0".$d;} $enddate = "$y-$m-$d"; } else { # an error... no match print qq{

$lex{'Missing Date'}

\n}; print qq{\n}; exit; } } elsif ($arr{startdate} and $arr{enddate}) { $startdate = $arr{startdate}; $enddate = $arr{enddate}; } else { # another error... no date or no startdate/enddate print qq{

$lex{'Missing Date'}

\n}; print qq{\n}; exit; } # display date range(s) Set startdate/enddate if singleday; set # prevday. Prevday is one day before the single day value or the day # before the start of the date range. It is used as the enddate for # searches for previous attendance values. We have 2 blocks of time: # 1) Start of Year to Prev Day. # 2) Single Day (1 day) or Startdate and Enddate (a block of days). if ( $singleday ) { print qq{$lex{Date}: $singleday
\n}; $startdate = $singleday; $enddate = $singleday; } else { # Date Range print qq{$lex{'Start Date'}: $startdate\n}; print qq{$lex{'End Date'}: $enddate
\n}; } # Set $prevday from $startdate my $tempjd = julian_day( split(/-/,$startdate) ); $tempjd -= 1; # take away 1 $prevday = join('-', inverse_julian_day( $tempjd )); my $sth; # Find the students that have attendance records in this date range if ( $singleday ) { # A single day query $sth = $dbh->prepare("select distinct studentid from attend where to_days(absdate) = to_days('$singleday') order by studentid"); } elsif ( $startdate ) { # We select a date range $sth = $dbh->prepare("select distinct studentid from attend where to_days(absdate) >= to_days('$startdate') and to_days(absdate) <= to_days('$enddate') order by studentid"); } else { # a mistake print qq{
$lex{'Missing Date'}
\n}; print qq{\n}; exit; } $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); my @studnum; while ( my $sn = $sth->fetchrow ) { # Get Name $sth1->execute( $sn ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr;} my ($lastname, $firstname) = $sth1->fetchrow; push @studnum, "$lastname:$firstname:$sn"; } # Map reason to points in points hash. my %points;; for (0..$#attend) { $points{$attend[$_]} = $points[$_]; } #foreach my $key ( sort keys %points ) { print qq{K:$key V:$points{$key}
\n}; } print qq{
\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{$lex{Add} $lex{'Discipline Record'}?}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{}; print qq{}; print qq{\n}; my $sth2 = $dbh->prepare("select distinct subjsec from attend where studentid = ? group by subjsec"); my $sth3 = $dbh->prepare("select description from subject where subjsec = ?"); my $sth4 = $dbh->prepare("select e.date,e.infraction from disc_event e, disc_ident i where i.studnum = ? and i.eventid = e.id and to_days(e.date) > to_days('$schoolstart') order by date"); #my $sth4 = $dbh->prepare("select id, infraction, date from discipline # where userid = ? and to_days(date) > to_days('$schoolstart') order by date"); print qq{Start:$startdate End:$enddate
\n}; foreach my $rec ( sort @studnum ) { my ($lastname, $firstname, $sn) = split(/:/, $rec); # Get subjects $sth2->execute( $sn ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $first = 1; while ( my $subj = $sth2->fetchrow ) { my $currpoints = calcPointsSubject($sn,$startdate,$enddate, $subj); if ( not $currpoints ) { next; } $sth3->execute($subj); my $desc = $sth3->fetchrow; my $prevpoints = calcPointsSubject($sn,$schoolstart,$prevday, $subj); my $totalpoints = $currpoints + $prevpoints; # Find the triggers, if any. They are keys in %trigger hash. my $triggerpoint; foreach my $trigger (sort keys %trigger) { if ( $prevpoints < $trigger and $totalpoints >= $trigger ) { $triggerpoint = $trigger; } } print qq{}; if ( $first ) { print qq{\n}; $first = 0; } else { print qq{\n}; } print qq{\n}; print qq{\n}; if ( $triggerpoint ) { print qq{\n}; } else { print qq{\n}; } } # Get Discpline Events $sth4->execute( $sn ); my $first = 1; while ( my ( $infraction,$date ) = $sth4->fetchrow ) { if ( $first ) { print qq{}; print qq{\n\n}; } print qq{
$lex{Click} $lex{Name} -> }; print qq{$lex{'Discipline Record'}, $lex{Subject} -> $lex{Attendance}
$lex{Student}$lex{Subject}$lex{Previous}
$lex{Points}		$lex{Current}
$lex{Points}		$lex{Total}
$lex{Points}		$lex{Result}
}; print qq{$firstname $lastname$firstname $lastname$desc ($subj)$prevpoints$currpoints$totalpoints\n}; print qq{$trigger{$triggerpoint} ($triggerpoint points)
$lex{Discipline}}; $first = 0; } print qq{$infraction - $date | \n}; } print qq{
}; print qq{\n}; print qq{$lex{Add} $lex{'Discipline Record'}?}; print qq{ \n}; print qq{
\n}; #----------------- sub showStartPage { #----------------- print qq{
\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Scan} $lex{'Date(s)'}
$lex{'Start Date'}\n}; print qq{\n}; print qq{
$lex{'End Date'}}; print qq{
}; print qq{
$lex{'Next Page'} $lex{Checked}}; print qq{
\n}; print qq{
\n}; # Print Reasons and Points per Reason print qq{
\n}; print qq{\n}; print qq{\n}; for (0..$#attend) { print qq{\n}; } print qq{
$lex{Reason}$lex{Points}
$attend[$_]$points[$_]
\n}; # Print Discipline Events and Trigger Points if ( %trigger ) { print qq{
}; print qq{\n}; print qq{}; print qq{\n}; foreach my $key (sort {$a <=> $b} keys %trigger) { print qq{\n}; } print qq{
$lex{Discipline}
$lex{Event}		$lex{Trigger}
$lex{Points}
$trigger{$key}$key
\n}; } else { print qq{

$lex{Trigger} $lex{'Not Found'}

\n}; } print qq{\n}; print qq{\n}; exit; } #------------- sub calcPoints { #------------- # calculate points for student for date range (inclusive). Lookups are in admin.conf my ( $studnum, $start, $end ) = @_; my $points; my $sth = $dbh->prepare("select distinct reason, count(reason) from attend where studentid = ? and to_days(absdate) >= to_days('$start') and to_days(absdate) <= to_days('$end') group by subjsec, reason"); $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ( $reason, $rcount ) = $sth->fetchrow ) { $points += ($points{$reason} * $rcount); # %points hash maps reason to points; created in main. } return $points; } #-------------------- sub calcPointsSubject { #-------------------- # calculate points for student for date range (inclusive) in a # subject. Lookups are in admin.conf my ($studnum, $start, $end, $subjsec) = @_; my $points; my $sth = $dbh->prepare("select distinct reason, count(reason) from attend where studentid = ? and subjsec = ? and to_days(absdate) >= to_days('$start') and to_days(absdate) <= to_days('$end') group by subjsec, reason"); $sth->execute( $studnum, $subjsec ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ( $reason, $rcount) = $sth->fetchrow) { $points += ( $points{$reason} * $rcount ); # %points hash maps reason to points; created in main. } return $points; } #--------------- sub writeRecords { #--------------- # Write the discipline attendance records and form # letters. Provide links to download the form letters pdf (as # normal) and also links to edit the discipline records created. use Data::UUID; my $disciplineWrite; if ( $arr{disciplinewrite} ) { $disciplineWrite = 1; } delete $arr{disciplinewrite}; my $sth1 = $dbh->prepare("select lastname, firstname, grade from studentall where studnum = ?"); my $sth2 = $dbh->prepare("select description from subject where subjsec = ?"); # Open a TeX file for creation; use a template... my $logfile = "pdflog$$.txt"; my $shortname = "attdisc$$"; my $filename = "$shortname.tex"; open(TEX,">$filename") || die "Can't open tex file"; printTeXStart(); # Setup the start of the file. my %studsort; foreach my $key ( keys %arr ) { # loop through all kids my ( $points, $studnum, $subjsec, $totalpoints ) = split(/:/,$key); $sth1->execute( $studnum ); my ( $lastname, $firstname ) = $sth1->fetchrow; my $newkey = "$lastname$firstname$studnum"; $studsort{ $newkey } = $key; } #Original: foreach my $key ( keys %arr ) { # loop through all kids foreach my $newkey ( sort keys %studsort ) { # loop through all kids my $key = $studsort{$newkey}; my ( $points, $studnum, $subjsec, $totalpoints ) = split(/:/,$key); if ( not $points or not $studnum or not $subjsec ) { print qq{$key - $lex{'Not Found'}
\n}; } # Find their name and grade (for ppd) $sth1->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname, $grade ) = $sth1->fetchrow; # Get Subject description $sth2->execute( $subjsec ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $desc = $sth2->fetchrow; # Get their formletter template my $templatename = $formletter{$points}; if ( not $templatename ){ print qq{$lex{'Form Letter'} $lex{'Not Found'} – $firstname $lastname \n}; print qq{– $desc ($subjsec)\n}; exit; } unless (open (FH,"<", "../../template/forms/$templatename")) { print $lex{'Cannot open'}. " form - $!\n"; die $lex{'Cannot open'}. " form - $!\n"; } my $text; { local $/; $text = ; close FH;} my $description = "$lex{Attendance} – $lex{'Over Limit'} – $desc ($subjsec)"; # Write the discipline record for attendance problems if ( $disciplineWrite ) { # checkbox on previous page # my $sth = $dbh->prepare("insert into discipline # ( date, userid, infraction, description ) # values ( now(), ?, ?, ? )"); my $ug = Data::UUID->new; my $uuid = $ug->create_str(); #print "STRING:$uuid
\n"; my $sth = $dbh->prepare("insert into disc_event ( date, location, infraction, comment ) values ( now(),$uuid,?,? )"); # Get the id field. my $sth1 = $dbh->prepare("select id from disc_event where location = ?"); # Clean up uuid value in record. my $sth2 = $dbh->prepare("update disc_event set location = NULL where id = ?"); # write the second record - disc_ident my $sth3 = $dbh->prepare("insert into disc_ident ( studnum, eventid, comment ) values ( ?, ?, ?)"); $sth->execute( $trigger{$points}, $description ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } # Get Id. $sth1->execute($uuid); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $id = $sth1->fetchrow; # Clean up UUID $sth2->execute($id); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } # Insert Ident record $sth3->execute($studnum, $id, $description); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } # Notify user of written record. print qq{$lex{Discipline} $lex{'Record Added'}}; print qq{: $firstname $lastname $desc ($subjsec)
\n}; } my $absentDivider; if ( $points[0] ) { # defined in admin.conf; normally 3 for abs unexcused $absentDivider = $points[0]; } else { # fallback; not necessarily correct value $absentDivider = 1; } # total points would be bigger if trigger point already # passed, but pass on larger value to the form letter; # separate points needed for trigger above since used as index # into array, etc. if ( $totalpoints > $points ) { $points = $totalpoints; } my $periods = round( $points / $absentDivider, 0 ); my $classesmissed = $periods; #print qq{CM: $classesmissed Points: $points Periods: $periods
\n}; my $periodsPerDay; if ( not $grade or not $g_ppd{$grade} ) { $periodsPerDay = 1; } else { $periodsPerDay = $g_ppd{$grade}; } # print qq{PPD:$periodsPerDay
\n}; my $days = round( $periods / $periodsPerDay ); %rec = (date => $currdate1, studentname => "$firstname $lastname", subject => "$desc ($subjsec)", daysmissed => "$days ". $lex{Days}, schoollogo => "\\includegraphics[width=3in]{../../etc/schoollogo.jpg}", schoolname => $schoolname, schooladdr1 => $schooladdr1, schooladdr2 => $schooladdr2, schooladdr3 => $schooladdr3, schoolcity => $schoolcity, schoolprov => $schoolprov, schoolpcode => $schoolpcode, schoolphone => $schoolphone, schoolfax => $schoolfax, schoolemail => $schoolemail, classesmissed => $classesmissed ); my $template = $text; # Now put replacement text back in. $template =~ s{\<\#(.*?)\#\>} { exists($rec{$1}) ? $rec{$1} : $1 }gsex; #print qq{Template is
$template
\n}; print TEX $template,"\n"; print TEX "\\newpage\n\n"; } print TEX "\\end{document}"; close TEX; system("$pdflatex $filename > $logfile"); system("mv $shortname.pdf $downloaddir"); system("mv $logfile $downloaddir"); system("rm $shortname.*"); print qq{

}; print qq{}; print qq{$lex{Discipline} $lex{'Form Letter'}

\n}; print qq{

[ $lex{Main} | }; print qq{$lex{Attendance} | \n}; print qq{$lex{'View Log File'} ]

\n}; print qq{\n}; exit; } # End of writeRecords #---------------- sub printTeXStart { #---------------- my $papersize; if ( $defaultpapersize ) { $papersize = $defaultpapersize; } else { $papersize = 'letterpaper'; } print TEX "\\documentclass[12pt,$papersize,oneside]{article} \\usepackage{array,colortbl,graphicx,inputenc} $a_latex_header \\renewcommand{\\familydefault}{\\sfdefault} \\pagestyle{empty} \\setlength{\\textwidth}{6.5in} \\setlength{\\textheight}{10in} \\setlength{\\hoffset}{-0.5in} \\setlength{\\voffset}{-0.5in} \\setlength{\\headsep}{10pt} \\setlength{\\headheight}{14pt} \\setlength{\\topmargin}{0pt} \\setlength{\\parindent}{0pt} \\setlength{\\tabcolsep}{5pt} \\setlength{\\extrarowheight}{3pt} \\thispagestyle{empty} \\pagestyle{empty} \\begin{document}\n"; } # End of printTeXStart