#!/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',
	   'Reading Tests' => 'Reading Tests',
	   'Edit' => 'Edit',
	   'Reading Level' => 'Reading Level',
	   'Category' => 'Category',	   
	   'Name' => 'Name',
	   'Save' => 'Save',
	   'Score' => 'Score',
	   'Test Date' => 'Test Date',
	   'No Blanks Allowed' => 'No Blanks Allowed',
	   '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',
	   'Record(s) Updated' => 'Record(s) Updated',
	   'Author' => 'Author',
	   'Grade' => 'Grade',
	   'Not Allowed' => 'Not Allowed',

	   );

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


my $self = 'readTestEdit.pl';

# Configuration Settings -----------------------
my $allow_author = 1; # allow author to edit
my $allow_dra = 1; # allow user with dra access code to edit
#-----------------------------------------------

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


# Check for dra access code
my $sth = $dbh->prepare("select field_value from staff_multi 
  where field_name = 'access' and userid = ?");
$sth->execute( $userid );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }

my $accessdra;
while ( my $val = $sth->fetchrow ) {
    if ( uc $val eq 'DRA' ) { $accessdra = 1; }
    # print qq{VAL:$val ACCESS:$accessdra<br>\n};
}




# Page Header
my $title = qq{$lex{Edit} $lex{'Reading Tests'}};
print qq{$doctype\n<html><head><title>$title</title>};
print qq{<link rel="stylesheet" href="$tchcss" type="text/css">\n};

print qq{<style type="text/css">td.ra { text-align:right; }
td.bcn { font-size:100%;text-align:center;font-weight:bold; }
</style>\n};

if ( not $arr{page} ) { # calendar popup.
    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>$lex{Edit} $lex{'Reading Tests'}</h1>\n};


if ( not $arr{page} ) {
    editTest( $arr{testid} );

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


#-------------
sub editTest {
#-------------

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

    my $testid = shift;

    # Get Reading Test fields.
    my $sth = $dbh->prepare("select studnum, readlevel, tdate, tauthor, tgrade, dratype from 
			    read_test where id = ?");
    $sth->execute( $testid );
    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
    my ( $studnum, $readlevel, $tdate, $tauthor, $tgrade, $dratype ) = $sth->fetchrow;
    # print qq{SN:$studnum  RL:$readlevel  DAte:$tdate  Author: $tauthor DRAtype:$dratype<br>\n};

    # Access Controls
    my $failflag;
    if ( not $allow_author and not $allow_dra ) { $failflag = 1; } # nobody edits
    elsif ( $allow_author and $tauthor ne $userid ) { $failflag = 1; } # not author

    if ( $allow_dra and $accessdra ) { $failflag = 0; } # allow override of author failure
    if ( $failflag ) {
	print qq{<h3>$lex{Edit} $lex{'Not Allowed'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    # Get Student Name
    my $sth1 = $dbh->prepare("select lastname, firstname from student where studnum = ?");
    $sth1->execute( $studnum );
    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    my ( $lastname, $firstname ) = $sth1->fetchrow;
    # print qq{Name: $lastname $firstname<br>\n};

    # Get the reading level values from read_level_dra? tables
    my %rldata; # store reading level categories, names.
    my $rltable = 'read_level_dra2';
    if ( $dratype == 3 ) {
	$rltable = 'read_level_dra3';
    }
    if ( not $dratype ) { $dratype = '2'; } # populate the test with a correct value

    
    my $sth1 = $dbh->prepare("select * from $rltable where readlevel = ?");
    $sth1->execute( $readlevel );
    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    while ( my $ref = $sth1->fetchrow_hashref ) {
	$rldata{ $ref->{seq}} = $ref; # store data by sequence number.
    }
    
    # Print Form Heading
    print qq{<form action="$self" method="post"> \n};
    print qq{<input type="hidden" name="page" value="1">\n};
    print qq{<input type="hidden" name="testid" value="$testid">\n};
    print qq{<input type="hidden" name="dratype" value="$dratype">\n};
    print qq{<input type="hidden" name="readlevel" value="$readlevel">\n};

    
    # Get Reading Scores
    my $sth2 = $dbh->prepare("select id, category, name, score, seq from read_test_score 
      where testid = ? order by seq");
    $sth2->execute( $testid );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }

    # Print Table Header and Heading values
    print qq{<h3>$firstname $lastname ($studnum)</h3>\n};
    print qq{<div class="la"><input type="submit" value="$lex{Save}"></div>\n};

    print qq{<table cellpadding="3" cellspacing="0" border="1" style="margin:0.5em;">\n};
    #print qq{style="border:1px solid gray;margin:0.5em;padding:0.5em;">\n};
    print qq{<tr><td class="bra">$lex{'Reading Level'}</td>};
    print qq{<td colspan="3" class="la">$readlevel</td></tr>\n};
    print qq{<tr><td class="bra">$lex{Author}</td><td colspan="3" class="la">$tauthor</td></tr>\n};

    print qq{<tr><td class="bra">$lex{'Test Date'}</td><td class="la" colspan="3"><input type="text" };
    print qq{name="tdate" id="tdate" size="10" value="$tdate">\n};
    print qq{<button type="reset" id="start_trigger">...</button>\n};
    print qq{</td></tr>\n\n};

    
    print qq{<tr><td class="bra">$lex{Grade}</td><td colspan="3" class="la">};
    print qq{<input type="text" name="tgrade" value="$tgrade" style="width:4ch;"></td></tr>\n};

    print qq{<tr><th>Order</th><th>$lex{Category}</th><th>$lex{Name}</th><th>$lex{Score}</th></tr>\n};

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

# Comparisons and Updates turned off		
#	my %r = %{ $rldata{$seq} }; # defined category, name
#	if ( $category ne $r{category} ) {
#	    print qq{<div><b>Error</b> Category $category NOT $r{category} - Order $seq Update?\n};
#	    print qq{<input type="checkbox" name="CAT:$id" value="1"></div>\n};
#	}

#	if ( $name ne $r{name} ) { print qq{<div><b>Error</b> Name $name NOT $r{name} - };
#				   print qq{Order $seq - Update?</div>\n};
#				   print qq{<input type="checkbox" name="CAT:$id" value=1"></div>\n};
#	}
	
	print qq{<tr><td class="cn">$seq</td><td class="ra">$category</td><td class="ra">$name</td>\n};
	print qq{<td class="la"><input type="text" name="$id" size="3" value="$score">};
	print qq{</td></tr>\n};
	delete $rldata{$seq}; # remove this record, so we can see if we need to add records.
	
    }

    # Left over outcomes/objectives without a score record.
    my $first = 1;
    foreach my $seq ( sort keys %rldata ) {
	if ( $first ) {
	    print qq{<tr style="background-color:#DDD;"><td class="bla" colspan="4">};
	    print qq{New Scores to Add based on Outcomes for this reading level.</td></tr>\n};
	    print qq{<tr style="background-color:#DDD;"><td class="bla" colspan="4">};
	    print qq{Blank Score Below = No Record Added</td></tr>\n};
	    $first = 0;
	}
	    
	my %r = %{ $rldata{$seq}};
	print qq{<tr><td class="cn">$seq</td><td class="ra">};
	print qq{<span style="color:green;font-weight:bold;">New Score</span> };
	print qq{$r{category}</td>};
	print qq{<td class="ra">$r{name}</td>\n};
	print qq{<td class="la"><input type="text" name="score:$seq" size="3" value="">};
	print qq{</td></tr>\n};
    }

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

    print qq{<script type="text/javascript">
     Calendar.setup({
        inputField     :    "tdate", 
        ifFormat       :    "%Y-%m-%d",
        button         :    "start_trigger",
        singleClick    :    false,
        step           :    1
    });
    </script>\n};

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

    exit;

}


#------------
sub writeTest {
#------------

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

=head    
    # Check for any Blanks
    foreach my $key ( sort keys %arr ) { 
	if ( not $arr{$key} ) {
	    print qq{<h3>$lex{'No Blanks Allowed'}</h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}
    }
=cut

    # Check for messed up Date Format
    my $errorflag;
    if ( $arr{tdate} =~ m/\// ) { # slashes rather than hyphens
	$errorflag = 1;
    } else {
	my ($y,$m,$d) = split('-', $arr{tdate});
	if ( not $m or ( $m < 1 or $m > 12 )) { $errorflag = 1; }
	if ( not $d or ( $d < 1 or $d > 31 )) { $errorflag = 1; }
    }
    if ( $errorflag ) {
	# print qq{<div>Year:$y Month:$m Day:$d</div>\n};
	print qq{<h3>$lex{'Test Date'} $lex{Error}: $arr{tdate}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    # remove extra values
    my $testid = $arr{testid};
    my $tdate = $arr{tdate};
    my $tgrade = $arr{tgrade};
    my $dratype = $arr{dratype};
    my $readlevel = $arr{readlevel};
    delete $arr{testid};
    delete $arr{tdate};
    delete $arr{tgrade};
    delete $arr{dratype};
    delete $arr{readlevel};

    my $rltable = 'read_level_dra2';
    if ( $dratype == 3 ) {
	$rltable = 'read_level_dra3';
    }

    
    foreach my $key ( keys %arr ) {
	my ($text,$val) = split(':', $key);
	if ( $text eq 'CAT' ) { # update the record with corrected category and name values;

	    # Outline: get readlevel from test, and then load the
	    # correct category,name from the correct read_level_draX
	    # table, using the sequence number of the record to
	    # update.
	    
	    #my $sth = $dbh->prepare("select readlevel from  read_test where id = ?");
	    #$sth->execute( $testid );
	    #if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	    #my $readlevel = $sth->fetchrow;


	    # find the sequence number in the record to update, to locate correct values
	    my $sth = $dbh->prepare("select seq from read_test_score where id = ?");
	    $sth->execute( $value );
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	    my $seq = $sth->fetchrow;

	    # load the correct category and name from read_level table.
	    my $sth = $dbh->prepare("select * from $rltable where readlevel = ? and seq = ?");
	    $sth->execute( $readlevel, $seq  );
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	    my $ref = $sth->fetchrow_hashref;
	    my %r = %$ref; # new category,name values from read_level table to put into read_test_score

	    print qq{<div>Update Score to Category:$r{category} / Name:$r{name} for ID:$value</div>\n};
	    my $sth = $dbh->prepare("update read_test_score set category = ?, name = ? where id = ?");
#	    $sth->execute( $r{category}, $r{name}, $value);
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }

	    delete $arr{$key};

	} elsif ( $text eq 'score' ) { # add a new record into read_test_score table;
	    # We must add new records to read_test_score
	    if ( not $arr{$key} ) { next; } # skip if no score added.
	    
	    # Load the read_level record given reading level and
	    # sequence, then add the record using tesetid, category,
	    # name, sequence, score;
	    my $seq = $val; # split above.
	    my $sth = $dbh->prepare("select * from $rltable where readlevel = ? and seq = ?");
	    $sth->execute( $readlevel, $seq ); # val is sequence
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	    my $ref = $sth->fetchrow_hashref;
	    my %r = %$ref;

	    my $sth = $dbh->prepare("insert into read_test_score (testid,category,name,seq,score) 
				    values(?,?,?,?,?)");
	    $sth->execute( $testid, $r{category},$r{name}, $seq, $arr{$key} );
	    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	    
	    delete $arr{$key};
	}

    }

    
    # Get Season from Date ($tdate)
    my ($y,$m, $d ) = split( '-', $tdate );
    my $season;
    if ( $m == 1 ) {
	$y--;
	$season = qq{$y-Fall};

    } elsif ( $m >= 8 ) {
	$season = qq{$y-Fall};

    } elsif ( $m <= 7 ) {
	$season = qq{$y-Spring};
    } else {
	$season = 'Undefined';
    }
    print qq{<div>Season $season</div>\n};
    
    

    # Update the test record
    my $sth = $dbh->prepare("update read_test set tdate = ?, tgrade = ?, season = ?, dratype = ?
			    where id = ?");
    $sth->execute( $tdate, $tgrade, $season, $dratype, $testid );
    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }


    # Update the score records
    my $sth = $dbh->prepare("update read_test_score set score = ? where id = ?");

    foreach my $key ( sort keys %arr ) {
	$sth->execute( $arr{$key},$key );
	if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }

    }

    print qq{<h1>$lex{'Record(s) Updated'}</h1>\n};

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

    exit;

}
