#!/usr/bin/perl # Copyright 2001-2023 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. # confperiods.pl - configure the period times for the grades that have subject attendance. my %lex = ('Eoy' => 'Eoy', 'Periods' => 'Periods', 'Error' => 'Error', 'Set' => 'Set', 'Tracks' => 'Tracks', 'Number of' => 'Number of', 'Terms' => 'Terms', 'Start Date' => 'Start Date', 'End Date' => 'End Date', 'Continue' => 'Continue', 'Grades' => 'Grades', 'Separate with Spaces' => 'Separate with Spaces', 'Term Block' => 'Term Block', 'Term' => 'Term', 'Start' => 'Start', 'End' => 'End', 'Default' => 'Default', 'Track' => 'Track', 'Main' => 'Main', 'Description' => 'Description', 'Map' => 'Map', 'Desc' => 'Desc', 'File' => 'File', 'Updated' => 'Updated', 'Record(s) Stored' => 'Record(s) Stored', 'Save' => 'Save', 'Illegal' => 'Illegal', 'later than' => 'later than', 'Date' => 'Date', 'Sequence' => 'Sequence', 'Duplicate' => 'Duplicate', 'Missing' => 'Missing', 'Outside' => 'Outside', 'Period' => 'Period', 'Times' => 'Times', 'Timetable' => 'Timetable', 'for' => 'for', 'Values' => 'Values', 'Starting Time' => 'Starting Time', 'Ending Time' => 'Ending Time', 'Grade' => 'Grade', 'Group' => 'Group', 'Update' => 'Update', 'Edit' => 'Edit', 'Add' => 'Add', 'New' => 'New', 'Delete' => 'Delete', 'Deleted' => 'Deleted', 'Record Updated' => 'Record Updated', 'Length' => 'Length', ); my $self = 'confperiods.pl'; my $defaultEtcPath = '../../etc'; use DBI; use CGI; use Data::Dumper; use Time::JulianDay; $Data::Dumper::Purity = 1; $Data::Dumper::Indent = 0; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } # Set Path to etc directory if ( not $g_EtcPath ) { $g_EtcPath = $defaultEtcPath; } my $q = CGI->new; print $q->header( -charset, $charset ); my %arr = $q->Vars; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); # my @fieldnames = qw( g_jquery_url g_jquery_ui_url ); #my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); #foreach my $var ( qw( doctype chartype css g_jquery_url g_jquery_ui_url g_AttendanceEntryMethod # g_PeriodMap g_PeriodTime g_JqueryUiCss homepage eoypage)) { # $sth->execute( $var ); # my $datavalue = $sth->fetchrow; # eval $datavalue; # if ( $@ ) { # print "$lex{Error}: $@
\n"; # die "$lex{Error}: $@\n"; # } #} # Page Header my $title = qq{$lex{Set} $lex{Period} $lex{Times} - for Grades with Subject Attendance}; print qq{$doctype\n$title\n}; print qq{\n}; if ( $arr{page} == 2 ) { # load jQuery libs for setPeriods print qq{\n}; print qq{\n}; print qq{\n"; print qq{\n"; print qq{\n"; } print qq{$chartype\n\n}; print qq{[ $lex{Main} | $lex{Eoy} |\n}; print qq{$lex{Start} ]\n}; print qq{

$title

\n}; #foreach my $key ( keys %arr ) { print "K:$key V:$arr{$key}
\n"; } if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; mapGrades(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; setPeriods(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; writeRecords(); } elsif ( $arr{page} == 4 ) { delete $arr{page}; deletePeriods(); } #---------------- sub deletePeriods { #---------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $id = $arr{id}; delete $arr{id}; # Period Group to Delete print qq{

$lex{Period} $lex{Group} $lex{Deleted}

\n}; print qq{}; print qq{\n}; my %r = %{ $g_PeriodTime{$id}}; foreach my $period ( sort keys %r ) { my $stime = conv24to12($r{$period}{s}); my $etime = conv24to12($r{$period}{e}); print qq{\n}; } print qq{
$lex{Period}$lex{Times}
$period$stime - $etime
\n}; my %newhash = %g_PeriodTime; # to store the configured values. delete $newhash{$id}; my $g_PeriodTimeEnc = setScalar('*g_PeriodTime', \%newhash); # print "g_PeriodTime: $g_PeriodTimeEnd
\n"; # $save{'g_PeriodTime'} = $g_PeriodTimeEnc; # Save the record into conf_system my $sth = $dbh->prepare("update conf_system set datavalue = ? where dataname = ? and filename = 'admin'"); $sth->execute( $g_PeriodTimeEnc,'g_PeriodTime' ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print qq{

$lex{'Record Updated'}

\n}; # Write the admin.conf file. my $filename = "$g_EtcPath/admin.conf"; 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 my $sth = $dbh->prepare("select id, datavalue from conf_system where filename = 'admin' order by dataname"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($id, $value) = $sth->fetchrow ) { print FH $value, "\n"; } print FH "\n1;\n"; # put in correct file ending with a 1. close FH; print qq{

$lex{Main} $lex{File} $lex{Updated}

\n}; print qq{

[ $lex{Start} ]

\n}; print qq{\n}; exit; } # end of deletePeriods #------------ sub mapGrades { # update the mapping variable g_PeriodMap; #------------ # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my %grades; foreach my $key ( sort keys %arr ) { my ($dud,$grade) = split(':', $key); $grades{$grade} = $arr{$key}; } my $datavalue = setScalar('*g_PeriodMap', \%grades); # Save the record into conf_system my $sth = $dbh->prepare("update conf_system set datavalue = ? where dataname = 'g_PeriodMap' and filename = 'admin'"); $sth->execute( $datavalue ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print qq{

$lex{'Record(s) Stored'}

\n}; print qq{

[ $lex{Start} ]

\n}; print qq{\n}; exit; } #---------------- sub showStartPage { #---------------- # Grades with Subject Attendance. my @grades; foreach my $grade ( sort {$a <=> $b} keys %g_AttendanceEntryMethod ) { if ( $g_AttendanceEntryMethod{ $grade } eq 'subject' ) { push @grades, $grade; } } print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Display Grades, and Period Block ID foreach my $gr ( @grades ) { print qq{}; print qq{\n}; } print qq{\n}; print qq{
$lex{Grade}$lex{Period}
$lex{Group} ID
$lex{Grade} $gr
\n}; # Display current values, floated print qq{\n}; print qq{\n}; foreach my $id ( sort keys %g_PeriodTime ) { my %r = %{ $g_PeriodTime{$id}}; print qq{\n}; } print qq{
ID$lex{Period} $lex{Group}
$id\n}; print qq{}; print qq{\n}; foreach my $period ( sort {$a <=> $b} keys %{ $g_PeriodTime{$id} } ) { my $stime = conv24to12($r{$period}{s}); my $etime = conv24to12($r{$period}{e}); my ($shr,$smin) = split(':', $r{$period}{'s'} ); $smin = $shr * 60 + $smin; my ($ehr,$emin) = split(':', $r{$period}{'e'} ); $emin = $ehr * 60 + $emin; my $length = $emin - $smin; print qq{}; print qq{\n}; } print qq{
$lex{Period}$lex{Times}$lex{Length}
$period$stime - $etime$length
\n}; print qq{		}; # Edit this Period Group print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; # Delete this Period Group print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; print qq{
\n}; print qq{
\n}; # Add new Period Group print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{$lex{'Number of'} $lex{Timetable} $lex{Periods}\n}; print qq{
\n}; print qq{\n}; exit; } # end of showStartPage #------------ sub setPeriods { #------------ # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my ($periods, $id); my %r; if ( $arr{id} ) { $id = $arr{id}; %r = %{ $g_PeriodTime{$id} }; # gives $r{period}{s/e times} # print "R:", %r, "
\n"; $periods = (keys %r ) + 1; } else { $periods = $arr{periods}; } # foreach my $period ( sort keys %r ) { # print "Per:$period S:$r{$period}{s} E:$r{$period}{e}
\n"; # } # Convert to 12 hour clock. foreach my $period ( sort keys %r ) { $r{$period}{s} = conv24to12( $r{$period}{s} ); $r{$period}{e} = conv24to12( $r{$period}{e} ); } if ( not $periods or ( $periods < 0 or $periods > 15 )) { print qq{

$lex{Error} - $lex{Periods}:$periods

\n}; print qq{\n}; exit; } # Form / Table Start print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; foreach my $period ( 1..$periods ) { print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } print qq{\n}; print qq{
$lex{Period}$lex{'Starting Time'}$lex{'Ending Time'}
$lex{Period} $period\n}; print qq{\n}; print qq{
\n}; print qq{\n}; exit; } #--------------- sub writeRecords { #--------------- # print "Entry Keys:
\n"; # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $id = $arr{id}; delete $arr{id}; my (%periods,%check); foreach my $key ( keys %arr ) { my $time = conv12to24( $arr{$key} ); my ($type, $per) = split(':', $key); # type is start 's' or end 'e'. $periods{$per}{$type} = $time; my ($h,$m) = split(':', $time); my $minutes = $h * 60 + $m; if ( not $minutes ) { next; } # not checking blanks. my $idx = $per; if ( $type eq 'e' ) { # add on .5 $idx += 0.5; } $check{$idx} = $minutes; # these will be total minutes from start of the day. } =head # Display values for periods foreach my $period ( sort keys %periods ) { foreach my $type ( sort keys %{ $periods{$period} } ) { print qq{Period:$period Type:$type Val:$periods{$period}{$type}
\n}; } } =cut # Check values for length, sequence, and overlap. my ($curr, $prev); foreach my $key ( sort {$a <=> $b} keys %check ) { $prev = $curr; $curr = $key; if ( $prev ) { # not at first; if ( $check{$curr} < $check{$prev} ) { # error; my ($currerr, $preverr ); $currerr = "Start"; if ( $curr =~ m/\./ ) { # is it a decimal value, if so, an end time $currerr = "End"; $curr =~ s/\..+//g; } $currerr = "Period $curr ". $currerr; $preverr = "Start"; if ( $prev =~ m/\./ ) { # is it a decimal value, if so, an end time $preverr = "End"; $prev =~ s/\..+//g; } $preverr = "Period $prev ". $preverr; print qq{

$lex{Error}: $currerr < $preverr

\n}; print qq{\n}; exit; } } # print "K:$key V:$check{$key}
\n"; } # Now get period lengths. my %lengths; # of periods in minutes. print qq{}; print qq{\n}; foreach my $period ( sort {$a <=> $b} keys %periods ) { my ($shr,$smin) = split(':', $periods{$period}{'s'} ); $smin = $shr * 60 + $smin; my ($ehr,$emin) = split(':', $periods{$period}{'e'} ); $emin = $ehr * 60 + $emin; my $length = $emin - $smin; $lengths{$period} = $length; if ( not $length ) { next; } print qq{\n}; } print qq{
$lex{Period}$lex{Times}$lex{Length}
$period$periods{$period}{s} - $periods{$period}{e}$length
\n}; my %newhash = %g_PeriodTime; # to store the configured values. if ( not $id ) { # pick the next available character (alphabetic) $id = 'A'; while ( exists $g_PeriodTime{$id} ) { $id++; } } print qq{

$lex{Period} $lex{Group} ID:$id

\n}; # Set g_PeriodsTime ( g_PeriodsTime{a} = {1 => {s => '9:00', e => '10:00'}, etc ) my $dref = {}; foreach my $period ( sort keys %periods ) { if ( not $periods{$period}{'s'} ) { next; } $dref->{$period}{'s'} = $periods{$period}{s}; $dref->{$period}{'e'} = $periods{$period}{e}; } $newhash{$id} = $dref; my $g_PeriodTimeEnc = setScalar('*g_PeriodTime', \%newhash); # print "g_PeriodTime: $g_PeriodTimeEnd
\n"; # Save the records into conf_system my $sth = $dbh->prepare("update conf_system set datavalue = ? where dataname = ? and filename = 'admin'"); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } $sth->execute( $g_PeriodTimeEnc, 'g_PeriodTime'); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } print qq{

$lex{'Record(s) Stored'}

\n}; print qq{

[ $lex{Start} ]

\n}; # Write the admin.conf file. my $filename = "$g_EtcPath/admin.conf"; 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 my $sth = $dbh->prepare("select id, datavalue from conf_system where filename = 'admin' order by dataname"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($id, $value) = $sth->fetchrow ) { print FH $value, "\n"; } print FH "\n1;\n"; # put in correct file ending with a 1. close FH; print qq{

$lex{Main} $lex{File} $lex{Updated}

\n}; print qq{\n}; exit; } #------------ sub setScalar { #------------ my ($dataname, $datavalue) = @_; my $name_ref = [ ]; my $value_ref = [ ]; push @$name_ref, $dataname; push @$value_ref, $datavalue; my $d = Data::Dumper->new( $value_ref, $name_ref ); return $d->Dump; } #------------- sub conv12to24 { #------------- my $time = shift; if ( not $time ) { return } $time =~ s/(AM|PM|am|pm)//; # strip am/pm. $ampm = $1; $ampm = uc $ampm; # uppercase value my ($hr, $min) = split(':', $time); if ( $ampm eq 'PM' and $hr < 12 ) { $hr += 12; } if ( $hr > 24 or $hr < 0 or $min < 0 or $min > 60 ) { print qq{

$lex{Error}: $time

\n}; print qq{\n}; exit; } return qq{$hr:$min}; } #------------- sub conv24to12 { #------------- my $time = shift; if ( not $time ) { return } my ($hr, $min) = split(':', $time); my $ampm = 'AM'; if ( $hr == 12 ) { $ampm = 'PM'; } if ( $hr == 0 ) { $hr = 12; }; if ( $hr > 12 ) { $hr -= 12; $ampm = 'PM'; } return qq{$hr:$min $ampm}; }