#!/usr/bin/perl
# Copyright 2001-2025 Leslie Richardson
# This file is part of Open Admin for Schools.
# Origin: from ppvtEdit.pl
my %lex = ('Main' => 'Main',
'Error' => 'Error',
'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',
'Close' => 'Close',
);
use DBI;
use CGI;
my @fields = ('shortvowels','digraphs','vce','longerwords','endspellpat','rctrlvowels','longvowelteams',
'othervowels','dipsilent','suffixprefix','addaffix');
my %fieldtext = ('shortvowels' => 'Short Vowels','digraphs' => 'Digraphs','vce' => 'VCe',
'longerwords' => 'Longer Words','endspellpat' => 'Ending Spelling Patterns',
'rctrlvowels' => 'R-Controlled Vowels','longvowelteams' => 'Long Vowel Teams',
'othervowels' => 'Other Vowels','dipsilent' => 'Diphthongs & Silent Letters',
'suffixprefix' => 'Suffixes & Prefixes','addaffix' => 'Additional Affixes');
my $self = 'ufliEdit.pl';
# Configuration Settings -----------------------
my $allow_author = 1; # allow author to edit
my $allow_fp = 1; # allow user with fp 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 $userid = $ENV{'REMOTE_USER'};
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
print $q->header( -charset, $charset);
# Check for FP 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 $access_fp;
while ( my $val = $sth->fetchrow ) {
if ( uc $val eq 'FP' ) { $access_fp = 1; }
# print qq{VAL:$val ACCESS:$access_fp
\n};
}
# Page Header
my $title = qq{$lex{Edit} F & P Reading Records};
print qq{$doctype\n$title\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} ]\n};
print qq{$title
\n};
if ( not $arr{page} ) {
editRecord( $arr{id} );
} elsif ( $arr{page} == 1 ) {
delete $arr{page};
writeRecord();
}
#-------------
sub editRecord {
#-------------
# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; }
my $id = shift;
# Get UFLI Record
my $sth = $dbh->prepare("select * from fp_ufli_test where id = ?");
$sth->execute( $id );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
my $ref = $sth->fetchrow_hashref;
my %r = %$ref;
# Access Controls
my $failflag;
if ( not $allow_author and not $allow_fp ) { $failflag = 1; } # nobody edits
elsif ( $allow_author and $ref->{tauthor} ne $userid ) { $failflag = 1; } # not author
if ( $allow_fp and $access_fp ) { $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( $r{studnum} );
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
my ( $lastname, $firstname ) = $sth1->fetchrow;
# Form Heading
print qq{