#!/usr/bin/perl # Copyright 2001-2019 Leslie Richardson # This file is part of Open Admin for Schools. # Get Grade and Year-Month and display attendance for each day. # Update: Jan 10, L520, section updated to correctly join days closed with partial days closed for NSD homerooms my %lex = ('Teacher' => 'Teacher', 'Error' => 'Error', 'Main' => 'Main', 'Attendance' => 'Attendance', 'Report' => 'Report', 'Entry' => 'Entry', 'Month' => 'Month', 'Start' => 'Start', 'Months' => 'Months', 'Continue' => 'Continue', 'Select' => 'Select', 'Grade' => 'Grade', 'Student' => 'Student', 'Subject' => 'Subject', 'Reason' => 'Reason', 'Late' => 'Late', 'Days Open' => 'Days Open', 'Days Closed' => 'Days Closed', 'Show' => 'Show', 'Withdrawn' => 'Withdrawn', 'or' => 'or', 'Homeroom' => 'Homeroom', 'Missing' => 'Missing', 'Value' => 'Value', 'WD' => 'WD', 'Enrolled' => 'Enrolled', 'Attended' => 'Attended', 'Method' => 'Method', 'View' => 'View', 'Hover' => 'Hover', 'Click' => 'Click', 'Edit' => 'Edit', 'Override' => 'Override', 'Periods per Day' => 'Periods per Day', 'Not Found' => 'Not Found', 'Period' => 'Period', 'Method' => 'Method', 'Absent' => 'Absent', 'Present' => 'Present', 'No Entry' => 'No Entry', 'OK' => 'OK', 'Skip' => 'Skip', 'Students' => 'Students', ); my $self = 'rptmonth4.pl'; my $closedcolor = '#AAA'; my $partclosedcolor = '#EEE'; my $notenrolledcolor = '#DDD'; use DBI; use CGI; use Cwd; use Time::JulianDay; use Number::Format qw(:all); # 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"; } eval require "$configpath/lib/libschedule.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"; } } =head my $sth = $dbh->prepare("select id, datavalue from conf_system where dataname = ?"); foreach my $field ( css ) { $sth->execute( $field ); 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"; } } } =cut # 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; # Set Date my @tim = localtime(time); my $cyear = @tim[5] + 1900; my $cmonth = @tim[4] + 1; my $cday = @tim[3]; my $currdate = "$cyear-$cmonth-$cday"; my $currjd = julian_day( split('-', $currdate) ); my $curryrmo = "$cyear-$cmonth"; my $title = "$lex{Monthly} $lex{Attendance} $lex{Report} 4"; 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} \n}; } print qq{]\n

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; showReport(); } #---------------- sub showStartPage { #---------------- # 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++; } 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; } } # Get the grades, for subject attendance. my @grades; my $sth = $dbh->prepare("select distinct grade from student where grade is not NULL and grade != ''"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth->fetchrow ) { if ( $g_AttendanceEntryMethod{$gr} eq 'subject' ) { push @grades, $gr; } } # Get the homerooms. my @homerooms; my $sth1 = $dbh->prepare("select distinct grade from student where homeroom = ? and grade != '' and grade is not NULL"); my $sth = $dbh->prepare("select distinct homeroom from student where homeroom is not NULL and homeroom != ''"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $hr = $sth->fetchrow ) { push @homerooms, $hr; # removed checking below # Now check for the grade level in this homeroom # $sth1->execute($hr); # if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } # while ( my $gr = $sth1->fetchrow ) { # if ( $g_AttendanceEntryMethod{$gr} eq 'homeroom' ) { # push @homerooms, $hr; # last; # } # } } print qq{
\n}; print qq{\n}; print qq{\n}; # Get Month print qq{}; print qq{\n}; print qq{\n}; # Homerooms print qq{}; print qq{\n}; # Grades print qq{}; print qq{\n}; print qq{\n}; # Override Attendance Entry Method print qq{}; print qq{\n}; # Override periods per day print qq{}; print qq{\n}; # Override Days Open print qq{}; print qq{\n}; # Skip Homeroom Students 1 print qq{}; print qq{\n}; # Skip Homeroom Students 2 print qq{}; print qq{\n}; # Show Withdrawn Students print qq{}; print qq{\n}; # Continue print qq{\n}; print qq{
$lex{Month}
$lex{Homeroom} $lex{Attendance}
$lex{or} }; print qq{$lex{Subject} $lex{Attendance} - $lex{Grade}
$lex{Override} $lex{Attendance} $lex{Method}
$lex{Override} $lex{'Periods per Day'}
$lex{Override} $lex{'Days Open'}
$lex{Skip} $lex{Homeroom} $lex{Students} 1
$lex{Skip} $lex{Homeroom} $lex{Students} 2
$lex{Show} $lex{Withdrawn}
\n}; print qq{
\n}; print qq{\n}; exit; } #------------- sub showReport { #------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Passed: homeroom, grade, month (yyyy-mm), showwithdrawn, attmethod, ppdoverride my $attmethodoverride = $arr{attmethodoverride}; my $ppdoverride = $arr{ppdoverride}; my $overridedaysopen = $arr{overridedaysopen}; delete $arr{attmethodoverride}; delete $arr{ppdoverride}; delete $arr{overridedaysopen}; my $skiphomeroom1 = $arr{skiphomeroom1}; my $skiphomeroom2 = $arr{skiphomeroom2}; delete $arr{skiphomeroom1}; delete $arr{skiphomeroom2}; # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Passed values left: month, grade, homeroom # Check for missing values. if ( not $arr{month} or ( not $arr{grade} and not $arr{homeroom} ) ) { print "

$lex{Missing} $lex{Value}

\n"; print "\n"; exit; } my $studtable = 'student'; if ( $arr{showwithdrawn} ) { $studtable = 'studentall'; } # Get the group, default to grade. my $homeroomteacher; my $groupvalue = $arr{grade}; my $grouptype = 'grade'; if ( not $arr{grade} ) { $groupvalue = $arr{homeroom}; $grouptype = 'homeroom'; # Get Homeroom teacher userid my $sth = $dbh->prepare("select userid from staff_multi where field_name = 'homeroom' and field_value = ?"); $sth->execute( $groupvalue ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } $homeroomteacher = $sth->fetchrow; if ( not $homeroomteacher ) { print "

$lex{Homeroom} $lex{Teacher} $lex{'Not Found'}

\n"; } } else { # get first homeroom teacher for that grade my $sth = $dbh->prepare("select userid from staff_multi where field_name = 'grade' and field_value = ?"); $sth->execute( $groupvalue ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my @teachers; while ( my $userid = $sth->fetchrow ) { push @teachers, $userid; } $homeroomteacher = $teachers[0]; # first element. } # Get the Days Open in the month and also Days Closed (to indicate school closed). # Get Separate Year and Month vals for query below. my ($year,$month) = split('-', $arr{month}); my %daysclosed; my $daysclosed; # scalar to count days closed my $sth = $dbh->prepare("select date, dayfraction from dates where month(date) = $month and year(date) = $year"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($dt, $fraction ) = $sth->fetchrow ) { my ($y,$m,$d) = split('-',$dt); $d =~ s/^0//; # strip leading zeros. $daysclosed{$d} = $fraction; $daysclosed += $fraction; } # foreach my $key ( sort keys %daysclosed ) { print "K:$key V:$daysclosed{$key}
\n"; } # Add to days closed for first month if not at the start of the month. my ($sy, $sm, $sd) = split('-', $schoolstart); # schoolstart is global var from config. if ( $sy == $year and $sm == $month ) { # starting year and month is current one. # Add to days closed if we don't start at first of the month. my $firstjd = julian_day( $year, $month, '1'); my $julianbase = $firstjd - 1; for my $d (1.. $sd - 1) { # loop through these other days, mark as closed my $jd = $julianbase + $d; my $dow = day_of_week( $jd ); if ( $dow == 0 or $dow == 6 ) { # nothing } else { # mark as closed. $daysclosed{$d} = '1.00'; } } } # Get the number of days in the month. Set $lastday value my $nextmonth = $month +1; my $nextyear = $year; if ( $nextmonth > 12 ) { $nextmonth = 1; $nextyear++; } my $nextfirstdayjd = julian_day( $nextyear, $nextmonth, '1'); my $lastday; if ( $currjd < ( $nextfirstdayjd - 1 ) ) { my @temp = inverse_julian_day( $currjd ); $lastday = $temp[2]; } else { my @temp = inverse_julian_day( $nextfirstdayjd - 1 ); $lastday = $temp[2]; } my $monthstartjd = julian_day($year, $month, '1'); my $monthendjd = julian_day($year, $month, $lastday); # Get the type of attendance done (homeroom or subject). my %teacherattendance; my %currterm; # structure to hold term based on grade and and dom (day of month) my @terms; # the terms for this month; my @grades; # the grades of this group of students. # populate @grades from student if ( $grouptype eq 'homeroom' ) { my $sth2 = $dbh->prepare("select distinct grade from student where homeroom = ?"); $sth2->execute( $groupvalue ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth2->fetchrow ) { push @grades, $gr; } } else { # only a single grade push @grades, $groupvalue; } # Add NSD (Non-School Days) if we have a K or PK grade. my $nsdflag; foreach my $gr (@grades) { if ( $gr eq 'K' or $gr eq 'PK' or $gr eq 'P3' ) { $nsdflag = 1; } } my %nonschoolday; foreach my $key ( keys %nonschoolday ) { # clean just in case. delete $nonschoolday{$key}; } if ( $nsdflag ) { # we have to parse the dates in the month for those grades. my $sth = $dbh->prepare("select * from dates_nonschool where month(date) = ? and year(date) = ?"); $sth->execute( $month,$year ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth->fetchrow_hashref ) { my %r = %$ref; $nonschoolday{ $r{homeroom} }{ $r{date} }{ $r{period} } = 1; # changed to store } # foreach my $hroom ( sort keys %nonschoolday ) { # foreach my $date ( sort keys %{ $nonschoolday{$hroom}} ) { # print qq{HR:$hroom DATE:$date Period:$nonschoolday{$hroom}{$date}
\n}; # } # } if ( $grouptype eq 'homeroom' ) { my $hroom = $groupvalue; foreach my $date ( sort keys %{ $nonschoolday{$hroom} } ) { my ($y,$m,$d) = split('-',$date); $d =~ s/^0//; # strip leading zeros. if ( $daysclosed{$d} < 1 ) { # add it in. my $closedcount; foreach my $period ( keys %{ $nonschoolday{$hroom}{$date} } ) { $closedcount++; } my $fraction = $closedcount / 2; $daysclosed += $fraction; $daysclosed{$d} += $fraction; if ( $daysclosed{$d} > 1 ) { $daysclosed{$d} = 1; } } } } } # end of nsdflag; # Check %daysclosed # foreach my $key ( sort {$a <=> $b } keys %daysclosed ) { # print qq{DAY:$key V:$daysclosed{$key}
\n}; # } # Set Attendance Entry Method if not override. my $attmethod; if ( not $attmethodoverride ) { $attmethod = $g_AttendanceEntryMethod{ $grades[0] }; } else { $attmethod = $attmethodoverride; } print "

$lex{Attendance} $lex{Method}: $attmethod

\n"; # Now find matching tracks for grade(s). my @tracks; foreach my $gr ( @grades ) { push @tracks, $g_MTrackTermType{$gr}; } my ( %tempterm ); # multiple dimensions; $currterm{grade}{dom} = term; # tempterm holds start:end pair instead of dom (day of month) # Loop through all terms of all tracks and get start/end dates, and populate %currterm; foreach my $gr ( @grades ) { my $trk = $g_MTrackTermType{$gr}; my %temp = %{$g_MTrackTerm{$trk}}; foreach my $term ( sort keys %temp ) { my $start = $temp{$term}{start}; my $end = $temp{$term}{end}; # Check using monthstartjd, monthendjd; my $startjd = julian_day( split('-', $start)); my $endjd = julian_day( split('-', $end)); if ( $startjd < $monthstartjd and $endjd > $monthendjd ) { # term straddles this month $tempterm{$gr}{"1:$lastday"} = $term; } elsif ( $startjd >= $monthstartjd and $startjd <= $monthendjd ) { # term starts in this month sometime. my ( $sy, $sm, $sd ) = split('-', $start); $tempterm{$gr}{"$sd:$lastday"} = $term; } elsif ( $endjd >= $monthstartjd and $endjd <= $monthendjd ) { # term ends in this month. my ( $ey, $em, $ed ) = split('-', $end); $tempterm{$gr}{"1:$ed"} = $term; } } } # populate the %currterm hash, so we know what term it is for any grade on any day this month. foreach my $gr ( keys %tempterm ) { foreach my $pair ( keys %{ $tempterm{$gr}} ) { my ( $start, $end ) = split(':', $pair); $start =~ s/^0//; # strip any leading zeros $end =~ s/^0//; for my $day ( $start..$end ) { $currterm{$gr}{$day} = $tempterm{$gr}{$pair}; } } } =head # Testing foreach my $gr ( keys %tempterm ) { my %temp = %{$tempterm{$gr}}; foreach my $day ( sort {$a <=> $b} keys %temp ) { print "TEMP Grade|$gr Day|$day Term: $temp{$day}
\n"; } } # Test foreach my $gr ( keys %currterm ) { my %temp = %{$currterm{$gr}}; foreach my $day ( sort {$a <=> $b} keys %temp ) { print "Grade|$gr Day|$day Term: $temp{$day}
\n"; } } =cut # Populate %teachername hash my %teachername; 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 ) { $teachername{$userid} = "$firstname $lastname"; } # foreach my $key ( sort keys %teachername ) { print "K:$key V:$teachername{$key}
\n"; } # Get their Attendance Entry for the Month; populate teacherattendance my $sth = $dbh->prepare("select * from tattend where month(attdate) = $month and year(attdate) = $year"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } # prepare to get homeroom for a teacher. my $sth1 = $dbh->prepare("select field_value from staff_multi where field_name = 'homeroom' and userid = ?"); while ( my $ref = $sth->fetchrow_hashref ) { my ($y,$m,$day) = split('-', $ref->{attdate}); $day =~ s/^0//; # strip leading zero my (@per, @subj); my $userid = $ref->{userid}; my $period = $ref->{periods}; if ($period =~ m/,/ ) { # if period contains commas, then we have to split @per = split(',',$period); } else { push @per, $period; } my $subject = $ref->{subjects}; if ( $subject =~ m/,/ ) { # multiple subjects print qq{

Warning: multiple subjects for User:$userid on $y-$m-$day: $subject

\n}; my @temp = split(',',$subject); $subject = $temp[0]; # throw away any trailing subjects. } elsif ( not $subject ) { # look up homeroom and populate with that instead $sth1->execute($userid); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $hr = $sth1->fetchrow; if ( not $hr) { print qq{

$lex{Error}: Missing Subject/Homeroom field for userid:$userid Day:$day

\n}; } else { # populate the subject field; $subject = 'HR:'.$hr; } } foreach my $per ( @per ) { $teacherattendance{$day}{$per}{$subject} = $userid; # day, period, subject should be unique. } } # Print Group Name if ( $grouptype eq 'grade' ) { # print "

$lex{Grade} $groupvalue - $teachername{$homeroomteacher} ($homeroomteacher)

\n"; print "

$lex{Grade} $groupvalue

\n"; } else { print "

$lex{Homeroom} $groupvalue - $teachername{$homeroomteacher} ($homeroomteacher)

\n"; } # Find DOW of first of month my %weekend; # stores weekend days in month my $firstsunday; my $firstjd = julian_day( $year, $month, '1'); my $julianbase = $firstjd - 1; my $daysopen; # first just gross days; take away closed days later for my $d ( 1..$lastday ) { my $jd = $julianbase + $d; my $dow = day_of_week( $jd ); if ( $dow == 0 or $dow == 6 ) { $weekend{$d} = $dow; } else { # open $daysopen++; $daysopen = $daysopen - $daysclosed{$d}; } # print "Day:$d Open:$daysopen Closed:$daysclosed{$d}
\n"; } # Adjustment value if overridedaysopen is set. We assume that the # override value is the real days open value (which has considered # days including days the school is fully or partially # closed. This is the daysopen value above. print qq{
Days Open (to date): $daysopen
\n}; my $overrideDO; if ( $overridedaysopen ) { $overrideDO = $daysopen - $overridedaysopen; # a positive value since days open will be larger. if ( overrideDO < 0 ) { print qq{

Error: The days open, $daysopen, (including days marked closed),
\n}; print qq{is smaller than the override days.

\n}; print qq{\n}; exit; } } if ( $overrideDO ) { print qq{
Days Open Override factor: $overrideDO. Days removed from days open
\n}; } =head print "Year:$year Month:$month
\n"; print "Last Day:$lastday
\n"; print "Closed: $daysclosed
\n"; exit; =cut my ($ppd, $currppd, $oldppd ); if ( $ppdoverride ) { $ppd = $ppdoverride; } else { # no override if ( $#grades == 0 ) { # only 1 grade; $gr = $grades[0]; $ppd = $g_ppd{$gr}; if ( not $ppd or $currppd != $oldppd ) { print "

Periods per Day Error for Grade:$gr

\n"; print "\n"; exit; } } else { # more than 1 grade; check all the same value my $first = 1; foreach my $gr ( @grades ) { if ( $first ) { # just set currppd $ppd = $currppd = $g_ppd{$gr}; $first = 0; next; } $oldppd = $currppd; $ppd = $currppd = $g_ppd{$gr}; if ( not $ppd or $currppd != $oldppd ) { print "

Periods per Day Error for Grade:$gr

\n"; print "\n"; exit; } } } } # end of no override # print "PPD:$ppd
\n"; # Map Periods to some text... my %map; if ( $ppd == 2 ) { # am/pm $map{1} = 'AM'; $map{2} = 'PM'; } else { for (1..$ppd) { $map{$_} = "P$_"; } } print qq{\n}; print qq{\n}; # Heading; print qq{}; foreach my $day ( 1..$lastday ) { if ( exists $weekend{$day} ) { next; } if ( $daysclosed{$day} >0.99 ) { # full day closed print qq{}; } else { # header for all periods print qq{}; } } print qq{\n}; print qq{}; foreach my $day ( 1..$lastday ) { if ( exists $weekend{$day} ) { next; } if ( $daysclosed{$day} >0.99 ) { # full day closed print qq{\n}; } else { # print periods for my $per ( 1..$ppd ) { if ( $per == $ppd ) { print qq{}; } else { print qq{}; } } } } print "\n"; # Get Current Student Group and Names my (%students, %studname, %studgrade, %studroom ); my $sth = $dbh->prepare("select lastname, firstname,studnum, grade, homeroom from $studtable where $grouptype = ? order by lastname, firstname"); $sth->execute( $groupvalue ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($lastname, $firstname, $studnum, $grade, $homeroom ) = $sth->fetchrow ) { # print "$lastname $firstname ($studnum)
\n"; if ( $homeroom and ( $homeroom eq $skiphomeroom1 or $homeroom eq $skiphomeroom2 )) { next; } $students{$studnum} = "$lastname$firstname$studnum"; # store sortkey in value; $studname{$studnum} = "$lastname, $firstname"; $studroom{$studnum} = $homeroom; $studgrade{$studnum} = $grade; } # Check enrollments and add/remove students for month of interest. # No longer required since we check for enrollment changes from start of current month... not the end. # my $nextmonthdate; # date of the first of next month for enrollment checking. # if ( $month == 12 ) { # my $m = 1; # my $y = $year + 1; # $nextmonthdate = "$y-$m-01"; # } else { # my $m = $month + 1; # $nextmonthdate = "$year-$m-01"; # } # The current %students hash has Current Students, so we have to # check for any that were added/removed from current date, back to # the start of this month. If they were students at any time # during this month, they are added/retained. my $cmonth = $arr{month}. '-01'; my $sth1 = $dbh->prepare("select * from transfer where to_days(date) >= to_days('$cmonth') order by date desc"); $sth1->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } # Setup query to get grade, homeroom my $sth2 = $dbh->prepare("select lastname, firstname, grade,homeroom from studentall where studnum = ?"); while ( my $ref = $sth1->fetchrow_hashref ) { my %tr = %$ref; my $studnum = $tr{studnum}; $sth2->execute( $studnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname, $grade,$homeroom) = $sth2->fetchrow; my $monthmode; # means that this enrollment record is in the month of interest my ($y,$m,$d) = split('-', $tr{date}); if ( $y == $year and $m == $month ) { $monthmode = 1; } # Change Enrollment Numbers, and %students if ( $tr{type} ne 'withdraw' ) { # then was an enrol after this month; thus not enrolled in this month. # Remove, if not current month if ( not $monthmode ) { delete $students{ $studnum }; } } else { # withdraw, so they must have been enrolled. Add them. if ( not $students{$studnum} ) { # put them in IF if ( ($grouptype eq 'grade' and $grade == $groupvalue ) or ($grouptype eq 'homeroom' and $homeroom eq $groupvalue )) { # add 'em $students{ $tr{studnum} } = "$lastname$firstname$tr{studnum}"; $studroom{ $tr{studnum} } = $homeroom; $studgrade{ $tr{studnum} } = $grade; } } } } # end of checking enrollments # Check if we have all the students we want.... # foreach my $key ( sort keys %students ) { # print qq{SN:$key NAME:$students{$key}
\n}; # } =head # Populate Teacher Attendance Entry Data my $prevterm; my %termcourses; # only for subject attendance; $termcourses{term}{subjsec}; if ( $attmethod eq 'subject' ) { # populate this data structure. foreach my $grade ( @grades ) { my $currentterm = -1; # start with a dud. foreach my $day ( 1..$lastday ) { $prevterm = $currterm; $currterm = $currterm{ $grade }{$day}; my @courses; if ( $currterm != $prevterm ) { # reload courses @courses = findCourses($currterm, @students); # find the courses for this group of students for this term. foreach my $subjsec ( @courses ) { $termcourses{$currterm}{$subjsec} = 1; } } } # end of day loop } # end of grade loop } # end of subject entry populate data loop. =cut # Now Get Coursedescriptions, teachers # Get Course Descriptions and Teachers for one or more grades my (%coursename, %teachercourse); my $sth = $dbh->prepare("select description, teacher, subjsec from subject"); # where subjsec = ? "); # foreach my $subjsec ( keys %{ $termcourses{$currterm} } ) { $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ( $desc, $userid, $subjsec ) = $sth->fetchrow ) { $coursename{$subjsec} = $desc; $teachercourse{$subjsec} = $userid; # get teacher userid from the course (subjsec) } # foreach my $key ( sort keys %coursename ) { print "K:$key V:$coursename{$key}
\n"; } # foreach my $key ( sort keys %teachercourse ) { print "K:$key V:$teachercourse{$key}
\n"; } # TEST # foreach my $term ( sort keys %termcourses ) { # foreach my $subjsec ( sort keys %{ $termcourses{$term} } ) { # print "Term:$term Subjsec:$subjsec "; # } # } # Create a hash for day in cycle for this month. my %dayincycle; for my $d ( 1..$lastday ) { my $dic = findDayInCycle( "$year-$month-$d", $dbh ); #print "Day of Month:$d Cycle Day:$dic
\n"; $dayincycle{$d} = $dic; } # Missing Attendance - show this on bottom row my %missingatt; # missing attendance $missingatt{$day}; # SETUP for STUDENT LOOP # get attendance values my $sth1 = $dbh->prepare("select * from attend where month(absdate) = $month and year(absdate) = $year and studentid = ?"); # wd status check for withdrawals this month. # $year and $month defined at top of the script. my $sth2 = $dbh->prepare("select count(*) from transfer where studnum = ? and type = 'withdraw' and month(date) = $month and year(date) = $year"); # get enrollment changes (ie. transfers) my $sth3 = $dbh->prepare("select date, type from transfer where month(date) = $month and year(date) = $year and studnum = ? order by date"); # Get Student Course Enrollments my $sth4 = $dbh->prepare("select subjcode from eval where studnum = ? and term = ?"); # Get student timetable values my $sth5 = $dbh->prepare("select day,period from schedat where subjsec = ? and term = ?"); # STUDENT LOOP my $studcount; # student count my ($totaldaysenrolled, $totaldaysattended); my %sorted = reverse %students; foreach my $key ( sort keys %sorted ) { my $studnum = $sorted{$key}; my $name = $studname{ $studnum }; my $grade = $studgrade{ $studnum }; # needed to find current term, thence course enrollments, timetable my $homeroom = $studroom{$studnum}; if ( not $name ) { my $sth1 = $dbh->prepare("select lastname, firstname from studentwd where studnum = ?"); $sth1->execute( $studnum ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } ($lastname, $firstname) = $sth1->fetchrow; $name = "$lastname, $firstname"; } my %trms; # get current terms for this student; foreach my $d ( 1..$lastday ) { my $t = $currterm{$grade}{$d}; $trms{$t} = 1; } my $statsflag = 1; # print the attendance stats in final column IF all teacher attendance entries done. my %studenttimetable; if ( $attmethod eq 'subject' ) { # get student timetable: term/day/period/ = subjsec; # First get enrolled subjects, then get timetable values for those subjects. foreach my $trm (sort keys %trms) { # loop over all terms this month for this student # Get enrolled courses $sth4->execute($studnum, $trm); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $subjsec = $sth4->fetchrow ) { # Get day/periods $sth5->execute($subjsec, $trm); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($day,$period) = $sth5->fetchrow ) { $studenttimetable{$trm}{$day}{$period} = $subjsec; } } } } # end of getting student timetable, for subject attendance. # Checking data structure of studenttimetable. =head print qq{
Student:$studnum
\n}; foreach my $t ( sort keys %studenttimetable ) { foreach my $d ( sort keys %{ $studenttimetable{$t} } ) { foreach my $p ( sort keys %{ $studenttimetable{$t}{$d} } ) { print qq{ Term:$t Day:$d Period:$p Subject:$studenttimetable{$t}{$d}{$p}
\n}; } } } =cut # Get Attendance Data my %att; $sth1->execute( $studnum ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $r = $sth1->fetchrow_hashref ) { my ($y,$m,$day) = split('-', $r->{absdate} ); $day =~ s/^0//; my $period = $r->{period}; $att{$day}{$period}{'reason'} = $r->{reason}; $att{$day}{$period}{'subjsec'} = $r->{subjsec}; $att{$day}{$period}{'late'} = $r->{late}; $att{$day}{$period}{'id'} = $r->{attid}; } # Get wd status: check for a withdrawal record this month. my $wdflag; $sth2->execute( $studnum ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $ecount = $sth2->fetchrow; if ( $ecount ) { $wdflag = 1; # print "WD - SN:$studnum
\n"; } # flag set (==1) is withdrawn; # Get Enrollment Data for this month. We don't have to get # later dates since this is already done to see if they are # current students or not. Earlier records are checked below. my %enrol; $sth3->execute( $studnum ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($date, $type) = $sth3->fetchrow ) { my ($y,$m,$day) = split('-', $date ); $day =~ s/^0//; # strip leading zero if ( exists $enrol{$day} ) { print "

Enrollment Error: $name ($studnum) - $date

\n"; } $enrol{$day} = $type; } # print "$studnum \n"; # foreach my $key ( sort keys %enrol ) { print "K:$key V:$enrol{$key}\n"; } # print "
\n"; # Set Initial Enrollment Status value ($estatus) my $estatus; if ( not %enrol ) { # no enrollment changes this month, were they enrolled before? # read the previous record to see if a withdraw my $startdate = "$year-$month-01"; my $sth = $dbh->prepare("select date, type from transfer where to_days(date) < to_days('$startdate') and studnum = ? order by date desc"); $sth->execute($studnum); # get the record just before this month to find enrollment status. my ($date, $type) = $sth->fetchrow; if ( $type eq 'withdraw' ) { # $estatus = 0; $wdflag = 1; } else { $estatus = 1; $wdflag = 0; } } else { # we have enrollment changes. my @tmp = sort {$a <=> $b} keys %enrol; my $etype = $enrol{$tmp[0]}; # first enrollment change value in the month; if ( $etype eq 'withdraw' ) { $estatus = 1; $wdflag = 0; # must have been enrolled at start of the month. # Note: even if withdrawn on the 1st, he/she would have been there for that day. # If type is enrol, then she/he must have not been enrolled at start of the month. } else { # first record NOT a withdraw, must be ENROL. $estatus = 0; # $wdflag = 1; } } # print "Name:$name Estatus:$estatus
\n"; my $wd; if ( $wdflag ) { $wd = qq{$lex{WD}}; } $studcount++; print qq{\n}; my ( $periodspresent, $daysenrolled, $attendclosure ); #attendclosure: student present, but school closed for part of day; an adjustment factor. # DAY LOOP - loop through the month foreach my $day ( 1..$lastday ) { if ( exists $weekend{$day} ) { next; } if ( $daysclosed{$day} > 0.99 ) { # also watch for enrollment changes ($estatus) if ( $enrol{$day} eq 'withdraw' ) { # status change $estatus = 0; } if ( $enrol{$day} eq 'enrol' ) { # status change $estatus = 1; } print qq{\n}; next; } my ($partclosed, $partclosedstyle); if ( $daysclosed{$day} ) { # partial closure $partclosedstyle = qq{style="background-color:$partclosedcolor;"}; $partclosed = qq{background-color:$partclosedcolor;}; } # update enrollment status ($estatus), if necessary if ( $enrol{$day} eq 'enrol' ) { # status change $estatus = 1; } if ( not $estatus ) { # not enrolled print qq{\n}; next; } # If here, then student is enrolled; $daysenrolled += (1 - $daysclosed{$day} ); # Note: the part of day absent cannot be greater than the part of the day open (ie. 1-daysclosed{$day}) if ( $daysclosed{$day} ) { # we have a partial day closure; full day closed is skipped above. my $temp; # find out how many periods marked absent. for my $per ( 1..$ppd ) { my $reason = $att{$day}{$per}{'reason'}; if ( $reason =~ m/Absent/ ) { $temp++; } } my $dayfractionabsent = $temp / $ppd; if ( $dayfractionabsent > $daysclosed{$day} ) { #print "Too much absent! Day:$day Student:$studnum
\n"; $attendclosure += (1 - $dayfractionabsent); } else { $attendclosure += $daysclosed{$day}; } } my $dayincycle = $dayincycle{$day}; # used for subject attendance my $currterm = $currterm{$grade}{$day}; # grade of student, day of month # PERIOD LOOP - loop through all periods for my $per ( 1..$ppd ) { my $class; if ( $per == $ppd ) { $class = qq{class="dr"}; } my ($subject, $late); if ( $att{$day}{$per}{'subjsec'} ) { my $subjsec = $att{$day}{$per}{'subjsec'}; my $desc = $coursename{$subjsec}; if ( not $desc ) { $desc = $subjsec; } $subject = "$lex{Subject}:$desc"; } if ( $att{$day}{$per}{'late'} ) { $late = "$lex{Late}:$att{$day}{$per}{'late'}"; } my $val; # Here is where we check that attendance has been entered by teacher. my $nocourseenrollment; # were they enrolled in a course in this period? if ( $attmethod eq 'subject' ) { # need to find the teacher for this period, this day. # we know: $day (of month), $dayincycle, $per (period), $currterm my $courseoffered = $studenttimetable{$currterm}{$dayincycle}{$per}; my $userid = $teacherattendance{$day}{$per}{$courseoffered}; # Check for an attendance entry if ( $userid ) { # a userid indicates things are done. my $coursename = $coursename{$courseoffered}; my $teachername = $teachername{$userid}; $val = qq{}; } elsif ( not $courseoffered ) { $nocourseenrollment = 1; $val = qq{}; } else { $missingatt{$day} = 1; # missing attendance my $coursename = $coursename{$courseoffered}; my $teacheruserid = $teachercourse{$courseoffered}; # is userid of teacher for this course. my $teachername = $teachername{$teacheruserid}; # print "Period:$per Day:$day Student:$studnum $coursename $teacheruserid
\n"; $val = qq{\n}; $statsflag = 0; } } else { # HOMEROOM METHOD my $hrsubject = 'HR:'.$arr{homeroom}; # what will be in the 'subject' field of array if ( $teacherattendance{$day}{$per}{$hrsubject} ){ $val = qq{}; } elsif ( $partclosed ) { # if day partially closed, don't show NE, just a C $val = qq{}; } else { $missingatt{$day} = 1; # missing attendance $val = qq{}; $statsflag = 0; } } if ( $reason = $att{$day}{$per}{'reason'} ) { # if we have a record for that day and period. my $rsn = q{NA}; if ( $reason =~ m/Absent/ ) { $rsn = 'A'; } elsif ( $reason =~ m/Late/ ) { $rsn = 'L'; $periodspresent++; # still consider them present; could add a variable and check minutes late. } my $attid = $att{$day}{$per}{'id'}; $val = qq{}; } else { # child was present if ( not $nocourseenrollment ) { # if enrolled in a course (doesn't affect homeroom) $periodspresent++; } } print $val; } # end of printing loop (each period) # update enrollment status ($estatus), if necessary if ( $enrol{$day} eq 'withdraw' ) { # status change $estatus = 0; } } # end of day loop my $tempdayspresent = ($periodspresent / $ppd) - $attendclosure; # print "SN:$studnum Present:$periodspresent Closure:$attendclosure TEMP:$tempdayspresent PPD:$ppd
\n"; if ( $overridedaysopen ) { $tempdayspresent = $tempdayspresent - $overrideDO; # overrideDO is difference between 'normal' days open and overridden days open } my $dayspresent = format_number( $tempdayspresent ,2,2); if ( $dayspresent < 0 ) { $dayspresent = 0; } # Adjust days enrolled by the same factor, even if we don't know for sure. if ( $overridedaysopen ) { $daysenrolled = $daysenrolled - $overrideDO; } $totaldaysattended += $dayspresent; $totaldaysenrolled += $daysenrolled; my $daysenrolled = format_number( $daysenrolled, 2, 2); my $percentattend; if ( $daysenrolled != 0 ) { $percentattend = format_number( $dayspresent / $daysenrolled * 100, 1); } else { $percentattend = '0'; } print qq{\n}; if ( $statsflag ) { print qq{\n}; } else { print qq{\n}; } # Empty the student timetable values foreach my $t ( sort keys %studenttimetable ) { foreach my $d ( sort keys %{ $studenttimetable{$t} } ) { foreach my $p ( sort keys %{ $studenttimetable{$t}{$d} } ) { # print qq{ Term:$t Day:$d Period:$p Subject:$studenttimetable{$t}{$d}{$p}
\n}; delete $studenttimetable{$t}{$d}{$p}; } delete $studenttimetable{$t}{$d}; } delete $studenttimetable{$t}; } } # end of student loop # Teacher Attendance Loop my $currterm = -1; # start with a dud. my $prevterm; my @courses; # only for subject attendance. print qq{\n}; foreach my $day ( 1..$lastday ) { if ( exists $weekend{$day} ) { next; } if ( $daysclosed{$day} > 0.99 ) { print qq{\n}; next; } if ( $missingatt{$day} and not $daysclosed{$day} ) { print qq{\n}; } elsif ( $daysclosed{$day} ) { print qq{\n}; } else { print qq{\n}; } } # end of teachers days loop my $pa = 0; if ( $totaldaysenrolled ) { $pa = format_number( 100 * $totaldaysattended / $totaldaysenrolled, 2, 2); } print qq{}; print qq{\n}; print qq{
}; print qq{$lex{Hover}=$lex{View}, $lex{Click}=$lex{Edit}}; print qq{P=$lex{Present}, }; print qq{A=$lex{Absent}, NE=$lex{'No Entry'}
$s_month[$month] $day$s_month[$month] $day
$lex{Student}$map{$per}$map{$per}$lex{Enrolled}$lex{Attended}
$name ($studnum) $wdGr:$grade
Hr:$homeroom		C}. qq{PNEPCNE}. qq{$rsn$daysenrolled$dayspresent ($percentattend%)
$lex{Error}
Attendance Entry}; print qq{$lex{Error}$lex{OK}$totaldaysenrolled$totaldaysattended ($pa%)
\n}; # print qq{\n}; # print qq{\n}; # print qq{\n}; # print qq{
$lex{'Days Open'}$daysopen
$lex{'Days Closed'}$daysclosed
\n}; print qq{\n}; exit; } # end of showReport #-------------- sub findCourses { #-------------- # Find the courses this term for these students, passed a list of studnums, after the term to check. my ( $term, @students ) = @_; if ( not $term ) { print "
Missing Term for students
\n"; return; } my %courses; my $sth = $dbh->prepare("select distinct subjcode from eval where studnum = ? and term = $term"); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } foreach my $studnum ( @students ) { $sth->execute( $studnum ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $subjsec = $sth->fetchrow ) { $courses{$subjsec} = 1; } } return keys %courses; } #--------------------- sub findCourseTeachers { #--------------------- # Find the teachers for these courses, passed a list of studnums my @courses = @_; my @teachers; my $sth = $dbh->prepare("select teacher from subject where subjsec = ?"); foreach my $subjsec ( @courses ) { $sth->execute( $subjsec ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $userid = $sth->fetchrow; push @teachers, $userid; } return @teachers; } #--------------------- sub getStudentsInMonth { # find all students in this month at some point. #--------------------- # Outline: Get current students, then backup to the END of current (actually start of following) month, adding and removing students from transfers my ($yrmo, $grade, $homeroom) = @_; my %students; my ($select, $selectval, $selecttype); if ( $grade ) { $select = 'where grade = ?'; $selectval = $grade; $selecttype = 'grade'; } elsif ( $homeroom ) { $select = 'where homeroom = ?'; $selectval = $homeroom; $selecttype = 'homeroom'; } else { print qq{

getStudentsInMonth - $lex{Error}: Missing Grade or Homeroom

\n}; exit; } # Get current kids in this room my $sth = $dbh->prepare("select studnum from student $select"); $sth->execute( $selectval ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $studnum = $sth->fetchrow ) { $students{$studnum} = 1; } # Now run through Transfer records checking for other students in # this grade/room, and update %students until we reach the month # of interest. my $sth1 = $dbh->prepare("select grade,homeroom from studentall where studnum = ?"); my $startdate = $yrmo. '-01'; 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 %tr = %$ref; $sth1->execute( $tr{studnum} ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($grade,$homeroom) = $sth2->fetchrow; if ( $selecttype eq 'homeroom' and $homeroom ne $selectval ) { next; } if ( $selecttype eq 'grade' and $homeroom ne $selectval ) { next; } # If here, they must be in the correct homeroom/grade group, if ( $tr{type} ne 'withdraw' ) { # Enrol here so we remove them, if not in the month of interest. if ( $tr{date} =! m/$yrmo/ ) { # if NOT month of interest, delete them. } } } }