#!/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 = ('Main' => 'Main',
'Error' => 'Error',
'Reading Level' => 'Reading Level',
'Category' => 'Category',
'Name' => 'Name',
'Date' => 'Date',
'Author' => 'Author',
'Score' => 'Score',
'No Records Found' => 'No Records Found',
'Continue' => 'Continue',
'Select' => 'Select',
'Student' => 'Student',
'Chk' => 'Chk',
'Homeroom' => 'Homeroom',
'Grade' => 'Grade',
'Edit' => 'Edit',
'Tests' => 'Tests',
'Delete' => 'Delete',
'Start Date' => 'Start Date',
'End Date' => 'End Date',
'Equivalent' => 'Equivalent',
'Next Page' => 'Next Page',
'Report' => 'Report',
'Progress' => 'Progress',
'Starting Season' => 'Starting Season',
'Ending Season' => 'Ending Season',
'Age' => 'Age',
'Level' => 'Level',
'Test' => 'Test',
);
my %seasondates = ('Spring' => {'start' => '01-01', 'end' => '03-31' },
'Summer' => {'start' => '05-15', 'end' => '06-30' },
'Fall' => {'start' => '09-01', 'end' => '10-31' }
);
use DBI;
use CGI;
use Cwd;
use Number::Format qw(:all);
my $self = 'readRptProgress2.pl';
eval require "../../etc/admin.conf";
if ( $@ ) {
print "$lex{Error}: $self: $@ \n";
die "$lex{Error}: $self: $@\n";
}
# Get current dir so know what CSS to display and shift settings.
if ( getcwd() !~ /tcgi/ ) { # we are in cgi
$tchcss = $css;
$tchpage = $homepage;
$tchdownloaddir = $downloaddir;
$tchwebdownloaddir = $webdownloaddir;
}
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{Progress} $lex{Report} 2};
print qq{$doctype\n
\n\n};
}
=cut
if ( not $arr{page} ) {
showStartPage();
} elsif ( $arr{page} == 1 ) {
delete $arr{page};
selectStudents();
} elsif ( $arr{page} == 2 ) {
delete $arr{page};
if ( not $arr{startseason} ) { # no season; use dates.
showReportbyDate();
} else { # show report by season
showReport();
}
}
#----------------
sub showStartPage {
#----------------
my @tim = localtime(time);
my $year = $tim[5] + 1900;
my $month = $tim[4] + 1;
my $currdate = "$year-$month-$tim[3]";
# Find by Student Group
my (@homerooms, @grades, @seasons );
my $sth = $dbh->prepare("select distinct homeroom from student");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while ( my $hr = $sth->fetchrow ) {
push @homerooms, $hr;
}
# Grades
$sth = $dbh->prepare("select distinct grade from student");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while ( my $gr = $sth->fetchrow ) {
push @grades, $gr;
}
@grades = sort {$a <=> $b} @grades;
# Distinct Seasons
my (@seasons, %seasons);
$sth = $dbh->prepare("select distinct season from read_test where season is not NULL");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my %seasons;
while ( my $season = $sth->fetchrow ) {
my ($y,$s) = split('-',$season);
if ( $s eq 'Fall' ) { $season = "$y-ZZZ"; } # fix sorting order.
$seasons{$season} = 1; # Spring, Summer or Fall
}
@seasons = sort {$b cmp $a} keys %seasons; # with 'aaa' rather than 'Spring'.
=head
print qq{Local Seasons };
foreach my $s ( sort keys %seasons ) {
print qq{Season:$s \n};
}
print qq{ \n};
=cut
if ( @g_FeederSchools ) { # find the seasons available there
my %fs; # feeder seasons
foreach my $db ( keys %feeder ) {
foreach my $id ( sort keys %{ $feeder{$db} } ) {
$fs{ $feeder{$db}{$id}{season} } = 1;
}
}
foreach my $season ( keys %fs ) {
my ($y,$s) = split('-',$season);
if ( $s eq 'Spring' ) { $season = "$y-AAA"; }
$seasons{$season} = 1; # update the seasons hash.
}
#print qq{Feeder Seasons };
#foreach my $s ( sort keys %fs ) {
# print qq{Season:$s \n};
#}
} else { # end of feeder schools
print qq{
No Feeder Schools configured
\n};
}
print qq{\n};
print qq{\n};
print qq{\n};
exit;
} # end of showStartPage
#-------------------
sub showReportbyDate {
#-------------------
# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key} \n}; }
# passed: startseason, endseason, startdate,enddate, all student numbers;
delete $arr{startseason};
delete $arr{endseason};
my $startdate = $arr{startdate};
delete $arr{startdate};
my $enddate = $arr{enddate};
delete $arr{enddate};
my $group = $arr{group}; # Homeroom or Grade value
delete $arr{group};
# only student numbers left now
print qq{
$group
\n};
my %feeder; # %feeder{schooldb}{studnum} = ref;
if ( @g_FeederSchools ) {
# open links to those DRA records and suck in, converting them to provnum values.
# Get global RO credentials.
eval { require "$globdir/global.conf"; };
if ( $@ ) {
print $lex{Error}. " $self: $@ \n";
die $lex{Error}. "$self: $@\n";
}
foreach my $schooldb ( @g_FeederSchools ) {
# open a connection
my $dsn1 = "DBI:$dbtype:dbname=$dbase";
my $dbh1 = DBI->connect($dsn1,$guser,$gpassword);
# read all reading tests in along with student info.
my $sth = $dbh1->prepare("select s.lastname, s.firstname, s.grade, s.birthdate,
s.provnum, r.* from studentall s, read_test r
where s.studnum = r.studnum");
my $sth1 = $dbh1->prepare("select sum(score) from read_test_score where testid = ?");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while ( my $ref = $sth->fetchrow_hashref ) {
my $id = $ref->{id};
$sth1->execute( $id );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my $totalscore = $sth1->fetchrow;
if ( $totalscore ) {
$ref->{score} = $totalscore;
$feeder{$schooldb}{$id} = $ref;
}
}
}
}
# Load the reading library containing the scoreToGrade function.
eval require "../../lib/libreading.pl";
if ( $@ ) {
print $lex{Error}. " $self: $@ \n";
die $lex{Error}. "$self: $@\n";
}
# Get the students
my $sth = $dbh->prepare("select lastname, firstname, grade, provnum from student
where studnum = ?");
my ( %studname, %sort, %provnum);
foreach my $studnum ( keys %arr ) {
# Get Student Info
$sth->execute( $studnum );
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
my ( $lastname, $firstname,$grade, $provnum ) = $sth->fetchrow;
$studname{$studnum} = "$lastname, $firstname";
$sort{"$grade$lastname$firstname$studnum"} = $studnum;
$provnum{$studnum} = $provnum;
}
if ( not %sort ) {
print qq{