#!/usr/bin/perl
#  Copyright 2001-2019 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',
	   'Report Card' => 'Report Card',
	   'Add' => 'Add',
	   'Clone' => 'Clone',
	   'Subject' => 'Subject',
	   'Section' => 'Section',
	   'Codes' => 'Codes',
	   'Other Codes' => 'Other Codes',
	   'Course Code' => 'Course Code',
	   'Section' => 'Section',
	   'Description' => 'Description',
	   'Short Description' => 'Short Description',
	   'Max' => 'Max',
	   'Characters' => 'Characters',
	   'Grade' => 'Grade',
	   'Start Term' => 'Start Term',
	   'End Term' => 'End Term',
	   'Teacher' => 'Teacher',
	   'Sequence' => 'Sequence',
	   'Controls printing order on report card' => 
	     'Controls printing order on report card',
	   'Web Visible' => 'Web Visible',
	   'Y' => 'Y',
	   'N' => 'N',
	   'Instructional Mode' => 'Instructional Mode',
	   'Class' => 'Class',
	   'Distance' => 'Distance',
	   'Exam Mix' => 'Exam Mix',
	   'School' => 'School',
	   'Blended' => 'Blended',
	   'Faculty' => 'Faculty',
	   'Mark Scheme' => 'Mark Scheme',
	   'Objective' => 'Objective',
	   'Save' => 'Save',
	   'Credit' => 'Credit',
	   'Difficulty' => 'Difficulty',
	   'Subject Area' => 'Subject Area',
	   'Calc Average' => 'Calc Average',
	   'If your subject only has marks and comments, no objective entry' => 
	     'If your subject only has marks and comments, no objective entry',
	   'is required. If you have non-mark based objectives, please enter' =>
	     'is required. If you have non-mark based objectives, please enter',
	   'the description that will appear on the report card. These will' =>
	     'the description that will appear on the report card. These will',
	   'also appear for evaluation entry. Limit: 255 characters' =>
	     'also appear for evaluation entry. Limit: 255 characters',
	   'Error' => 'Error',
	   'Contact' => 'Contact',
	   'No Student(s) Found' => 'No Student(s) Found',
	   'Exists' => 'Exists',
	   'Record(s) Stored' => 'Record(s) Stored',
	   'cannot be larger than' => 'cannot be larger than',
	   'Terms' => 'Terms',
	   'No Spaces' => 'No Spaces',
	   'Only' => 'Only',
	   'Course' => 'Course',
	   'Letters' => 'Letters',
	   'Numbers' => 'Numbers',
	   'Master' => 'Master',

	   );

my $studentCheck = 0; # check for students in that grade.
my $defaultSection = '1'; # default section value
my $maxterms = 12; # maximum size of term values.

use DBI;
use CGI;

my $self = 'subjadd.pl';

my $defaultsequence = 100; 
# Starting value for sequence number.

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

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

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

my $title = "$lex{Add} $lex{Course} $lex{Master}";
print qq{$doctype\n<html><head><title>$title</title>\n};
print qq{<link rel="stylesheet" href="$css" type="text/css">\n};
print qq{<style>textarea { height:1em; }</style>\n};
print qq{$chartype\n</head><body style="padding:1em 2em;">\n};

print qq{[ <a href="$homepage">$lex{Main}</a> |\n};
print qq{<a href="$reppage">$lex{'Report Card'}</a> ]\n};

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

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

if ( $arr{writeflag} ) {
    delete $arr{writeflag};
    writeRecord();
}


# If 'cloning' selected while looping, pull in the record.
my %subj = ();
my $cloneflag;
if ( $arr{subjsec} ) {
    $sth = $dbh->prepare("select * from subject where subjsec = ?"); 
    $sth->execute( $arr{subjsec} );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my $ref = $sth->fetchrow_hashref;
    %subj = %$ref;
    $cloneflag = 1;
}


# Load teachers into hash
my %teachers;
$sth = $dbh->prepare("select lastname, firstname, userid from staff 
 order by lastname, firstname"); 
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
while ( my ( $lastname, $firstname, $userid) = $sth->fetchrow ) {
    $teachers{"$lastname, $firstname ($userid)"} = $userid;
}


# Set sequence number; if cloning, keep existing val
if ( $subj{sequence} ) { $defaultsequence = $subj{sequence}; }



print qq{<form action="$self" method="post" style="display:inline;">\n};
print qq{<input type="submit" value="$lex{Clone} $lex{Course}">\n};
print qq{<input type="text" name="subjsec" size="9"> };
print qq{($lex{'Course Code'}-$lex{Section})</form>\n};

print qq{<h1>$title</h1>\n};


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

print qq{<table cellpadding="3" cellspacing="0" border="0">\n};
print qq{<tr><td></td><td><input type="submit" value="$lex{Save} $lex{Course}};
print qq{"> (<span style="color:red;">* = Required</span>)</td></tr>\n};

print qq{<tr><td class="bra">$lex{'Course Code'}<span style="color:red;">*</span></td>\n};
print qq{<td><input type="text" name="subjcode" size="10" value="$subj{subjcode}">};

print qq{ [ <a href="../sasked/coursecodeview.pl" target="_blank">View Course Codes (new tab)</a> ]</td></tr>\n};


if ( not $subj{section} ) { $subj{section} = $defaultSection; }
if ( $cloneflag ) { $subj{section} = undef; }
print qq{<tr><td class="bra">$lex{Section}<span style="color:red;">*</span></td>
<td><input type="text" name="section" size="6" value="$subj{section}"></td></tr>\n};

print qq{<tr><td class="bra">$lex{Description}<span style="color:red;">*</span></td>
<td><input type="text" name="description" size="50" maxlength="255" 
  value="$subj{description}"></td></tr>\n};

print qq{<tr><td class="bra">$lex{'Short Description'}<span style="color:red;">*</span></td>
<td><input type="text" name="smdesc" size="8" maxlength="8" value="$subj{smdesc}"> };
print qq{$lex{Max}: 8 $lex{Characters}</td></tr>\n};


print qq{<tr><td class="bra">$lex{Grade}<span style="color:red;">*</span></td>
<td><input type="text" Name="grade" size="4" maxlength="8" value="$subj{grade}">
</td></tr>\n};

print qq{<tr><td class="bra">$lex{'Start Term'}<span style="color:red;">*</span></td>
<td><input type="text" name="startrptperiod" size="6" value="$subj{startrptperiod}">
</td></tr>\n};

print qq{<tr><td class="bra">$lex{'End Term'}<span style="color:red;">*</span></td>
<td><input type="text" name="endrptperiod" size="6" value="$subj{endrptperiod}">
</td></tr>\n};

my ($userid, $name);
if ( $subj{teacher} ) {
    if ( $subj{teacher} =~ m/\((\w+)\)/ ) { # if teacher has parenthesis, strip name;
	$userid = $1;
    } else {
	$userid = $subj{teacher};
    }

    # Get teacher name
    my $sth = $dbh->prepare("select lastname, firstname from staff where userid = ?"); 
    $sth->execute( $userid );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my ($ln, $fn ) = $sth->fetchrow;
    $name = "$ln, $fn ($userid)";
}

# Teacher entry
print qq{<tr><td class="bra">$lex{'Teacher'}<span style="color:red;">*</span></td>
<td><select name="teacher"><option value="$userid">$name</option>\n};

foreach my $key ( sort keys %teachers ) {
    my $userid = $teachers{$key};
    print qq{<option value="$userid">$key</option>\n};
}

print qq{<option></option></select></td></tr>\n};

print qq{<tr><td class="bra">$lex{Sequence}</td>\n};
print qq{<td><input type="text" name="sequence" size="8" value="$defaultsequence">\n};
print qq{$lex{'Controls printing order on report card'}.</td></tr>\n};

print qq{<tr><tr><td class="bra">$lex{'Web Visible'}</td>\n};
print qq{<td><select name="visible"><option>$subj{visible}</option>\n};
print qq{<option>$lex{Y}</option><option>$lex{N}</option></select>};
print qq{ Allow Gradebook Scores to be seen on parent/student site</td></tr>\n};

print qq{<tr><td class="bra">$lex{'Instructional Mode'}</td>\n};
print qq{<td><select name="instmode"><option>$subj{instmode}</option>\n};
print qq{<option>$lex{'Class'}</option><option>$lex{Distance}</option></select></td></tr>\n};

print qq{<tr><td class="bra">$lex{'Exam Mix'}</td><td><select name="exammix">\n};
print qq{<option>$subj{exammix}</option><option>$lex{School}</option><option>$lex{Blended}};
print qq{</option></select> Grade 12 Departmental Exams are 'Blended', otherwise 'School'</td></tr>\n};

print qq{<tr><td class="bra">$lex{Faculty}</td><td><input type="text" name="faculty" 
 size="12" maxlength="255" value="$subj{faculty}"></td></tr>\n};

print qq{<tr><td class="bra">Location / Room #</td><td><input type="text" name="location" 
size="12" maxlength="255" value="$subj{location}"></td></tr>\n};

# Don't show this, since this is the layout for gradebook marks.
# print qq{<tr><td class="bra">$lex{'Mark Scheme'}</td><td><textarea name="markscheme" 
# rows="6" cols="40">$subj{markscheme}</textarea></td></tr>\n};

print qq{<tr><td class="bra">$lex{'Credit'}</td><td>};
if ( @creditValues ) { # from transcript.conf
    print qq{<select name="credit">\n};
    print qq{<option>$subj{credit}</option>\n};
    foreach my $val ( @creditValues ) {
	print qq{<option>$val</option>\n};
    }
    print qq{</select>\n};
} else {
    print qq{<input type="text" name="credit" size="4" };
    print qq{maxlength="8" value="$subj{credit}">};
}
print qq{</td></tr>\n};


print qq{<tr><td class="bra">$lex{'Difficulty'}</td>};
print qq{<td><input type="text" name="difficulty" 
size="4" maxlength="8" value="$subj{difficulty}"></td></tr>\n};

print qq{<tr><td class="bra">$lex{'Subject Area'}</td>\n};

if ( %gradRequirements ) {
    print qq{<td><select name="area"><option>$subj{area}</option>\n};
    foreach my $key ( sort keys %gradRequirements ) {
	print qq{<option>$key</option>\n};
    }
    print qq{</select></td></tr>\n};
} else {
    print qq{<td><input type="text" name="area" size="20" maxlength="255" };
    print qq{value="$subj{area}"></td></tr>\n};
}

print qq{<tr><td class="bra">$lex{'Calc Average'}</td><td><select name="calcavg">\n};
if ( $subj{calcavg} ) { # We have an existing value...
    print qq{<option>$subj{calcavg}</option>\n};
}
print qq{<option>$lex{N}</option><option>$lex{Y}</option>\n};
print qq{</select></td></tr>\n};


print qq{<tr><td></td><td><div style="border:1px solid gray;margin:1em 0;padding:1em;width:60ch;">\n};
print qq{$lex{'If your subject only has marks and comments, no objective entry'}<br>\n};
print qq{$lex{'is required. If you have non-mark based objectives, please enter'}<br>\n};
print qq{$lex{'the description that will appear on the report card. These will'}<br>\n};
print qq{$lex{'also appear for evaluation entry. Limit: 255 characters'}</div></td></tr>\n};

for my $i ( 1..20 ) {
    my $field = 'q'. $i;
    print qq{<tr><td class="bra">$lex{Objective} $i</td><td><textarea };
    print qq{name="$field" cols="60">$subj{$field}</textarea></td></tr>\n};
}

print qq{<tr><td></td><td>\n};
print qq{<input type="submit" value="$lex{Save} $lex{Course}"></td></tr>\n};
print qq{</table></form></body></html>\n};



#--------------
sub writeRecord {
#--------------

    foreach my $chk ( qw(subjcode section )) {
	my $val = $arr{$chk};
	if ( $val =~ m/\W|\s+/ ) { # check for nonalphas and spaces.
	    print qq{<h3>$lex{Letters},$lex{Numbers} $lex{Only}; $lex{'No Spaces'}: \n};
	    print qq{<span style="color:red;">$val</span></h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}
    }

    foreach my $chk (qw(description smdesc )) {
	my $val = $arr{$chk};
	if ( $val !~ m/\w|\s/ ) { # only alphanumerics and spaces
	    print qq{<h3>$lex{Letters},$lex{Numbers} $lex{Only}: \n};
	    print qq{<span style="color:red;">$val</span></h3>\n};
	    print qq{</body></html>\n};
	    exit;
	}
    }


    # Make sure it has the right fields filled in and no hyphens
    if ( not $arr{subjcode} or not $arr{section} or 
	 not $arr{description} or not $arr{startrptperiod} or 
	 not $arr{endrptperiod} or not $arr{grade} or 
	 not $arr{teacher} or  $arr{subjcode} =~ m/-/) {

	print qq{<h1>$lex{'Required Field Missing'}</h1>\n};
	print qq{</body></html>\n};
	exit;
    }


    # Join Subject and Section to make Subjsec
    my $subjsec = $arr{subjcode}. '-'. $arr{section};


    # Check for existing subject-section ( subjsec )
    my $sth = $dbh->prepare("select count(*) from subject where subjsec = ?");
    $sth->execute( $subjsec );
    if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
    my $count = $sth->fetchrow;
    if ( $count > 0 ){
	print qq{<h1>$lex{Course} $lex{Exists}</h1>\n};
	print qq{</body></html>\n};
	exit;
    }

    if ( $studentCheck ) {
	# Check that this grade exists ( among students )
	my $sth = $dbh->prepare("select count(*) from student where grade = ?");
	$sth->execute( $arr{grade} );
	if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
	my $gradecount = $sth->fetchrow;
	if ( $gradecount < 1 ){ # no kids in this grade.
	    print qq{<h1>$lex{'No Student(s) Found'} &ndash; $lex{Grade}: $arr{grade}</h1>\n};
	    print qq{</body></html>\n};
	    exit;
	}
    }


    # Check for start/end term errors: sequence, < 1, > maxterms
    if ( $arr{startrptperiod} > $arr{endrptperiod} or 
	 $arr{startrptperiod} < 1 or 
	 $arr{endrptperiod} < 1 ) {
	print qq{<h3>$lex{'Start Term'} $lex{'cannot be larger than'} $lex{'End Term'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    if ( $arr{startrptperiod} > $maxterms or $arr{endrptperiod} > $maxterms ) {
	print qq{<h3>$lex{Terms} $lex{'cannot be larger than'} $maxterms</h3>\n};
	print qq{</body></html>\n};
	exit;
    }



    #Note: modules and type field left null

    $sth = $dbh->prepare("insert into subject ( 
     subjcode, description, grade, teacher,
     sequence , section, subjsec,
     q1, q2, q3, q4, q5, q6, q7, q8, q9, q10,
     q11, q12, q13, q14, q15, q16, q17, q18, q19, q20,
     visible, startrptperiod, endrptperiod,
     markscheme, faculty, location, smdesc,
     instmode, exammix, credit, difficulty, area, calcavg )
     values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,
      ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
    # 40 fields;

    $sth->execute( $arr{subjcode}, $arr{description}, $arr{grade}, 
     $arr{teacher}, $arr{sequence}, $arr{section}, $subjsec,
     $arr{q1}, $arr{q2}, $arr{q3}, $arr{q4}, $arr{q5},
     $arr{q6}, $arr{q7}, $arr{q8}, $arr{q9}, $arr{q10},
     $arr{q11}, $arr{q12}, $arr{q13}, $arr{q14}, $arr{q15},
     $arr{q16}, $arr{q17}, $arr{q18}, $arr{q19}, $arr{q20},
     $arr{visible}, $arr{startrptperiod}, $arr{endrptperiod},
     $arr{markscheme}, $arr{faculty}, $arr{location}, $arr{smdesc},
     $arr{instmode}, $arr{exammix}, $arr{credit}, $arr{difficulty}, 
     $arr{area}, $arr{calcavg} );
    

    if (not $DBI::errstr ) {
	print qq{<h3>$lex{'Record(s) Stored'}</h3>\n};
    } else { 
	print qq{<h3>$lex{Error}: $DBI::errstr<br>};
	print qq{$lex{Contact} $adminname };
	print qq{(<a href="mailto:$adminemail">$adminemail</a>)</h3>\n};
    }

    print qq{<p>[ <a href="$self">$lex{Add} $lex{Course}</a> |\n};
    print qq{<a href="$reppage">$lex{'Report Card'}</a> ]</p>\n};
    print qq{</center></body></html>\n};

    exit;

}
