#!/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', 'Add' => 'Add', 'Scores' => 'Scores', 'Student' => 'Student', 'Raw Score' => 'Raw Score', 'Continue' => 'Continue', 'Standard Score' => 'Standard Score', 'Percentile' => 'Percentile', 'Age' => 'Age', 'Equivalent' => 'Equivalent', 'Record(s) Stored' => 'Record(s) Stored', 'Save' => 'Save', 'Test Date' => 'Test Date', 'No User Id' => 'No User Id', 'No Password' => 'No Password', 'Please Log In' => 'Please Log In', 'Grade' => 'Grade', 'Select' => 'Select', 'No Blanks Allowed' => 'No Blanks Allowed', 'Grade' => 'Grade', 'Homeroom' => 'Homeroom', 'Select' => 'Select', 'Students' => 'Students', 'No Students Found' => 'No Students Found', ); use DBI; use CGI; use CGI::Session; my $self = 'pvTestAdd.pl'; my $q = new CGI; my %arr = $q->Vars; my @tim = localtime(time); my $year = $tim[5] + 1900; my $month = $tim[4] + 1; my $day = $tim[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; my ( $userid, $duration); # 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 $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 # Page Header my $title = "$lex{Add} PPVT $lex{Scores}"; print qq{$doctype\n$title\n}; print qq{\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}; selectStudent(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; enterScores(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; writeRecords(); } #---------------- sub showStartPage { #---------------- print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; # Continue to next page print qq{\n}; print qq{
$lex{'Test Date'}\n}; print qq{\n}; print qq{
$lex{Select} $lex{Students} }; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; exit; } # end of showStartPage #---------------- sub selectStudent { #---------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Get students my $select; if ( $arr{grouptype} eq 'grade' ) { $select = "where grade = ?"; } else { # homeroom $select = "where homeroom = ?"; } $arr{groupvalue} =~ s/\'|"//g; # strip quotes my $sth = $dbh->prepare("select lastname, firstname, studnum, grade from student $select order by lastname, firstname"); $sth->execute( $arr{groupvalue} ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $first = 1; while ( my ($lastname, $firstname, $studnum, $grade ) = $sth->fetchrow ) { if ( $first ) { print qq{\n}; $first = 0; } print qq{\n}; } if ( $first ) { print qq{
$lex{Select} $lex{Student}
}; print qq{$lastname, $firstname

$lex{'No Students Found'}

\n}; print qq{\n}; exit; } # Continue to next page print qq{}; print qq{\n}; print qq{\n}; print qq{\n}; exit; } # end of selectStudent #-------------- sub enterScores { #-------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $date = $arr{date}; delete $arr{date}; my $sth = $dbh->prepare("select lastname, firstname from student where studnum = ?"); # Create data structure to provide name and student in sorted order. my %students = (); my %studname = (); foreach $studnum ( keys %arr ) { $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname ) = $sth->fetchrow; $students{"$lastname$firstname$studnum"} = $studnum; $studname{$studnum} = "$lastname, $firstname"; } print qq{

$lex{'Test Date'} $date

\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; foreach my $key ( sort keys %students ) { my $studnum = $students{$key}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } print qq{\n}; print qq{\n}; print qq{
$lex{Student}RawStdPerAgeE
$studname{$studnum} }; print qq{
}; print qq{Raw = $lex{'Raw Score'},  Std = $lex{'Standard Score'},\n}; print qq{Per = $lex{Percentile},  AgeE = $lex{Age} $lex{Equivalent}
\n
\n}; print qq{\n}; exit; } # end of enterScores #--------------- sub writeRecords { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $date = $arr{date}; delete $arr{date}; # Check for any Blanks foreach my $key ( keys %arr ) { if ( not $arr{$key} ) { print qq{

$lex{'No Blanks Allowed'}

\n}; print qq{\n}; exit; } } my $sth = $dbh->prepare("insert into ppvt_test ( studnum, tdate, tauthor, tgrade, tstamp, rawscore, stdscore, confsetting, confstart, confend, percentile, normalce, stanine, growthsv, equivage, equivgrade ) values ( ?,?,?,?,now(),?,?,?,?,?,?,?,?,?,?,?)"); my $sth1 = $dbh->prepare("select grade from student where studnum = ?"); foreach my $key ( sort keys %arr ) { my ( $code, $studnum ) = split(/:/, $key); if ( $code ne 'N' ){ next; } # skip all but N (Name) fields. my $rkey = 'R:'. $studnum; my $skey = 'S:'. $studnum; my $pkey = 'P:'. $studnum; my $akey = 'A:'. $studnum; # Get student grade $sth1->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $grade = $sth1->fetchrow; # Write the test record $sth->execute( $studnum, $date, $userid, $grade, $arr{$rkey}, $arr{$skey}, $arr{confsetting}, $arr{confstart}, $arr{confend}, $arr{$pkey}, $arr{normalce}, $arr{stanine}, $arr{growthsv}, $arr{$akey}, $arr{equivgrade} ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } } print qq{

$lex{'Record(s) Stored'}

\n}; print qq{

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

\n}; exit; }