#!/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}. ": $@<br>\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}: $@<br>\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<html><head><title>$title</title>\n};
print qq{<link rel="stylesheet" href="$css" type="text/css">
<style type="text/css">
th.fs6{font-size:60%;}
td.r { background-color:#822;color:white;font-size:120%;font-weight:bold; }
td.y { background-color:#BB1;color:white;font-size:120%;font-weight:bold; }
td.b { background-color:#228;color:white;font-size:120%;font-weight:bold; }
td.g { background-color:#282;color:white;font-size:120%;font-weight:bold; }
a {color:white; }
a.alt {color:blue; }
</style>\n};


print qq{<script language="javascript" type="text/javascript">
function showhelp(type) {
  winName=window.open('/tcgi-bin/reading/showhelp.pl?id=' + type,'helpWindow',
  'height=300,width=700,screenX=100,screenY=100,resizeable');
  winName.focus();
}
</script>
$chartype\n</head><body style="padding:1em 6em 0 0.5em;">\n};


# Show Grade and Reading Levels Expected.
print qq{<div style="position:absolute;top:0;right:0;">\n};
print qq{<table cellspacing="0" cellpadding="3" border="1">\n};
print qq{<tr><th>$lex{Gr}</th><th>$lex{'Levels'}</th></tr>\n};
foreach my $key ( sort keys %levelExpect ) {
    my ($start, $end ) = split(':', $levelExpect{$key} );
    if ( $start == '0' ) { $start = 'A'; }
    print qq{<tr><td>$key</td><td>$start &ndash; $end</td></tr>\n};
}
print qq{</table></div>\n};

print qq{[ <a href="$homepage" class="alt">$lex{Main}</a> \n};
if ( not $teachermode ) {
    print qq{| <a href="/ssp.html" class="alt">SSP</a> \n};
}
print qq{]\n<h1 style="text-align:left;margin:0;padding:0.5em;">$title</h1>\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<br>};
    foreach my $s ( sort keys %seasons ) {
	print qq{Season:$s<br>\n};
    }
    print qq{<br>\n};
=cut
    
    # Form Start - Student Group
    print qq{<form action="$self" method="post"> \n};
    print qq{<input type="hidden" name="page" value="1">\n};


    print qq{<table cellpadding="3" cellspacing="0" border="0" };
    print qq{style="padding:0.5em;border:1px solid gray;">\n};

    # Select Grade
    print qq{<tr><td class="bra">$lex{Select} $lex{Grade}</td>\n};
    print qq{<td class="la"><select name="grade"><option></option>\n};
    foreach my $grade ( @grades ) {
	print qq{<option>$grade</option>\n};
    }
    print qq{</select></td></tr>\n};


    print qq{<tr><td class="bra">OR</td><td></td></tr>\n};

    # Select Homeroom
    my $sth = $dbh->prepare("select lastname, firstname from staff s, staff_multi sm 
      where s.userid = sm.userid and field_name = 'homeroom' and field_value = ?");


    print qq{<tr><td class="bra">$lex{Select} $lex{Homeroom}</td>\n};
    print qq{<td class="la"><select name="homeroom"><option></option>\n};
    foreach my $hr ( @homerooms ) {
	$sth->execute($hr);
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my ($lastname, $firstname) = $sth->fetchrow;
	my $hrname = $hr;
	if ( $lastname ) { $hrname = "$hr ($firstname $lastname)"; }

	print qq{<option value="$hr">$hrname</option>\n};
    }
    print qq{</select></td></tr>\n};

    print qq{<tr><td colspan="2"><hr></td></tr>\n};


    print qq{<tr><td class="bra">$lex{'Reading Level'}</td>\n<td class="la">};
    print qq{<select name="readlevel"><option></option>\n};
    foreach my $rl ( @readinglevel ) {
	print qq{<option>$rl</option>};
    }
    print qq{\n</select> $lex{'Blank=All'}</td></tr>\n\n};

    # Show Only Latest
    print qq{<tr><td class="ra">\n};
    print qq{<input type="checkbox" name="onlylatest" value="1" checked="checked">\n};
    print qq{<td  class="la">$lex{'Show Only Latest Test'}\n};
    print qq{</td></tr>\n};

    
    # Select Starting Season
    print qq{<tr><td class="bra">$lex{'Starting Season'}</td>\n};
    print qq{<td class="la"><select name="startseason"><option></option>\n};
    foreach my $season ( @seasons ) {
	$season =~ s/ZZZ/Fall/;
	print qq{<option>$season</option>\n};
    }
    print qq{</select></td></tr>\n};


    # Select Ending Season
    print qq{<tr><td class="bra">$lex{'Ending Season'}</td>\n};
    print qq{<td class="la"><select name="endseason"><option></option>\n};
    foreach my $season ( @seasons ) {
	$season =~ s/ZZZ/Fall/;
	print qq{<option>$season</option>\n};
    }
    print qq{</select></td></tr>\n};

    print qq{<tr><td  class="bra">$lex{Students}</td>};
    print qq{<td class="la"><select name="studtable"><option value="student">Current</option>\n};
    print qq{<option value="studentall">All</option><option value="studentwd">Withdrawn</option>\n};
    print qq{</select></td></tr>\n};


    print qq{<tr><td></td><td class="la"><input type="submit" value="$lex{Continue}"></td></tr>\n};
    print qq{</table></form>\n};

    print qq{</body></html>\n};

    exit;

} # end of showStartPage



#-------------
sub showReport {
#-------------

    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\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: $@<br>\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<br>\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<br>\n};
	print qq{Text:$seasons{$season}<br>\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{<div style="font-size:120%;font-weight:bold;">$dbase{$arr{db}}</div>\n};
    
    # Display Group of students (or entire school)
    print qq{<h3 style="text-align:left;font-size:120%;margin:0;padding:0.3em;">};
    
    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{ &ndash; $firstname $lastname};
    }

    print qq{</h3>\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<br>\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<br>\n};
	    
	    if ( $seasonsRev{$season} ) {  # we have a hit
		
#		print qq{SN:$studnum RL:$readlevel Season:$season<br>\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<br>\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{<div style="padding:1em;color:red;font-weight:bold;font-size:120%;">\n};
	print qq{$lex{'No Students Found'}</div></body></html>\n};
	exit;
    }


=head    
    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<br>\n};
	}
    }
=cut


    my %data; # needed to munge the other data struct: latestReadingLevel{$studnum} = $tdate:readlevel;

    foreach my $studnum ( sort keys %ReadingLevel ) {
	foreach my $rl ( sort keys  %{ $ReadingLevel{$studnum} } ) {
	    my ($id,$season,$readlevel) = split(':', $ReadingLevel{$studnum}{$rl} );
	    $data{$readlevel}{$studnum} = $season;
	}
    }

    
    foreach my $readinglevel ( sort {$a <=> $b} keys %data ) {

	# Find students in group / reading levels
	my (@students,%students);
	foreach my $studnum ( keys %{ $data{$readinglevel} } ) {
	    $students{"$studname{$studnum}$studnum"} = $studnum;
	}

	foreach my $key ( sort keys %students ) {
	    push @students, $students{$key};
	}
	# @students now sorted by name.

	
	showReadingLevel( $readinglevel, $arr{onlylatest}, \@students, $startdate, $enddate, $dbh );

    }

    print qq{</body></html>\n};

    exit;

}



#-------------------
sub showReadingLevel {
#-------------------
    my ( $readinglevel, $onlylatest, $stud_ref, $startdate, $enddate, $dbh ) = @_;

    my @students = @$stud_ref;

    # Check that tests exist
    my $sth = $dbh->prepare("select id from read_test 
     where studnum = ? and readlevel = ? and to_days( tdate ) >= to_days( '$startdate' ) 
     and to_days( tdate ) <= to_days( '$enddate')"); # get tests

    my $testflag = 0;
    foreach my $studnum ( @students ) {
	# Check for Tests
	$sth->execute( $studnum, $readinglevel );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my $trows = $sth->rows;
	if ( $trows > 0 ) { $testflag = 1; }
    }
    if ( not $testflag ) { return; }


    # Setup for Reading Level Heading, Get Category and Name
    my $sth = $dbh->prepare("select name, category, seq from read_level where readlevel = ?");

    my %objectives;
    my %catcount;


    $sth->execute( $readinglevel );
    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }

    while ( my ( $name, $category, $seq ) = $sth->fetchrow ) {
	$catcount{ $category } = $catcount{$category} + 1;
	$objectives{ $seq } = $category. '::'. $name;
    }

    # foreach my $cat ( keys %catcount ) { print "CAT:$cat VAL:$catcount{$cat}<br>\n"; }
    
    

    # Set Index values for all objectives
    my $count = 0;
    my $startcount;
    my %skip;
    my $currcat = '';

    # Print out First Heading Line
    my $colspan = 4 + keys %catcount; # %catcount holds categories and number of types in each.
    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
    print qq{<tr><th colspan="$colspan">$lex{'Reading Level'} $readinglevel</th>\n};

    my @catorder; # ordering of categories
    my %temp; # used to track cat in loop

    foreach my $key ( sort { $a <=> $b } keys %objectives ) { # numeric sort 

	my ( $category, $name ) = split(/::/, $objectives{$key} );

	if ( not $temp{$category} ) {
	    push @catorder, $category;
	    $temp{$category} = 1;
	}

	$oldcat = $currcat;
	$currcat = $category;

	if ( $oldcat ne $currcat and $count ) {
	    $diff = $count - $startcount;
	    print qq{<th colspan="$diff" style="font-size:100%;">$oldcat</th>\n};
	    $skip{$oldcat} = $diff;
	    $startcount = $count;
	}
	
	$count++;

    }
    $diff = $count - $startcount;
    $skip{$currcat} = $diff;
    print qq{<th colspan="$diff" style="font-size:100%;">$currcat</th></tr>\n};


    # Print Out Second Heading Line
    print qq{<tr><th>$lex{Name}</th><th>$lex{Date}</th><th>$lex{EGr}</th>\n};


    foreach my $key ( @catorder ) {
	#    foreach my $key ( sort keys %catcount ) {
	# old - remove when done testing.
	print qq{<th>$shortCategory{$key}<br>$lex{Score}</th>};
    }
    print qq{<th>Overall<br>Score</th>\n};


    # SQL Query of 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{<th class="fs6">};
	if ( $help1 ) {
	    print qq{<a href="javascript:showhelp($id)">$name</a>};

	} else {
	    print qq{$name};
	}
	print qq{</th>\n};

    }
    print qq{</tr>\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 desc"); # 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{<tr><td class="la"><b>$lastname</b>, $firstname</td><td>};
	    print fmtDate($tdate). qq{</td>\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;
	    my %cattotal;
	    my %catcount;



	    while ( my ( $category, $name, $score, $seq ) = $sth2->fetchrow ) {

		# Check objective
	        my ( $tcat, $tname ) = split(/::/, $objectives{ $seq } );
		if ( $tcat ne $category or $tname ne $name ) { # error
		    print qq{<div>$lex{Error} Mismatch Level:$readinglevel Student:$studnum - };
		    print qq{Reference:$tcat: Yours:$category: OR Reference:$tname: - Yours:$name:</div>\n};
		    next;
		}

		$cattotal{$category} += $score;
		$catcount{$category} += 1;

		$studata[$seq] = $score;
		$total += $score;
		$count++;
	    }


	    # Equivalent Grade print
	    my $equivgrade = scoreToGrade($total, $readinglevel, $dratype );
	    print qq{<td>$equivgrade</td>\n};
 
	    # Category Scores
	    my $totalscore;
	    my $totalpossible;
#	    foreach my $cat ( sort keys %catcount ) {
# Old 
	    foreach my $cat ( @catorder ) {
		my $tot = $catcount{$cat} * 4;
		print qq{<td>$cattotal{$cat}/$tot</td>};
		$totalscore += $cattotal{$cat};
		$totalpossible += $catcount{$cat};
	    }
	    $totalpossible *= 4;
	    print qq{<td>$totalscore/$totalpossible</td>};


	    # 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{<td class="$cl">$val</td>};
	    }
	    print qq{</tr>\n};
	} # end of test print loop

    } # end of student loop.

    print qq{</table><p></p>\n};
    return;

}


#----------------
sub selectSchool { 
#----------------

    if (not @g_FeederSchools ) {
	print qq{<h3>No Feeder Schools Found</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    print qq{<h3>Select Feeder School</h3>\n};

    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="1">\n};
    
    foreach my $db ( @g_FeederSchools ) {
	print qq{<div><input type="radio" name="db" value="$db">$dbase{$db}</div>\n};
    }

    print qq{<p><input type="submit" value="Continue"></p>\n};
    print qq{</form>\n};
    
    print qq{</body></html>\n};
    
    exit;

}

    

#---------------
sub selectGroup {
#---------------
    
    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }
    # passed db to view.

    print qq{<h3>Feeder School - $dbase{$arr{db}}</h3>\n};

    
    my $dbtype = 'mysql';
    my $dsn = "DBI:$dbtype:dbname=$arr{db}";
    my $dbh = DBI->connect($dsn,$guser,$gpassword);
    
    
    my @grades;

    # Get Grades
    $sth = $dbh->prepare("select distinct grade from studentall 
      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'. 


    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="2">\n};
    print qq{<input type="hidden" name="db" value="$arr{db}">\n};
    
    print qq{<table cellpadding="3" cellspacing="0" border="0">\n};


    # Select Grade
    print qq{<tr><td class="bra">$lex{'Select by'} $lex{Grade}</td>};
    print qq{<td class="la"><select name="grade"><option></option>\n};
    foreach my $gr ( @grades ) {
	print qq{<option>$gr</option>\n};
    }
    print qq{</select></td></tr>\n};


    # Show Only Latest
    print qq{<tr><td class="ra">\n};
    print qq{<input type="checkbox" name="onlylatest" value="1" checked="checked">\n};
    print qq{<td  class="la">$lex{'Show Only Latest Test'}\n};
    print qq{</td></tr>\n};

    
    # Select Starting Season
    print qq{<tr><td class="bra">$lex{'Starting Season'}</td>\n};
    print qq{<td class="la"><select name="startseason"><option></option>\n};
    foreach my $season ( @seasons ) {
	$season =~ s/ZZZ/Fall/;
	print qq{<option>$season</option>\n};
    }
    print qq{</select></td></tr>\n};


    # Select Ending Season
    print qq{<tr><td class="bra">$lex{'Ending Season'}</td>\n};
    print qq{<td class="la"><select name="endseason"><option></option>\n};
    foreach my $season ( @seasons ) {
	$season =~ s/ZZZ/Fall/;
	print qq{<option>$season</option>\n};
    }
    print qq{</select></td></tr>\n};


    # Show Current Students
    print qq{<tr><td class="bra">Show Current Students</td>};
    print qq{<td class="la"><input type="checkbox" name="showcurrent" value="1"></td></tr>\n};


    # Continue
    print qq{<tr><td class="ra"><input type="submit" value="$lex{Continue}"></td></tr>\n};
    print qq{</table>\n};
    print qq{</form></body></html>\n};

    exit;

}

