#!/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',
	   'Needs Assessment' => 'Needs Assessment',
	   'Student' => 'Student',
	   'Reading Level' => 'Reading Level',
	   'Continue' => 'Continue',
	   'Category' => 'Category',	   
	   'Name' => 'Name',
	   'Save' => 'Save',
	   'Score' => 'Score',
	   'Test Date' => 'Test Date',
	   'Values must be from 1-4' => 'Values must be from 1-4',
	   'No User Id' => 'No User Id',
	   'No Password' => 'No Password',
	   'Please Log In' => 'Please Log In',
	   'Grade' => 'Grade',
	   'Homeroom' => 'Homeroom',
	   'Select' => 'Select',
	   'Blank=All' => 'Blank=All',
	   'Check' => 'Check',
	   'Record Exists' => 'Record Exists',
	   'Edit Record' => 'Edit Record',
	   'Required' => 'Required',
	   'Date and Reading Level' => 'Date and Reading Level',
	   'Only' => 'Only',
	   'No Blanks Allowed' => 'No Blanks Allowed',
	   'Skipping' => 'Skipping',
	   'Next Page' => 'Next Page',

	   );

use DBI;
use CGI;
use CGI::Session;

my %exceptions = ( 'moved' => 'Moved', 'attendance' => 'Persistent Absences', 'altprog' => 'Alternate Program', 'other' => 'Other' );
my @exceptions = ( 'moved', 'attendance', 'altprog', 'other');


my $self = 'needsAdd.pl';
my %recommend = ( 'EDPSY' => 'Ed Psych',
		  'SLP' => 'Speech Language',
		  'MH' => 'Mental Health',
		  'SPEC' => 'Special Ed',
		  'OT' => 'Occupational Therapy',
		  'TB' => 'Targeted Behaviour',
    );



my $q = new CGI;
my %arr = $q->Vars;

my @time = localtime(time);
my $year = $time[5] + 1900;
my $month = $time[4] + 1;
my $currdate = "$year-$month-$time[3]";


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


my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);

# Session Setup Here
my $session = new CGI::Session("driver:mysql;serializer:FreezeThaw",
 undef,{Handle => $dbh}) or die CGI::Session->errstr;

# Get/Set  Session Values (a defined userid means it was passed)
if ( $arr{userid} ){ # we want to login, passed userid/password pair.

    # Check password/userid against database (-1 no user, -2 wrong password);
    my $error = checkPassword($arr{userid}, $arr{password}, $dbh);
    if ($error == -1){ print $q->header( -charset, $charset ); login($lex{'No User Id'}); }
    if ($error == -2){ print $q->header( -charset, $charset ); login($lex{'No Password'}); }

    $cookietime = checkCookieTime( $arr{duration} );

    # Set values for userid and logged_in in session
    $session->param( 'logged_in','1');
    $session->expire( 'logged_in', $cookietime );
    $session->param( 'userid',$arr{userid} );
    $session->param( 'duration',$cookietime );

    $userid = $arr{userid};


} else { # check logged_in value in session

    if ( not $session->param('logged_in') ){
	$userid = $session->param('userid');
        print $q->header( -charset, $charset );
        print $lex{'Please Log In'}. "</body></html>\n"; 
        exit;
    }
    # Ok, we have a login. Values below we have in environment.

    $userid = $session->param('userid');
    $duration = $session->param('duration');

    if ( not ($duration =~ /\+/)) { # if not in +20m format, do so.
	$duration = checkCookieTime( $duration );
    }

    $session->expire('logged_in', $duration );


} # End of check for logged_in value

print $session->header( -charset, $charset );

# Session Setup End

# Page Header
my $title = "$lex{Add} $lex{Student} $lex{'Needs Assessment'}";
print qq{$doctype\n<html><head><title>$title</title>\n}; 
print qq{<link rel="stylesheet" href="$tchcss" 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 style="padding:1em 2em;">\n};
print qq{[ <a href="$tchpage">$lex{Main}</a> ]\n};
print qq{<h1>$title</h1>\n};


if ( not $arr{page} ) {
    showStartPage();

} elsif ( $arr{page} == 1 ) {
    delete $arr{page};
    selectStudents();

} elsif ( $arr{page} == 2 ) {
    delete $arr{page};
    enterNeeds();

} elsif ( $arr{page} == 3 ) {
    delete $arr{page};
    writeRecords();

} elsif ( $arr{page} == 4 ) {
    delete $arr{page};
    writeExceptions();
}



#----------------
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" cellspacing="0" border="0">\n};


    print qq{<tr><td class="bra">$lex{Select} $lex{Student}\n};
    print qq{</td><td><select name="groupname">};
    print qq{<option value="grade">$lex{Grade}</option>\n};
    print qq{<option value="homeroom">$lex{Homeroom}</option>\n};
    print qq{</select>\n};
    print qq{<input type="text" name="groupvalue" size="10"> ". $lex{'Blank=All'}. "</td></tr>\n};


    print qq{<tr><td class="bra">$lex{Check} $lex{'Next Page'}</td>\n};
    print qq{<td><input type="checkbox" name="chk" value="checked">\n};
    print qq{</td></tr>\n};    

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

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

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

    exit;

} # end of showStartPage



#----------------
sub selectStudents {
#----------------

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

    my $groupvalue = $arr{groupvalue};
    delete $arr{groupvalue};
    my $chk = $arr{chk};
    delete $arr{chk};

    my $select;
    if ( $groupvalue ) { # we're picking a group
	if ( $arr{groupname} eq 'grade') {
	    $select = 'where grade = ?';
	} else {
	    $select = 'where homeroom = ?';
	}
    }
    my $sth = $dbh->prepare("select lastname, firstname, studnum from student
      $select order by lastname, firstname");
    if ( $select ) {
	$sth->execute( $groupvalue );
    } else {
	$sth->execute;
    }
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }

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


    print qq{<table cellpadding="3" cellspacing="0" border="0">\n};
    print qq{<tr><td class="ra"><input type="submit" value="$lex{Continue}"></td>\n};


    print qq{<tr><th>Needs<br>Assess</th><th>Absent</th><th></th></tr>\n};


    while ( my ( $lastname, $firstname, $studnum ) = $sth->fetchrow ) {
	print qq{<tr><td class="cn"><input type="checkbox" name="$studnum" value="1" $chk></td>\n};
	print qq{<td class="cn"><input type="checkbox" name="ABS:$studnum" value="1"></td>\n};
	print qq{<td class="la"><b>$lastname</b>, $firstname ($studnum)</td>};
    }

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

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

    exit;

} # end of selectStudents



#-------------
sub enterNeeds {
#-------------

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


    my $sth = $dbh->prepare("select lastname, firstname, grade from student where studnum = ?");
    my @absent;
    my @students;
    my %students;
    # Extract the absences
    foreach my $key ( keys %arr ) {
	my ($flag, $id ) = split(':', $key);
	if ( $flag eq 'ABS' ) {
	    push @absent, $id;
	    delete $arr{$key};
	} else {
	    $sth->execute( $key );
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	    my ( $ln, $fn, $gr) = $sth->fetchrow;
	    $students{"$ln$fn$key"} = $key;
	}
    }

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


    # Print Form Heading
    print qq{<form action="$self" method="post"> \n};
    print qq{<input type="hidden" name="page" value="3">\n};


    foreach my $studnum ( @absent ) {
	print qq{<input type="hidden" name="ABS:$studnum" value="$studnum">\n};
    }

    print qq{<div style="text-align:left;"><input type="submit" value="$lex{Save}"></div>\n};



    foreach my $studnum ( @students ) {

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

	print qq{<div style="text-align:left;font-size:140%;font-weight:bold;">};
	print qq{$lastname, $firstname</div>\n};

	print qq{<table cellpadding="6" cellspacing="0" border="1">\n};
	print qq{<td class="bra">Strengths</td><td><textarea name="$studnum:STR" };
	print qq{rows="6" cols="80"></textarea></td></tr>\n};

	print qq{<td class="bra">Challenges</td><td><textarea name="$studnum:CHA" };
	print qq{rows="6" cols="80"></textarea></td></tr>\n};

	print qq{<td class="bra">Support<br>Received</td>};
	print qq{<td><textarea name="$studnum:SUP" rows="6" cols="80"></textarea>};
	print qq{</td></tr>\n};

	print qq{<td class="bra">Recommendations</td>};

	print qq{<td>};
	for my $key ( sort keys %recommend ) {
	    print qq{<input type="checkbox" name="$studnum:$key"> $recommend{$key}<br>\n};
	    #print qq{<input type="checkbox" name="$studnum:SLP"> Speech Language<br>\n};
	    #print qq{<input type="checkbox" name="$studnum:MH"> Mental Health<br>\n};
	    #print qq{<input type="checkbox" name="$studnum:SPED"> Spec Ed<br>\n};
	    #print qq{<input type="checkbox" name="$studnum:OT"> Occupational Therapy<br>\n};
	}
	print qq{</td></tr>\n};


	print qq{<td class="bra">Other Recommendations</td>};
	print qq{<td><textarea name="$studnum:OTH" rows="6" cols="80"></textarea>};
	print qq{</td></tr>\n};

	print qq{<td class="bra">Classroom<br>Recommendations</td>};
	print qq{<td><textarea name="$studnum:CLS" rows="6" cols="80">};
	print qq{</textarea></td></tr>\n};

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

    }

    if ( $first ) { # no student tests, could be absences
	if ( @absent ) {
	    print qq{<h3 style="text-align:left;">};
	    print qq{<input type="submit" value="$lex{Continue} to $lex{Absences}"></h3>\n};

	} else { # No students, no absences. Stop
	    print qq{<h3>$lex{'No Students Found'}</h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}

    } else {
	print qq{<div style="text-align:left;"><input type="submit" value="$lex{Save}"></div>\n};
    }
	
    print qq{</form></body></html>\n};

    exit;

}


#---------------
sub writeRecords {
#---------------

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

    # Extract the absences
    my @absent;
    foreach my $key ( keys %arr ) {
	my ($flag, $id ) = split(':', $key);
	if ( $flag eq 'ABS' ) {
	    push @absent, $id;
	    delete $arr{$key};
	} 
    }

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


    # Load student record
    my $sth1 = $dbh->prepare("select * from studentall where studnum = ?");
    my $sth2 = $dbh->prepare("select userid from staff_multi where 
			     field_name = 'homeroom' and field_value = ?");
    my $sth3 = $dbh->prepare("select lastname, firstname from staff where userid = ?");

    foreach my $key ( sort keys %arr ) {

	my ( $studnum, $label ) = split(/:/, $key);
	if ( $label ne 'STR' ) { next; } # skip all elements but strengths.
	
	my $chakey = qq{$studnum:CHA};
	my $supkey = qq{$studnum:SUP};
	my $othkey = qq{$studnum:OTH};
	my $clskey = qq{$studnum:CLS};

	# Get Student Record
	$sth1->execute( $studnum );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $ref = $sth1->fetchrow_hashref;
	my %r = %$ref;

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

	# Get Homeroom teacher;
	$sth2->execute( $r{homeroom} );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $hruserid = $sth2->fetchrow;

	$sth3->execute( $hruserid );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my ($tlastname, $tfirstname ) = $sth3->fetchrow;
	my $hrteacher = "$tfirstname $tlastname ($hruserid)";


	my %newrec; # holds values to write

	$newrec{strengths} = $arr{$key};
	$newrec{challenges} = $arr{$chakey};
	$newrec{support} = $arr{$supkey};
	$newrec{'rec_other'} = $arr{$othkey};
	$newrec{'rec_classroom'} = $arr{$clskey};

	# Student Info
	$newrec{studnum} = $studnum;
	$newrec{treatynum} = $r{treaty};
	$newrec{lastname} = $r{lastname};
	$newrec{firstname} = $r{firstname};
	$newrec{birthdate} = $r{birthdate};
	$newrec{grade} = $r{grade};
	$newrec{hrteacher} = $hrteacher;

	$newrec{date} = $currdate;
	$newrec{author} = $userid; # from login.

	# Assemble recommendations.
	my $rfield;
	foreach my $rkey ( keys %recommend ) {
	    my $key = "$studnum:$rkey";
	    if ( $arr{$key} ) { # is this recommendation checked?
		$rfield .= "$rkey;";
	    }
	}
	$newrec{recommendations} = $rfield; # values stored as semicolon separated list.

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


	# Prepare to insert the record.
	my (@fields, @values, @qst );
	foreach my $key ( sort keys %newrec ) {
	    push @fields, $key;
	    push @values, $newrec{$key};
	    push @qst, '?';
	}
	my $fields = join(',', @fields);
	my $qst = join(',', @qst);

	my $sth = $dbh->prepare( "insert into student_needs ( $fields ) values ( $qst )" ); 
	$sth->execute( @values );

    }


    # Add SSP Exceptions for absent students
    my $sth = $dbh->prepare("select lastname, firstname, grade from studentall where studnum = ?");

    my $first = 1;
    foreach my $studnum ( @absent ) {

	# Get Student Info
	$sth->execute( $studnum );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $ref = $sth->fetchrow_hashref;
	my %r = %$ref;

	if ( $first ) {
	    # Print Form Heading
	    print qq{<form action="$self" method="post"> \n};
	    print qq{<input type="hidden" name="page" value="4">\n};
	    print qq{<input type="hidden" name="tdate" value="$currdate">\n};
	    
	    # Table
	    print qq{<p></p><div class="la"><input type="submit" value="$lex{Save}"></div>\n};
	    print qq{<table cellpadding="3" cellspacing="0" border="1">\n};
	    print qq{<tr><th>$lex{Student}</th><th>Reasons for No Student Score</th></tr>\n};
	    $first = 0;
	}

	print qq{<tr><td class="bra">$r{firstname} $r{lastname}</td>};
	print qq{<td class="la">};
	foreach my $key ( @exceptions ) {
	    print qq{<input type="radio" name="EX:$studnum" value="$key">$exceptions{$key}<br>\n};
	}
	print qq{<span style="font-size:80%;">If Other, Please Specify</span> <input type="text" };
	print qq{size="60" name="OTHER:$studnum"></td></tr>\n};

    }

    if ( not $first ) { 
	print qq{</table>\n};
	print qq{<div class="la"><input type="submit" value="$lex{Save}"></div>\n};
	print qq{</form>\n};

    } else {
	print qq{<p>[ <a href="$self">$title</a> |\n};
	print qq{<a href="$tchpage">$lex{Main}</a> ]</p>\n};
    }

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

    exit;
}




#------------------
sub writeExceptions {
#------------------

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

    my $sth1 = $dbh->prepare("select * from studentall where studnum = ?");

    foreach my $key ( keys %arr ) {

	my ($type, $studnum ) = split(':', $key);

	if ( $type eq 'OTHER' ) { next; } # skip all 'Other' values.

	my $othercode = qq{OTHER:$studnum};
	my $reasonother = $arr{$othercode};
	my $reason = $arr{$key};


	# Check for existing record
	my $sth = $dbh->prepare("select count(*) from ssp_exceptions 
				where studnum = ? and tdate = ? and ssptype = ?");
	$sth->execute( $studnum, $tdate, 'needs' );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $count = $sth->fetchrow;

	# Get Student Info
	$sth1->execute( $studnum );
	if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
	my $studref = $sth1->fetchrow_hashref;
	my %r = %$studref;

	if ( $count ) { # we've already written this record..
	    print qq{<div><b>$lex{'Record Exists'}</b>\n};
	    print qq{- $rec{firstname} $rec{lastname} ($studnum)};
	    print qq{<b>$lex{Test} $lex{Date}:</b> $tdate -<b>$lex{Skipping}</h3>\n};

	    next;
	}

	my $age = calcAge( $r{birthdate}, $tdate );
	my $treatynum = $r{treaty};
	if ( not $treatynum ) { $treatynum = $r{provnum}; }

	# Insert a record.
	$sth = $dbh->prepare("insert into ssp_exceptions
          ( studnum, treatynum, ssptype, tdate, tauthor, tgrade, tage, reasoncode, reasonother ) 
          values ( ?, ?, ?, ?, ?, ?, ?, ?, ? )");
	$sth->execute( $studnum, $treatynum, 'needs', $tdate, $userid, $r{grade},
		       $age, $reason, $reasonother );
        if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }

	print qq{<div>$r{firstname} $r{lastname} Exception $lex{Record} $lex{Added}</div>\n};

    }

    print qq{<p>[ <a href="$self">$title</a> |\n};
    print qq{<a href="$tchpage">$lex{Main}</a> ]</p>\n};
    print qq{</body></html>\n};

    exit;

} # end of writeExceptions



#----------
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";

}


