#!/usr/bin/perl # Copyright 2001-2018 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; version 2 of # the License, only. my %lex = ('Error' => 'Error', 'Main' => 'Main', 'Date' => 'Date', 'Topic' => 'Topic', 'Description' => 'Description', 'Edit' => 'Edit', 'Delete' => 'Delete', 'Required Field Missing' => 'Required Field Missing', 'Record Updated' => 'Record Updated', 'Contact' => 'Contact', 'Are you sure' => 'Are you sure', 'Record' => 'Record', 'Yes' => 'Yes', 'Deleted' => 'Deleted', 'Update' => 'Update', 'Announcements' => 'Announcements', 'Top' => 'Top', 'Type' => 'Type', 'No Record(s) Found' => 'No Record(s) Found', 'Unable to open template file' => 'Unable to open template file', ); my $self = 'announcedeled.pl'; use DBI; use CGI; use Time::JulianDay; eval require "../../etc/admin.conf"; if ( $@ ) { print qq{$lex{Error} $@
\n}; die qq{$lex{Error} $@
\n}; } my $q = new CGI; my %arr = $q->Vars; print $q->header( -charset, $charset ); my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); # Set Page Title my $title = "$lex{Edit}/$lex{Delete} $lex{Announcements}"; # HTML Page Header print qq{$doctype\n$title\n}; print qq{\n}; if ( $arr{page} == 1 ) { # load date picker 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} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; editRecord(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; writeRecord(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; confirmDelete( $arr{id} ); } elsif ( $arr{page} == 4 ) { delete $arr{page}; deleteRecord(); } #---------------- sub showStartPage { #---------------- my $sth = $dbh->prepare("select * from announce order by adate "); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $first = 1; while ( my $ref = $sth->fetchrow_hashref ) { # load records my %rec; %rec = %$ref; if ( $first ) { # Start Table print qq{\n}; print qq{}; print qq{\n}; $first = 0; } print qq{}; print qq{\n}; print qq{\n}; print qq{\n}; if ( $rec{topstay} ) { $rec{topstay} = $lex{Yes}; } print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } if ( $first ) { print qq{

$lex{'No Record(s) Found'}

\n}; } print qq{\n}; exit; } #------------- sub editRecord { #------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Load Meta Library eval require "../../lib/libmeta.pl"; if ( $@ ) { print qq{$lex{Error} $@
\n}; die qq{$lex{Error} $@\n}; } # Load Record my $sth = $dbh->prepare("select * from announce where id = ?"); $sth->execute( $arr{id} ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; # print top of form, then $text, then bottom of page. print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Start Table print qq{
$lex{Date}$lex{Topic}Author$lex{Description}$lex{Top}$lex{Type}
$rec{adate}$rec{atopic}$rec{author}$rec{adesc}$rec{topstay}$rec{atype}
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; # Read in Template unless (open (FH,"<../../template/announce.tpl")) { print qq{$lex{'Unable to open template file'}: $!\n}; die qq{$lex{'Unable to open template file'}: $!\n}; } my $formtext; { local $/; $formtext = ; close FH;} # Create hash for fieldnames from meta my $sth = $dbh->prepare("select fieldid, fieldname from meta where tableid = ?"); $sth->execute( 'announce' ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my %fieldnames = (); while ( my ( $fieldid, $fieldname ) = $sth->fetchrow ) { $fieldnames{$fieldid} = $fieldname; } # Now put replacement text back in. $formtext =~ s{\<\*(.*?)\*\>} { exists( $fieldnames{$1} ) ? $fieldnames{$1} : $1 }gsex; # Formtext is now ready for multiple use; only contains <@fieldid@> values. # now parse for form entry replacement elements <@name@> my $text = $formtext; # formtext contains original form. # Current Record Value my %fieldvals = %{ $ref }; # get replacement values for fields foreach my $fieldid ( keys %fieldnames ) { $values{$fieldid} = metaInputField('announce', $fieldid, $fieldvals{$fieldid}, $dbh, $studnum ); } # Fiddle to get data popup working, by putting in id attribute $values{'adate'} =~ s/name="adate"/name="adate" id="date"/; # now put field values back into $text variable... $text =~ s{ \<\@(.*?)\@\> } { exists($values{$1}) ? $values{$1} : "$values{$1}-$1" }gsex; print $text, qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; exit; } #--------------- sub writeRecord { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # get record id and remove from the hash. my $id = $arr{id}; delete $arr{id}; # Make sure it has the right fields filled in my $sth = $dbh->prepare("select fieldid, fieldname from meta where tableid = ? and required = 'Y'"); $sth->execute( 'announce' ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($fieldid, $fieldname) = $sth->fetchrow ) { if ( not $arr{"$fieldid"} ) { print qq{

$lex{'Required Field Missing'}: $fieldname ($fieldid)

\n}; print qq{\n}; exit; } } # Check for any checkbox formtypes, reset to NULL if not found. my $sth = $dbh->prepare("select fieldid, fieldname from meta where tableid = ? and formtype = 'checkbox'"); $sth->execute( 'announce' ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($fieldid, $fieldname) = $sth->fetchrow ) { if ( not $arr{"$fieldid"} ) { # checkbox turned off... reset to NULL my $sth = $dbh->prepare("update announce set $fieldid = NULL where id = ?"); $sth->execute( $id ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } } # Update passed values. foreach my $fieldid ( keys %arr ) { my $sth = $dbh->prepare("update announce set $fieldid = ? where id = ?"); $sth->execute( $arr{"$fieldid"}, $id ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } if ( not $DBI::errstr ) { print qq{

$lex{'Record Updated'}

\n}; } else { print qq{

$lex{Error}: $DBI::errstr
}; print qq{$lex{Contact} $adminname }; print qq{($adminemail)

\n}; } print qq{

[ $title ]

\n}; print qq{\n}; exit; } # End of writeRecord #---------------- sub confirmDelete { #---------------- my $id = shift; # Load Record my $sth = $dbh->prepare("select * from announce where id = ?"); $sth->execute( $id ); my $ref = $sth->fetchrow_hashref; if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Topic}}; print qq{$ref->{atopic}
$lex{Date}}; print qq{$ref->{adate}
$lex{Description}}; print qq{$ref->{adesc}
\n}; print qq{

$lex{Delete} $lex{Record}: $lex{'Are you sure'}?

\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
\n}; exit; } #--------------- sub deleteRecord { #--------------- #foreach my $key ( sort keys %arr) { print qq{K:$key V:$arr{$key}
\n}; } my $sth = $dbh->prepare("delete from announce where id = ?"); $sth->execute( $arr{id} ); if ( $DBI::errstr ) { print qq{

$lex{Error}: $DBI::errstr
\n}; print qq{$lex{Contact}: $adminname ( $adminemail )

\n}; } else { print qq{

$lex{Record} $lex{Deleted}: $arr{topic}

\n}; } print qq{

[ $title ]

\n}; print qq{\n}; exit; }