#! /usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. my %lex = ('Main' => 'Main', 'Mark Entry' => 'Mark Entry', 'School' => 'School', 'Set' => 'Set', 'Error' => 'Error', 'Save' => 'Save', 'Path' => 'Path', 'Record(s)' => 'Record(s)', 'Updated' => 'Updated', 'File' => 'File', 'Edit' => 'Edit', 'Not Found' => 'Not Found', 'Update' => 'Update', 'Track' => 'Track', 'Entry Term' => 'Entry Term', 'Grades' => 'Grades', 'Report Card' => 'Report Card', 'Disable' => 'Disable', ); my $self = 'termmarkentry.pl'; use DBI; use CGI; # Read only basic config variables eval require "../../etc/admin.conf.root"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } # Setup Database access my $dsn = "DBI:mysql:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; # Load variables of interest from DB. my @fieldnames = qw(doctype charset css r_MarkEntryTerm g_MTrackTerm g_MTrackTermType g_TermDisplay g_TrackDisplay g_EtcPath homepage reppage); my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); foreach my $var ( @fieldnames ) { $sth->execute( $var ); my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print "$lex{Error}: $@
\n"; die "$lex{Error}: $@\n"; } } my $q = new CGI; my %arr = $q->Vars; print $q->header( -charset, $charset ); # Page Header my $title = "$lex{Set} $lex{'Mark Entry'} $lex{Term}"; print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{

[ $lex{Main} |\n}; print qq{ $lex{'Report Card'} ]

\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } else { delete $arr{page}; writeValues(); } #---------------- sub showStartPage { #---------------- # Starting Note print qq{

This setting controls which term teachers may enter marks and comments }; print qq{for report cards.
\n}; print qq{Setting a track entry term to Disable will prevent mark entry by teachers.

\n}; # Start Form print qq{
\n}; print qq{\n}; print qq{\n}; =head # Load Existing Configuration Data. my $sth = $dbh->prepare("select * from conf_system where (filename = 'repcard' and sectionname = 'Config' ) or dataname = 'r_MarkEntryTerm' order by sequenceval"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $ref = $sth->fetchrow_hashref ) { # put value into namespace my $datavalue = $ref->{datavalue}; eval $datavalue; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my $dataname = $ref->{dataname}; } =cut print qq{\n}; foreach my $trk ( sort keys %g_MTrackTerm ){ # populate %terms,@terms for this track. my %terms; # for this track. foreach my $trm ( keys %{ $g_MTrackTerm{$trk} } ){ $terms{$trm} = 1; } my @terms = sort keys %terms; # populate the grades. my @grades; foreach my $gr ( keys %g_MTrackTermType ) { if ( $g_MTrackTermType{$gr} eq $trk ) { # this grade is a member of current track push @grades, $gr; } } my $grades = join(',',sort {$a <=> $b} @grades); print qq{\n}; print qq{\n}; } print qq{
$lex{Track}$lex{Grades}$lex{'Entry Term'}
$g_TrackDisplay{$trk}$grades}; print qq{
\n}; print qq{\n}; print qq{
\n}; print qq{\n}; exit; } #-------------- sub writeValues { #-------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } use Data::Dumper; $Data::Dumper::Purity = 1; $Data::Dumper::Indent = 0; my $value_ref = [ ]; my $name_ref = [ ]; # only Scalar Value push @$name_ref, '*r_MarkEntryTerm'; push @$value_ref, \%arr; my $d = Data::Dumper->new( $value_ref, $name_ref ); my $datavalue = $d->Dump; # print "Datavalue: $datavalue
\n"; my $sth = $dbh->prepare("update conf_system set datavalue = ? where dataname = 'r_MarkEntryTerm'"); $sth->execute( $datavalue ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } if ( not $DBI::errstr ) { print qq{

$lex{'Mark Entry'} $lex{Updated}

\n}; } else { print qq{

$lex{Error}:$DBI::errstr;

\n}; } # Now write the file update updateFiles('repcard'); print qq{
\n}; print qq{
\n}; print qq{\n}; exit; } # End of Update #-------------- sub updateFiles { #-------------- # Note: needs file path $g_EtcPath to write files to. if ( not -e $g_EtcPath ) { print qq{

$lex{Path} $lex{'Not Found'}

\n}; exit; } my $singlefile = shift; my @files; if ( $singlefile ) { push @files, $singlefile; } else { # do them all my $sth = $dbh->prepare("select distinct filename from conf_system where filename is not NULL and filename != '' order by filename"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $filename = $sth->fetchrow ) { push @files, $filename; } } foreach my $updatefile ( @files ) { my $filename = "$g_EtcPath/$updatefile.conf"; print qq{
$lex{Update}: $filename
\n}; # special case for admin.conf if ( $updatefile eq 'admin' ) { # use the admin.conf.root file. unless ( -e "$g_EtcPath/admin.conf.root" ) { print qq{

$g_EtcPath}. '/admin.conf.root'. qq{ $lex{'Not Found'}

\n}; } system("cp -f $g_EtcPath/admin.conf.root $g_EtcPath/admin.conf"); # print "Result:", $? >> 8, "
\n"; open(FH,">>$filename") or die "Cannot open file $filename: $!\n"; # open for append } else { open(FH,">$filename") or die "Cannot open file $filename: $!\n"; } my $sth = $dbh->prepare("select id, datavalue from conf_system where filename = ? order by dataname"); $sth->execute( $updatefile ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($id, $value) = $sth->fetchrow ) { print FH $value, "\n"; } print FH qq{\n1;\n}; close FH; print qq{

$lex{File} $lex{Updated}: $updatefile

\n}; } if ( $singlefile ) { return; } else { # did them all print qq{\n}; exit; } }