#!/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', 'PPVT Scores' => 'PPVT Scores', 'Edit' => 'Edit', 'Update' => 'Update', 'No Blanks Allowed' => 'No Blanks Allowed', 'No User Id' => 'No User Id', 'No Password' => 'No Password', 'Please Log In' => 'Please Log In', 'Record(s) Updated' => 'Record(s) Updated', 'Edit not allowed' => 'Edit not allowed', 'Raw Score' => 'Raw Score', 'Standard Score' => 'Standard Score', 'Confidence' => 'Confidence', 'Interval' => 'Interval', 'Percentile' => 'Percentile', 'Normal Curve Equivalent' => 'Normal Curve Equivalent', 'Stanine' => 'Stanine', 'Growth Scale Value' => 'Growth Scale Value', 'Age' => 'Age', 'Equivalent' => 'Equivalent', ); use DBI; use CGI; use CGI::Session; my $self = 'pvTestEdit.pl'; # Configuration Settings ----------------------- my $allow_author = 1; # allow author to edit my $allow_ppvt = 1; # allow user with ppvt 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}, $dbh); 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 qq{$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 ppvt 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 'PPVT' ) { $accessdra = 1; } # print qq{VAL:$val ACCESS:$accessdra
\n}; } # Page Header print qq{$doctype\n$lex{Edit} $lex{'PPVT Scores'}}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} ]\n}; print qq{

$lex{Edit} $lex{'PPVT Scores'}

\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 * from ppvt_test where id = ?"); $sth->execute( $testid ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; # Access Controls my $failflag; if ( not $allow_author and not $allow_ppvt ) { $failflag = 1; } # nobody edits elsif ( $allow_author and $ref->{tauthor} ne $userid ) { $failflag = 1; } # not author if ( $allow_ppvt and $accessppvt ) { $failflag = 0; } # allow override of author failure if ( $failflag ) { print qq{

$lex{'Edit 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}; # Print Form Heading print qq{\n}; exit; } #-------------- sub writeTest { #-------------- # This only updates student scores; no change to test itself. # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # 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; } } my $sth = $dbh->prepare("update ppvt_test set confend = ?, confsetting = ?, confstart = ?, equivage = ?, equivgrade = ?, growthsv = ?, normalce = ?, percentile = ?, rawscore = ?, stanine = ?, stdscore = ? where id = ?"); $sth->execute($arr{confend},$arr{confsetting},$arr{confstart},$arr{equivage}, $arr{equivgrade},$arr{growthsv},$arr{normalce},$arr{percentile}, $arr{rawscore},$arr{stanine},$arr{stdscore}, $arr{id} ); 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; }

}; print qq{
$firstname $lastname
$ref->{tdate} — $ref->{tauthor}
$lex{'Raw Score'}	\n}; print qq{

$lex{'Standard Score'}	\n}; print qq{
$lex{Percentile}	\n}; print qq{

$lex{Age} $lex{Equivalent}	\n}; print qq{
\n}; print qq{