#!/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 = ('Cohort' => 'Cohort',
	   'Report' => 'Report',
	   'Error' => 'Error',
	   'Main' => 'Main',
	   'Start Date' => 'Start Date',
	   'End Date' => 'End Date',
	   'Continue' => 'Continue',
	   'Student' => 'Student',
	   'Enrollment' => 'Enrollment',
	   'Attendance' => 'Attendance',
	   'Days' => 'Days',
	   'Average' => 'Average',
	   'Blocks' => 'Blocks',
	   'Beginning' => 'Beginning',
	   'Current' => 'Current',
	   'Retention' => 'Retention',

	   );

my $self = 'rptcohort.pl';

use DBI;
use CGI;
use Time::JulianDay;
use Number::Format qw(:all);

eval require "../../etc/admin.conf";
if ( $@ ) {
    print $lex{Error}. " $@<br>\n";
    die $lex{Error}. " $@\n";
}

# load attendance library
eval require "../../lib/libattend.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";
$dbh = DBI->connect($dsn,$user,$password);


# Set Date
my @tim = localtime(time);
my $year = @tim[5] + 1900;
my $month = @tim[4] + 1;
my $day = @tim[3];
my $currdate = "$year-$month-$day";
my $currdate1 = "$month[$month] $day, $year";


my $title = qq{$lex{Cohort} $lex{Report}};
print qq{$doctype\n<html><head><title>$title</title>\n};
print qq{<link rel="stylesheet" href="$css" type="text/css">\n};

print qq{<link rel="stylesheet" type="text/css" media="all" };
print qq{href="/js/calendar-blue.css" title="blue">\n};
print qq{<script type="text/javascript" src="/js/calendar.js"></script>\n};
print qq{<script type="text/javascript" src="/js/lang/calendar-en.js"></script>\n};
print qq{<script type="text/javascript" src="/js/calendar-setup.js"></script>\n};

print qq{$chartype\n</head><body>\n};
print qq{[ <a href="$homepage">$lex{Main}</a> |\n};
print qq{ <a href="$attpage">$lex{Attendance}</a> ] $currdate1\n};
print qq{<h1>$title</h1>\n};

if ( not $arr{page} ) {
    showStartPage();
    
} elsif ( $arr{page} == 1 ) {
    showReport();
}


#----------------
sub showStartPage {
#----------------

    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="1">\n};

    print qq{<table cellpadding="3" border="0" cellspacing="0">\n};

    print qq{<tr><td>$lex{'Start Date'}</td><td>};
    print qq{<input type="text" name="sdate" id="sdate" size="12">\n};
    print qq{<button type="reset" id="start_trigger">...</button></td></tr>\n};

    print qq{<tr><td colspan="2" style="text-align:center;">\n};
    print qq{<input type="submit" value="$lex{Continue}">\n};
    print qq{</td></tr>\n};

    print qq{</table></form></center>\n};

    print qq{<script type="text/javascript">\n};
    print qq{Calendar.setup({
        inputField     :    "sdate", // id of the input field
        ifFormat       :    "%Y-%m-%d", // format of the input field
        button         :    "start_trigger", // trigger for the calendar (button ID)
        singleClick    :    false,        // double-click mode
        step           :    1             // show all years in drop-down boxes 
    })};


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

    exit;
}


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

    # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }

    my $startjd = julian_day( split /-/, $arr{sdate} );
    my $endjd = julian_day( split /-/, $arr{edate} );
    my $currjd = julian_day( split /-/, $currdate );

    
    # Find current enrollment.
    my %students;
    my $sth = $dbh->prepare("select studnum, lastname, firstname from student");
    $sth->execute;
    if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    while ( my ( $studnum, $lastname, $firstname ) = $sth->fetchrow ) {
	$students{ $studnum } = "$lastname, $firstname";
    }

    my %currstud = %students; # Current Student Cohort
    my $currentenrol = keys %students;

    # Back up through transfers until we get to start date (Sept 30).
    $sth = $dbh->prepare("select studnum, type, date from transfer where 
      to_days(date) >= to_days('$arr{sdate}') order by date desc");
    $sth->execute;
    if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }

    # Setup for name retrieve;
    my $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");

    my %wddate = (); # withdrawal dates

    while ( my ( $studnum, $type, $date ) = $sth->fetchrow ) {
	
	if ( $type eq 'withdraw' ) { # then ADD student to students hash.

	    if ( not $wddate{ $studnum } ) {
		$wddate{ $studnum } =  [ $date ];
	    } else { # have an existing value
		push @{ $wddate{ $studnum } }, $date;
	    }

	    # Get Name
	    $sth1->execute( $studnum );
	    if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	    my ( $lastname, $firstname ) = $sth->fetchrow;
	    if ( not $lastname ) { $lastname = '-1'; }

	    $students{ $studnum } = "$lastname, $firstname";

	} else { # it's an enrol, # then REMOVE from list
	    delete $students{ $studnum };
	}
    }


    # Start the table
    print qq{<table cellspacing="0" border="1" cellpadding="3" };
    print qq{style="font-size:150%;font-weight:bold;">\n};
    print qq{<tr><td>$lex{Current} $lex{Enrollment} ($currdate)</td><td>$currentenrol</td></tr>\n};
    print qq{<tr><td>$lex{Beginning} $lex{Enrollment} ($arr{sdate})</td>};

    # Now Compare the 2 Hashes:  Start Vs Current - Who is still here.
    my $startsize = keys %students;
    print qq{<td>$startsize</td></tr>\n};
    my %remainstud = ();

    # Combine the 2 hashes.
    my %masterstud = ( %students, %currstud );
    my %withdrawstud;

    foreach my $studnum ( sort keys %masterstud ) {
	if ( $currstud{$studnum} and $students{$studnum} ) { # student still here
	    $remainstud{ $studnum } = $currstud{ $studnum };
	}
	if ( $students{$studnum} and not $currstud{$studnum} ) { # withdrawn student
	    $withdrawstud{ $studnum } = $students{$studnum};
	}
    }


    my $remainsize = keys %remainstud;
    print qq{<tr><td>Remaining  $lex{Enrollment}</td><td>$remainsize</td></tr>\n};

    my $retentionpercent;
    if ( $startsize ) {
	$retentionpercent = $remainsize / $startsize * 100;
    } else {
	$retentionpercent = 0;
    }
    $retentionpercent = format_number( $retentionpercent, 2);
    print qq{<tr><td colspan="2" style="background-color:#DDD;text-align:center;">};
    print qq{$lex{Retention}: $retentionpercent\%</td></tr>\n};
    print qq{</table><p></p>\n};



    print qq{<h3>Withdrawn Students Stay Length</h3>\n};

    # now show the stay length for these withdrawn students.
    my %studenrolblock = ();
    my %studsort = ();

    my $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");


    foreach my $sn ( sort keys %withdrawstud ) {

	$active = 0; # since withdrawn currently.
	my @enrolblocks = findEnrollmentBlocks( $sn, $schoolstart, $currdate, $dbh );
	$studenrolblock{$sn} = \@enrolblocks;

	$sth->execute( $sn );
	if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my ( $lastname, $firstname ) = $sth->fetchrow;
	$studsort{"$lastname$firstname$sn"} = $sn;


	my ( $blockcount, $daysEnrolled );

	foreach my $block ( @enrolblocks ){

	    my $start = $block->{start};
	    my $end = $block->{end};
#	    print qq{<br>ST: $start END: $end };
	    my $blocklength = calcDaysOpen($start,$end);

	    $blockcount++;
	    $daysEnrolled += $blocklength;

#	    print qq{<br>Student: $sn  BlockLen: $blocklength : $blockcount<br>\n};

	}

	my $staylength;
	if ( $blockcount ) {
	    $staylength = $daysEnrolled / $blockcount;
	} else {
	    $staylength = 0;
	}
#	print qq{Stay: $staylength<br>\n};

	$studentstay{$sn} = format_number($staylength, 1);

    }


    # Setup Table to Display
    print qq{<table cellspacing="0" border="1" cellpadding="3">\n};
    print qq{<tr><th>$lex{Student}</th><th>$lex{Days}</th><th>$lex{Blocks}</th></tr>\n};

    my $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?");
    my $sth1 = $dbh->prepare("select exittype, description from transfer 
			     where studnum = ? and date = ?");

    my ($total, $count);
    my $studcount = 1;

    foreach my $key ( sort keys %studsort ) {

	my $sn = $studsort{$key};

	$sth->execute( $sn );
	if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my ( $lastname, $firstname ) = $sth->fetchrow;

	print qq{<tr><td>$studcount. $lastname, $firstname ($sn)</td><td>$studentstay{$sn}</td><td>};
	$studcount++;

	my $first = 1;
	foreach my $block ( @{$studenrolblock{$sn}} ){
	    my $start = $block->{start};
	    my $end = $block->{end};

	    $sth1->execute( $sn, $end );
	    if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	    my ( $exittype, $description ) = $sth1->fetchrow;

	    if ( not $first ) { print qq{<br>}; } else { $first = 0; }
	    print qq{$start &mdash; $end ($exittype - $description)};
	}

	print qq{</td></tr>\n};
	$count++;
	$total += $studentstay{$sn}
    }


    my $averagestay;
    if ( $count ) {
	$averagestay = format_number( $total / $count, 2 );
    } else {
	$averagestay = 0;
    }
    print qq{<tr style="background-color:#DDD;text-align:center;font-size:130%;};
    print qq{font-weight:bold;"><td colspan="3">};
    print qq{$lex{Average}: $averagestay $lex{Days}</td></tr>\n};

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