#!/usr/bin/perl
#  Copyright 2001-2022 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.

# confyear.pl - configure the school year.

my %lex = ('Eoy' => 'Eoy',
	   'School Year' => 'School Year',
	   'Error' => 'Error',
	   'Set' => 'Set',
	   'Tracks' => 'Tracks',
	   'Number of' => 'Number of',
	   'Terms' => 'Terms',
	   'Start Date' => 'Start Date',
	   'End Date' => 'End Date',
	   'Continue' => 'Continue',
	   'Grades' => 'Grades',
	   'Separate with Spaces' => 'Separate with Spaces',
	   'Term Block' => 'Term Block',
	   'Term' => 'Term',
	   'Start' => 'Start',
	   'End' => 'End',
	   'Default' => 'Default',
	   'Track' => 'Track',
	   'Main' => 'Main',
	   'Start' => 'Start',
	   'Description' => 'Description',
	   'Map' => 'Map',
	   'Desc' => 'Desc',
	   'File' => 'File',
	   'Updated' => 'Updated',
	   'Record(s) Stored' => 'Record(s) Stored',
	   'Save' => 'Save',
	   'Illegal' => 'Illegal',
	   'later than' => 'later than',
	   'Date' => 'Date',
	   'Sequence' => 'Sequence',
	   'Duplicate' => 'Duplicate',
	   'Missing' => 'Missing',
	   'Outside' => 'Outside',

	   );

my $self = 'confyear.pl';

my $defaultEtcPath = '../../etc';

use DBI;
use CGI;
use Data::Dumper;
use Time::JulianDay;

$Data::Dumper::Purity = 1;
$Data::Dumper::Indent = 0;

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

# Set Path to etc directory
if ( not $g_EtcPath ) {
    $g_EtcPath = $defaultEtcPath;
}


my $q = CGI->new;
print $q->header( -charset, $charset ); 
my %arr = $q->Vars;

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


# Page Header
print qq{$doctype\n<html><head><title>$lex{Set} $lex{'School Year'}</title>\n};
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> | <a href="$eoypage">$lex{Eoy}</a> |\n};
print qq{<a href="$self">$lex{Start}</a> ]\n};

print qq{<h1>$lex{Set} $lex{'School Year'}</h1>\n};

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

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

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

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

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


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

    # Read in values from conf_system;
    my $sth = $dbh->prepare("select datavalue from conf_system
			    where dataname = ? and filename = 'admin'");
    foreach my $dataname ( qw( g_MTrackTerm schoolstart schoolend schoolyear )) { # load 4 values.
	$sth->execute($dataname);
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my $datavalue = $sth->fetchrow;
	eval $datavalue;
	if ( $@ ) {
	    print $lex{Error}. " $@<br>\n";
	    die $lex{Error}. " $@\n";
	}
    }


    # Figure out terms and tracks.
    my $deftracks = keys %g_MTrackTerm;

    #~~  if ( not $g_DefaultTrack ) { $g_DefaultTrack = 1; }

    my $defterms;
    for my $trk ( 1..$deftracks ) {
	my $terms = keys %{$g_MTrackTerm{$trk}};
	if ( $terms > $defterms ) { $defterms = $terms; }
    }
    
    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;float:left;">\n};

    # School Year
    if ( not $schoolyear and $schoolstart and $schoolend ) {
	my @start = split(/-/, $schoolstart );
	my @end = split(/-/, $schoolend );
	$schoolyear = "$start[0]-$end[0]";
    }

    print qq{<tr><td class="bra">$lex{'School Year'} };
    print qq{<span style="font-size:80%;font-weight:normal;">(yyyy-yyyy)</span></td>\n};
    print qq{<td class="la"><input type="text" name="schoolyear" size="10" value="$schoolyear">};
    print qq{</td></tr>\n};

    print qq{<tr><td class="bra">$lex{'Start Date'} };
    print qq{<span style="font-size:80%;font-weight:normal;">(yyyy-mm-dd)</span></td>\n};
    print qq{<td class="la"><input type="text" name="startdate" value="$schoolstart" size="10">\n};
    print qq{</td></tr>\n};

    print qq{<tr><td class="bra">$lex{'End Date'} };
    print qq{<span style="font-size:80%;font-weight:normal;">(yyyy-mm-dd)</span></td>\n};
    print qq{<td class="la"><input type="text" name="enddate" value="$schoolend" size="10">\n};
    print qq{</td></tr>\n};

    print qq{<tr><td class="bra">Max $lex{'Number of'} $lex{Terms}</td>\n};
    print qq{<td class="la"><input type="text" name="terms" size="4" value="$defterms"></td></tr>\n};

    print qq{<tr><td class="bra">Max $lex{'Number of'} $lex{Tracks}</td>\n};
    print qq{<td class="la"><input type="text" name="tracks" size="4" value="$deftracks"></td></tr>\n};

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

    # Explain Term/Track
    print qq{<table cellpadding="3" cellspacing="0" border="0" };
    print qq{style="padding:0.5em;float:left;width:50ch;">\n};

    print qq{<tr><td>A <b>Term</b> is a period of time with a report card at the end. };
    print qq{If you have 4 report cards in a school year, you have 4 terms. };
    print qq{Elementary schools typically have 3 terms/report card (November,March,June) };
    print qq{while high schools typically have 4 terms (October,January,April,June)</td></tr>\n};

    print qq{<tr><td>A <b>Track</b> is a group of grades that share the same terms };
    print qq{(with same start/end dates.) Typically in a K-12 school there will be 2 tracks };
    print qq{with the K-9 grades in one track and 10-12 grades in another track };
    print qq{(each with their own distinct term start/end dates). High Schools and Elementary };
    print qq{schools typically are only a single track.</td></tr>\n};

    print qq{</table>\n};

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

    exit;

} # end of showStartPage



#-----------
sub setTerms {
#-----------

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

    if ( not checkdate( $arr{startdate}) ) {
	print qq{<h3>$lex{Illegal} $lex{'Start Date'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    if ( not checkdate( $arr{enddate}) ) {
	print qq{<h3>$lex{Illegal} $lex{'End Date'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    # Check school year
    my ($sy, $ey) = split(/-/, $arr{schoolyear});
    my $failflag;
    if ( $sy =~ m/\D/ ) { $failflag = 1; };
    if ( $ey =~ m/\D/ ) { $failflag = 1; };
    if ( length($sy) != 4 or length($ey) != 4 ) { $failflag = 1; };
    if ( not $ey ) { $failflag = 1; }; # wrong separator.
    if ( $failflag ) {
	print qq{<h3>$lex{Illegal} $lex{'School Year'}: $arr{schoolyear} \n};
	print qq{(YYYY-YYYY)</h3>\n</body></html>\n};
	exit;
    }


    # zero pad month and day.
    foreach my $var ( $arr{startdate}, $arr{enddate} ) {
	my ( $y, $m, $d ) = split('-', $var );
	if ( length($m) == 1 ) { $m = '0'. $m; };
	if ( length($d) == 1 ) { $d = '0'. $d; };
	$var = "$y-$m-$d";
    }


    my $schoolstartjd = julian_day( split('-', $arr{startdate}) );
    my $schoolendjd = julian_day( split('-', $arr{enddate}) );

    if ( $schoolstartjd > $schoolendjd ) {
	print qq{<h3>$lex{'Start Date'} $lex{'later than'} $lex{'End Date'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }



    # Read in values from conf_system;
    my $sth = $dbh->prepare("select datavalue from conf_system
      where dataname = ? and filename = 'admin'");
    foreach my $dataname ( qw( g_MTrackTerm g_TrackDisplay g_TermDisplay )) { 
	$sth->execute( $dataname );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my $datavalue = $sth->fetchrow;
	eval $datavalue;
	if ( $@ ) {
	    print $lex{Error}. " $@<br>\n";
	    die $lex{Error}. " $@\n";
	}
    }


    # Form / Table Start
    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="2">\n};
    foreach my $key ( keys %arr ) { # add passed values as hidden also.
	print qq{<input type="hidden" name="$key" value="$arr{$key}">\n};
    }
    
    print qq{<table cellpadding="3" cellspacing="0" border="0">\n};
    print qq{<tr><td class="bra">$lex{'School Year'}</td><td class="la" colspan="2">$arr{schoolyear}</td></tr>\n};


    # Tracks Row
    print qq{<tr><td class="bra">$lex{Tracks}-></td>\n};
    for my $trk ( 1 .. $arr{tracks} ) {
	print qq{<td class="bcn" colspan="2">$trk  $lex{Desc} <input type="text" name="trkdesc:$trk" };
	print qq{size="8" maxlength="8" value="$g_TrackDisplay{$trk}"></td>};
    }
    print qq{</tr>\n};


    # Term Description
    print qq{<tr><td class="bcn">$lex{Terms}</td>\n};
    for my $trk ( 1 .. $arr{tracks} ) {
	print qq{<td class="cn">$lex{Description}</td>};
	print qq{<td class="cn">$lex{'Start Date'}</td>\n};
    }
    print qq{</tr>\n};


    # Term Rows
    for my $trm ( 1 .. $arr{terms} ) {
	print qq{<tr><td class="bcn">$trm</td>};
	for my $trk ( 1 .. $arr{tracks} ) {
	    print qq{<td class="cn">};
	    print qq{<input type="text" name="trmdesc:$trk:$trm" size="12" value="$g_TermDisplay{$trk}{$trm}"></td>};
	    print qq{<td class="la"><input type="text" name="date:$trk:$trm" };
	    print qq{size="12" value="$g_MTrackTerm{$trk}{$trm}{'start'}"></td>};
	}
	print qq{</tr>\n};
    }


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

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

    exit;

}


#------------
sub setTracks {  # and end dates, 
#------------

    # Set Mapping of Grades to School, Track End dates, TermDisplayBlock values (ie. semester)
    # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}<br>\n"; }

    my $startjd = julian_day( split('-', $arr{startdate}) );
    my $endjd = julian_day( split('-', $arr{enddate}) );

    # Check Date Values
    my %dateseqcheck;
    foreach my $key ( keys %arr ) { 
	my ($type, $trk, $trm ) = split(':', $key );
	if ( $type eq 'date' ) { # check the date
	    if ( not $arr{$key} ) { next; } # blank is possible for shorter tracks
	    if ( not checkdate( $arr{$key} ) ) {
		print qq{<h3>$lex{Illegal} $lex{Date} - $lex{Track} $trk $lex{Term} $trm</h3>\n};
		print qq{</body></html>\n};
		exit;
	    }

	    # Zero pad the dates.
	    my ( $y, $m, $d ) = split('-', $arr{$key} );
	    if ( length($m) == 1 ) { $m = '0'. $m; };
	    if ( length($d) == 1 ) { $d = '0'. $d; };
	    $arr{$key} = "$y-$m-$d";

	    my $currjd = julian_day( split('-', $arr{$key} ) );
	    if ( $currjd < $startjd or $currjd > $endjd ) { 
		print qq{<h3>$lex{Illegal} $lex{Date} - $lex{Outside} $lex{'School Year'}: $arr{$key}</h3>\n};
		print qq{</body></html>\n};
		exit;
	    }

	    $dateseqcheck{$trk}{$trm} = $arr{$key}; # the date
	}
    }

    my %enddates;
    
    # Check Date Sequence for each track.
    foreach my $trk ( keys %dateseqcheck ) {
	my ($prevjd, $currjd);
	foreach my $trm ( sort { $a <=> $b } keys %{ $dateseqcheck{$trk}} ) {
	    my $nextterm = $trm + 1; # even if no 'next' term.
	    if ( $dateseqcheck{$trk}{$nextterm} ) { # if we have this next term...
		my $nexttermstartjd = julian_day( split('-', $dateseqcheck{$trk}{$nextterm} ));
		my $daybefore = $nexttermstartjd - 1;
		$enddates{$trk}{$trm} = join('-',inverse_julian_day($daybefore));
#		print "TRM:$trm Next Term:$nextterm NextDate: $dateseqcheck{$trk}{$nextterm} ";
#		print "NextJD:$nexttermstartjd Before:$daybefore<br>\n";

	    } else { # no next term, use year end date, which will be editable.
		$enddates{$trk}{$trm} = $arr{enddate}; # end of school year.
	    }

#	    print qq{Trk:$trk  Trm:$trm Date:$dateseqcheck{$trk}{$trm}<br>\n";

	    $prevjd = $currjd;
	    $currjd = julian_day( split(/-/, $dateseqcheck{$trk}{$trm} ));

#	    print qq{Curr:$currjd Prev:$prevjd<br>\n";

	    if ( $currjd < $prevjd ) { # Error
		print qq{<h3>$lex{Date} $lex{Sequence} $lex{Error}<br>};
		print qq{$lex{Track} $trk  $lex{Term} $trm  $lex{Date} $dateseqcheck{$trk}{$trm}</h3>\n};
		print qq{</body></html>\n};
		exit;
	    }
	}
    }

=head  # Test End Dates
    print qq{<p>End Dates</p>\n};
    foreach my $trk ( sort keys %enddates ) {
	foreach my $trm ( sort keys %{ $enddates{$trk} } ) {
	    print "Trk:$trk Term:$trm  Date:$enddates{$trk}{$trm}<br>\n";
	}
    }
=cut

    
    # Read in values from conf_system;
    my $sth = $dbh->prepare("select datavalue from conf_system
      where dataname = ? and filename = 'admin'");
    foreach my $dataname ( qw( g_MTrackTermType g_TermDisplayBlock )) { # load values.
	$sth->execute( $dataname );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my $datavalue = $sth->fetchrow;
	eval $datavalue;
	if ( $@ ) {
	    print $lex{Error}. " $@<br>\n";
	    die $lex{Error}. " $@\n";
	}
    }


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


    # School Year
    print qq{<p style="font-weight:bold;">$lex{'School Year'} $arr{schoolyear}</p>\n};


    # Start Table
    print qq{<table cellpadding="3" cellspacing="0" border="0" };
    print qq{style="border:1px solid gray;padding:0.5em;margin:0.5em;">\n};
    print qq{<tr><td colspan="4" style="font-size:130%;font-weight:bold;padding-top:0em;">};
    print qq{$lex{Set} $lex{'End Date'}</td></tr>\n};

    # Display Term Start/End Dates and Tracks.
    # Track Descriptions Row
    print qq{<tr><th>$lex{Terms}</th>\n};
    for my $trk ( 1 .. $arr{tracks} ) {
	my $trkkey = "trkdesc:$trk";
	print qq{<th colspan="2">$lex{Track} $trk: $arr{$trkkey}</th>};
    }
    print qq{</tr>\n};

    # Start/End Date Descriptors
    print qq{<tr><td></td>\n};
    for my $trk ( 1 .. $arr{tracks} ) {
	print qq{<td class="cn">$lex{'Start Date'}</td>};
	print qq{<td class="cn">$lex{'End Date'}</td>};
    }
    print qq{</tr>\n};

    # Term Rows
    my %eoyflag; # flag use of end of year date
    for my $trm ( 1 .. $arr{terms} ) {
	my $termkey = "trmdesc:$trm";
	print qq{<tr><td class="bcn">$trm</td>};
	for my $trk ( 1 .. $arr{tracks} ) {
	    my $sdatekey = "date:$trk:$trm";
	    my $warnflag; # flag for holes between term blocks, or other issue

	    if ( $arr{$sdatekey} ) { # if this track has start date, then do enddate;
		
		# Figure out next term start date, if any
		my $nextterm = $trm + 1;
		my $nextdatekey = "date:$trk:$nextterm";
		my $nextstart;
		if ( $arr{$nextdatekey} ) {
		    $nextstart = $arr{$nextdatekey};
		} else {
		    $nextstart = $arr{enddate}; # use school end date;
		    $eoyflag{$trk} = 1;
		}

		
		my $enddate;
		if ( not $eoyflag{$trk} ) { # use back one day from next term start.
		    my $calcenddate;
		    if ( my $nextstartjd = julian_day( split('-',$nextstart)) ) {
			my @tmp = inverse_julian_day($nextstartjd - 1);
			if ( length $tmp[1] == 1 ) { $tmp[1] = '0'. $tmp[1]; }
			if ( length $tmp[2] == 1 ) { $tmp[2] = '0'. $tmp[2]; }
			$calcenddate = join('-',@tmp );
		    }
		    
		    if ( $g_MTrackTerm{$trk}{$trm}{'end'} ) { 
			$enddate = $g_MTrackTerm{$trk}{$trm}{'end'};
		    } else { # no date stored, used calculated date
			$enddate = $calcenddate;
		    }

		    if ( $enddate ne $calcenddate ) { # set warning element over mismatch.
			$warnflag = qq{<span style="color:red;" }.
			qq{title="Current End Date:$enddate does not match recommended }.
			qq{end date $calcenddate">Warning</span>};
			$enddate = $calcenddate;
		    }
		    
		} else { # it is eoy
		    if ( $g_MTrackTerm{$trk}{$trm}{'end'} ) { # if we have a value
			$enddate = $g_MTrackTerm{$trk}{$trm}{'end'}
		    } else {
			$enddate = $arr{enddate};
		    }
		}

#		print "Track:$trk Term:$trm Enddate:$enddate EOY:$eoyflag<br>\n";
		
		# Print results.
		print qq{<td class="cn">$arr{$sdatekey}</td>};
		if ( $eoyflag{$trk} ) { # allow to edit.
		    print qq{<td class="cn"><input type="text" name="edate:$trk:$trm" };
		    print qq{size="12" value="$enddate"></td>\n};
		} else { # just update the value.
		    print qq{<td class="cn">};
		    print qq{<input type="hidden" name="edate:$trk:$trm" value="$enddate">\n};
		    print qq{$enddate</td>\n};
		}

	    } else { # delete and skip
		delete $arr{$sdatekey};
		print qq{<td colspan="2"></td>};
		
	    }
	}
	print qq{</tr>\n};
    }
    print qq{</table>\n};


    # Map Grades to Tracks.
    my %map;
    foreach my $grade (sort {$a <=> $b} keys %g_MTrackTermType ) {
	my $trk = $g_MTrackTermType{$grade};
	if ( not exists $map{$trk} ) { 
	    $map{$trk} = "$grade ";
	} else {
	    $map{$trk} = $map{$trk}. "$grade ";
	}
    }

    print qq{<table cellpadding="3" cellspacing="0" border="0" };
    print qq{style="border:1px solid gray;padding:0.5em;margin:0.5em;">\n};
    print qq{<tr><td colspan="4" style="font-size:130%;font-weight:bold;">};
    print qq{$lex{Map} $lex{Grades} -> $lex{Tracks}</td></tr>\n};
    print qq{<tr><th>$lex{Tracks}</th><th>$lex{Description}</th><th>$lex{Grades}</th></tr>\n};
    for my $trk ( 1..$arr{tracks} ) {
	my $key = 'trkdesc:'. $trk;
	print qq{<tr><td class="bcn">$trk</td><td>$arr{$key}</td>};
	print qq{<td><input type="text" name="trkgrades:$trk" size="30" value="$map{$trk}"></td></tr>\n};
	if ( $trk == 1 ) { # put in extra row
	    print qq{<tr><td></td><td></td><td class="cn">$lex{'Separate with Spaces'}</td></tr>\n};
	}
    }

    print qq{</table>\n};

# Disabled currently, since not used in report card.    
=head
    # Set Term Display Block (ie. Semester, etc)
    print qq{<table cellpadding="3" cellspacing="0" border="0" };
    print qq{style="border:1px solid gray;padding:0.5em;">\n};
    my @keys = sort keys %g_TermDisplayBlock;

    print qq{<tr><td colspan="4" style="font-size:130%;font-weight:bold;padding-top:0em;">};
    print qq{$lex{Set} $lex{'Term Block'} $lex{Description}</td></tr>\n};
    print qq{<tr><th>$lex{Start} $lex{Term}</th><th>$lex{End} $lex{Term}</th>};
    print qq{<th>$lex{Description}</th></tr>\n};

    for my $idx ( 1..$arr{terms} ) { # worst case scenario for number of desc required.
	my $key = shift @keys; # get value like '1-2'
	my $blockname = $g_TermDisplayBlock{$key};
	my ($sterm, $eterm) = split('-', $key);
	
	print qq{<tr><td class="cn"><input type="text" name="sterm:$idx" size="4" value="$sterm"></td>\n};
	print qq{<td class="cn"><input type="text" name="eterm:$idx" size="4" value="$eterm"></td>\n};
	print qq{<td><input type="text" name="blkdesc:$idx" size="12" value="$blockname"></td></tr>\n};
    }

    print qq{</table>\n};

=cut

    print qq{<div style="margin:0.5em;"><input type="submit" value="$lex{Save}"></div>\n};


    # put rest of hidden values ( in %arr )
    foreach my $key ( sort keys %arr ) { # add passed values as hidden also.
	print qq{<input type="hidden" name="$key" value="$arr{$key}">\n};
    }

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

    exit;

}



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

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

    my $startjd = julian_day( split('-', $arr{startdate}) );
    my $endjd = julian_day( split('-', $arr{enddate}) );

    # Check End Date Values
    my %dateseqcheck;
    my %trkgrades;
    foreach my $key ( keys %arr ) { 
	my ($type, $trk, $trm ) = split(/:/, $key );
	if ( $type eq 'edate' ) { # check the date
	    if ( not checkdate( $arr{$key} ) ) {
		print "<h3>$lex{Illegal} $lex{Date} - $lex{Track} $trk $lex{Term} $trm</h3>\n";
		print "</body></html>\n";
		exit;
	    }

	    # Zero pad the end dates.
	    my ( $y, $m, $d ) = split('-', $arr{$key} );
	    if ( length($m) == 1 ) { $m = '0'. $m; };
	    if ( length($d) == 1 ) { $d = '0'. $d; };
	    $arr{$key} = "$y-$m-$d";


	    my $currjd = julian_day( split(/-/, $arr{$key} ) );
	    if ( $currjd < $startjd or $currjd > $endjd ) { 
		print "<h3>$lex{Illegal} $lex{Date} - $lex{Outside} $lex{'School Year'}: $arr{$key}</h3>\n";
		print "</body></html>\n";
		exit;
	    }

	    $dateseqcheck{$trk}{$trm} = $arr{$key}; # the date
	}
	if ( $type eq 'trkgrades' ) {
	    # strip leading and trailing spaces.
	    $arr{$key} =~ s/^\s+//;
	    $arr{$key} =~ s/\s+$//;
	    $trkgrades{$trk} = $arr{$key};
	}
    }


    # Check Date Sequence for each track.
    foreach my $trk ( keys %dateseqcheck ) {
	my ($prevjd, $currjd);
	foreach my $trm ( sort keys %{ $dateseqcheck{$trk}} ) {

#	    print "Trk:$trk  Trm:$trm Date:$dateseqcheck{$trk}{$trm}<br>\n";

	    $prevjd = $currjd;
	    $currjd = julian_day( split(/-/, $dateseqcheck{$trk}{$trm} ));

#	    print "Curr:$currjd Prev:$prevjd<br>\n";

	    if ( $currjd < $prevjd ) { # Error
		print "<h3>$lex{Date} $lex{Sequence} $lex{Error}<br>";
		print "$lex{Track} $trk  $lex{Term} $trm  $lex{Date} $dateseqcheck{$trk}{$trm}</h3>\n";
		print "</body></html>\n";
		exit;
	    }
	}
    }



    # Check for Correct and Complete Mapping of tracks to grades, none missed, none redundant.
    my %grades;
    my %dupgrades;
    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 ) {
	$grades{$gr} = 1;
    }

    # %grades holds existing grades, and has all elements removed by
    # %loop below; if there is anything left in %grades at the end,
    # %then we have some grades not mapped. Looking for duplicate
    # %mapping (in both strings), we insert values in the loop below
    # %and if we have one already existing before insert, then we have
    # %a duplicate.

    foreach my $trk ( keys %trkgrades ) {
	my @grades = split(/\s+/, $trkgrades{$trk} );
	foreach my $gr ( @grades ) {
	    if ( $dupgrades{$gr} ) {
		print qq{<h3>$lex{Map} $lex{Error}: $lex{Duplicate} $lex{Grade} $gr</h3>\n};
		print qq{</body></html>\n};
		exit;

	    } else { # add in this grade
		$dupgrades{$gr} = 1;
	    }

	    delete $grades{$gr};
	}
    }
    if ( %grades ) { # some student grades not mapped 
	print qq{<h3>$lex{Map} $lex{Error}: $lex{Missing} $lex{Grades} };
	foreach my $gr ( keys %grades ) { print qq{$gr }; }
	print qq{</h3></body></html>\n};
	exit;
    }



    my %save; # records to store

    # School Start/End
    my $schoolstartEnc = setScalar( 'schoolstart', $arr{startdate} );
    # print "SchoolStart:$schoolstartEnc<br>\n";
    $save{schoolstart} = $schoolstartEnc;

    my $schoolendEnc = setScalar( 'schoolend', $arr{enddate} );
    # print "SchoolEnd:$schoolendEnc<br>\n";
    $save{schoolend} = $schoolendEnc;

    # School Year
    my $schoolyearEnc = setScalar( 'schoolyear', $arr{schoolyear} );
    # print "SchoolYear:$schoolyearEnc<br>\n";
    $save{schoolyear} = $schoolyearEnc;


    # g_TermDisplay hash
    my %newhash;
    for my $trk ( 1..$arr{tracks} ) {
	for my $trm ( 1..$arr{terms} ) {
	    my $key = "trmdesc:$trk:$trm";
	    if ( $arr{$key} ) { $newhash{$trk}{$trm} = $arr{$key}; }
	}
    }
    my $g_TermDisplayEnc = setScalar( '*g_TermDisplay', \%newhash );
    # print "g_TermDisplay:$g_TermDisplayEnc<br>\n";
    $save{'g_TermDisplay'} = $g_TermDisplayEnc;


    # g_TermDisplayBlock hash
    my %newhash = ();
    for my $trm ( 1..$arr{terms} ) {
	my $key = 'blkdesc:'. $trm;
	my $datakey = $arr{"sterm:$trm"}. '-'. $arr{"eterm:$trm"};
	if ( $arr{$key} ) { $newhash{$datakey} = $arr{$key}; }
    }
    my $g_TermDisplayBlockEnc = setScalar('*g_TermDisplayBlock', \%newhash);
    # print "g_TermDisplayBlock: $g_TermDisplayBlockEnc<br>\n";
    $save{'g_TermDisplayBlock'} = $g_TermDisplayBlockEnc;


    # now do term blocks for each track ( first 
    # MTrackTerm{Track}{Term}->{ start => sdate, end =>
    # edate }, MTrackType ( maps grades to tracks),


    # Set MTrackTerm
    my %newhash;
    for my $trk ( 1..$arr{tracks} ) {
	for my $trm ( 1..$arr{terms} ) {
	    my $sdatekey = "date:$trk:$trm";
	    my $edatekey = "edate:$trk:$trm";
	    if ( not $arr{$sdatekey} or not $arr{$edatekey} ) { next; }

	    my $dref = {};
	    $dref->{'start'} = $arr{$sdatekey};
	    $dref->{'end'} = $arr{$edatekey};
	    $newhash{$trk}{$trm} = $dref;
	}
    }
    my $g_MTrackTermEnc = setScalar('*g_MTrackTerm', \%newhash);
    # print "g_MTrackTerm: $g_MTrackTermEnc<br>\n";
    $save{'g_MTrackTerm'} = $g_MTrackTermEnc;



    # Set MTrackTermType
    %newhash = ();
    for my $trk ( 1..$arr{tracks} ) {
	my $key = 'trkgrades:'. $trk;
	my @grades = split(/\s/, $arr{$key});
	for my $grade (@grades) {
	    $newhash{$grade} = $trk;
	}
    }

    # populate empty hash if since track and no values.
    if ( not %newhash and $arr{tracks} == 1 ) { # put them all in one track
	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 ) {
	    $newhash{$gr} = 1;
	}
    }

    my $g_MTrackTermTypeEnc = setScalar('*g_MTrackTermType', \%newhash);
    # print "g_MTrackTermType: $g_MTrackTermTypeEnc<br>\n";
    $save{'g_MTrackTermType'} = $g_MTrackTermTypeEnc;



    # Set Track Description g_TrackDisplay
    %newhash = ();
    for my $trk ( 1..$arr{tracks} ) {
	my $key = 'trkdesc:'. $trk;
	if ( $arr{$key} ) {
	    $newhash{$trk} = $arr{$key};
	}
    }

    if ( not %newhash and $arr{tracks} == 1  ) {
	$newhash{'1'} = 'All';
    }

    my $g_TrackDisplayEnc = setScalar('*g_TrackDisplay', \%newhash);
    # print "g_TrackDisplay: $g_TrackDisplayEnc<br>\n";
    $save{'g_TrackDisplay'} = $g_TrackDisplayEnc;


#    print "Records to Save:<br>\n";
#    foreach my $key ( sort keys %save ) { print "K:$key V:$save{$key}<br>\n"; }



    # Save the records into conf_system
    my $sth = $dbh->prepare("update conf_system set datavalue = ? 
      where dataname = ? and filename = 'admin'");
    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    foreach my $dataname ( keys %save ) {
	$sth->execute( $save{$dataname}, $dataname );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    }
    print qq{<h3>$lex{'Record(s) Stored'}</h3>\n};


    # Write the admin.conf file.
    my $filename = "$g_EtcPath/admin.conf";

    system("cp -f $g_EtcPath/admin.conf.root $g_EtcPath/admin.conf");
    # print "Result:", $? >> 8, "<br>\n";

    open(FH,">>$filename") or
	die "Cannot open file $filename: $!\n"; # open for append

    my $sth = $dbh->prepare("select id, datavalue from conf_system 
     where filename = 'admin' order by dataname");
    $sth->execute;
    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }

    while ( my ($id, $value) = $sth->fetchrow ) {
	print FH $value, "\n";
    }

    print FH "\n1;\n"; # put in correct file ending with a 1.
    close FH;

    print qq{<h3>$lex{Main} $lex{File} $lex{Updated}</h3>\n};
    print qq{</body></html>\n};

    exit;
}


#------------
sub setScalar {
#------------

    my ($dataname, $datavalue) = @_;

    my $name_ref = [ ];
    my $value_ref = [ ];
    push @$name_ref, $dataname;
    push @$value_ref, $datavalue;
    my $d = Data::Dumper->new( $value_ref, $name_ref );
    return $d->Dump;

}


#------------
sub checkdate {  # check date for validity
#------------

    my @mdays = (0,31,28,31,30,31,30,31,31,30,31,30,31);
    my $maxyear = 2100;

    my $val = shift;

    if ( not $val =~ m/-/ ) {  # fail if no hyphens
	return undef;
    }

    # Strip Spaces
    $val =~ s/^\s+//g;
    $val =~ s/\s+$//g;

    my ( $year, $month, $day) = split(/-/, $val);


    # Check for non-digits
    if ($year =~ m/\D/) { return undef; }
    if ($month =~ m/\D/) { return undef; }
    if ($day =~ m/\D/) { return undef; }

    # reset Feb max days, if leap years
    if ($month == 2) {
	if ($year % 4 != 0) { $mdays[2] = 28; }
	elsif ($year % 400 == 0) { $mdays[2] = 29; }
	elsif ($year % 100 == 0) { $mdays[2] = 28; }
	else { $mdays[2] = 29; }
    }

    # check ranges
    if ( $day < 1 or $day > $mdays[$month] ) { # days out of range
	return undef;
    } elsif ( $month < 1 or $month > 12 ) { # month error
	return undef;
    } elsif ( $year < 1 or $year > $maxyear ) {
	return undef;
    }

    return $val;

}
