#!/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 = ('No Student(s) Found' => 'No Student(s) Found', 'Student Search' => 'Student Search', 'Main' => 'Main', 'Last,First/Last/Initials/Studnum', 'Last,First/Last/Initials/Studnum', 'Search' => 'Search', 'Cannot open' => 'Cannot open', 'Error' => 'Error', 'Cumulative Report' => 'Cumulative Report', 'School Year' => 'School Year', 'Select' => 'Select', 'Student' => 'Student', 'Current' => 'Current', 'Starting' => 'Starting', 'Grade' => 'Grade', 'School Year' => 'School Year', 'Attendance' => 'Attendance', 'Not Enrolled' => 'Not Enrolled', 'Birthdate' => 'Birthdate', 'Age' => 'Age', 'Discipline' => 'Discipline', 'No Records' => 'No Records', 'Reading' => 'Reading', 'Reading Level' => 'Reading Level', 'Name' => 'Name', 'Date' => 'Date', 'Tot' => 'Tot', 'EGr' => 'EGr', 'Homeroom' => 'Homeroom', 'or' => 'or', 'No Selection' => 'No Selection', 'Mathematics' => 'Mathematics', ); use DBI; use CGI; use Cwd; 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. } eval require "$configpath/etc/admin.conf"; 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/libreading.pl"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my $q = new CGI; print $q->header( -charset, $charset ); my %arr = $q->Vars; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; # print HTML heading my $title = $lex{'Cumulative Report'}; print qq{$doctype\n$title}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} ]\n}; print qq{

$title

\n}; # print "$remoteuser - $remotehost - $remotepassword
\n"; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectStudent(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; showReport(); } #------------- sub showReport { #------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # studnum and startdb passed. # Get the student information from current db my $sth = $dbh->prepare("select * from student where studnum = ?"); $sth->execute( $arr{studnum} ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; my %r = %$ref; # Get current date, in order to find student age. my @time = localtime(time); my $year = $time[5] + 1900; my $month = $time[4] + 1; my $currdate = "$year-$month-$time[3]"; my $tmp = calcAge($r{birthdate}, $currdate); my ($y,$m) = split ':', $tmp; my $age = $y. 'Y'. $m. 'M'; # Student Name, print qq{
$r{firstname} $r{lastname}
\n}; print qq{
$lex{Birthdate} $r{birthdate}
\n}; print qq{
$lex{Grade} $r{grade}
\n}; print qq{
$lex{Age} $age
\n}; my %mapdb2years; my $startyear = $arr{startdb}; $startyear =~ s/\D//g; my $currdb = $arr{startdb}; $currdb =~ s/\d//g; my ($sy,$ey) = split('-', $schoolyear); my $endyear = $ey - 1; # last year. my @schoolyears; if ( $startyear) { # must be previous year(s) for my $y ( $startyear..$endyear) { push @schoolyears, "$currdb$y"; $mapdb2years{"$currdb$y"} = $y; } } push @schoolyears, $currdb; $mapdb2years{$currdb} = $lex{Current}; # print "School Years:", @schoolyears, "
\n"; my %skipyear; # student not enrolled school years. # Attendance print qq{\n}; print qq{\n}; print qq{\n}; foreach my $db ( @schoolyears ) { my $schoolyear = $mapdb2years{$db}; if ( $schoolyear ne $lex{Current} ) { my $ty = $schoolyear - 1; $schoolyear = "$ty-$schoolyear"; } my $dbht; # temp in this loop if ( $db ne $currdb ) { # remote connection. my $dsnr = "DBI:mysql:database=$db;host=$remotehost"; $dbht = DBI->connect($dsnr,$remoteuser,$remotepassword); } else { $dbht = $dbh; # current db } my ($enrolled,$absent) = split(':', getStudentAttendance($dbht, $arr{studnum}) ); if ( not $enrolled ) { # not enrolled this year print qq{\n}; $skipyear{$db} = 1; } else { # we have enrollment my $present = $enrolled - $absent; my $perattend = format_number( $present / $enrolled * 100 ,2,2); print qq{\n}; } } # end of db loop print qq{
$lex{Attendance}
$lex{'School Year'}$lex{Attendance}
$schoolyear$lex{'Not Enrolled'}
$schoolyear$perattend%
\n}; # Update for any school years where student not enrolled. my @newdb; if ( %skipyear ) { # we have to update the @schoolyears. foreach my $db ( @schoolyears ) { if ( not $skipyear{$db} ) { push @newdb, $db; } } @schoolyears = @newdb; } # Discipline print qq{\n}; print qq{\n}; print qq{\n}; foreach my $db ( @schoolyears ) { my $schoolyear = $mapdb2years{$db}; if ( $schoolyear ne $lex{Current} ) { my $ty = $schoolyear - 1; $schoolyear = "$ty-$schoolyear"; } my $dbht; # temp in this loop if ( $db ne $currdb ) { # remote connection. my $dsnr = "DBI:mysql:database=$db;host=$remotehost"; $dbht = DBI->connect($dsnr,$remoteuser,$remotepassword); } else { $dbht = $dbh; # current db } # my $disccount = getStudentDiscipline($dbht, $arr{studnum}) ); my $sth = $dbht->prepare("select count(*) from disc_ident where studnum = ?"); $sth->execute( $arr{studnum} ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $disccount = $sth->fetchrow; if ( not $discount ) { # not enrolled this year $disccount = $lex{'No Records'}; } print qq{\n}; } # end of db loop print qq{
$lex{Discipline}
$lex{'School Year'}$lex{Discipline}
$schoolyear$disccount
\n}; # Reading print qq{\n\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Reading}
\n}; foreach my $db ( @schoolyears ) { my $schoolyear = $mapdb2years{$db}; if ( $schoolyear ne $lex{Current} ) { my $ty = $schoolyear - 1; $schoolyear = "$ty-$schoolyear"; } # print qq{

$schoolyear

\n}; my $dbht; # temp in this loop if ( $db ne $currdb ) { # remote connection. my $dsnr = "DBI:mysql:database=$db;host=$remotehost"; $dbht = DBI->connect($dsnr,$remoteuser,$remotepassword); } else { $dbht = $dbh; # current db } # Load schoolyear, schoolstart,schoolend dates my $sth = $dbht->prepare("select id, datavalue from conf_system where dataname = ?"); foreach my $field ( qw(schoolstart schoolend schoolyear) ) { $sth->execute( $field ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($id, $datavalue) = $sth->fetchrow ) { eval $datavalue; if ( $@ ) { print qq{$lex{Error}: $@
\n}; die "$lex{Error}: $@\n"; } } } # print qq{ $arr{studnum}, $schoolstart, $schoolend, $schoolyear, $dbht
\n}; showReading( $arr{studnum}, $schoolstart, $schoolend, $schoolyear, $dbht ); } # end of db loop print qq{\n
\n}; # MATH print qq{\n}; print qq{\n}; print qq{}; print qq{}; print qq{\n}; foreach my $db ( @schoolyears ) { my $schoolyear = $mapdb2years{$db}; if ( $schoolyear ne $lex{Current} ) { my $ty = $schoolyear - 1; $schoolyear = "$ty-$schoolyear"; } my $dbht; # temp in this loop if ( $db ne $currdb ) { # remote connection. my $dsnr = "DBI:mysql:database=$db;host=$remotehost"; $dbht = DBI->connect($dsnr,$remoteuser,$remotepassword); } else { $dbht = $dbh; # current db } # Get the grade of the student from student table. my $sth = $dbht->prepare("select grade from student where studnum = ?"); $sth->execute( $arr{studnum} ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $grade = $sth->fetchrow; # Number of outcomes. my $sth = $dbht->prepare("select count(*) from mathca_outcomes where grade = ?"); $sth->execute( $grade ); if ( DBI::errstr ) { print qq{$DBI::errstr
\n}; next; } my $outcomecount = $sth->fetchrow; # Get score total my $sth = $dbht->prepare("select sum(score) from mathca_scores where prepost = 'posttest' and studnum = ? and tgrade = ?"); $sth->execute( $arr{studnum}, $grade ); if ( DBI::errstr ) { print qq{$DBI::errstr
\n}; next; } my $totalscore = $sth->fetchrow; # Outcomes completed my $sth = $dbht->prepare("select count(*) from mathca_scores where prepost = 'posttest' and studnum = ? and tgrade = ?"); $sth->execute( $arr{studnum}, $grade ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $outcomescomplete = $sth->fetchrow; my $average = '0'; if ( $outcomescomplete ) { $average = format_number( $totalscore / $outcomescomplete, 2,2 ); } print qq{}; print qq{\n}; } # end of db loop print qq{
$lex{Mathematics}
$lex{'School Year'}Grade# Out# CompAverage
$schoolyear$grade$outcomecount$outcomescomplete$average
\n}; # end of MATH # Look through the databases and get enrollment records, and attendance records. # Get remote databases # my $remotedbase = 'information_schema'; # my $dsnr = "DBI:mysql:database=$remotedbase;host=$remotehost"; # my $dbhr = DBI->connect($dsnr,$remoteuser,$remotepassword); exit; } #----------------------- sub getStudentAttendance { #----------------------- my ($dbh, $studnum) = @_; use Time::JulianDay; # get school year and dates closed. my %closed; my $sth = $dbh->prepare("select date, dayfraction from dates"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($dt, $fraction ) = $sth->fetchrow ) { $closed{$dt} = $fraction; } # Get Student record to see if present, then get grade. my $sth = $dbh->prepare("select * from studentall where studnum = ?"); $sth->execute($studnum); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; if ( not $ref ) { return; } # not in this db. my $grade = $ref->{grade}; # Load schoolyear, ppd vars my $sth = $dbh->prepare("select id, datavalue from conf_system where dataname = ?"); foreach my $field ( qw(schoolstart schoolend schoolyear g_ppd absentString) ) { $sth->execute( $field ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($id, $datavalue) = $sth->fetchrow ) { eval $datavalue; if ( $@ ) { print qq{$lex{Error}: $@
\n}; die "$lex{Error}: $@\n"; } } } my $ppd = $g_ppd{$grade}; if ( not $ppd ) { print qq{

PPD not defined for grade: $grade

\n}; return; } # print qq{Start:$schoolstart End:$schoolend
\n}; # Get his/her enrollment blocks. (libattend library function) my @blocks = findEnrollmentBlocks($studnum, $schoolstart, $schoolend, $dbh); if ( not @blocks ) { return; } # no enrollment. my (%tattend, %attend); my $sth = $dbh->prepare("select * from attend where studentid = ?"); $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth->fetchrow_hashref ) { %r = %$ref; if ( $r{reason} =~ m/.*$absentString.*/ ) { # good record. $tattend{ $r{absdate} }{ $r{period} } = 1; # print qq{Reason:$r{reason} }; } } foreach my $date ( keys %tattend ) { # join them together. # Add up the periods my $total; foreach my $p ( keys %{ $tattend{$date}} ) { $total++; # we're just counting periods } $attend{$date} = $total; } # foreach my $key ( sort keys %attend ) { print qq{K:$key V:$attend{$key}
\n}; } my ($enrolled, $absentperiods); foreach my $block ( @blocks ) { my %b = %$block; # has start, end # my $startdate = $b{start}; my $startjd = julian_day( split('-', $b{start})); my $endjd = julian_day( split('-', $b{end})); foreach my $currjd ( $startjd..$endjd ) { my $dow = day_of_week($currjd); if ( $dow == 6 or $dow == 0 ) { next; } # skip weekends. my $date = join('-', inverse_julian_day( $currjd )); # print qq{Closed:$closed{$date} }; # Check Closed and Attendance if ( my $frac = $closed{$date} ) { my $open = 1 - $frac; $enrolled = $enrolled + $open; my $equivperiods = $open * $ppd; # how many periods is school open if ( $attend{$date} > $equivperiods ) { # print qq{
EQ Periods:$equivperiods
\n}; $attend{date} = $equivperiods; } # Can't be absent more than school is open. } else { $enrolled += 1; } $absentperiods += $attend{$date}; # print qq{D:$date \n}; } } # print qq{
ENrolled:$enrolled Absent Periods:$absentperiods
\n}; # foreach my $key ( sort keys %b ) { print qq{K:$key V:$b{$key}
\n}; } my $daysabsent = $absentperiods / $ppd; return "$enrolled:$daysabsent"; } #---------------- sub selectStudent { #---------------- #foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } #exit; # Passed startdb; my $fields = 'lastname, firstname, studnum, birthdate, grade'; my $sth; if ( $arr{student} ) { my $student = $arr{student}; # Setup the Search if ($student =~ /\d+/) { # we have a student number # $studentnumber = $student; $sth = $dbh->prepare("select $fields from student where studnum = ?"); $sth->execute( $student ); } else { # we have words hopefully with a comma my ( $lastname,$firstname ) = split /\,/, $student; $firstname =~ s/^\s*//; $lastname =~ s/^\s*//; if ( $lastname and $firstname ){ # both entered. $sth = $dbh->prepare("select $fields from student where lastname = ? and firstname = ?"); $sth->execute( $lastname, $firstname ); } elsif ($lastname and not $firstname){ # only lastname (no comma) if ( length($lastname) == 2 ){ # search by initials: fi, li. my $fi = substr($lastname,0,1). '%'; my $li = substr($lastname,1,1). '%'; $sth = $dbh->prepare("select $fields from student where lastname $sql{like} ? and firstname $sql{like} ?"); $sth->execute( $li, $fi ); } else { $sth = $dbh->prepare("select $fields from student where lastname = ? order by firstname"); $sth->execute( $lastname ); } } else { # print an error.... print qq{

$lex{Error}:$lex{'No Student(s) Found'}

\n}; print qq{\n}; exit; } } # Last Else } elsif ( $arr{grade} ) { $sth = $dbh->prepare("select $fields from student where grade = ? order by lastname, firstname"); $sth->execute( $arr{grade} ); } elsif ( $arr{homeroom} ) { $sth = $dbh->prepare("select $fields from student where homeroom = ? order by lastname, firstname"); $sth->execute( $arr{homeroom} ); } else { print qq{

$lex{Error}: $lex{'No Selection'}

\n}; print qq{\n}; exit; } if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $first = 1; while ( my $ref = $sth->fetchrow_hashref ) { my %r = %$ref; if ( $first ) { print qq{\n}; print qq{\n}; $first = 0; } print qq{\n}; print qq{\n}; } if ( $first ) { print qq{

$lex{Error}:$lex{'No Student(s) Found'}

\n}; print qq{\n}; exit; } else { print qq{
$lex{Student}$lex{Grade}
$r{lastname}, $r{firstname}$r{grade}
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
\n}; } print qq{\n}; exit; } #---------------- sub showStartPage { #---------------- # Get remote databases my $remotedbase = 'information_schema'; my $dsnr = "DBI:mysql:database=$remotedbase;host=$remotehost"; my $dbhr = DBI->connect($dsnr,$remoteuser,$remotepassword); my $sth = $dbhr->prepare("select distinct table_schema from TABLES order by table_schema"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my %remotedb; while ( my $db = $sth->fetchrow ) { if ( $db eq 'mysql' or $db eq 'information_schema' or $db eq 'performance_schema' ) { next; } if ( $db =~ m/$dbase/ ) { $remotedb{$db} = 1; } } # Get the grades 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 ) { push @grades, $gr; } # Get the homerooms. my @homerooms; 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; } print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; foreach my $db ( sort keys %remotedb ) { print qq{\n}; } print qq{\n}; # Divider print qq{\n}; # Student Info print qq{\n}; print qq{\n}; print qq{\n}; # Divider # print qq{\n}; # Grades print qq{\n}; print qq{\n}; # Homerooms print qq{\n}; print qq{\n}; print qq{
$lex{Select} $lex{Starting} $lex{'School Year'}
$db
$lex{Current}
$lex{Student}\n}; print qq{
}; print qq{$lex{'Last,First/Last/Initials/Studnum'}
$lex{or}
$lex{Grade} }; print qq{
$lex{or}
$lex{Homeroom} }; print qq{
\n}; print qq{
\n}; print qq{\n}; exit; } #=========== Subsidiary, Imported functions found here. #---------- sub calcAge { #---------- # Passed (birthdate, $currdate) my ( $birthdate, $currdate ) = @_; my ($byear,$bmonth,$bday) = split /-/,$birthdate; my ($cyear,$cmonth,$cday) = split /-/,$currdate; my $age = $cyear - $byear; my $month = $cmonth - $bmonth; #print qq{BD: $birthdate CD: $currdate Age: $age MO:$month
\n}; if ($cmonth < $bmonth){ $month = $month + 12; if ($cday < $bday){ $month--;} $age--; } elsif ($cmonth == $bmonth and $cday < $bday){ $age--; $month = 11; } elsif ($cmonth > $bmonth and $cday < $bday) { $month--; } if ( $age < 0 or $age > 100 ) { $age = 0; $month = 0; } return "$age:$month"; } #-------------- sub showReading { #-------------- my ($studnum, $startdate, $enddate, $schoolyear, $dbh ) = @_; # Get student grade. my $sth = $dbh->prepare("select grade from student where studnum = ?"); $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $grade = $sth->fetchrow; # print "SN:$studnum GR:$grade
\n"; # Get the readling levels for this year; my @readinglevels; $sth = $dbh->prepare("select distinct readlevel from read_test where studnum = ? and to_days( tdate ) >= to_days('$startdate') and to_days( tdate ) <= to_days('$enddate')"); $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $rl = $sth->fetchrow ) { push @readinglevels, $rl; } @readinglevels = sort {$a <=> $b} @readinglevels; # print "RL:@readinglevels
\n"; my $first = 1; foreach my $readinglevel ( @readinglevels ) { if ( $first ) { print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; $first = 0; } my $sth = $dbh->prepare("select distinct rs.name, rs.category, rs.seq from read_test_score as rs, read_test as rt where rs.testid = rt.id and readlevel = ?"); my %objectives; $sth->execute( $readinglevel ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ( $name, $category, $seq ) = $sth->fetchrow ) { $objectives{ $seq } = $category. '::'. $name; } # Set Index values for all objectives my $count = 0; my $startcount; my %skip; my $currcat = ''; # Print out First Heading Line my $colspan = 4; # print qq{\n}; foreach my $key ( sort { $a <=> $b } keys %objectives ) { # numeric sort my ( $category, $name ) = split(/::/, $objectives{$key} ); $oldcat = $currcat; $currcat = $category; if ( $oldcat ne $currcat and $count ) { $diff = $count - $startcount; # print qq{\n}; $skip{$oldcat} = $diff; $startcount = $count; } $count++; } $diff = $count - $startcount; $skip{$currcat} = $diff; # print qq{\n}; # Print Out Second Heading Line # print qq{\n}; # SQL Query of global reading level table. my $sth1 = $dbh->prepare("select id, help1 from read_level where readlevel = ? and category = ? and name = ?"); foreach my $key ( sort { $a <=> $b } keys %objectives ) { # numeric sort my ( $category, $name ) = split(/::/, $objectives{$key} ); # Get the record id and help for this... $sth1->execute( $readinglevel, $category, $name ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ($id, $help1 ) = $sth1->fetchrow; # print qq{\n}; } # print qq{\n}; # Now loop through all students printing results; setup queries first $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); $sth1 = $dbh->prepare("select id, tdate, $dratype from read_test where studnum = ? and readlevel = ? and to_days( tdate ) >= to_days( '$startdate' ) and to_days( tdate ) <= to_days( '$enddate') order by tdate $sortorder"); # get tests my $sth2 = $dbh->prepare("select category, name, score, seq from read_test_score where testid = ? order by seq"); # foreach my $studnum ( @students ) { # Get Name # $sth->execute( $studnum ); # my ( $lastname, $firstname ) = $sth->fetchrow; # if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } # Get Tests $sth1->execute( $studnum, $readinglevel ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $trows = $sth1->rows; # if $onlylatest, limit to 1 test # $onlylatest = 1; # added # if ( $onlylatest and $trows > 1 ) { $trows = 1; } for ( 1 .. $trows ) { my ( $testid, $tdate, $dratype ) = $sth1->fetchrow; print qq{}; # Loop through all the items. $sth2->execute( $testid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my @studata = (); my $total = 0; my $count = 0; while ( my ( $category, $name, $score, $seq ) = $sth2->fetchrow ) { my ( $tcat, $tname ) = split(/::/, $objectives{ $seq } ); if ( $tcat ne $category or $tname ne $name ) { # error print qq{$lex{Error} Mismatch: $tcat - $category OR $tname - $name
\n}; next; } $studata[$seq] = $score; $total += $score; $count++; } # Equivalent Grade my $equivgrade = scoreToGrade( $total, $readinglevel, $dratype ); print qq{\n}; } # end of test print loop } # end of readlevel loop if ( not $first ) { print qq{
$schoolyear
Read
Level		$lex{Date}Equiv
Grade		Stud
Grade
$lex{'Reading Level'} $readinglevel$oldcat$currcat
$lex{Name}$lex{Date}$lex{Tot}$lex{EGr}}; if ( $help1 ) { # print qq{}; # print qq{$name}; } else { # print $name; } # print qq{
$readinglevel}. fmtDate($tdate). qq{$equivgrade$grade

\n}; } return; } # end of showReadingLite #------------------- sub showReadingLevel { #------------------- my ( $readinglevel, $onlylatest, $stud_ref, $startdate, $enddate, $sortorder, $dbh ) = @_; if ( $sortorder eq 'ascending' ) { $sortorder = ''; # normal ascending sort } else { $sortorder = 'desc'; # descending sort } my @students = @$stud_ref; my $sth = $dbh->prepare("select distinct rs.name, rs.category, rs.seq from read_test_score as rs, read_test as rt where rs.testid = rt.id and readlevel = ?"); my %objectives; $sth->execute( $readinglevel ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ( $name, $category, $seq ) = $sth->fetchrow ) { $objectives{ $seq } = $category. '::'. $name; } # Set Index values for all objectives my $count = 0; my $startcount; my %skip = (); my $currcat = ''; # Print out First Heading Line my $colspan = 4; print qq{\n}; print qq{\n}; foreach my $key ( sort { $a <=> $b } keys %objectives ) { # numeric sort my ( $category, $name ) = split(/::/, $objectives{$key} ); $oldcat = $currcat; $currcat = $category; if ( $oldcat ne $currcat and $count ) { $diff = $count - $startcount; print qq{\n}; $skip{$oldcat} = $diff; $startcount = $count; } $count++; } $diff = $count - $startcount; $skip{$currcat} = $diff; print qq{\n}; # Print Out Second Heading Line print qq{\n}; # SQL Query of global reading level table. my $sth1 = $dbh->prepare("select id, help1 from read_level where readlevel = ? and category = ? and name = ?"); foreach my $key ( sort { $a <=> $b } keys %objectives ) { # numeric sort my ( $category, $name ) = split(/::/, $objectives{$key} ); # Get the record id and help for this... $sth1->execute( $readinglevel, $category, $name ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ($id, $help1 ) = $sth1->fetchrow; print qq{\n}; } print qq{\n}; # Now loop through all students printing results; setup queries first $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); $sth1 = $dbh->prepare("select id, tdate, dratype from read_test where studnum = ? and readlevel = ? and to_days( tdate ) >= to_days( '$startdate' ) and to_days( tdate ) <= to_days( '$enddate') order by tdate $sortorder"); # get tests my $sth2 = $dbh->prepare("select category, name, score, seq from read_test_score where testid = ? order by seq"); foreach my $studnum ( @students ) { # Get Name $sth->execute( $studnum ); my ( $lastname, $firstname ) = $sth->fetchrow; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } # Get Tests $sth1->execute( $studnum, $readinglevel ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $trows = $sth1->rows; # if $onlylatest, limit to 1 test if ( $onlylatest and $trows > 1 ) { $trows = 1; } for ( 1 .. $trows ) { my ( $testid, $tdate, $dratype ) = $sth1->fetchrow; print qq{}; print qq{\n}; # Loop through all the items. $sth2->execute( $testid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my @studata = (); my $total = 0; my $count = 0; while ( my ( $category, $name, $score, $seq ) = $sth2->fetchrow ) { my ( $tcat, $tname ) = split(/::/, $objectives{ $seq } ); if ( $tcat ne $category or $tname ne $name ) { # error print qq{$lex{Error}- Mismatch: $tcat - $category OR $tname - $name
\n}; next; } $studata[$seq] = $score; $total += $score; $count++; } =head # Print the average my $average; if ( $count ) { $average = format_number( $total / $count, 2,2 ); } else { $average = 0; } =cut print qq{\n}; # was $average, from above. # Equivalent Grade #if ( $readinglevel >= 40 ) { my $equivgrade = scoreToGrade( $total, $readinglevel, $dratype ); print qq{\n}; #} # Now do the numeric print. my %class = ( 1 => 'r', 2 => 'y', 3 => 'b', 4 => 'g' ); foreach my $key ( sort { $a <=> $b } keys %objectives ) { # numeric sort my $val = $studata[ $key ]; my $cl = $class{ $val }; print qq{}; } print qq{\n}; } # end of test print loop } # end of student loop. print qq{
$lex{'Reading Level'} $readinglevel$oldcat$currcat
$lex{Name}$lex{Date}$lex{Tot}$lex{EGr}}; if ( $help1 ) { print qq{}; print qq{$name}; } else { print qq{$name}; } print qq{
$lastname, $firstname}. fmtDate($tdate). q{$total$equivgrade$val

\n}; return; } #---------- sub fmtDate { #---------- my ( $year, $mon, $day ) = split '-', shift; return "$year-$s_month[$mon]-$day"; }