#!/usr/bin/perl # Copyright 2001-2022 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. # confyear.pl - configure the school year. my %lex = ('Eoy' => 'Eoy', 'School Year' => 'School Year', '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', 'Start' => 'Start', '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', ); my $self = 'confyear.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); $dbh->{mysql_enable_utf8} = 1; # Page Header print qq{$doctype\n$lex{Set} $lex{'School Year'}\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} | $lex{Eoy} |\n}; print qq{$lex{Start} ]\n}; print qq{

$lex{Set} $lex{'School Year'}

\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}; setTerms(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; setTracks(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; writeRecords(); } #---------------- sub showStartPage { #---------------- # Read in values from conf_system; my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ? and filename = 'admin'"); foreach my $dataname ( qw( g_MTrackTerm schoolstart schoolend schoolyear )) { # load 4 values. $sth->execute($dataname); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } } # Figure out terms and tracks. my $deftracks = keys %g_MTrackTerm; #~~ if ( not $g_DefaultTrack ) { $g_DefaultTrack = 1; } my $defterms; for my $trk ( 1..$deftracks ) { my $terms = keys %{$g_MTrackTerm{$trk}}; if ( $terms > $defterms ) { $defterms = $terms; } } print qq{
\n}; print qq{\n}; print qq{\n}; # School Year if ( not $schoolyear and $schoolstart and $schoolend ) { my @start = split(/-/, $schoolstart ); my @end = split(/-/, $schoolend ); $schoolyear = "$start[0]-$end[0]"; } 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{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{'School Year'} }; print qq{(yyyy-yyyy)}; print qq{
$lex{'Start Date'} }; print qq{(yyyy-mm-dd)\n}; print qq{
$lex{'End Date'} }; print qq{(yyyy-mm-dd)\n}; print qq{
Max $lex{'Number of'} $lex{Terms}
Max $lex{'Number of'} $lex{Tracks}
\n}; # Explain Term/Track print qq{\n}; print qq{\n}; print qq{\n}; print qq{
A Term is a period of time with a report card at the end. }; print qq{If you have 4 report cards in a school year, you have 4 terms. }; print qq{Elementary schools typically have 3 terms/report card (November,March,June) }; print qq{while high schools typically have 4 terms (October,January,April,June)
A Track is a group of grades that share the same terms }; print qq{(with same start/end dates.) Typically in a K-12 school there will be 2 tracks }; print qq{with the K-9 grades in one track and 10-12 grades in another track }; print qq{(each with their own distinct term start/end dates). High Schools and Elementary }; print qq{schools typically are only a single track.
\n}; print qq{\n}; exit; } # end of showStartPage #----------- sub setTerms { #----------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } if ( not checkdate( $arr{startdate}) ) { print qq{

$lex{Illegal} $lex{'Start Date'}

\n}; print qq{\n}; exit; } if ( not checkdate( $arr{enddate}) ) { print qq{

$lex{Illegal} $lex{'End Date'}

\n}; print qq{\n}; exit; } # Check school year my ($sy, $ey) = split(/-/, $arr{schoolyear}); my $failflag; if ( $sy =~ m/\D/ ) { $failflag = 1; }; if ( $ey =~ m/\D/ ) { $failflag = 1; }; if ( length($sy) != 4 or length($ey) != 4 ) { $failflag = 1; }; if ( not $ey ) { $failflag = 1; }; # wrong separator. if ( $failflag ) { print qq{

$lex{Illegal} $lex{'School Year'}: $arr{schoolyear} \n}; print qq{(YYYY-YYYY)

\n\n}; exit; } # zero pad month and day. foreach my $var ( $arr{startdate}, $arr{enddate} ) { my ( $y, $m, $d ) = split('-', $var ); if ( length($m) == 1 ) { $m = '0'. $m; }; if ( length($d) == 1 ) { $d = '0'. $d; }; $var = "$y-$m-$d"; } my $schoolstartjd = julian_day( split('-', $arr{startdate}) ); my $schoolendjd = julian_day( split('-', $arr{enddate}) ); if ( $schoolstartjd > $schoolendjd ) { print qq{

$lex{'Start Date'} $lex{'later than'} $lex{'End Date'}

\n}; print qq{\n}; exit; } # Read in values from conf_system; my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ? and filename = 'admin'"); foreach my $dataname ( qw( g_MTrackTerm g_TrackDisplay g_TermDisplay )) { $sth->execute( $dataname ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } } # Form / Table Start print qq{
\n}; print qq{\n}; foreach my $key ( keys %arr ) { # add passed values as hidden also. print qq{\n}; } print qq{\n}; print qq{\n}; # Tracks Row print qq{\n}; for my $trk ( 1 .. $arr{tracks} ) { print qq{}; } print qq{\n}; # Term Description print qq{\n}; for my $trk ( 1 .. $arr{tracks} ) { print qq{}; print qq{\n}; } print qq{\n}; # Term Rows for my $trm ( 1 .. $arr{terms} ) { print qq{}; for my $trk ( 1 .. $arr{tracks} ) { print qq{}; print qq{}; } print qq{\n}; } print qq{\n}; print qq{
$lex{'School Year'}$arr{schoolyear}
$lex{Tracks}->$trk $lex{Desc}
$lex{Terms}$lex{Description}$lex{'Start Date'}
$trm}; print qq{
\n}; print qq{\n}; exit; } #------------ sub setTracks { # and end dates, #------------ # Set Mapping of Grades to School, Track End dates, TermDisplayBlock values (ie. semester) # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $startjd = julian_day( split('-', $arr{startdate}) ); my $endjd = julian_day( split('-', $arr{enddate}) ); # Check Date Values my %dateseqcheck; foreach my $key ( keys %arr ) { my ($type, $trk, $trm ) = split(':', $key ); if ( $type eq 'date' ) { # check the date if ( not $arr{$key} ) { next; } # blank is possible for shorter tracks if ( not checkdate( $arr{$key} ) ) { print qq{

$lex{Illegal} $lex{Date} - $lex{Track} $trk $lex{Term} $trm

\n}; print qq{\n}; exit; } # Zero pad the dates. my ( $y, $m, $d ) = split('-', $arr{$key} ); if ( length($m) == 1 ) { $m = '0'. $m; }; if ( length($d) == 1 ) { $d = '0'. $d; }; $arr{$key} = "$y-$m-$d"; my $currjd = julian_day( split('-', $arr{$key} ) ); if ( $currjd < $startjd or $currjd > $endjd ) { print qq{

$lex{Illegal} $lex{Date} - $lex{Outside} $lex{'School Year'}: $arr{$key}

\n}; print qq{\n}; exit; } $dateseqcheck{$trk}{$trm} = $arr{$key}; # the date } } my %enddates; # Check Date Sequence for each track. foreach my $trk ( keys %dateseqcheck ) { my ($prevjd, $currjd); foreach my $trm ( sort { $a <=> $b } keys %{ $dateseqcheck{$trk}} ) { my $nextterm = $trm + 1; # even if no 'next' term. if ( $dateseqcheck{$trk}{$nextterm} ) { # if we have this next term... my $nexttermstartjd = julian_day( split('-', $dateseqcheck{$trk}{$nextterm} )); my $daybefore = $nexttermstartjd - 1; $enddates{$trk}{$trm} = join('-',inverse_julian_day($daybefore)); # print "TRM:$trm Next Term:$nextterm NextDate: $dateseqcheck{$trk}{$nextterm} "; # print "NextJD:$nexttermstartjd Before:$daybefore
\n"; } else { # no next term, use year end date, which will be editable. $enddates{$trk}{$trm} = $arr{enddate}; # end of school year. } # print qq{Trk:$trk Trm:$trm Date:$dateseqcheck{$trk}{$trm}
\n"; $prevjd = $currjd; $currjd = julian_day( split(/-/, $dateseqcheck{$trk}{$trm} )); # print qq{Curr:$currjd Prev:$prevjd
\n"; if ( $currjd < $prevjd ) { # Error print qq{

$lex{Date} $lex{Sequence} $lex{Error}
}; print qq{$lex{Track} $trk $lex{Term} $trm $lex{Date} $dateseqcheck{$trk}{$trm}

\n}; print qq{\n}; exit; } } } =head # Test End Dates print qq{

End Dates

\n}; foreach my $trk ( sort keys %enddates ) { foreach my $trm ( sort keys %{ $enddates{$trk} } ) { print "Trk:$trk Term:$trm Date:$enddates{$trk}{$trm}
\n"; } } =cut # Read in values from conf_system; my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ? and filename = 'admin'"); foreach my $dataname ( qw( g_MTrackTermType g_TermDisplayBlock )) { # load values. $sth->execute( $dataname ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } } # Form / Table Start print qq{
\n}; print qq{\n}; # School Year print qq{

$lex{'School Year'} $arr{schoolyear}

\n}; # Start Table print qq{\n}; print qq{\n}; # Display Term Start/End Dates and Tracks. # Track Descriptions Row print qq{\n}; for my $trk ( 1 .. $arr{tracks} ) { my $trkkey = "trkdesc:$trk"; print qq{}; } print qq{\n}; # Start/End Date Descriptors print qq{\n}; for my $trk ( 1 .. $arr{tracks} ) { print qq{}; print qq{}; } print qq{\n}; # Term Rows my %eoyflag; # flag use of end of year date for my $trm ( 1 .. $arr{terms} ) { my $termkey = "trmdesc:$trm"; print qq{}; for my $trk ( 1 .. $arr{tracks} ) { my $sdatekey = "date:$trk:$trm"; my $warnflag; # flag for holes between term blocks, or other issue if ( $arr{$sdatekey} ) { # if this track has start date, then do enddate; # Figure out next term start date, if any my $nextterm = $trm + 1; my $nextdatekey = "date:$trk:$nextterm"; my $nextstart; if ( $arr{$nextdatekey} ) { $nextstart = $arr{$nextdatekey}; } else { $nextstart = $arr{enddate}; # use school end date; $eoyflag{$trk} = 1; } my $enddate; if ( not $eoyflag{$trk} ) { # use back one day from next term start. my $calcenddate; if ( my $nextstartjd = julian_day( split('-',$nextstart)) ) { my @tmp = inverse_julian_day($nextstartjd - 1); if ( length $tmp[1] == 1 ) { $tmp[1] = '0'. $tmp[1]; } if ( length $tmp[2] == 1 ) { $tmp[2] = '0'. $tmp[2]; } $calcenddate = join('-',@tmp ); } if ( $g_MTrackTerm{$trk}{$trm}{'end'} ) { $enddate = $g_MTrackTerm{$trk}{$trm}{'end'}; } else { # no date stored, used calculated date $enddate = $calcenddate; } if ( $enddate ne $calcenddate ) { # set warning element over mismatch. $warnflag = qq{Warning}; $enddate = $calcenddate; } } else { # it is eoy if ( $g_MTrackTerm{$trk}{$trm}{'end'} ) { # if we have a value $enddate = $g_MTrackTerm{$trk}{$trm}{'end'} } else { $enddate = $arr{enddate}; } } # print "Track:$trk Term:$trm Enddate:$enddate EOY:$eoyflag
\n"; # Print results. print qq{}; if ( $eoyflag{$trk} ) { # allow to edit. print qq{\n}; } else { # just update the value. print qq{\n}; } } else { # delete and skip delete $arr{$sdatekey}; print qq{}; } } print qq{\n}; } print qq{
}; print qq{$lex{Set} $lex{'End Date'}
$lex{Terms}$lex{Track} $trk: $arr{$trkkey}
$lex{'Start Date'}$lex{'End Date'}
$trm$arr{$sdatekey}}; print qq{\n}; print qq{$enddate
\n}; # Map Grades to Tracks. my %map; foreach my $grade (sort {$a <=> $b} keys %g_MTrackTermType ) { my $trk = $g_MTrackTermType{$grade}; if ( not exists $map{$trk} ) { $map{$trk} = "$grade "; } else { $map{$trk} = $map{$trk}. "$grade "; } } print qq{\n}; print qq{\n}; print qq{\n}; for my $trk ( 1..$arr{tracks} ) { my $key = 'trkdesc:'. $trk; print qq{}; print qq{\n}; if ( $trk == 1 ) { # put in extra row print qq{\n}; } } print qq{
}; print qq{$lex{Map} $lex{Grades} -> $lex{Tracks}
$lex{Tracks}$lex{Description}$lex{Grades}
$trk$arr{$key}
$lex{'Separate with Spaces'}
\n}; # Disabled currently, since not used in report card. =head # Set Term Display Block (ie. Semester, etc) print qq{\n}; my @keys = sort keys %g_TermDisplayBlock; print qq{\n}; print qq{}; print qq{\n}; for my $idx ( 1..$arr{terms} ) { # worst case scenario for number of desc required. my $key = shift @keys; # get value like '1-2' my $blockname = $g_TermDisplayBlock{$key}; my ($sterm, $eterm) = split('-', $key); print qq{\n}; print qq{\n}; print qq{\n}; } print qq{
}; print qq{$lex{Set} $lex{'Term Block'} $lex{Description}
$lex{Start} $lex{Term}$lex{End} $lex{Term}$lex{Description}
\n}; =cut print qq{
\n}; # put rest of hidden values ( in %arr ) foreach my $key ( sort keys %arr ) { # add passed values as hidden also. 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 $startjd = julian_day( split('-', $arr{startdate}) ); my $endjd = julian_day( split('-', $arr{enddate}) ); # Check End Date Values my %dateseqcheck; my %trkgrades; foreach my $key ( keys %arr ) { my ($type, $trk, $trm ) = split(/:/, $key ); if ( $type eq 'edate' ) { # check the date if ( not checkdate( $arr{$key} ) ) { print "

$lex{Illegal} $lex{Date} - $lex{Track} $trk $lex{Term} $trm

\n"; print "\n"; exit; } # Zero pad the end dates. my ( $y, $m, $d ) = split('-', $arr{$key} ); if ( length($m) == 1 ) { $m = '0'. $m; }; if ( length($d) == 1 ) { $d = '0'. $d; }; $arr{$key} = "$y-$m-$d"; my $currjd = julian_day( split(/-/, $arr{$key} ) ); if ( $currjd < $startjd or $currjd > $endjd ) { print "

$lex{Illegal} $lex{Date} - $lex{Outside} $lex{'School Year'}: $arr{$key}

\n"; print "\n"; exit; } $dateseqcheck{$trk}{$trm} = $arr{$key}; # the date } if ( $type eq 'trkgrades' ) { # strip leading and trailing spaces. $arr{$key} =~ s/^\s+//; $arr{$key} =~ s/\s+$//; $trkgrades{$trk} = $arr{$key}; } } # Check Date Sequence for each track. foreach my $trk ( keys %dateseqcheck ) { my ($prevjd, $currjd); foreach my $trm ( sort keys %{ $dateseqcheck{$trk}} ) { # print "Trk:$trk Trm:$trm Date:$dateseqcheck{$trk}{$trm}
\n"; $prevjd = $currjd; $currjd = julian_day( split(/-/, $dateseqcheck{$trk}{$trm} )); # print "Curr:$currjd Prev:$prevjd
\n"; if ( $currjd < $prevjd ) { # Error print "

$lex{Date} $lex{Sequence} $lex{Error}
"; print "$lex{Track} $trk $lex{Term} $trm $lex{Date} $dateseqcheck{$trk}{$trm}

\n"; print "\n"; exit; } } } # Check for Correct and Complete Mapping of tracks to grades, none missed, none redundant. my %grades; my %dupgrades; my $sth = $dbh->prepare("select distinct grade from student where grade is not NULL and grade != ''"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth->fetchrow ) { $grades{$gr} = 1; } # %grades holds existing grades, and has all elements removed by # %loop below; if there is anything left in %grades at the end, # %then we have some grades not mapped. Looking for duplicate # %mapping (in both strings), we insert values in the loop below # %and if we have one already existing before insert, then we have # %a duplicate. foreach my $trk ( keys %trkgrades ) { my @grades = split(/\s+/, $trkgrades{$trk} ); foreach my $gr ( @grades ) { if ( $dupgrades{$gr} ) { print qq{

$lex{Map} $lex{Error}: $lex{Duplicate} $lex{Grade} $gr

\n}; print qq{\n}; exit; } else { # add in this grade $dupgrades{$gr} = 1; } delete $grades{$gr}; } } if ( %grades ) { # some student grades not mapped print qq{

$lex{Map} $lex{Error}: $lex{Missing} $lex{Grades} }; foreach my $gr ( keys %grades ) { print qq{$gr }; } print qq{

\n}; exit; } my %save; # records to store # School Start/End my $schoolstartEnc = setScalar( 'schoolstart', $arr{startdate} ); # print "SchoolStart:$schoolstartEnc
\n"; $save{schoolstart} = $schoolstartEnc; my $schoolendEnc = setScalar( 'schoolend', $arr{enddate} ); # print "SchoolEnd:$schoolendEnc
\n"; $save{schoolend} = $schoolendEnc; # School Year my $schoolyearEnc = setScalar( 'schoolyear', $arr{schoolyear} ); # print "SchoolYear:$schoolyearEnc
\n"; $save{schoolyear} = $schoolyearEnc; # g_TermDisplay hash my %newhash; for my $trk ( 1..$arr{tracks} ) { for my $trm ( 1..$arr{terms} ) { my $key = "trmdesc:$trk:$trm"; if ( $arr{$key} ) { $newhash{$trk}{$trm} = $arr{$key}; } } } my $g_TermDisplayEnc = setScalar( '*g_TermDisplay', \%newhash ); # print "g_TermDisplay:$g_TermDisplayEnc
\n"; $save{'g_TermDisplay'} = $g_TermDisplayEnc; # g_TermDisplayBlock hash my %newhash = (); for my $trm ( 1..$arr{terms} ) { my $key = 'blkdesc:'. $trm; my $datakey = $arr{"sterm:$trm"}. '-'. $arr{"eterm:$trm"}; if ( $arr{$key} ) { $newhash{$datakey} = $arr{$key}; } } my $g_TermDisplayBlockEnc = setScalar('*g_TermDisplayBlock', \%newhash); # print "g_TermDisplayBlock: $g_TermDisplayBlockEnc
\n"; $save{'g_TermDisplayBlock'} = $g_TermDisplayBlockEnc; # now do term blocks for each track ( first # MTrackTerm{Track}{Term}->{ start => sdate, end => # edate }, MTrackType ( maps grades to tracks), # Set MTrackTerm my %newhash; for my $trk ( 1..$arr{tracks} ) { for my $trm ( 1..$arr{terms} ) { my $sdatekey = "date:$trk:$trm"; my $edatekey = "edate:$trk:$trm"; if ( not $arr{$sdatekey} or not $arr{$edatekey} ) { next; } my $dref = {}; $dref->{'start'} = $arr{$sdatekey}; $dref->{'end'} = $arr{$edatekey}; $newhash{$trk}{$trm} = $dref; } } my $g_MTrackTermEnc = setScalar('*g_MTrackTerm', \%newhash); # print "g_MTrackTerm: $g_MTrackTermEnc
\n"; $save{'g_MTrackTerm'} = $g_MTrackTermEnc; # Set MTrackTermType %newhash = (); for my $trk ( 1..$arr{tracks} ) { my $key = 'trkgrades:'. $trk; my @grades = split(/\s/, $arr{$key}); for my $grade (@grades) { $newhash{$grade} = $trk; } } # populate empty hash if since track and no values. if ( not %newhash and $arr{tracks} == 1 ) { # put them all in one track my $sth = $dbh->prepare("select distinct grade from student where grade is not NULL and grade != ''"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth->fetchrow ) { $newhash{$gr} = 1; } } my $g_MTrackTermTypeEnc = setScalar('*g_MTrackTermType', \%newhash); # print "g_MTrackTermType: $g_MTrackTermTypeEnc
\n"; $save{'g_MTrackTermType'} = $g_MTrackTermTypeEnc; # Set Track Description g_TrackDisplay %newhash = (); for my $trk ( 1..$arr{tracks} ) { my $key = 'trkdesc:'. $trk; if ( $arr{$key} ) { $newhash{$trk} = $arr{$key}; } } if ( not %newhash and $arr{tracks} == 1 ) { $newhash{'1'} = 'All'; } my $g_TrackDisplayEnc = setScalar('*g_TrackDisplay', \%newhash); # print "g_TrackDisplay: $g_TrackDisplayEnc
\n"; $save{'g_TrackDisplay'} = $g_TrackDisplayEnc; # print "Records to Save:
\n"; # foreach my $key ( sort keys %save ) { print "K:$key V:$save{$key}
\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; } foreach my $dataname ( keys %save ) { $sth->execute( $save{$dataname}, $dataname ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } print qq{

$lex{'Record(s) Stored'}

\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 checkdate { # check date for validity #------------ my @mdays = (0,31,28,31,30,31,30,31,31,30,31,30,31); my $maxyear = 2100; my $val = shift; if ( not $val =~ m/-/ ) { # fail if no hyphens return undef; } # Strip Spaces $val =~ s/^\s+//g; $val =~ s/\s+$//g; my ( $year, $month, $day) = split(/-/, $val); # Check for non-digits if ($year =~ m/\D/) { return undef; } if ($month =~ m/\D/) { return undef; } if ($day =~ m/\D/) { return undef; } # reset Feb max days, if leap years if ($month == 2) { if ($year % 4 != 0) { $mdays[2] = 28; } elsif ($year % 400 == 0) { $mdays[2] = 29; } elsif ($year % 100 == 0) { $mdays[2] = 28; } else { $mdays[2] = 29; } } # check ranges if ( $day < 1 or $day > $mdays[$month] ) { # days out of range return undef; } elsif ( $month < 1 or $month > 12 ) { # month error return undef; } elsif ( $year < 1 or $year > $maxyear ) { return undef; } return $val; }