#!/usr/bin/perl # Copyright 2001-2020 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', 'Add' => 'Add', 'Scores' => 'Scores', 'Common Math Assessment' => 'Common Math Assessment', 'Student' => 'Student', 'Continue' => 'Continue', 'Save' => 'Save', 'Date' => 'Date', 'No User Id' => 'No User Id', 'No Password' => 'No Password', 'Please Log In' => 'Please Log In', 'Grade' => 'Grade', 'Homeroom' => 'Homeroom', 'Select' => 'Select', 'Record' => 'Record', 'Skipping' => 'Skipping', 'Students' => 'Students', 'Test' => 'Test', 'Missing Value' => 'Missing Value', 'Score' => 'Score', 'Record Exists' => 'Record Exists', 'Added' => 'Added', 'Select by' => 'Select by', 'Or' => 'Or', 'Updated' => 'Updated', 'Check' => 'Check', 'Next Page' => 'Next Page', ); use DBI; use CGI; use CGI::Session; use Time::JulianDay; my %exceptions = ( 'moved' => 'Moved', 'attendance' => 'Persistent Absences', 'altprog' => 'Alternate Program', 'other' => 'Other' ); my @exceptions = ( 'moved', 'attendance', 'altprog', 'other'); my $self = 'ilangAdd.pl'; my $q = new CGI; my %arr = $q->Vars; my @time = localtime(time); my $year = $time[5] + 1900; my $month = $time[4] + 1; my $day = $time[3]; if ( length $month == 1 ) { $month = '0'. $month; } if ( length $day == 1 ) { $day = '0'. $day; } my $currdate = "$year-$month-$day"; 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); # 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}); if ($error == -1){ print $q->header( -charset, $charset ); print qq{

$lex{'No User Id'}

}; } if ($error == -2){ print $q->header( -charset, $charset ); print qq{

$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 qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
\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 = qq{$lex{Add} Indigenous Language $lex{Scores}}; print qq{$doctype\n$title\n}; print qq{\n}; if ( not $arr{page} ) { 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}; selectStudents(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; enterScores(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; writeScores(); } elsif ( $arr{page} == 4 ) { delete $arr{page}; writeExceptions(); } #---------------- sub showStartPage { #---------------- my (@homerooms, @grades ); # Get Homerooms my $sth = $dbh->prepare("select distinct homeroom from student where homeroom is not NULL and homeroom != ''"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my $hr = $sth->fetchrow ) { push @homerooms, $hr; } @homerooms = sort {$a <=> $b} @homerooms; # Get Grades $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 ) { push @grades, $gr; } @grades = sort {$a <=> $b} @grades; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; # Select Grade print qq{\n}; print qq{}; print qq{\n}; # OR print qq{\n}; # Select Homeroom print qq{}; print qq{\n}; # Divider print qq{\n}; # check next page? print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Test} $lex{Date}\n}; print qq{ yyyy-mm-dd\n}; print qq{
Pretest or Posttest
$lex{'Select by'} $lex{Grade}
$lex{Or}
$lex{'Select by'} $lex{Homeroom}
$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"; } # Check for any Blanks foreach my $key ( 'prepost', 'tdate' ) { if ( not $arr{$key} ) { print qq{

$lex{'Missing Value'}: $key

\n}; print qq{\n}; exit; } } # Check Date format. my $err = checkDate( $arr{tdate} ); if ( $err == 1 ) { print qq{

$lex{Error}: Date Outside School Year: $arr{tdate}

\n}; print qq{\n}; exit; } elsif ( $err ) { print qq{

Date Error: $err

\n}; print qq{\n}; exit; } my @tdate = split('-', $arr{tdate}); my $tdatejd = julian_day( @tdate ); my $dow = day_of_week( $tdatejd ); $dow++; # since I'm stupid. my $weekday = $dow[$dow]; my $tmonth = $tdate[1]; my $checked; if ( $arr{chk} ) { $checked = 'CHECKED'; } delete $arr{chk}; my ($select, %grades, $group); if ( $arr{grade} ) { $select = 'where grade = ?'; $grades{ $arr{grade} } = 1; } elsif ( $arr{homeroom} ) { $select = 'where homeroom = ?'; # Get the associated grade(s) for this homeroom my $sth = $dbh->prepare("select distinct grade from student where homeroom = ?"); $sth->execute( $arr{homeroom} ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth->fetchrow ) { $grades{$gr} = 1; } } else { #error print qq{

$lex{Error}: No Student Selection

\n}; print qq{\n}; exit; } if ( $arr{grade} ) { $group = $arr{grade}; } else { $group = $arr{homeroom}; } my $sth = $dbh->prepare("select * from student $select order by lastname, firstname"); $sth->execute( $group ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } print qq{
$lex{Test} $lex{Date} $weekday, $arr{tdate}
\n}; # Print Form Heading print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Score Month print qq{
}; print qq{Select Scoring Month\n}; print qq{ Only one pretest/posttest per month allowed
\n}; my $first = 1; # Student Loop while ( my $ref = $sth->fetchrow_hashref ) { my %r = %$ref; if ( $first ) { print qq{
\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{\n}; } print qq{
$lex{Student}$lex{Grade}
}; print qq{$r{lastname}, $r{firstname}$r{grade}
\n}; print qq{
\n}; exit; } # end of selectStudent #-------------- sub enterScores { #-------------- # print "
Enter Scores
\n"; # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Get School Year, we use $ey my ($sy, $ey) = split('-', $schoolyear); my $prepost = $arr{prepost}; delete $arr{prepost}; my $tdate = $arr{tdate}; delete $arr{tdate}; my $scoremonth = $arr{scoremonth}; delete $arr{scoremonth}; $scoremonth =~ s/^0//; # strip any leading zeros. # Anything left in %arr will be student numbers. # print qq{
\n}; # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } if ( not %arr ) { print qq{

$lex{Error}: No Student Selection

\n}; print qq{\n}; exit; } my (%sort, %student); my $sth = $dbh->prepare("select * from student where studnum = ?"); foreach my $studnum (keys %arr ) { $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; $student{$studnum} = $ref; my %r = %{ $ref }; $sort{"$r{lastname}$r{firstname}$studnum"} = $studnum; } # Test Date print qq{
$lex{Test} $lex{Date} $tdate
\n}; # Score Month print qq{
Score Month $month[$scoremonth]
\n}; # Type print qq{
Type $prepost
\n}; # Print Form Heading print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; my $first = 1; my $sth = $dbh->prepare("select score from cree_scores where studnum = ? and scoremonth = ? and prepost = ?"); # Student Loop foreach my $key ( sort keys %sort ) { my $studnum = $sort{$key}; my %r = %{ $student{$studnum}}; # Check for an existing record and get it's score $sth->execute( $studnum, $scoremonth, $prepost ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $score = $sth->fetchrow; # print "SN:$studnum Score:$score
\n"; if ( $first ) { print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{\n}; print qq{\n}; } print qq{
}; print qq{Blank Scores will require exception reasons
$lex{Student}$lex{Grade}$lex{Score}
$r{firstname} $r{lastname}$r{grade}\n}; print qq{
\n}; print qq{
\n}; exit; } # end of enterScores #--------------- sub writeScores { #--------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } # Get School Year my ($sy, $ey) = split('-', $schoolyear); if ( not $ey ) { print qq{

School Year not correctly defined. Contact Office!

\n}; print qq{\n}; exit; } # $ey will be value stored in table (end year). my $tdate = $arr{tdate}; delete $arr{tdate}; my $prepost = $arr{prepost}; delete $arr{prepost}; my $scoremonth = $arr{scoremonth}; delete $arr{scoremonth}; # print qq{-------
\n}; # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $sth1 = $dbh->prepare("select * from studentall where studnum = ?"); my $sth2 = $dbh->prepare("insert into cree_scores ( studnum, treatynum, tdate, tauthor, tgrade, tage, tstamp, prepost, scoremonth, score, schoolyear ) values ( ?, ?, ?, ?, ?, ?, now(), ?, ?, ?, $ey )"); foreach my $studnum ( keys %arr ) { $arr{$studnum} =~ s/\s+//g; # strip any spaces. my $score = $arr{$studnum}; if ( $score =~ m/[a-zA-Z]/ or not $score ) { next; } # skip any values with text or blank # Check for existing score for this student, this scoremonth, this pre/post, this school year my %scorepresent; # stores scores which are already present. my $sth = $dbh->prepare("select id from cree_scores where studnum = ? and prepost = ? and scoremonth = ? and schoolyear = ?"); $sth->execute( $studnum, $prepost, $scoremonth, $ey ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $id = $sth->fetchrow; if ( $id ) { $scorepresent{$studnum} = $id; } # Get Student Info $sth1->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $studref = $sth1->fetchrow_hashref; my %r = %$studref; my $age = calcAge( $r{birthdate}, $tdate ); my $treatynum = $r{treaty}; if ( not $treatynum ) { $treatynum = $r{provnum}; } # Insert or Update if ( $id ) { # we have a current record already # update score my $sth = $dbh->prepare("update cree_scores set score = ? where id = ?"); $sth->execute($score, $id ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } print qq{
}; print qq{$r{firstname} $r{lastname} $lex{Score} $lex{Updated} }; print qq{to $score
\n}; } else { # insert a record # Insert a record. $sth2->execute( $studnum, $treatynum, $tdate, $userid, $r{grade}, $age, $prepost, $scoremonth, $score ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } print qq{
$r{firstname} $r{lastname} $lex{Score} }; print qq{$score $lex{Added}
\n}; } } # end student loop # Add SSP Exceptions for some students my $first = 1; foreach my $studnum ( keys %arr ) { my $score = $arr{$studnum}; if ( $score =~ m/[a-zA-Z]/ or not $score ) { # Get Student Info $sth1->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth1->fetchrow_hashref; my %r = %$ref; if ( $first ) { # Print Form Heading print qq{
\n}; print qq{\n}; print qq{\n}; # Table print qq{

\n}; print qq{\n}; print qq{\n}; $first = 0; } print qq{}; print qq{\n}; } } if ( not $first ) { print qq{
$lex{Student}Reasons for No Student Score
$r{firstname} $r{lastname}}; foreach my $key ( @exceptions ) { print qq{$exceptions{$key}
\n}; } print qq{If Other, Please Specify}; print qq{
\n}; print qq{
\n}; print qq{
\n}; } else { # display link options. print qq{

[ View iLang Scores | \n}; print qq{ Add iLang Scores | \n}; print qq{ $lex{Main} ]

\n}; } print qq{\n}; exit; } # end of writeScores #------------------ sub writeExceptions { #------------------ # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $tdate = $arr{tdate}; delete $arr{tdate}; my $sth1 = $dbh->prepare("select * from student 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, 'cma' ); 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{
$lex{'Record Exists'}\n}; print qq{- $rec{firstname} $rec{lastname} ($studnum)}; print qq{$lex{Test} $lex{Date}: $tdate -$lex{Skipping}\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, 'cree', $tdate, $userid, $r{grade}, $age, $reason, $reasonother ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } print qq{
$r{firstname} $r{lastname} Exception $lex{Record} $lex{Added}
\n}; } print qq{

[ $title |\n}; print qq{$lex{Main} ]

\n}; print qq{\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 "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 "$age:$month"; } #------------ sub checkDate { #------------ use Time::JulianDay; my $date = shift; my ($y,$m,$d) = split('-',$date); if ( not $d ) { return 255; } # wrong format. if ( $m > 12 or $m < 1 ) { return 255; } if ( $d > 31 or $d < 1 ) { return 255; } my $datejd = julian_day( $y, $m, $d ); my $startjd = julian_day( split('-', $schoolstart )); my $endjd = julian_day( split('-', $schoolend )); # print "DATE:$date - $datejd Start:$schoolstart - $startjd End:$schoolend - $endjd
\n"; if ( $datejd > $endjd or $datejd < $startjd ) { return 1; # different code for date outside of current year; } return 0; }