#!/usr/bin/perl # Copyright 2001-2024 Leslie Richardson # This file is part of Open Admin for Schools. # Edit an existing accident record my %lex = ('Main' => 'Main', 'Error' => 'Error', 'Edit' => 'Edit', 'Name' => 'Name', 'Update' => 'Update', 'Injury' => 'Injury', 'Accident' => 'Accident', 'Record Updated' => 'Record Updated', 'Edit not allowed' => 'Edit not allowed', 'Scores' => 'Scores', 'Date' => 'Date', 'Close' => 'Close', 'Location' => 'Location', 'Time' => 'Time', 'Action' => 'Action', 'Taken' => 'Taken', ); use DBI; use CGI; use Cwd; my $self = 'accEdit.pl'; # Configuration Settings ----------------------- my $allow_author = 1; # allow author to edit my $allow_accident = 1; # allow user with math access code to edit #----------------------------------------------- my $q = new CGI; print $q->header( -charset, $charset ); 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"; } # Get current dir so know what CSS to display and shift settings. if ( getcwd() !~ /tcgi/ ) { # we are in cgi $tchcss = $css; $tchpage = $homepage; $tchdownloaddir = $downloaddir; $tchwebdownloaddir = $webdownloaddir; } my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); # Check for 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 $accessWR; while ( my $val = $sth->fetchrow ) { if ( uc $val eq 'INJ' ) { $accessinjr = 1; } print qq{VAL:$val ACCESS:$accessWR
\n}; } # Page Header my $title = "$lex{Edit} Injury/Accident Records"; print qq{$doctype\n$title}; print qq{\n}; if ( not $arr{page} ) { # date widget 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} ) { editAccident(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; writeAccident(); } #--------------- sub editAccident { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # id is passed. my $id = $arr{id}; delete $arr{id}; # Print Form Heading print qq{
\n}; print qq{\n}; print qq{\n}; # Get Accident Record my $sth = $dbh->prepare("select * from accident where id = ?"); $sth->execute( $id ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; my %r = %$ref; my $studnum = $r{studnum}; =head # Access Controls my $failflag; if ( not $allow_author and not $allow_cma ) { $failflag = 1; } # nobody edits elsif ( $allow_author and $r{tauthor} ne $userid ) { $failflag = 1; } # not author if ( $allow_cma and $accesscma ) { $failflag = 0; } # allow override of author failure for catalyst. if ( $failflag ) { print qq{

$lex{'Edit not allowed'}

\n}; print qq{\n}; exit; } =cut # Get Student Record my $sth1 = $dbh->prepare("select * from student where studnum = ?"); $sth1->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth1->fetchrow_hashref; # my %s = %$ref; # Print Table Header and Heading values print qq{\n}; print qq{\n}; # Name print qq{}; print qq{\n}; # Injury Accident print qq{}; print qq{\n}; # Date print qq{}; print qq{\n}; # Time print qq{}; print qq{\n}; # Location print qq{}; print qq{\n}; # Action Taken print qq{}; print qq{\n}; # Update print qq{\n}; print qq{
$lex{Name}$s{firstname} $s{lastname}
$lex{Injury}/
$lex{Accident}
$lex{Date}\n}; print qq{\n}; print qq{
$lex{Time}
$lex{Location}
$lex{Action}/
$lex{Taken}
\n}; print qq{\n}; print qq{\n}; exit; } #------------- sub writeAccident { #------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $id = $arr{id}; delete $arr{id}; my $first = 1; foreach my $field ( sort keys %arr ) { if ( $first ) { print qq{\n}; print qq{\n}; $first = 0; } if ( $field eq 'date' ) { # check validity my $err = checkDate( $arr{$field} ); if ( $err == 1 ) { print qq{

$lex{Error}: Date Outside School Year: $arr{$key}. Skipping

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

Date Error: $err. Skipping

\n}; next; } } my $sth = $dbh->prepare("update accident set $field = ? where id = ?"); $sth->execute( $arr{$field}, $id ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } print qq{\n}; } print qq{
FieldNew Value
$field$arr{$field}
\n}; print qq{

Record Updated

\n}; print qq{
Note: Reload main view page to see updates
\n}; print qq{

\n}; print qq{

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