#!/usr/bin/perl
# Copyright 2001-2021 Leslie Richardson
# 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 = ('Periods per Day' => 'Periods per Day',
'Main' => 'Main',
'Date' => 'Date',
'Next Week' => 'Next Week',
'Previous Week' => 'Previous Week',
'Continue' => 'Continue',
'Subject' => 'Subject',
'Student' => 'Student',
'Error' => 'Error',
'Add' => 'Add',
'Homeroom' => 'Homeroom',
'Attendance' => 'Attendance',
'Record' => 'Record',
'Exists' => 'Exists',
'Select' => 'Select',
'Go' => 'Go',
'Perfect Attendance' => 'Perfect Attendance',
'Term' => 'Term',
'Course' => 'Course',
'No Timetable Entry' => 'No Timetable Entry',
'Save' => 'Save',
'More' => 'More',
'Skipping' => 'Skipping',
'No Absences Found' => 'No Absences Found',
'Contact' => 'Contact',
'Saved' => 'Saved',
'Not Found' => 'Not Found',
'Weekly' => 'Weekly',
);
use DBI;
use CGI;
use Time::JulianDay;
use Cwd;
my $self = 'attAddCrsWeek.pl';
# Since we may run in admin or teacher site.
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.
}
eval require "$configpath/etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
# Needs findDayInCycle function
eval require "$configpath/lib/libschedule.pl";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
$dbh->{mysql_enable_utf8} = 1;
my $q = CGI->new;
my %arr = $q->Vars; # Get passed values
if ( $teachermode ) {
$css = $tchcss;
$homepage = $tchpage;
}
print $q->header( -charset, $charset );
# Print top of page
my $title = qq{$lex{Add} Subject/Course $lex{Attendance}};
print qq{$doctype\n$title\n};
print qq{\n};
print qq{
\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} };
if ( not $teachermode ) { print qq{| $lex{Attendance}}; }
print qq{ ]\n};
print qq{
$title
\n};
# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key} \n}; }
if ( not $arr{page} ) {
selectTeacher();
} elsif ( $arr{page} == 1 ) {
delete $arr{page};
enterAttendance();
} elsif ( $arr{page} == 2 ) {
delete $arr{page};
writeAttendance();
}
#---------------------
sub enterAttendance {
#---------------------
# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key} \n}; }
my ($userid, $date);
foreach my $key ( keys %arr ) {
my ($type,$fld) = split(':', $key);
if ( $type eq 'U' ) { # userid
$userid = $fld;
} #elsif ( $type = 'D' ) { # date
# $date = $fld; }
}
if ( $teachermode and not $userid ) {
$userid = $ENV{'REMOTE_USER'};
}
# print "Userid:$userid \n";
# Load Teacher / Userid name
my $sth = $dbh->prepare("select lastname, firstname from staff where userid = ?");
$sth->execute($userid);
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my ($tchlastname,$tchfirstname) = $sth->fetchrow;
if ( not $tchlastname ) {
print qq{
Staff Member not found!
\n};
}
print qq{$tchfirstname $tchlastname\n};
# Date Functions - current date, date data structures.
# First days of year, teacher days, mess this up.
# so set first day of first term to schoolstart.
my $schoolstart = $g_MTrackTerm{1}{1}{'start'}; # use first track, first term
my $startjd = julian_day( split('-',$schoolstart));
my $endjd = julian_day(split('-',$schoolend));
my ( $year, $month, $day ); # now global for homeroom entry method
my ($currdate, $mondayjd, $currjd, $dow, $dayfraction );
if ( $arr{date} ) { # passed a date;
$currjd = julian_day(split('-',$arr{date}));
$dow = day_of_week($currjd); # for use below in subject att entry
$mondayjd = $currjd - ($dow-1);
$currdate = join('-', inverse_julian_day($currjd));
} else { # use current date
@tim = localtime(time);
$year = $tim[5] + 1900;
$month = $tim[4] + 1;
$day = $tim[3];
$currjd = julian_day($year,$month,$day);
$dow = day_of_week($currjd); # for consumption below also; subj att entry
$mondayjd = $currjd - ($dow-1); #This will now give Monday of that week.
$currdate = "$year-$month-$day";
}
# Figure out the current term(s) for each track.
my ($currterm, %terms, %grade2terms, %track2grades ); #%track2grades{track} = @grades.
foreach my $trk ( sort {$a <=> $b} keys %g_MTrackTerm ) {
for my $trm ( sort {$a <=> $b} keys %{ $g_MTrackTerm{$trk}} ) {
my $startjd = julian_day( split('-', $g_MTrackTerm{$trk}{$trm}{start}) );
my $endjd = julian_day( split('-', $g_MTrackTerm{$trk}{$trm}{end}) );
if ( $currjd >= $startjd and $currjd <= $endjd ) { # we have the term.
$terms{$trk} = $trm;
last; # done with this track.
}
}
}
# foreach my $key ( sort keys %terms ) { print "K:$key V:$terms{$key} \n"; }
foreach my $gr ( keys %g_MTrackTermType ) {
my $track = $g_MTrackTermType{$gr};
push @{ $track2grades{$track}}, $gr; # used to display grade and term at line~1036
$grade2terms{$gr} = $terms{$track};
}
# Testing: foreach my $key ( sort keys %grade2terms ) {
# print "Grade:$key Term:$grade2terms{$key} \n"; }
# foreach my $track ( sort keys %track2grades ) {
# print "Track:$track Grades: ", @{ $track2grades{$track} }, " \n"; }
# Set Maximum periods per day; (Used by Subject entry and MultiDay)
my $maxppd = 0; # Maximum periods per day
if ( not %g_ppd ){
print $q->header( -charset, $charset );
print qq{
$lex{'Periods per Day'} - $lex{'Not Found'} in Configuration!
\n};
print qq{\n};
exit;
}
# Setup Array and Hash to hold Dates and DOW Dates (Multi-Day Method)
my $weekcount = 1; # we're not doing 2!
my ($ddref, $dayref) = mkDateData($mondayjd,$weekcount);
my @days = @$dayref;
my %datedata = %$ddref;
# foreach my $key ( sort keys %datedata ) {
# print "K:$key DateData:$datedata{$key} \n";
# }
# Rest of Top of Page...
print qq{
\n};
my $firstview = 1;
foreach my $trk ( sort keys %terms ) {
my $trm = $terms{$trk};
my @grades = sort {$a <=> $b} @{ $track2grades{$trk} } ;
my $gradestring = qq{$grades[0]-$grades[-1]};
# my $gradestring = join(',', sort {$a <=> $b} @{ $track2grades{$trk} } );
if ( not $firstview ) { print qq{ | }; }
print qq{ Grade $gradestring$lex{Term} $trm};
$firstview = 0;
}
print qq{
\n};
# Weekly Date Calcs - Previous Week / Next Week.
my $prevjd = $mondayjd - 7;
if ( $prevjd < $startjd ){ $prevjd = $startjd;}
my $prevdate = join('-', inverse_julian_day($prevjd));
print qq{
\n};
print qq{\n};
my $nextjd = $mondayjd + 7;
if ($nextjd > $endjd){ $nextjd = $endjd;}
my $nextdate = join('-', inverse_julian_day($nextjd));
print qq{\n\n};
# Pop Up Calendar Date Selector
print qq{\n};
print qq{
\n\n};
# Start Form
print qq{\n};
print qq{\n};
print qq{\n};
} # end of enterAttendance
#------------------
sub dailyAttendance {
#------------------
my ($teacher,$date,$grade2termsRef, $datedataref, $dbh) = @_;
# Also need grade2term so we can pick teacher current courses.
my %gradeToTerms = %{$grade2termsRef}; # note name change
my %datedata = %{$datedataref};
# Get Date info.
my $jd = julian_day( split('-',$date));
my $dow = day_of_week( $jd );
my ($y,$m,$d) = split('-',$date);
my $fmtdate = qq{$month[$m] $d};
# Get Current Courses.
my $sth = $dbh->prepare("select * from subject where teacher = ?");
my $sth1 = $dbh->prepare("select count(*) from eval where subjcode = ?");
$sth->execute( $teacher );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my (%courses, %smallcourses, %courseTerm );
while ( my $ref = $sth->fetchrow_hashref ) {
my %s = %$ref;
my $grade = $s{grade};
my $currterm = $gradeToTerms{$s{grade}};
# print qq{
\n};
# }
# Get DayInCycle
my $dayincycle = findDayInCycle( $date, $dbh );
# print "Day In Cycle $dayincycle\n";
# Get courses taught today along with their period.
my %periods; # periods{subjsec} = period
my $sth = $dbh->prepare("select period from schedat where subjsec = ? and day = ? and term = ?");
foreach my $subjsec ( keys %courses ) {
my $term = $courseTerm{ $subjsec };
$sth->execute( $subjsec, $dayincycle, $term );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my $period = $sth->fetchrow;
# print qq{
Term $term / $subjsec / $period
\n};
if ( $period ) { # timetable today.
$periods{$subjsec} = $period;
}
}
# Now reverse
my %revperiods; # {period} = @subjsecs.
foreach my $subjsec ( keys %periods ) {
my $period = $periods{$subjsec};
push @{ $revperiods{$period} }, $subjsec;
}
# Testing
# foreach my $subjsec ( sort keys %periods ) {
# print qq{
$courses{$subjsec} $subjsec / $periods{$subjsec}
\n};
# }
# Get students enrolled in courses today, and sort by name
my (%studname, @studsort);
my $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
my $sth2 = $dbh->prepare("select count(*) from studentwd where studnum = ?");
# check for existing attendance record
my $sth3 = $dbh->prepare("select attid from attend where studentid = ?
and absdate = ? and period = ? and subjsec = ? ");
my $sth = $dbh->prepare("select distinct studnum from eval where subjcode = ?");
my %eval; # eval{subjsec}{studnum} = 1;
my @notInSchool;
foreach my $subjsec ( keys %periods ) {
$sth->execute( $subjsec );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
while ( my $studnum = $sth->fetchrow ) {
# Get Name, and check for wd
$sth1->execute( $studnum );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my ($lastname, $firstname ) = $sth1->fetchrow;
$sth2->execute( $studnum );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my $wd = $sth2->fetchrow;
if ( $wd ) {
push @notInSchool, qq{$firstname $lastname ($studnum)};
# print qq{
\n};
next;
}
$studname{$studnum} = qq{$lastname, $firstname};
$studsort{"$lastname$firstname$studnum"} = $studnum;
$eval{$subjsec}{$studnum} = 1; # needed to track which students in which course for att
}
}
if ( not %eval ) {
print qq{
$fmtdate - No Courses Enrolled
\n};
return;
}
# SUMMARY: We now have periods scheduled today, and we have the students.
# Now Display the table for Attendance Entry
print qq{\n\n
\n};
print qq{
};
print qq{$datedata{$date} / Day $dayincycle
\n};
# First Row - Courses.
print qq{
};
foreach my $period ( sort keys %revperiods ) {
my @courses = @{ $revperiods{$period} };
foreach my $subjsec ( @courses ) {
print qq{
$smallcourses{$subjsec}
};
}
}
print qq{
\n};
# Second Row - Perfect Attendance
print qq{
};
print qq{
Perfect Attendance
\n};
foreach my $period ( sort keys %revperiods ) {
my @courses = @{ $revperiods{$period} };
foreach my $subjsec ( @courses ) {
print qq{
Period $period };
print qq{
};
#PA:subjsec:date:period - value of the 'name' of checkbox.
}
}
print qq{
\n};
# Following Rows - all students.
foreach my $key ( sort keys %studsort ) {
print qq{
};
my $studnum = $studsort{$key};
print qq{
$studname{$studnum}
};
foreach my $period ( sort keys %revperiods ) {
my @courses = @{ $revperiods{$period} };
foreach my $subjsec ( @courses ) {
if ( $eval{$subjsec}{$studnum} ) {
# Check for an existing attendance entry.
$sth3->execute($studnum,$date,$period, $subjsec );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my $attid = $sth3->fetchrow;
print qq{
\n};
}
# Students Not Enrolled in School
if ( @notInSchool ) {
print qq{
};
print qq{Not In School - Skipped \n};
foreach my $stud ( @notInSchool ) {
print qq{$stud \n};
}
print qq{
\n};
}
print qq{
\n};
return;
} # end of dailyAttendance (table)
#-------------
sub mkDateData {
#-------------
my ($jd, $weeks) = @_;
my (%datedata, @days);
# Build an array of ISO dates (YYYY-MM-DD) and a hash using them
# as keys to hash values of 'Mon Jan 6' format.
# If one week, then just 5 values, if two wk then 10, etc.
my $counter = 7;
if ( $weeks == 2 ) { $counter = 14; };
for ( 1..$counter ){
my ($yr,$mon,$day) = inverse_julian_day($jd);
if ( length( $mon ) == 1 ) { $mon = '0'. $mon; }
# if ( length( $day ) == 1 ) { $day = '0'. $day; }
my $dow = day_of_week($jd);
if ( $dow == 0 or $dow == 6 ) { # 0 is Sunday, 6 is Saturday
$jd++;
next;
} # skip Saturday, Sunday.
my $date = qq{$yr-$mon-$day};
# Check if the school is closed all day.
my $sth = $dbh->prepare("select id, dayfraction from dates where date = ?");
$sth->execute( $date );
my ( $id, $dayfrac ) = $sth->fetchrow;
if ( $dayfrac > 0.99 ) {
$jd++;
next;
} # skip if closed all day
push @days, $date;
$datedata{"$yr-$mon-$day"} = qq{$dowstd[$dow], $month[$mon] $day};
$jd++;
}
# print "DAYS:", @days, " \n";
return \%datedata, \@days;
} # end of mkDateData
#------------------
sub writeAttendance {
#------------------
#foreach my $key ( sort keys %arr ) {
# if ( not $arr{$key} ) { next; }
# print "K:$key V:$arr{$key} \n";
#}
# Strip passed userid.
my $userid = $arr{userid};
delete $arr{userid};
# reference values
my @fields = qw(studentid absdate reason period subjsec );
my %studname;
my $first = 1;
my $sth1 = $dbh->prepare("select count(*) from attend where studentid = ? and
absdate = ? and period = ? and subjsec = ?");
my $sth2 = $dbh->prepare("select lastname, firstname from student where studnum = ?");
foreach my $key ( keys %arr ) {
if ( not $arr{$key} ) { next; } # skip no reasons/PA have 1 values.
my ( $studnum,$subjsec,$date,$period ) = split(':',$key);
if ( $studnum eq 'PA' ) { next; }; # pa done below
my $reason = $arr{$key}; # reason is value of hash element.
# Get Student Name
if ( not exists $studname{$studnum} ) { # add it in.
$sth2->execute( $studnum );
if ( $DBI::errstr ) { print $DBI::errstr;die $DBI::errstr; }
my ($lastname, $firstname ) = $sth2->fetchrow;
if ( not $lastname ) { $lastname = qq{Name Missing}; }
$studname{$studnum} = qq{$lastname, $firstname};
}
my $name = $studname{$studnum};
$first = 0;
my @values;
my @fieldnames = @fields;
my @qst = qw(? ? ? ? ?); # 5 fields
push @values, $studnum, $date, $reason, $period, $subjsec;
# if ( $late ) {
# push @values, $late;
# push @fieldnames, 'late';
# push @qst, '?';
# }
my $fieldnames = join(',', @fieldnames);
my $qst = join(',', @qst);
# Check for a matching record, skip if so. (same student, date, period, course).
$sth1->execute( $studnum, $date, $period, $subjsec );
if ( $DBI::errstr ) { print $DBI::errstr;die $DBI::errstr; }
my $count = $sth1->fetchrow;
if ( $count ) {
print qq{
\n};
}
# Now do teacher attendance entries, including perfect attendance
# Insert the teacher attendance record
my $sth = $dbh->prepare("insert into tattend ( userid, attdate, currdate, subjects, periods )
values ( ?,?,now(),?,? )");
my $sth1 = $dbh->prepare("select count(*) from tattend where userid = ? and attdate = ?
and subjects = ? and periods = ?");
# Teacher Attendance Entry; loop through all passed values.
my %tchatt; # hold list of teacher attendance already done.
foreach my $key ( keys %arr ) {
if ( not $arr{$key} ) { next; } # skip no reasons
my ( $studnum,$subjsec,$date,$period ) = split(':',$key);
my $tchkey = qq{$userid:$subjsec:$date:$period};
# Check if added already to tattend (teacher attendance) table.
if ( not $tchatt{$tchkey} ) { # teacher att record not yet added.
# Add to tchatt hash and also tattend entry
print qq{