#! /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); $dbh->{mysql_enable_utf8} = 1; # 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{
[ $lex{Main} ]
\n}; print qq{

$title

\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{
}; print qq{Test Grade $tgrade ($prevyear-$arr{schoolyear})
\n}; print qq{\n}; print qq{\n}; # header section. print qq{}; foreach my $strand ( @strands ) { if ( $strandcount{$strand} ) { # print IF we have that strand print qq{\n}; } } print qq{\n}; # Second Line: Desc; print qq{}; foreach my $strand ( @strands ) { if ( $strandcount{$strand} ) { # print IF we have that strand print qq{}; print qq{}; print qq{\n}; print qq{\n}; } } print qq{\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{\n}; if ( $nodata{$studnum} ) { print qq{\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{}; print qq{\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{}; print qq{\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{\n}; } elsif ( $pass{$studnum}{'count'} ) { # have count, but no passes print qq{\n}; } else { # print blank. print qq{\n}; } } # end of student loop print qq{
Hover on Column Titles to see text descriptions
Student}; print qq{$strandnames{$strand} ($strandcount{$strand})Score Averages
OutPre
Avg
Post
Avg
}; print qq{PassTotal
Outcomes
PrePostDifferencePass
$names{$studnum}No Data
$postcount$preavg$postavg$passString$posttotalcount$pretotalavg$posttotalavg$diff$passpercent% ($pass{$studnum}{'pass'}/$pass{$studnum}{'count'})
0% (0/$pass{$studnum}{'count'})

\n}; # Now Summary of all students in the grade print qq{\n}; print qq{\n}; # Heading print qq{\n}; # Data Section foreach my $strand ( @strands ) { my $avg = '0'; if ( $strandtotalcount{$strand} ) { $avg = format_number( $strandtotalsum{$strand} / $strandtotalcount{$strand}, 2); } print qq{\n}; } print qq{
Summary
StrandAverage Score
$strandnames{$strand} ($strandcount{$strand})$avg
\n}; } # end of grade loop print qq{\n}; exit; } # end of showReport #---------------- sub showStartPage { # Entry Values for Custom Script #---------------- my (@homerooms, @grades, @schoolyears ); # Get 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; } @homerooms = sort {$a <=> $b} @homerooms; # Get 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; # Get School Years $sth = $dbh->prepare("select distinct schoolyear from mathca_scores"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my $yr = $sth->fetchrow ) { push @schoolyears, $yr; } @schoolyears = reverse sort @schoolyears; # Start Form print qq{
\n}; print qq{\n}; print qq{\n}; # Select Grade print qq{}; print qq{\n}; # OR print qq{\n}; # Select Homeroom print qq{}; print qq{\n}; # School Year print qq{}; print qq{\n}; # Withdrawn print qq{}; print qq{\n}; =head # Sort Order print ""; print ""; print "\n"; =cut print qq{\n}; print qq{
$lex{'Select by'} $lex{Grade}
$lex{OR}
$lex{'Select by'} $lex{Homeroom}
$lex{'School Year'}
$lex{'Show Withdrawn'}
$lex{'Sort by'}
\n}; print qq{
\n}; exit; }