#! /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',
'Continue' => 'Continue',
'Homeroom' => 'Homeroom',
'Grade' => 'Grade',
'Select by' => 'Select by',
'Error' => 'Error',
'Sort by' => 'Sort by',
'Name' => 'Name',
'Common Math Assessment' => 'Common Math Assessment',
'Report' => 'Report',
'OR' => 'OR',
'No Selection' => 'No Selection',
'School Year' => 'School Year',
'Show Withdrawn' => 'Show Withdrawn',
);
my $self = 'cmaRpt2.pl';
use DBI;
use CGI;
use Cwd;
use Number::Format qw(:all);
my @strands = qw(P N SS SP);
my %strandnames = ('P' => 'Patterns and Relations',
'N' => 'Numbers and Operations',
'SS' => 'Shape and Space',
'SP' => 'Stats and Prob'
);
my $configpath = '../../..';
if ( getcwd() =~ /tcgi/ ){ # we are in tcgi
$configpath = '../..';
}
eval require "$configpath/etc/admin.conf";
if ( $@ ) {
print $lex{Error}. " $@ \n";
die $lex{Error}. " $@\n";
}
my $q = new CGI;
print $q->header( -charset, $charset );
my %arr = $q->Vars;
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $iddst) = localtime(time);
$year = $year + 1900;
$wday++; $mon++;
my $currdate = "$dow[$wday], $month[$mon] $mday, $year";
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
# Get current dir so know what CSS to display;
if ( getcwd() =~ /tcgi/ ){ # we are in tcgi
$css = $tchcss;
$homepage = $tchpage;
}
my $title = "$lex{'Common Math Assessment'} $lex{Report} 2 - $schoolname";
print qq{$doctype\n$title\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{
\n};
if ( not $arr{page} ) {
showStartPage();
} elsif ( $arr{page} == 1 ) {
delete $arr{page};
showReport();
}
#-------------
sub showReport {
#-------------
# foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key} \n"; }
# Passed: grade, homeroom, schoolyear;
my $studenttable = 'student';
if ( $arr{showwithdrawn} ) {
$studenttable = 'studentwd';
}
# Select the students of interest.
my ($select, $selectval, @grades, $classname);
if ( $arr{grade} ) {
$select = "where grade = ?";
$selectval = $arr{grade};
push @grades, $arr{grade};
$classname = "Grade $arr{grade}";
} elsif ( $arr{homeroom} ) {
$select = "where homeroom = ? ";
$selectval = $arr{homeroom};
$classname = "Homeroom $arr{homeroom}";
my $sth = $dbh->prepare("select distinct grade from student where homeroom = ?
and grade != '' and grade is not NULL order by grade");
$sth->execute( $arr{homeroom} );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $gr = $sth->fetchrow ) {
push @grades, $gr;
}
} else {
print qq{
$lex{'No Selection'}
\n};
print qq{\n};
exit;
}
# Select the students
my %students;
my $sth = $dbh->prepare("select lastname, firstname, studnum, grade from $studenttable
$select order by lastname, firstname");
$sth->execute( $selectval );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $ref = $sth->fetchrow_hashref ) {
# my %r = %$ref;
my $studnum = $ref->{studnum};
$students{$studnum} = $ref;
} # we now have all students in %students - $students{$studnum} = $ref;
print qq{
$classname - $currdate
\n};
# Build outcomes data structure
my %outcomes; # lists outcomes.
my %odesc; # outcomes description.
my $sth = $dbh->prepare("select * from mathca_outcomes");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $ref = $sth->fetchrow_hashref ) {
my %r = %$ref;
my $oid = $r{oid};
my $grade = $r{grade};
my ($cat, $seq) = split(/\./, $oid);
$cat =~ s/$grade$//; # remove grade
# print qq{OID:$oid GR:$grade CAT:$cat SEQ:$seq DESC:$r{odesc} \n};
$outcomes{$grade}{$cat}{$seq} = $oid;
$odesc{$oid} = $r{odesc};
} # Done building data structure of outcomes as above; (oid like N7.1)
# select the tgrades for this group of students in this school year.
my %tgrades;
my $sth = $dbh->prepare("select distinct tgrade from mathca_scores where studnum = ? and schoolyear = ?");
foreach my $studnum ( keys %students ) {
$sth->execute( $studnum, $arr{schoolyear} );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my $tgrade = $sth->fetchrow ) {
$tgrades{$tgrade} = 1;
}
}
foreach my $tgrade ( keys %tgrades ) {
# Now build a structure for this tgrade
my %strandcount; # $catcount{category} = number in this category.
foreach my $cat ( sort keys %{ $outcomes{$tgrade} } ) {
foreach my $seq ( sort keys %{ $outcomes{$tgrade}{$cat} } ) {
if ( $seq > $strandcount{$cat} ) { $strandcount{$cat} = $seq; }
}
}
my %withdrawn;
my %data; # holds all data $data{studnum}{outcome}{prepost} = score;
my @students; # provides order of students
my %pass; # $pass{studnum} = count of passes ( >= 3)
my %strandpass;
my %nodata; # nodata{studnum}; track kids without data.
my %names; # store student names;
my %tdates; # store test dates for outcomes and pre/post $tdates{outcome}{pretest/posttest};
my %grades; # test grade for this student ( $grades{studnum} = grade; ) from tgrade value.
# Get Student Data
my $sth1 = $dbh->prepare("select prepost, outcome, score, tdate from mathca_scores
where schoolyear = ? and studnum = ? order by tdate");
# Queries for Withdrawn and Having Data
my $sth2 = $dbh->prepare("select count(*) from studentwd where studnum = ?");
my $sth3 = $dbh->prepare("select count(*) from mathca_scores
where schoolyear = ? and studnum = ?");
my %sort;
# Loop through all students; build data structure.
foreach my $studnum ( keys %students ) {
my $ref = $students{$studnum};
my %r = %$ref;
# Have Data?
$sth3->execute($arr{schoolyear}, $studnum );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $datacount = $sth3->fetchrow;
# print qq{DC:$datacount - $studnum $students{$studnum}->{lastname} $students{$studnum}->{firstname} \n};
if ( not $datacount ) {
# print qq{Nodata:$studnum $students{$studnum}->{lastname} \n};
$nodata{$studnum} = 1;
}
# print qq{SN:$studnum DATACOUNT:$datacount \n};
# Check for withdrawn and having any data this year.
if ( $arr{showwithdrawn} ) { # check if student is withdrawn
# Withdrawn?
$sth2->execute( $studnum );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $wdcount = $sth2->fetchrow;
if ( $wdcount > 0 and $datacount < 1 ) { # withdrawn and no data
next;
}
}
push @students, $studnum;
$names{$r{studnum}} = "$r{lastname}, $r{firstname}";
$sort{"$r{lastname}$r{firstname}$studnum"} = $studnum;
# Get this student's data
$sth1->execute( $arr{schoolyear}, $studnum );
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while ( my ($prepost, $outcome, $score, $tdate) = $sth1->fetchrow ) {
# print qq{PP:$prepost - $outcome - $score - $tdate \n};
# Store passes;
if ( $prepost eq 'posttest' ) {
if ( $score >= 3 ) {
$pass{$studnum}{'pass'}++;
$strandpass{$studnum}{$outcome}{'pass'}++;
}
$pass{$studnum}{'count'}++;
$strandpass{$studnum}{$outcome}{'count'}++;
}
$data{$studnum}{$outcome}{$prepost} = $score;
# print "DATA - $studnum - $outcome - $prepost -- $score \n";
}
} # end of student loop
# use Data::Dumper;
# print Dumper %data;
# exit;
my $prevyear = $arr{schoolyear} - 1;
print qq{
};
foreach my $strand ( @strands ) {
if ( $strandcount{$strand} ) { # print IF we have that strand
print qq{
Out
};
print qq{
Pre Avg
};
print qq{
Post Avg
\n};
print qq{
};
print qq{Pass
\n};
}
}
print qq{
Total Outcomes
Pre
Post
Difference
Pass
\n};
# used for summary stats at the end;
my (%strandtotalcount, %strandtotalsum );
# Loop through each student, finding averages for each strand
foreach my $key ( sort keys %sort ) {
my $studnum = $sort{$key};
my ($pretotalcount, $pretotalsum, $posttotalcount, $posttotalsum);
print qq{
$names{$studnum}
\n};
if ( $nodata{$studnum} ) {
print qq{
No Data
\n};
next;
}
foreach my $strand ( @strands ) {
if ( not $strandcount{$strand} ) { next; } # skip any strands not covered in this grade.
# Loop through all tests and find averages for this strand of outcomes.
my ( $preavg, $presum, $precount, $postavg,$postsum, $postcount, $passsum, $passcount );
foreach my $seq ( sort keys %{ $outcomes{$tgrade}{$strand} } ) {
my $outcome = $outcomes{$tgrade}{$strand}{$seq};
# print "SN:$studnum Strand:$strand SEQ:$seq OUT:$outcome \n";
$passsum += $strandpass{$studnum}{$outcome}{pass};
$passcount += $strandpass{$studnum}{$outcome}{count};
my $pretest = $data{$studnum}{$outcome}{'pretest'};
my $posttest = $data{$studnum}{$outcome}{'posttest'};
# print "SN:$studnum OUT:$outcome Pre:$pretest Post:$posttest \n";
if ( $pretest and $posttest or
( $tgrade eq '2' or $tgrade eq '1' or $tgrade eq 'K' or $tgrade eq 'PK')) {
$presum += $pretest;
$precount++;
$postsum += $posttest;
$postcount++;
} else {
next;
}
} # end of outcome
if ( $precount ) {
$preavg = format_number( $presum / $precount, 2);
$pretotalcount += $precount;
$pretotalsum += $presum;
}
if ( $postcount ) {
$postavg = format_number( $postsum / $postcount, 2);
$posttotalcount += $postcount;
$posttotalsum += $postsum;
}
my $passString;
if ( $passcount ) {
$passString = "$passsum / $passcount";
}
$strandtotalcount{$strand} += $postcount;
$strandtotalsum{$strand} += $postsum;
print qq{
$postcount
$preavg
};
print qq{
$postavg
$passString
\n};
} # end of this strand
# now totals for this student
my ($pretotalavg, $posttotalavg);
if ( $pretotalcount ) {
$pretotalavg = format_number( $pretotalsum / $pretotalcount, 2);
}
if ( $posttotalcount ) {
$posttotalavg = format_number( $posttotalsum / $posttotalcount, 2);
}
my $diff = format_number( $posttotalavg - $pretotalavg, 2);
print qq{
$posttotalcount
$pretotalavg
};
print qq{
$posttotalavg
$diff
\n};
# Passes;
my $passpercent;
if ( $pass{$studnum}{'count'} and $pass{$studnum}{'pass'} ) {
$passpercent = format_number( $pass{$studnum}{'pass'} * 100 / $pass{$studnum}{'count'}, 2);
}
if ( $passpercent ) {
print qq{