#!/usr/bin/perl # Copyright 2001-2024 Leslie Richardson # This file is part of Open Admin for Schools. # Add writing test scores to the write_scores table. my %lex = ('Main' => 'Main', 'Error' => 'Error', 'Students' => 'Students', 'Continue' => 'Continue', 'Save' => 'Save', 'Select' => 'Select', 'Check' => 'Check', 'Next Page' => 'Next Page', 'Required' => 'Required', 'Test Date' => 'Test Date', ); use DBI; use CGI; use Cwd; my $self = 'wrAdd.pl'; 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: $@
\n"; die $lex{Error}. "$self: $@\n"; } my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); my $userid = $ENV{'REMOTE_USER'}; print $q->header( -charset, $charset ); my $mycss = $css; if ( getcwd() =~ /tcgi/ ){ # we are in cgi $mycss = $tchcss; } # Page Header my $title = qq{Add Writing Tests}; print qq{$doctype\n$title\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} ]\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; enterTests(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; writeRecords(); } #---------------- sub showStartPage { #---------------- # Get Grades my (%grades, %homerooms); my $sth = $dbh->prepare("select distinct grade from student where grade != '' and grade is not NULL"); $sth->execute; if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth->fetchrow ) { $grades{$gr} = 1; } my @grades = sort { $a <=> $b } keys %grades; # Homerooms my $sth = $dbh->prepare("select distinct homeroom from student where homeroom != '' and homeroom is not NULL"); $sth->execute; if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } while ( my $hr = $sth->fetchrow ) { $homerooms{$hr} = 1; } my @homerooms = sort { $a <=> $b } keys %homerooms; print qq{

\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Students - Grade print qq{\n}; print qq{\n}; # Select Homeroom my $sth = $dbh->prepare("select lastname, firstname from staff s, staff_multi sm where s.userid = sm.userid and field_name = 'homeroom' and field_value = ?"); print qq{\n}; # Check Next Page # print qq{\n}; # print qq{\n}; # Continue print qq{\n}; print qq{

$lex{'Test Date'}	\n}; print qq{\n}; print qq{(yyyy-mm-dd)
$lex{Select} $lex{Students}
Grade	or
Homeroom	}; print qq{
$lex{Check} $lex{'Next Page'}	\n}; # print qq{
	\n

\n}; print qq{

\n}; print qq{\n}; print qq{\n}; exit; } # end of showStartPage #---------------- sub selectStudents { #---------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $chk = $arr{chk}; delete $arr{chk}; # Check for any Blanks in date if ( not $arr{date} ) { print qq{

Date $lex{Required}

\n}; print qq{\n}; exit; } # Check for messed up Date Format my $errorflag; if ( $arr{date} =~ m/\// ) { # slashes rather than hyphens $errorflag = 1; } else { my ($y,$m,$d) = split('-', $arr{date}); 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{

Year:$y Month:$m Day:$d

\n}; print qq{

$lex{'Test Date'} $lex{Error}: $arr{date}

\n}; print "\n"; exit; } my ($sth, $groupname); if ( $arr{grade} ) { # we're picking a group $sth = $dbh->prepare("select lastname, firstname, studnum from student where grade = ? order by lastname, firstname"); $sth->execute( $arr{grade} ); $groupname = qq{Grade $arr{grade}}; } elsif ( $arr{homeroom} ) { $sth = $dbh->prepare("select lastname, firstname, studnum from student where homeroom = ? order by lastname, firstname"); $sth->execute( $arr{homeroom} ); $groupname = qq{Homeroom $arr{homeroom}}; } else { # everyone $sth = $dbh->prepare("select lastname, firstname, studnum from student order by lastname, firstname"); $sth->execute; } if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Form Header print qq{

\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; # print qq{\n}; print qq{\n}; while ( my ( $lastname, $firstname, $studnum ) = $sth->fetchrow ) { print qq{\n}; # print qq{\n}; print qq{}; } print qq{\n}; print qq{

Test	$groupname

Test - Add Test Score }; # print qq{Absent - Add Reason for Absence
		$lastname, $firstname ($studnum)

\n}; exit; } # end of selectStudents #------------- sub enterTests { #------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Check for any Blanks in date if ( not $arr{date} ) { print qq{

Date $lex{Required}

Year:$y Month:$m Day:$d

\n}; print qq{

$lex{'Test Date'} $lex{Error}: $arr{date}

\n}; print "\n"; exit; } my $date = $arr{date}; delete $arr{date}; # Done with date print qq{

Date: $date

\n}; my ($sth, $groupname); if ( $arr{grade} ) { # we're picking a group $sth = $dbh->prepare("select lastname, firstname, studnum, grade from student where grade = ? order by lastname, firstname"); $sth->execute( $arr{grade} ); $groupname = qq{Grade $arr{grade}}; } elsif ( $arr{homeroom} ) { $sth = $dbh->prepare("select lastname, firstname, studnum, grade from student where homeroom = ? order by lastname, firstname"); $sth->execute( $arr{homeroom} ); $groupname = qq{Homeroom $arr{homeroom}}; } else { # Error... NOT everyone print qq{

Missing Grade or Homeroom

\n}; print qq{\n}; exit; } if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Print Form Heading print qq{

\n}; print qq{\n}; print qq{\n}; # Save print qq{

\n}; # Print Table Header and Heading values print qq{\n}; print qq{\n}; print qq{\n}; while ( my ( $lastname, $firstname, $studnum, $grade ) = $sth->fetchrow ) { print qq{}; print qq{\n}; } print qq{

Enter Writing Score 1-4
}; print qq{Single Decimals allowed (2.8)
Student	Score
$lastname, $firstname (Gr $grade)

\n}; print qq{

\n}; exit; } #--------------- sub writeRecords { #--------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $date = $arr{date}; delete $arr{date}; # Now only student scores left in hash # strip any missing scores (ie. blanks) foreach my $studnum ( sort keys %arr ) { if ( not $arr{$studnum} ) { # no score delete $arr{$studnum}; } } # Check for any values outside of range 1-4, and text characters foreach my $studnum ( sort keys %arr ) { if ( ($arr{$studnum} =~ m/[0-9]/) and ( $arr{$studnum} > 4 or $arr{$studnum} < 1 )) { print qq{

Score $arr{$studnum} is outside of allowed range (1-4)

\n}; print qq{\n}; exit; } if ( $arr{$studnum} =~ m/[a-zA-Z]/ ) { print qq{

$arr{$studnum} contains non-numeric values

\n}; print qq{\n}; exit; } } # Get full student record my $sth1 = $dbh->prepare("select * from student where studnum = ?"); # Check for existing record with same date and student. my $sth = $dbh->prepare("select count(*) from write_scores where studnum = ? and tdate = ?"); foreach my $studnum ( sort keys %arr ) { $sth->execute( $studnum, $date); my $count = $sth->fetchrow; if ( $count ) { # Get Name $sth1->execute($studnum); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth1->fetchrow_hashref; my %r = %$ref; print qq{

Record exists for $date for student $r{firstname} $r{lastname} ($studnum)

\n}; print qq{\n}; exit; } } # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Get Season from Date my ($y,$m, $d) = split( '-', $date ); my $season = 'Undefined'; if ( $m == 9 or $m == 10 ) { # September, October - Fall (Sept 1 - Oct 31 ); $season = qq{$y-Fall}; } elsif ( $m == 1 or $m == 2 or $m == 3 ) { # Spring Jan 1 to March 31 $season = qq{$y-Spring}; } elsif ( $m == 6 or ($m == 5 and $d >= 15 ) ) { # Summer May 15 to June 30 $season = qq{$y-Summer}; } # Otherwise season is undefined. print qq{

Season $season - $date

\n}; # Write the test record my $sth = $dbh->prepare("insert into write_scores ( studnum, tdate, tauthor, tgrade, tage, score, season ) values ( ?, ?, ?, ?, ?, ?, ?) "); foreach my $studnum ( keys %arr ) { my $score = $arr{$studnum}; # Get Student Record $sth1->execute( $studnum); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth1->fetchrow_hashref; my %r = %$ref; # Get age. my $age = calcAge($r{birthdate}, $currdate); $sth->execute( $studnum, $date, $userid, $r{grade}, $age, $score, $season ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } print qq{

Score $score Added for $r{firstname} $r{lastname} ($studnum)

\n}; } print qq{\n}; exit; } #---------- 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
\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 qq{$age:$month}; }