#!/usr/bin/perl
# Copyright 2001-2019 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 = ('Main' => 'Main',
'Error' => 'Error',
'Sync' => 'Sync',
'Continue' => 'Continue',
'Student' => 'Student',
'Start Date' => 'Start Date',
'End Date' => 'End Date',
'Records' => 'Records',
'Delete' => 'Delete',
'Nominal Roll' => 'Nominal Roll',
'Add' => 'Add',
'Not Found' => 'Not Found',
'Previous' => 'Previous',
'Year' => 'Year',
'Current' => 'Current',
'Check' => 'Check',
'Next Page' => 'Next Page',
);
use DBI;
use CGI;
use Time::JulianDay;
# use Number::Format qw(:all);
my $self = 'nrsync.pl';
my $cutoff = '-09-30'; # Sept 30; last day to be present for funding.
my @time = localtime(time);
my $year = $time[5] + 1900;
my $month = $time[4] + 1;
my $day = $time[3];
my $realdate = "$year-$month-$day"; # not overridden as below.
my $realdatejd = julian_day( split('-', $realdate));
if ( $month < 10 ) { $month = 10; $day= '01'; } # override to make date Oct 1.
my $currdate = "$year-$month-$day";
$curryear = $year;
$prevyear = $year - 1;
# $year--;
# my $startdate = "$year-09-29";
# my $enddate = "$year-10-01";
my $ppyear = $prevyear - 1; # previous previous year.
my $ppyeardate = $ppyear. '-08-01';
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. " $self: $@ \n";
die $lex{Error}. "$self: $@\n";
}
eval require "../../lib/libattend.pl";
if ( $@ ) {
print $lex{Error}. " $self: $@ \n";
die $lex{Error}. "$self: $@\n";
}
my $q = new CGI;
print $q->header;
my %arr = $q->Vars;
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
# Page Header
my $title = qq{$lex{Sync} $lex{'Nominal Roll'} $lex{Records}};
print qq{$doctype\n$title\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} ]\n};
print qq{
$title
\n};
if ( not $arr{page} ) {
showStartPage();
} elsif ( $arr{page} == 1 ) {
delete $arr{page};
syncRecords();
}
#----------------
sub showStartPage {
#----------------
# Form Start
print qq{\n};
print qq{\n};
exit;
} # end of showStartPage
#-------------
sub syncRecords {
#-------------
# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key} \n}; }
# Passed; prevyear, curryear, checkadd, checkdel
my %current;
my $sth = $dbh->prepare("select lastname, firstname, studnum from student");
$sth->execute;
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my ($lastname, $firstname, $studnum) = $sth->fetchrow ) {
$current{$studnum} = "$lastname, $firstname";
}
my ($checkadd, $checkdel);
if ( $arr{checkadd} ) {
$checkadd = qq{checked="checked"};
delete $arr{checkadd};
}
if ( $arr{checkdel} ) {
$checkdel = qq{checked="checked"};
delete $arr{checkdel};
}
my $cyeardate = $arr{curryear}. $cutoff;
my $pyeardate = $arr{prevyear}. $cutoff;
my $pyearjd = julian_day( split('-', $pyeardate));
my $cyearjd = julian_day( split('-', $cyeardate));
# Get previous year kids to add in to active hash
my $startjd = $pyearjd - 1;
my $endjd = $pyearjd + 1;
my $startdate = join('-', inverse_julian_day( $startjd ));
my $enddate = join('-', inverse_julian_day( $endjd ));
#print qq{Start:$startdate \n};
#print qq{End:$enddate \n};
# list of all students in nomroll or current.
my %active; # current students + previous year ones
my %master; # master list to check all.
%active = %current; # current students are all active, by definition
if ( $realdatejd > $cyearjd ) { # We're after Sept 30th, this year, add/remove kids to get Sept 30th kids
my $sth = $dbh->prepare("select * from transfer where date > '$cyeardate'");
$sth->execute;
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my $ref = $sth->fetchrow_hashref ) {
my %r = %$ref;
if ( $r{type} eq 'withdraw' ) { # add them in.
$active{$r{studnum}} = 1;
} else { # remove them
delete $active{$r{studnum}};
}
}
}
%current = %active; # Current will only be current, active have both current and prev year.
# Find students enrolled PREVIOUS Sept 30th, checking all transfer records.
my $sth = $dbh->prepare("select distinct studnum from transfer
where studnum != '' and studnum is not NULL and
to_days(date) > to_days('$pyeardate') and
to_days(date) <= to_days('$cyeardate')");
$sth->execute;
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my $studnum = $sth->fetchrow ) {
if ( not $active{$studnum} ) {
# print "New:$studnum \n";
$active{$studnum} = 1;
}
}
# Get Previous Kids list
my %previous;
foreach my $studnum ( keys %active ) {
if ( not $current{$studnum} ) { # not here anymore
$previous{$studnum} = 1;
}
}
my $currcount = keys %current;
my $prevcount = keys %previous;
print qq{
Current Students $currcount, Previous Students (no longer here) $prevcount
\n};
%master = %active; # start populating master.
# Load nominal roll student records
my %nomroll;
my $sth = $dbh->prepare("select studnum from student_inac where studnum != 0 and studnum is not NULL");
$sth->execute;
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my $studnum = $sth->fetchrow ) {
$nomroll{$studnum} = 1;
$master{$studnum} = 1; # also put into master, so we have ANY student including 2 years ago;
}
# Loop through master and delete any current students who already have a nominal roll record.
foreach my $studnum ( keys %master ) {
if ( $active{$studnum} and $nomroll{$studnum} ) { # in both lists
delete $active{$studnum};
delete $nomroll{$studnum};
}
}
# Students left in %active need to have NR records added.
# Students left in %nomroll need to be deleted from there (since no longer active)
my $sth = $dbh->prepare("select lastname, firstname, birthdate, provnum, treaty from studentall
where studnum = ?");
my $sth1 = $dbh->prepare("select * from transfer where studnum = ? order by date desc");
# Records to DELETE
if ( %nomroll ) {
print qq{\n};
} else { # no students to delete.
print qq{
};
print qq{};
print qq{No $lex{'Nominal Roll'} $lex{Records} To Delete
\n};
}
# print qq{ACTIVE \n};
# foreach my $key ( sort keys %active ) { print qq{K:$key V:$active{$key} \n}; }
# Records to ADD
if ( %active ) {
print qq{\n};
} else { # no students to add;
print qq{
};
print qq{};
print qq{No $lex{'Nominal Roll'} $lex{Records} To Add