#!/usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. # Get Grade and Year-Month and display attendance for each day. my %lex = ('Teacher' => 'Teacher', 'Error' => 'Error', 'Main' => 'Main', 'Attendance' => 'Attendance', 'Report' => 'Report', 'Month' => 'Month', 'Start' => 'Start', 'Continue' => 'Continue', 'Select' => 'Select', 'Grade' => 'Grade', 'Student' => 'Student', 'Course' => 'Course', 'Show' => 'Show', 'Withdrawn' => 'Withdrawn', 'or' => 'or', 'Homeroom' => 'Homeroom', 'Missing' => 'Missing', 'Value' => 'Value', 'View' => 'View', 'Hover' => 'Hover', 'Students' => 'Students', 'Starting' => 'Starting', 'Ending' => 'Ending', 'Override' => 'Override', 'Days Open' => 'Days Open', 'No Students Selected' => 'No Students Selected', 'Open' => 'Open', 'End' => 'End', 'Yearly' => 'Yearly', ); my $self = 'rptattstud1.pl'; my $closedcolor = '#AAA'; my $partclosedcolor = '#EEE'; my $notenrolledcolor = '#DDD'; my %nonstandardGrades = ('P3' => 1, 'K' => 1, 'PK' => 1); # grades, that as homerooms, have nonstandard days closed(ie varying). 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"; } # for parseGradesPeriod function eval require "$configpath/lib/libDate.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"; } } # 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) ); if (length $cmonth == 1 ) { $cmonth = '0'. $cmonth; } my $curryrmo = "$cyear-$cmonth"; my $prevyrmo; if ( $cmonth == 1 ) { my $prevyr = $cyear - 1; $prevyrmo = "$prevyr-12"; } else { my $prevmo = $cmonth - 1; if (length $prevmo == 1 ) { $prevmo = '0'. $prevmo; } $prevyrmo = "$cyear-$prevmo"; } my $title = "$lex{Yearly} $lex{Student} $lex{Attendance} $lex{Report} 1"; print qq{$doctype\n$title\n}; print qq{\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} |\n}; print qq{ $lex{Attendance} ]\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectStudents(); } elsif ( $arr{page} == 2 ) { 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. if ( length( $sm ) == 1 ) { $sm = '0'. $sm; } my $yrmo = "$sy-$sm"; push @months, $yrmo; $months{$yrmo} = "$s_month[$sm]-$sy"; for my $i (1..10) { my $mo = $sm + $i; if ( length( $mo ) == 1 ) { $mo = '0'. $mo; } my $yr = $sy; if ( $mo > 12 ) { $mo = $mo - 12; if ( length( $mo ) == 1 ) { $mo = '0'. $mo; } $yr++; } my $yrmo = "$yr-$mo"; push @months, $yrmo; $months{$yrmo} = "$s_month[$mo]-$yr"; } # 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 } print qq{
\n}; print qq{\n}; print qq{\n}; # Starting Month print qq{}; print qq{\n}; # Ending Month print qq{}; print qq{\n}; # Spacer print qq{\n}; # Homerooms print qq{}; print qq{\n}; # Grades print qq{}; print qq{\n}; print qq{\n}; # Show Withdrawn Students print qq{}; print qq{\n}; # Spacer print qq{\n}; # Override Days Open print qq{}; print qq{\n}; print qq{\n}; print qq{
$lex{Starting} $lex{Month}
$lex{Ending} $lex{Month}
$lex{Homeroom} $lex{Attendance}
$lex{or} }; print qq{$lex{Course} $lex{Attendance} - $lex{Grade}
$lex{Show} $lex{Withdrawn}
$lex{Override} $lex{'Days Open'}}; print qq{ For Kindergarten or Pre-Kindergarten; partial/alternate days
\n}; print qq{\n}; print qq{\n}; foreach my $mo ( @months ) { my ($y,$m) = split('-', $mo ); print qq{\n}; if ( $mo eq $curryrmo ) { last; } } print qq{
$lex{Month}$lex{'Days Open'}
$month[$m] ($mo)}; print qq{}; print qq{
\n}; # Continue print qq{
\n}; print qq{
\n}; print qq{\n}; exit; } #----------------- sub selectStudents { #----------------- my $studtable = 'student'; my $showwithdrawn; if ( $arr{showwithdrawn} ) { $studtable = 'studentall'; $showwithdrawn = 1; delete $arr{showwithdrawn}; } # Check end month vs current month (can't go into future month...) my ($y, $m) = split('-', $arr{endmonth}); if ( ($y == $cyear and $m > $cmonth ) or $y > $cyear ) { #Error print "

Ending Month Not Allowed

\n"; print "\n"; exit; } # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Start Form print qq{
\n}; print qq{\n}; foreach my $key ( sort keys %arr ) { # pass arguments through print qq{\n}; } my $sth1 = $dbh->prepare("select count(*) from studentwd where studnum = ?"); my $sth; if ( $arr{homeroom} and $arr{grade} ) { # Error print qq{

Error: Select Only Grade or Homeroom

\n}; print qq{\n}; exit; } elsif ( $arr{homeroom} ) { $sth = $dbh->prepare("select lastname, firstname, studnum from $studtable where homeroom = ? order by lastname, firstname"); $sth->execute( $arr{homeroom} ); } elsif ( $arr{grade} ) { $sth = $dbh->prepare("select lastname, firstname, studnum from $studtable where grade = ? order by lastname, firstname"); $sth->execute( $arr{grade} ); } else { # all students selected $sth = $dbh->prepare("select lastname, firstname, studnum from $studtable order by lastname, firstname"); $sth->execute; } my $first = 1; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($lastname, $firstname, $studnum ) = $sth->fetchrow ) { my $wd; if ( $showwithdrawn ) { $sth1->execute( $studnum ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } if ( $sth1->fetchrow ) { # we have a WD student $wd = qq{WD\n}; } } if ( $first ) { if ( $arr{grade} ) { print qq{

$lex{Grade} $arr{grade}

\n}; } elsif ( $arr{homeroom} ) { print qq{

$lex{Homeroom} $arr{homeroom}

\n}; } else { # all students print qq{

All $lex{Students}

\n}; } print qq{\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{\n}; } print qq{\n}; if ( not $first ) { print qq{
$lex{Select} $lex{Students}
}; print qq{$wd $lastname, $firstname
\n}; } print qq{
\n}; print qq{\n}; exit; } #------------- sub showReport { #------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Passed: startmonth, endmonth, override (ovr) months, student numbers, grade,homeroom # Put Override days open in a month into hash and remove from %arr my %override; # override days open per month. foreach my $key ( sort keys %arr ) { my ($txt,$ym) = split(':', $key ); if ( $txt eq 'ovr' and $ym ) { # it's override and we have a year-month value $override{$ym} = $arr{$key}; delete $arr{$key}; } } # Check override # foreach my $key ( sort keys %override ) { # print "OVR:K:$key V:$override{$key}
\n"; # } my $grade = $arr{grade}; delete $arr{grade}; my $homeroom = $arr{homeroom}; delete $arr{homeroom}; # Mode to know if using what dates table. my $mode = 'homeroom'; # but only P3,PK,K grades will use dates_homeroom table. if ( $grade ) { $mode = 'grade'; } # my $datetable = 'dates_periods'; # either dates_homeroom or dates_period my @grades; # if a split homeroom if ( $mode eq 'homeroom' ) { # find the grade that matches this homeroom; needed to figure # out what table to use. my $sth = $dbh->prepare("select distinct grade from student where homeroom = ? and grade is not null and grade != '' order by grade"); $sth->execute( $homeroom ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth->fetchrow ) { # if ( $nonstandardGrades{$gr} ) { # reset datetable to homeroom # $datetable = 'dates_homeroom'; # } push @grades, $gr; } $grade = $grades[0]; } # print "
Main - Mode:$mode
\n"; # remaining values in %arr # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Check for missing month entry if ( not $arr{startmonth} or ( not $arr{endmonth} ) ) { print qq{

$lex{Missing} $lex{Value}

\n}; print qq{\n}; exit; } # Create hash of year-month values my @yearmonth; my ($yr, $mo ) = split('-', $arr{startmonth}); my ($ey, $em ) = split('-', $arr{endmonth}); # increment end month so we can get last days correctly. if ( $em == 12 ) { $em = '01'; $ey++; } else { $em ++; }; if ( length $em == 1 ) { $em = '0'. $em; }; $arr{endmonth} = "$ey-$em"; my $ym = $arr{startmonth}; while ( $ym ne $arr{endmonth} ) { push @yearmonth, $ym; $mo++; if ( $mo > 12 ) { $mo = 1; $yr++; } if ( length $mo == 1 ) { $mo = '0'. $mo; } $ym = qq{$yr-$mo}; } push @yearmonth, $ym; # final month push # Hash to store last days of the month. my %lastdays; my ($currym, $prevym); foreach my $ym ( @yearmonth ) { if (not $currym ) { $currym = $ym; next; } # skip first element $prevym = $currym; $currym = $ym; my $startjd = julian_day( split('-',$currym),1); my $prevjd = $startjd - 1; # end of previous month. my @date = inverse_julian_day( $prevjd ); $lastdays{$prevym} = $date[2]; } pop @yearmonth; # remove extra month added to get last day in last month. # foreach my $key ( sort keys %lastdays ) { print "YM:$key V:$lastdays{$key}
\n"; } delete $arr{startmonth}; delete $arr{endmonth}; # should only be student numbers left in %arr at this point. # Check for Students if ( not %arr ) { print qq{

$lex{'No Students Selected'}

\n}; print qq{\n}; exit; } # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Load student info and create sorting hash. my (%student, %sort ); # $student{studnum}{all fields} = value; my $sth = $dbh->prepare("select * from studentall where studnum = ?"); foreach my $studnum ( keys %arr ) { $sth->execute($studnum); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth->fetchrow_hashref ) { $student{$studnum} = $ref; $sort{"$ref->{lastname}$ref->{firstname}$studnum"} = $studnum; } } # Get days closed for the year or year fraction. my %daysclosed; # daysclosed{ym}{day} = fraction my %daysclosedcount; # daysclosedcount{ym} = total # Populate DaysClosed hashes my $sth = $dbh->prepare("select date, dayfraction from dates where month(date) = ? and year(date) = ?"); foreach my $ym ( @yearmonth ) { my ($yr,$mo) = split '-', $ym; $sth->execute($mo, $yr); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $closed; # sum of days closed fraction while ( my ($dt, $fraction ) = $sth->fetchrow ) { my ($y,$m,$d) = split('-',$dt); $d =~ s/^0//; # strip leading zeros from the day if ( $fraction ) { # should only a 1 or 0 value now; partial handled by dates_periods table $daysclosed{$ym}{$d} = $fraction; $closed += $fraction; } } $daysclosedcount{$ym} = $closed; } # Test Days closed (fully) # foreach my $ym ( sort keys %daysclosed ) { # print "
YM:$ym $daysopen{$ym}
\n"; # foreach my $day ( sort {$a <=> $b} keys %{ $daysclosed{$ym} } ) { # print "K:$day V:$daysclosed{$ym}{$day}
\n"; # } # } # Periods Closed - read both tables. homeroom will have HR:homeroom key my %pclosed; # pclosed{GR/HR}{ym}{day}{period} = type (type not really used currently) # $datetable is set above. # homeroom closed my $sth = $dbh->prepare("select * from dates_homeroom where month(date) = ? and year(date) = ?"); # periods closed; partial day closure my $sth1 = $dbh->prepare("select * from dates_periods where month(date) = ? and year(date) = ?"); foreach my $ym ( @yearmonth ) { my ($yr,$mo) = split '-', $ym; # Dates_Homeroom closed $sth->execute($mo, $yr); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth->fetchrow_hashref ) { my %r = %$ref; my ($y,$m,$d) = split('-',$r{date}); $d =~ s/^0//; # strip leading zeros from the day $pclosed{"HR:$r{homeroom}"}{$ym}{$d}{$r{period}} = 1; } # Dates_Periods table $sth1->execute($mo, $yr); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth1->fetchrow_hashref ) { my %r = %$ref; my ($y,$m,$d) = split('-',$r{date}); $d =~ s/^0//; # strip leading zeros from the day # Get the grades my $gref = parseGradesPeriod( $r{date}, $dbh); my %temp = %$gref; # {grades}{period} - more than one period possible in day. foreach my $gr ( keys %temp ) { foreach my $per ( keys %{ $temp{$gr}} ) { $pclosed{$gr}{$ym}{$d}{$per} = 1; } } } # end of dates_periods loop } # end of ym loop # Testing Section for pclosed hash # foreach my $grp ( sort keys %pclosed ) { # foreach my $ym ( sort keys %{ $pclosed{$grp}} ) { # foreach my $day ( sort {$a <=> $b} keys %{ $pclosed{$grp}{$ym} } ) { # foreach my $period (sort {$a <=> $b} keys %{ $pclosed{$grp}{$ym}{$day} } ) { # print qq{Grp:$grp / $ym / $day / $period
\n}; # } } } }; =head # Outline for teacher attendance checking. The teacher information in tattend has: userid - teacher userid attdate - date of attendance entry subjects - (singular) subject subjsec OR homeroom in format HR:5/6 periods - again, now singular, the period that it was done for.... In order to check if a particular student's attendance was done, we have to: a) Homeroom Get students grade and homeroom and get attendance entry method. If homeroom method, then get the teacher associated with this homeroom (only 1, check 'does attendance, too?). Then use this userid to check records with value: this userid, this subjects field (HR:homeroom), Use tAttendHomeroom{ym}{day}{period} {userid} This will give the attdate, and periods that attendance was done. b) Course/Subject (really Course) With a course entry method for a grade, we need the student timetable, and then find the matching teacher attendance table. 1) Get Day in Cycle, find courses student took. 2) Check if teacher attendance was done for that attdate, for that period, for that subjsec (subjects field). We don't care about userid, since student linkage is via subjsec not homeroom assignment. create tAttendCourse{ym}{day}{period} {subjsec} Checking for a particular date, period, we first need the day in cycle in order to get the timetable values for the student, which gives: Period->subjsec. Looping over the periods, we get the subjsec (course identifier), we then check for this entry in tAttendCourse. =cut # Teacher Attendance my (%tAttendHomeroom, %tAttendCourse); # tAttendHomeroom{ym}{day}{period} {userid} tAttendCourse{ym}{day}{period} {subjsec} my $sth = $dbh->prepare("select * from tattend where year(attdate) = ? and month(attdate) = ?"); foreach my $ym ( @yearmonth ) { my ($yr,$mo) = split '-', $ym; $sth->execute($yr, $mo); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth->fetchrow_hashref ) { my %r = %$ref; my ($y,$m,$day) = split('-', $r{attdate}); $day =~ s/^0//; # strip leading zero # print "Y:$y M:$m D:$day P:$r{periods} S:$r{subjects}
\n"; if ( $r{subjects} =~ m/HR:.+/ ) { # or not $r{subjects} ) { # if a homeroom my $hr = $r{subjects}; $hr =~ s/HR://; $tAttendHomeroom{$ym}{$day}{ $r{periods} }{ $hr } = 1; # students linked by homeroom, was userid } elsif ( $r{subjects} ) { $tAttendCourse{$ym}{$day}{ $r{periods} }{ $r{subjects} } = 1; # students linked by course. } else { # blank 'subjects' field print qq{
Missing Teacher Attendance Course/Homeroom field}; print qq{ Date:$r{attdate} Userid:$r{userid} Period:$r{periods}
\n}; } } # get dates loop } # ym loop # use Data::Dumper; # print "Homeroom
\n";
#    print Dumper %tAttendHomeroom;
#    print "

\n"; # print "Course
\n";
#    print Dumper %tAttendCourse;
#    print "

\n"; # For Subject based attendance, create a termjd{track}{start:end} = # term to look up term of current date; MTrackTerm{$track}{$term}{ # start => startdate, end => $enddate } my %termjd; foreach my $track ( keys %g_MTrackTerm ) { foreach my $term ( keys %{ $g_MTrackTerm{$track}} ) { my $sdate = $g_MTrackTerm{$track}{$term}{start}; my $edate = $g_MTrackTerm{$track}{$term}{end}; my $sdatejd = julian_day( split('-',$sdate)); my $edatejd = julian_day( split('-',$edate)); $termjd{$track}{"$sdatejd:$edatejd"} = $term; } } # use Data::Dumper; # print "termjd
\n";
#    print Dumper %termjd;
#    print "

\n"; # Global Timetable - load this and then each student will use a subset for their courses. my %ttb; # ttb{term}{subjsec}{dayincycle}{period} my $sth = $dbh->prepare("select * from schedat"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchall_hashref('id'); foreach my $key ( sort keys %{ $ref } ) { foreach my $hkey ( sort keys %{ $ref->{$key}} ) { my %r = %{ $ref->{$key} }; $ttb{ $r{term} }{ $r{subjsec} }{ $r{day} }{ $r{period} } = 1; } } # use Data::Dumper; # print "Timetable (%ttb)
\n";
#    print Dumper %ttb;
#    print "

\n"; my $schoolstartjd = julian_day(split('-', $schoolstart)); # get homerooms of teachers (in order to link to children by homeroom for tattend. my (%homeroom, %teachername); # %homeroom{homeroom} = $userid; # OLD:%homeroom{homeroom}{userid} = 1 my $sth1 = $dbh->prepare("select lastname, firstname from staff where userid = ?"); my $sth = $dbh->prepare("select userid, field_value from staff_multi where field_name = 'homeroom'"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($userid, $rm ) = $sth->fetchrow ) { $sth1->execute($userid); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname) = $sth1->fetchrow; # $homeroom{$rm}{$userid} = 1; # in case of more than one teacher in same homeroom...? $teachername{$userid} = "$firstname $lastname"; $homeroom{$rm} = $userid; # only one teacher doing attendance. Too ugly otherwise } # Main Student Loop foreach my $key ( sort keys %sort ) { my $studnum = $sort{$key}; my %r = %{ $student{$studnum}}; # student record. my $teacher = $homeroom{ $r{homeroom}}; my $homeroom = $r{homeroom}; my $grade = $r{grade}; my ( @courses, %localttb ); # courses and local timetable for this student; # $localttb{$subjsec}{$day}{$period} = 1; my ( $totaldaysopen, $totaldaysenrolled, $totaldaysabsent ); # total for statistics line. # Set Attendance Entry Method my $attmethod = $g_AttendanceEntryMethod{ $r{grade} }; # Track my $track = $g_MTrackTermType{ $r{grade} }; # PPD (Periods per Day attendance is taken my $ppd = $g_ppd{ $r{grade} }; # print "Method: $attmethod Track:$track Grade:$r{grade}
\n"; # Heading print qq{

$r{firstname} $r{lastname}}; if ( $attmethod eq 'homeroom' ) { # show homeroom teacher print qq{ - Teacher $teachername{$teacher}}; } print qq{

\n}; # get their enrollment for the year, and populate status my @enrolblocks = findEnrollmentBlocks($studnum, $schoolstart, $schoolend, $dbh); # populate status keys (ym values) my %enrol; foreach my $ym ( @yearmonth ) { # enter all months, keys only, so far. $enrol{$ym}; } # Put in the trigger points (enrollment status change). foreach my $blockref ( @enrolblocks ) { my ($sy,$sm,$sd) = split('-', $blockref->{start} ); $sd =~ s/^0//; $enrol{"$sy-$sm"}{$sd} = 'e'; my ($ey,$em,$ed) = split('-', $blockref->{end} ); $ed =~ s/^0//; $enrol{"$ey-$em"}{$ed} = 'w'; } # Update the first day of each month with the enrollment status my $estatus; foreach my $ym ( @yearmonth ) { my $first = 1; foreach my $day (1..31) { # Logic to populate the first day of the month with an # estatus value, if no value already on the first. # This is the first value in the month; if ( $enrol{$ym}{$day} and $first ) { # if we have a trigger value. if ( $day != 1 ) { # if this is not on the first, then put in the day 1 value # if an 'e'(enrol), then must have been withdrawn to that point if ($enrol{$ym}{$day} eq 'e' ) { $enrol{$ym}{1} = 'w'; $estatus = 'e'; } else { $enrol{$ym}{1} = 'e'; $estatus = 'w' } } $first = 0; } # The normal situation: if an enrollment, estatus is 'e'; if a withdraw, estatus is 'w'. if ( $enrol{$ym}{$day} ) { $estatus = $enrol{$ym}{$day}; } } # end of days; if ( $first ) { # no enrollment change; $enrol{$ym}{1} = $estatus; } } # end of ym update loop =head # Test the %enrol hash foreach my $ym ( sort keys %enrol ) { foreach my $day ( sort keys %{ $enrol{$ym} } ) { print qq{YM:$ym Day:$day VAL:$enrol{$ym}{$day}
\n}; } } =cut # Start the Main Table print qq{\n}; print qq{\n}; # Heading; print qq{}; foreach my $day (1..31) { print qq{}; } print qq{}; print qq{\n}; my $sth = $dbh->prepare("select * from attend where absdate = ? and studentid = ?"); my ($currterm, $prevterm); # Loop through each month. foreach my $ym ( @yearmonth ) { my ($y,$m) = split('-', $ym); print qq{}; my $lastday = $lastdays{$ym}; # IF subject attendance, create a hash for day in cycle for this month. my %dayincycle; if ( $attmethod eq 'subject' ) { for my $d ( 1..$lastday ) { my $dic = findDayInCycle( "$ym-$d", $dbh ); #print "Day of Month:$d Cycle Day:$dic
\n"; $dayincycle{$d} = $dic; } } my $daysabsent; # total count of days absent for the month. my $daysenrolled; # total count of days enrolled for the month. my $daysopen; # days school is open for the month my $estatus = $enrol{$ym}{1}; # daily value for enrollment status my $tAttendMonthlyFlag; # Day Loop foreach my $day ( 1..31 ) { my $tAttendFlag; # flag to indicate if teacher has missed attendance today my $tAttendMsg = "$lex{Missing} $lex{Teacher} $lex{Attendance}:"; if ( $day > $lastday ) { print qq{\n}; next; } my $date = qq{$ym-$day}; my $currjd = julian_day(split('-', $date)); my $dow = day_of_week( $currjd ); # Weekend or School Not Started Yet if ( $dow == 0 or $dow == 6 or $currjd < $schoolstartjd ) { print qq{\n}; next; } # Get Current Term, for subject attendance checking. my $term; if ( $attmethod eq 'subject' ) { foreach my $key ( keys %{ $termjd{$track}} ) { my ($startjd, $endjd ) = split(':', $key); if ( $currjd >= $startjd and $currjd <= $endjd ) { $term = $termjd{$track}{$key}; last; } } # if ( not $term ) { # print qq{

$lex{Error}: Term not found for $date

\n}; # } } if ( $term ) { $prevterm = $currterm; $currterm = $term; } # print "Date:$date CT:$currterm PV:$prevterm
\n"; # Updated Enrollment status if ( $enrol{$ym}{$day} ) { # we have an enrollment change trigger $estatus = $enrol{$ym}{$day}; } # Fully Closed / Partially Closed PLUS Update Days enrolled (partial or complete) my $openfrac; # fraction of the day open, to check below on attendance if ( $daysclosed{$ym}{$day} >0.99 ) { # full day closed print qq{\n}; next; } elsif ( $daysclosed{$ym}{$day} > 0.01 ) { # partially closed from dates tables $openfrac = round( 1 - $daysclosed{$ym}{$day}, 2); $daysopen += $openfrac; if ( $estatus eq 'e' ) { # enrolled! $daysenrolled += $openfrac; } # Note: no next here since we are going to print attendance for partial day open. } elsif ( $pclosed{$grade}{$ym}{$day} or $pclosed{"HR:$homeroom"}{$ym}{$day} ) { # OLD: exists $daysclosed{$ym}{$day} and $daysclosed{$ym}{$day} == 0 ) { # partially closed (zero fraction), periods set in dates_periods or dates_homeroom my ($pcount,$tempcount); # Grade of student if ( $pclosed{$grade}{$ym}{$day} ) { # we have periods to do $tempcount = scalar %{ $pclosed{$grade}{$ym}{$day} }; $pcount += $tempcount; } # Homeroom, if not grade already set closed if ( not $tempcount ) { if ( $pclosed{"HR:$homeroom"}{$ym}{$day} ) { # we have periods to do $tempcount = scalar %{ $pclosed{"HR:$homeroom"}{$ym}{$day} }; $pcount += $tempcount; } } #my $date = qq{$ym-$day}; # my $ref = parseGradesPeriod($date,$dbh); # We know $grade and $ppd for the student. #my %periods = %{ $ref->{$grade}}; #my $pcount; # count of periods closed #foreach my $period ( sort keys %periods ) { # $pcount++; # we could be more complicated if periods not same length, etc. # } $openfrac = round( 1 - ($pcount / $ppd), 2); if ( not $openfrac ) { # full day closed (openfrac is 0) print qq{\n}; next; } else { # day is partially open for this student if ( $estatus eq 'e' ) { # enrolled! $daysenrolled += $openfrac; } } } else { # full day open/enrolled $daysopen++; if ( $estatus eq 'e' ) { # enrolled! $daysenrolled++; } } if ( $estatus ne 'e' ) { # not enrolled! print qq{\n}; next; } # Check for teacher attendance entry # if ( not $openfrac ) { # the day is closed if ( $attmethod eq 'homeroom' ) { my $aflag; foreach my $period ( 1..$ppd ) { if ( not $tAttendHomeroom{$ym}{$day}{$period}{$homeroom} ) { # print qq{YM:$ym D:$day P:$period HR:$homeroom
\n}; #print "Missing Attendance:$ym - $day - $period - $teacher
\n"; $tAttendFlag = 1; $tAttendMonthlyFlag = 1; $aflag = 1; } } if ( $aflag ) { print qq{\n}; next; } } else { # subject attendance check if ( $currterm != $prevterm and $prevterm ) { # we have a term change.... # Get Courses Student is enrolled in for this term. my $sth = $dbh->prepare("select subjcode from eval where studnum = ? and term = ?"); $sth->execute( $studnum, $term ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } # reset courses and timetable @courses = (); # courses %localttb = (); # local timetable while ( my $subjsec = $sth->fetchrow ) { push @courses, $subjsec; if ( $ttb{$term}{$subjsec} ) { # we have a timetable entry for this subject foreach my $day ( keys %{ $ttb{$term}{$subjsec} } ) { foreach my $period ( keys %{ $ttb{$term}{$subjsec}{$day} } ) { $localttb{$subjsec}{$day}{$period} = 1; } } } } if ( not @courses or not %localttb ) { $tAttendFlag = 1; } } # end of term change my $dayincycle = $dayincycle{$day}; # print "Date:$date Day:$day DIC:$dayincycle
\n"; my $sth = $dbh->prepare("select id from tattend where attdate = ? and subjects = ? and periods = ?"); # Get todays courses and their periods. (may be more than 1 or same...) my $firstatt = 1; foreach my $subjsec ( @courses ) { if ( $localttb{$subjsec}{$dayincycle} ) { foreach my $period ( sort keys %{ $localttb{$subjsec}{$dayincycle} } ) { if ( $pclosed{$grade}{$ym}{$day}{$period} ) { # part day closed next; } $sth->execute( $date, $subjsec, $period ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $id = $sth->fetchrow; if ( not $id ) { # no entry $tAttendFlag = 1; $tAttendMonthlyFlag = 1; $tAttendMsg .= " $subjsec P$period,"; } } } # end of timetable entry exists loop for this subject today } # end of courses loop } # end of subject attendance teacher entry check if ( $tAttendFlag ) { print qq{\n}; next; # day } # Get Attendance for today $sth->execute( $date, $studnum ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $abscount; while ( my $ref = $sth->fetchrow_hashref ) { if ( $ref->{reason} =~ m/Absent/ ) { $abscount++; } } my $absent = round($abscount / $ppd, 2); $daysabsent += $absent; if ( $openfrac and $absent > $openfrac ) { $absent = $openfrac; # because we can't be more absent than school is open! } my $display; if ( $absent < 0.01 ) { $display = 'P'; } elsif ( $absent > 0.99 ) { $display = 'A'; } else { $display = $absent. 'A'; } my $partdaystyle; if ( $openfrac ) { $partdaystyle = qq{style="background-color:$partclosedcolor;"}; } print qq{\n}; } if ( $override{$ym} ) { $daysopen = $override{$ym}; if ( $daysenrolled > $daysopen ) { $daysenrolled = $override{$ym}; } } print qq{\n\n}; if ( $tAttendMonthlyFlag ) { # no stats shown, since missing attendance entry at some point. print qq{\n}; next; } my ($percentattend, $dayspresent, $ratio); if ( $daysenrolled ) { $dayspresent = $daysenrolled - $daysabsent; $ratio = $dayspresent .' / '. $daysenrolled; $percentattend = '('. round( $dayspresent * 100 / $daysenrolled, 1). '%)'; $totaldaysenrolled += $daysenrolled; } $totaldaysopen += $daysopen; $totaldaysabsent += $daysabsent; print qq{}; print qq{\n}; } # year month loop # Statistics Line my $totaldayspresent = $totaldaysenrolled - $totaldaysabsent; my $totalpercentattend; if ( $totaldaysenrolled ) { $totalpercentattend = round( $totaldayspresent * 100 / $totaldaysenrolled, 1); } print qq{\n}; print qq{\n};; print qq{\n}; print qq{\n}; print qq{
}; print qq{$lex{Hover} = $lex{View}, C = Closed, X = Weekend/Not Started, }; print qq{NE = No Teacher Attendance Entry
$lex{Month}$day$lex{Open}$lex{Attendance}
$month[$m], $yXCCNENE$display$daysopen$lex{Error}
$ratio $percentattend
StatisticsPercent Attendance: }; print qq{$totalpercentattend%Days Present / Absent / Enrolled: }; print qq{$totaldayspresent / $totaldaysabsent }; print qq{/ $totaldaysenrolledDays Open: $totaldaysopen
\n\n}; # Enrollment Table. print qq{\n}; print qq{\n}; print qq{\n}; foreach my $ref ( @enrolblocks ) { print qq{\n}; } print qq{
Enrollment
$lex{Start}$lex{End}
$ref->{start}$ref->{end}
\n}; # foreach my $key ( sort keys %{ $ref } ) { print "K:$key V:$ref->{$key}
\n"; } # Page Break print qq{
\n}; } # student loop print qq{\n}; exit; } # end of showReport