#!/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}. ": $@<br>\n";
    die $lex{Error}. ": $@\n";
}

eval require "$configpath/lib/libattend.pl";
if ( $@ ) {
    print $lex{Error}. " $@<br>\n";
    die $lex{Error}. " $@\n";
}

eval require "$configpath/lib/libreading.pl";
if ( $@ ) {
    print $lex{Error}. " $@<br>\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);


# print HTML heading
my $title = $lex{'Cumulative Report'};
print qq{$doctype\n<html><head><title>$title</title>};
print qq{<link rel="stylesheet" href="$css" type="text/css">\n};
print qq{$chartype\n</head><body>\n};

print qq{[ <a href="$homepage">$lex{Main}</a> ]\n};
print qq{<h1>$title</h1>\n};

# print "$remoteuser - $remotehost - $remotepassword<br>\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}<br>\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{<div style="font-size:130%;font-weight:bold;">$r{firstname} $r{lastname}</div>\n};
    print qq{<div>$lex{Birthdate} $r{birthdate}</div>\n};
    print qq{<div>$lex{Grade} $r{grade}</div>\n};
    print qq{<div style="margin-bottom:1.5em;">$lex{Age} $age</div>\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, "<br>\n";


    my %skipyear; # student not enrolled school years.

    # Attendance    
    print qq{<table cellpadding="3" cellspacing="0" border="1" style="margin-bottom:1.5em;">\n};
    print qq{<caption style="font-size:120%;font-weight:bold;">$lex{Attendance}</caption>\n};
    print qq{<tr><th>$lex{'School Year'}</th><th>$lex{Attendance}</th></tr>\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{<tr><td>$schoolyear</td><td>$lex{'Not Enrolled'}</td></tr>\n};
	    $skipyear{$db} = 1;
	} else { # we have enrollment
	    my $present = $enrolled - $absent;
	    my $perattend = format_number( $present / $enrolled * 100 ,2,2);	
	    print qq{<tr><td>$schoolyear</td><td>$perattend%</td></tr>\n};
	}

    } # end of db loop
    
    print qq{</table>\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{<table cellpadding="3" cellspacing="0" border="1" style="margin-bottom:1.5em;">\n};
    print qq{<caption style="font-size:120%;font-weight:bold;">$lex{Discipline}</caption>\n};
    print qq{<tr><th>$lex{'School Year'}</th><th>$lex{Discipline}</th></tr>\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{<tr><td>$schoolyear</td><td>$disccount</td></tr>\n};


    } # end of db loop
    
    print qq{</table>\n};

    

    # Reading
    print qq{\n\n};
    print qq{<table cellpadding="3" cellspacing="0" };
    print qq{style="margin-bottom:1.5em;border:1px solid gray;">\n};    
    print qq{<caption style="font-size:120%;font-weight:bold;">$lex{Reading}</caption>\n};
    print qq{<tr><td class="la">\n};
    
    foreach my $db ( @schoolyears ) {

	my $schoolyear = $mapdb2years{$db};
	if ( $schoolyear ne $lex{Current} ) {
	    my $ty = $schoolyear - 1;
	    $schoolyear = "$ty-$schoolyear";
	}

	# print qq{<h3>$schoolyear</h3>\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}: $@<br>\n};
		    die "$lex{Error}: $@\n";
		}
	    }
	}


#	print qq{ $arr{studnum}, $schoolstart, $schoolend, $schoolyear, $dbht<br>\n};
	showReading( $arr{studnum}, $schoolstart, $schoolend, $schoolyear, $dbht );
	

    } # end of db loop
    
    print qq{\n</td></tr></table>\n};
    


    # MATH
    print qq{<table cellpadding="3" cellspacing="0" border="1" style="margin-bottom:1.5em;">\n};
    print qq{<caption style="font-size:120%;font-weight:bold;">$lex{Mathematics}</caption>\n};
    print qq{<tr><th>$lex{'School Year'}</th><th>Grade</th>};
    print qq{<th title="Number of Outcomes"># Out</th><th title="Outcomes Completed"># Comp</th>};
    print qq{<th title="Average Score (of values 1-4)">Average</th></tr>\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<br>\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<br>\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{<tr><td>$schoolyear</td><td>$grade</td><td class="cn">$outcomecount</td>};
	print qq{<td class="cn">$outcomescomplete</td><td class="cn">$average</td></tr>\n};


    } # end of db loop
    
    print qq{</table>\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}: $@<br>\n};
		die "$lex{Error}: $@\n";
	    }
	}
    }

    my $ppd = $g_ppd{$grade};
    if ( not $ppd ) {
	print qq{<h3>PPD not defined for grade: $grade</h3>\n};
	return;
    }

    
#    print qq{Start:$schoolstart End:$schoolend<br>\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}<br>\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{<br>EQ Periods:$equivperiods<br>\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{<br>ENrolled:$enrolled  Absent Periods:$absentperiods<br>\n};
#    foreach my $key ( sort keys %b ) { print qq{K:$key V:$b{$key}<br>\n}; }

    my $daysabsent = $absentperiods / $ppd;

    
    return "$enrolled:$daysabsent";

}
    
    

#----------------
sub selectStudent {
#----------------

    #foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\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{<p><b>$lex{Error}:$lex{'No Student(s) Found'}</b></p>\n};
		print qq{</body></html>\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{<h3>$lex{Error}: $lex{'No Selection'}</h3>\n};
	print qq{</body></html>\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{<table border="1" cellspacing="0" cellpadding="3">\n};
	    print qq{<tr><th>$lex{Student}</th><th>$lex{Grade}</th><th></th></tr>\n};
	    $first = 0;
	}

	print qq{<tr><td class="la"><b>$r{lastname}</b>, $r{firstname}</td><td class="cn">$r{grade}</td>\n};
	print qq{<td><form action="$self" method="post">\n};
	print qq{<input type="hidden" name="page" value="2">\n};
	print qq{<input type="hidden" name="studnum" value="$r{studnum}">\n};
	print qq{<input type="hidden" name="startdb" value="$arr{startdb}">\n};
	
	print qq{<input type="submit" value="$lex{Select}"></form></td></tr>\n};
	
    }
    
    if ( $first ) { 
	print qq{<p><b>$lex{Error}:$lex{'No Student(s) Found'}</b></p>\n};
	print qq{</body></html>\n};
	exit;
	
    } else {
	print qq{</table>\n};
    }


    print qq{</body></html>\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{<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};

    print qq{<tr><td class="bla">$lex{Select} $lex{Starting} $lex{'School Year'}</td><td></td></tr>\n};
    foreach my $db ( sort keys %remotedb ) { 
	print qq{<tr><td class="la"><input type="radio" name="startdb" value="$db">$db</td></tr>\n};
    }
    print qq{<tr><td class="la"><input type="radio" name="startdb" };
    print qq{value="$dbase">$lex{Current}</td></tr>\n};
    

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

    
    # Student Info
    print qq{<tr><td class="bla" colspan="2">$lex{Student}\n};
    print qq{<input type="text" name="student" size="30"></td></tr>\n};
    
    print qq{<tr><td colspan="2" style="font-size:120%;" class="cn">};
    print qq{$lex{'Last,First/Last/Initials/Studnum'}</td></tr>\n};

    
    print qq{<tr><td class="bla"><span style="font-weight:normal;">$lex{or}</span></td></tr>\n};
    
    # Divider
    # print qq{<tr><td colspan="2"><hr></td></tr>\n};


    # Grades
    print qq{<tr><td class="bla">$lex{Grade} };
    print qq{<select name="grade"><option></option>\n}; 
    foreach my $gr ( sort {$a <=> $b} @grades ) {
	print qq{<option>$gr</option>\n};
    }
    print qq{</select></td></tr>\n};

    print qq{<tr><td class="la"><span style="font-weight:normal;">$lex{or}</span></td></tr>\n};
    
    # Homerooms
    print qq{<tr><td class="bla">$lex{Homeroom} };
    print qq{<select name="homeroom"><option></option>\n}; 
    foreach my $hr ( sort {$a <=> $b} @homerooms ) {
	print qq{<option>$hr</option>\n};
    }
    print qq{</select></td></tr>\n};

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

    print qq{</form>\n};
    print qq{</body></html>\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<br>\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<br>\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<br>\n";

    my $first = 1;
    
    
    foreach my $readinglevel ( @readinglevels ) {


	if ( $first ) {
	    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
	    print qq{<caption style="font-size:120%;font-weight:bold;">$schoolyear</caption>\n};
	    print qq{<tr><th>Read<br>Level</th><th>$lex{Date}</th><th>Equiv<br>Grade</th>\n};
	    print qq{<th>Stud<br>Grade</th></tr>\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{<tr><th colspan="$colspan">$lex{'Reading Level'} $readinglevel</th>\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{<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{Tot}</th><th>$lex{EGr}</th>\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{<th class="fs6">};
	    if ( $help1 ) {
#		print qq{<a href="javascript:showhelp($id)">};
#		print qq{$name</a>};
	    } else {
#		print $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 $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{<tr><td class="cn">$readinglevel</td><td>}. fmtDate($tdate). qq{</td>};
	    
	    # 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<br>\n};
		    next;
		}
		$studata[$seq] = $score;
		$total += $score;
		$count++;
	    }

	    
	    # Equivalent Grade
	    my $equivgrade = scoreToGrade( $total, $readinglevel, $dratype );
	    print qq{<td class="cn">$equivgrade</td><td class="cn">$grade</td></tr>\n};

	} # end of test print loop

    } # end of readlevel loop

    if ( not $first ) {
	print qq{</table><p></p>\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{<table cellpadding="3" cellspacing="0" border="1">\n};
    print qq{<tr><th colspan="$colspan">$lex{'Reading Level'} $readinglevel</th>\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{<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{Tot}</th><th>$lex{EGr}</th>\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{<th class="fs6">};
	if ( $help1 ) {
	    print qq{<a href="javascript:showhelp($id)">};
	    print qq{$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 $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{<tr><td class="la"><b>$lastname</b>, $firstname</td>};
	    print qq{<td>}. fmtDate($tdate). q{</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;

	    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<br>\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{<td>$total</td>\n}; # was $average, from above.
	    
	    # Equivalent Grade
	    #if ( $readinglevel >= 40 ) {
	    my $equivgrade = scoreToGrade( $total, $readinglevel, $dratype );
	    print qq{<td>$equivgrade</td>\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{<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 fmtDate {
#----------

    my ( $year, $mon, $day ) = split '-', shift;
    return "$year-$s_month[$mon]-$day";
}

