#!/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',
'Class Reading Report' => 'Class Reading Report',
'Reading Level' => 'Reading Level',
'Name' => 'Name',
'Date' => 'Date',
'Continue' => 'Continue',
'Select' => 'Select',
'Student' => 'Student',
'Homeroom' => 'Homeroom',
'Grade' => 'Grade',
'Blank=All' => 'Blank=All',
'No Students Found' => 'No Students Found',
'Show Only Latest Test' => 'Show Only Latest Test',
'Gr' => 'Gr',
'Levels' => 'Levels',
'Score' => 'Score',
'Start Date' => 'Start Date',
'End Date' => 'End Date',
'EGr' => 'EGr',
'Students' => 'Students',
'Starting Season' => 'Starting Season',
'Ending Season' => 'Ending Season',
'Select by' => 'Select by',
);
# Grade => Start:End Reading Level
my %levelExpect = ( K => '0:3', 1 => '3:16', 2 => '16:28', 3 => '28:38', 4 => '40:50',
5 => '50:60', 6 => '60:70', 7 => '70:80', 8 => '80:80' );
my %shortCategory = ( 'Oral Fluency' => 'OrFlu', 'Reading Engagement' =>'RdEg',
'Comprehension' => 'Comp', 'Printed Language Concepts' => 'pLgCcp');
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 Number::Format qw(:all);
use Cwd;
use Time::JulianDay;
my $self = 'feederReadingView.pl';
my @time = localtime(time);
my $year = $time[5] + 1900;
my $month = $time[4] + 1;
my $currdate = "$year-$month-$time[3]";
# 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";
}
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";
}
}
# Load global user and password
require "$globdir/global.conf" or die "Cannot open global.conf!\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{'Class Reading Report'} - $schoolname};
print qq{$doctype\n$title\n};
print qq{
\n};
print qq{
$chartype\n\n};
# Show Grade and Reading Levels Expected.
print qq{
\n};
print qq{[ $lex{Main} \n};
if ( not $teachermode ) {
print qq{| SSP \n};
}
print qq{]\n
$title
\n};
if ( not $arr{page} ) {
selectSchool();
} elsif ( $arr{page} == 1) {
delete $arr{page};
selectGroup();
} elsif ( $arr{page} == 2) {
delete $arr{page};
showReport();
}
#----------
sub fmtDate {
#----------
my ( $year, $mon, $day ) = split '-', shift;
return "$year-$s_month[$mon]-$day";
}
#----------------
sub showStartPage {
#----------------
# Get global reading levels.
my %readinglevel;
my @readinglevel;
my $sth = $dbh->prepare("select distinct readlevel from read_level
where readlevel is not NULL");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while ( my $rl = $sth->fetchrow ) {
$readinglevel{$rl} = 1;
}
@readinglevel = sort { $a <=> $b } keys %readinglevel;
# Get grades and homerooms
my (@homerooms, @grades );
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;
}
@homerooms = sort {$a <=> $b} @homerooms;
# Grades
$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 ) {
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
# Form Start - Student Group
print qq{\n};
print qq{\n};
exit;
} # end of showStartPage
#-------------
sub showReport {
#-------------
# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key} \n}; }
my $dbtype = 'mysql';
my $dsn = "DBI:$dbtype:dbname=$arr{db}";
my $dbh = DBI->connect($dsn,$guser,$gpassword);
# Load the reading library containing the scoreToGrade function.
eval require "../../lib/libreading.pl";
if ( $@ ) {
print $lex{Error}. " $self: $@ \n";
die $lex{Error}. "$self: $@\n";
}
# Spring = 1, Summer = 2, Fall = 3
my %seasonText2Num = ('Spring' => 1, 'Summer' => 2, 'Fall' => 3 );
my %seasonNum2Text = reverse %seasonText2Num;
my ($sy,$ss) = split('-', $arr{startseason});
my $startdate = $seasondates{$ss}{start};
$startdate = qq{$sy-$startdate};
my ($ey,$es) = split('-', $arr{endseason} );
my $enddate = $seasondates{$es}{end};
$enddate = qq{$ey-$enddate};
# print qq{Start Date:$startdate End Date:$enddate \n};
my $first = 1;
my (@seasons, %seasons, %seasonsRev);
foreach my $y ( $sy..$ey ) {
foreach my $s ( 1..3 ) {
if ( $first and $seasonNum2Text{$s} ne $ss ) {
next ; # skip until we get a start;
} else { $first = 0; };
push @seasons, "$y-$s";
$seasons{"$y-$s"} = "$y-$seasonNum2Text{$s}";
if ( $y == $ey and $seasonNum2Text{$s} eq $es ) {
last;
}
}
}
%seasonsRev = reverse %seasons; # Rev version has text to numberic matching.
=head
foreach my $season ( @seasons ) {
print qq{Season:$season \n};
print qq{Text:$seasons{$season} \n};
}
=cut
delete $arr{startseason};
delete $arr{endseason};
my $studtable = 'studentwd';
if ( $arr{showcurrent} ) {
$studtable = 'studentall';
}
my ($select,$selectvalue); # value of homeroom or grade
my %studname;
my %ReadingLevel;
# Feeder School Name
print qq{
$dbase{$arr{db}}
\n};
# Display Group of students (or entire school)
print qq{
};
if ( $arr{grade} ) {
print qq{$lex{Grade} $arr{grade}};
$selectvalue = $dbh->quote($arr{grade});
$select = "where grade = $selectvalue";
} elsif ( $arr{homeroom} ) {
print qq{$lex{Homeroom} $arr{homeroom}};
$selectvalue = $dbh->quote( $arr{homeroom} );
$select = "where homeroom = $selectvalue";
} else {
print qq{All Students\n};
}
# Get Teacher Name if a homeroom
if ( $arr{homeroom} ) {
my $sth = $dbh->prepare("select lastname, firstname from staff as s, staff_multi as sm
where sm.userid = s.userid and field_name = 'homeroom' and field_value = ?");
$sth->execute( $arr{homeroom} );
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
my ( $lastname, $firstname ) = $sth->fetchrow;
print qq{ – $firstname $lastname};
}
print qq{
\n};
# Get Students with this/these seasons
my $sth = $dbh->prepare("select studnum from read_test where season = ?");
my %students;
foreach my $sn ( @seasons ) { # Numeric Version ( 2017-1 )
my $season = $seasons{$sn}; # now a text version to match values in DB.
# print qq{Season SN:$sn $season \n};
$sth->execute( $season );
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my $studnum = $sth->fetchrow ) {
$students{$studnum} = 1;
}
}
# Now get student names, grade/homeroom selection and reading levels
my $sth = $dbh->prepare("select lastname, firstname, studnum from $studtable $select");
my $sth1 = $dbh->prepare("select id, season, readlevel from read_test where
studnum = ? order by tdate desc");
$sth->execute;
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my ($lastname, $firstname, $studnum) = $sth->fetchrow ) {
if ( not $students{$studnum} ) { next; } # no tests, so skip.
$studname{$studnum} = "$lastname$firstname";
# Get tests in season range.
$sth1->execute($studnum);
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my ($id, $season,$readlevel) = $sth1->fetchrow ) {
# print qq{ID:$id S:$season RL:$readlevel Studnum:$studnum \n};
if ( $seasonsRev{$season} ) { # we have a hit
# print qq{SN:$studnum RL:$readlevel Season:$season \n};
$ReadingLevel{$studnum}{$readlevel} = "$id:$season:$readlevel";
if ( $arr{onlylatest} ) { last; }
}
}
} # end of student loop
=head
# Check Data
foreach my $studnum ( sort keys %ReadingLevel ) {
foreach my $readlevel ( sort keys %{ $ReadingLevel{$studnum} } ) {
my ($id, $season,$readlevel) = split ':', $ReadingLevel{$studnum}{$readlevel};
print qq{$studname{$studnum} $studnum RL:$readlevel Season:$season \n};
}
}
=cut
# look for kids with particular reading level, remove others.
if ( $arr{readlevel} ) {
foreach my $studnum ( keys %ReadingLevel ) {
foreach my $readlevel ( sort keys %{ $ReadingLevel{$studnum} } ) {
# my ($id,$season,$readlevel) = split(':', $ReadingLevel{$studnum}{"$arr{readlevel}"} );
if ( $readlevel ne $arr{readlevel} ) {
delete $ReadingLevel{$studnum}{$readlevel};
}
}
}
}
if ( not %ReadingLevel ) {
print qq{