#!/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: $@
\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 ); 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'}. "\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
\n}; } # Page Header my $title = qq{$lex{Edit} $lex{'Reading Tests'}}; print qq{$doctype\n$title}; print qq{\n}; print qq{\n}; if ( not $arr{page} ) { # calendar popup. print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } print qq{$chartype\n\n}; print qq{[ $lex{Main} ]\n}; print qq{

$lex{Edit} $lex{'Reading Tests'}

\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}
\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
\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{

$lex{Edit} $lex{'Not Allowed'}

\n}; print qq{\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
\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{

\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\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{

$firstname $lastname ($studnum)

\n}; print qq{

\n}; print qq{\n}; #print qq{style="border:1px solid gray;margin:0.5em;padding:0.5em;">\n}; print qq{}; print qq{\n}; print qq{\n}; print qq{\n\n}; print qq{\n}; print qq{\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{

Error Category $category NOT $r{category} - Order $seq Update?\n}; # print qq{

\n}; # } # if ( $name ne $r{name} ) { print qq{

Error Name $name NOT $r{name} - }; # print qq{Order $seq - Update?

\n}; # print qq{\n}; # } print qq{\n}; print qq{\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{\n}; print qq{\n}; $first = 0; } my %r = %{ $rldata{$seq}}; print qq{}; print qq{\n}; print qq{\n}; } print qq{

Order	$lex{Category}	$lex{Name}	$lex{Score}
$lex{'Reading Level'}	$readlevel
$lex{Author}	$tauthor
$lex{'Test Date'}	\n}; print qq{\n}; print qq{
$lex{Grade}	}; print qq{
$seq	$category	$name	}; print qq{
}; print qq{New Scores to Add based on Outcomes for this reading level.
}; print qq{Blank Score Below = No Record Added
$seq	}; print qq{New Score }; print qq{$r{category}	$r{name}	}; print qq{

\n}; print qq{

\n}; print qq{\n}; print qq{\n}; exit; } #------------ sub writeTest { #------------ foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } =head # Check for any Blanks foreach my $key ( sort keys %arr ) { if ( not $arr{$key} ) { print qq{

$lex{'No Blanks Allowed'}

\n}; print qq{\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{

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

\n}; print qq{

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

\n}; print qq{\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{

Update Score to Category:$r{category} / Name:$r{name} for ID:$value

\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{

Season $season

\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{

$lex{'Record(s) Updated'}

\n}; print qq{

[ $lex{Main} ]

\n}; print qq{\n}; exit; }