#! /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 = 'cmaRpt4.pl'; use DBI; use CGI; use Cwd; use Number::Format qw(:all); use Time::JulianDay; 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' ); =head my %colormap = ( 1 => '#822', 2 => '#BB1', 3 => '#228', 4 => '#282' ); =cut my %colormap = ( 1 => 'r', 2 => 'y', 3 => 'b', 4 => 'g' ); 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 $currsdate = "$year-$mon-$mday"; my $currdate = "$dow[$wday], $month[$mon] $mday, $year"; my $currjd = julian_day( split('-', $currsdate) ); 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} 4 - $schoolname"; print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{\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 qq{K:$key V:$arr{$key}
\n}; } my $studenttable = 'student'; if ( $arr{showwithdrawn} ) { $studenttable = 'studentwd'; } 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 = ? and grade = ?"; $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; } # Figure out the number of days in the school year and also where # the current date fits into that. my %closed; # $closed{julian date} = fraction of day closed. my $sth = $dbh->prepare("select date, dayfraction from dates"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my ($d, $frac) = $sth->fetchrow ) { if ( not $frac ) { next; } # just in case my $jd = julian_day( split('-', $d) ); $closed{$jd} = $frac; } my $startjd = julian_day( split('-', $schoolstart) ); my $endjd = julian_day( split('-', $schoolend) ); # print qq{School Start: $schoolstart School End:$schoolend
\n}; # loop through the school year; count # number of days until end and also until the current date. my ($totaldays, $partdays ); for my $jd ( $startjd..$endjd ) { # run through the school year my $dow = day_of_week( $jd ); if ( $dow == 6 or $dow == 1 ) { next; } if ( $closed{$jd} ) { my $open = 1 - $closed{$jd}; $totaldays += $open; if ( $jd <= $currjd ) { $partdays += $open; } } else { $totaldays++; if ( $jd <= $currjd ) { $partdays++; } } } # print qq{

Total:$totaldays Part:$partdays
\n}; my $percentdone = format_number( $partdays * 100 / $totaldays, 1,1 ); print qq{

Percent of School Year Complete: $percentdone%

\n}; print qq{

$classname – $currdate

\n}; foreach my $grade ( @grades ) { # my $grade = $grades[0]; # only look at first grade so far. # Build Outcomes selection 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}; # print qq{OID:$oid
}; my ($cat, $seq) = split(/\./, $oid); $cat =~ s/$grade$//; # remove grade # print qq{Grade:$grade CAT:$cat SEQ:$seq

\n}; $outcomes{$grade}{$cat}{$seq} = $oid; $odesc{$oid} = $r{odesc}; } # Done building data structure. # Now build a structure for this grade my %strandcount; # $catcount{category} = number in this category. foreach my $cat ( sort keys %{ $outcomes{$grade} } ) { foreach my $seq ( sort keys %{ $outcomes{$grade}{$cat} } ) { if ( $seq > $strandcount{$cat} ) { $strandcount{$cat} = $seq; } } } my $totaloutcomes; foreach my $key ( keys %strandcount ) { $totaloutcomes += $strandcount{$key}; } # Now Select the students to display; skip any withdrawn kids w/o data. my $sth = $dbh->prepare("select lastname, firstname, studnum, grade from $studenttable $select order by lastname, firstname"); if ( $arr{homeroom} ) { # add on grade selector to only get part of the class. $sth->execute( $selectval, $grade ); } else { $sth->execute( $selectval ); } if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } 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 %names; # store student names; my %tdates; # store test dates for outcomes and pre/post $tdates{outcome}{pretest/posttest}; # 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 = ?"); # Loop through all students; build data structure. while ( my $ref = $sth->fetchrow_hashref ) { my %r = %$ref; my $studnum = $r{studnum}; # 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; # Have Data? $sth3->execute($arr{schoolyear}, $studnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $datacount = $sth3->fetchrow; if ( $wdcount > 0 and $datacount < 1 ) { # withdrawn and no data next; } } push @students, $studnum; $names{$r{studnum}} = "$r{lastname}, $r{firstname}"; # 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 ) { if ( $prepost eq 'posttest' ) { # only do posttests for data. push @{ $data{$studnum}{$outcome} }, $score; if ( $score >= 3 ) { $pass{$studnum}{'pass'}++; } $pass{$studnum}{'count'}++; } } } # Start Printing Data print qq{
Grade $grade
\n}; print qq{\n}; print qq{\n}; # header section. print qq{}; 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 foreach my $seq ( sort keys %{ $outcomes{$grade}{$strand} } ) { my $outcome = $outcomes{$grade}{$strand}{$seq}; print qq{}; } } } print qq{\n}; # Loop through each student foreach my $studnum ( @students ) { print qq{\n}; # %pass my ($pass, $mst, $outcomecount); if ( $pass{$studnum}{count} ) { $pass = format_number( $pass{$studnum}{pass} * 100 / $pass{$studnum}{count}, 0, 0); #if ( $pass ) { $pass .= '%'; } } # now figure out how many outcomes have scores foreach my $outcome ( keys %{ $data{$studnum} } ) { if ( ${ $data{$studnum}{$outcome} }[0] ) { $outcomecount++; } } if ( $pass{$studnum}{count} and $totaloutcomes ) { $mst = format_number( $pass{$studnum}{pass} / $pass{$studnum}{count} * $outcomecount / $totaloutcomes, 2, 2); } print qq{}; foreach my $strand ( @strands ) { if ( not $strandcount{$strand} ) { next; } # skip any strands not covered in this grade. foreach my $seq ( sort keys %{ $outcomes{$grade}{$strand} } ) { my $outcome = $outcomes{$grade}{$strand}{$seq}; my @scores = @{ $data{$studnum}{$outcome} }; my $displayval; my $first = 1; my $max; foreach my $score ( @scores ) { if ( not $first ) { $displayval .= qq{/}; } else { $first = 0; } $displayval .= $score; if ( $score > $max ) { $max = $score; } } my $class = $colormap{$max}; print qq{}; } } # end of this strand =head # 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}; } =cut } # end of student loop print qq{
Hover on Column Titles to see text descriptions
StudentPass
Per
MST}; print qq{$strandnames{$strand} ($strandcount{$strand})
$outcome
$names{$studnum}$pass$mst$displayval$posttotalcount$pretotalavg$posttotalavg$diff$passpercent% ($pass{$studnum}{'pass'}/$pass{$studnum}{'count'})
0% (0/$pass{$studnum}{'count'})
\n}; } # next grade. print qq{
}; print qq{All scores are posttest scores. Pretest scores are }; print qq{not shown on this report
\n}; print qq{
}; print qq{If more than one test is given to a student on the }; print qq{same outcome, these scores are separated by slashes
\n}; 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; print qq{
\n}; 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}; print qq{\n}; print qq{
$lex{'Select by'} $lex{Grade}
$lex{OR}
$lex{'Select by'} $lex{Homeroom}
$lex{'School Year'}
$lex{'Show Withdrawn'}
\n}; print qq{
\n}; exit; }