#!/usr/bin/perl -w
# print HTTP headers
print "Content-type:text/html\n\n";
# be anal retentive
use strict;
use CGI::Carp qw(fatalsToBrowser set_message);
BEGIN {
sub handle_errors {
my $msg = shift;
print "<h2>The Calendar Update program has encountered an error.</h2><br>Exiting...<br>";
print "$msg";
print "<br>$!";
}
&set_message (\&handle_errors);
}
$| = 1; # flush buffers after each print
# initialize the $ENV hash
$main::ENV = \%ENV;
# grab & parse input
my $FORM = &parseSTDIN();
# grab templates
my $templatehead = &suckFile("./templates/cal/templatehead.html");
my $templatefoot = &suckFile("./templates/cal/templatefoot.html");
# where's the password db?
my $adminpassfile = "./data/pwddb.txt";
# autoload the default methods for this program if no parameters are passed
&default() if $ENV->{CONTENT_LENGTH} == 0;
# validate program caller when command parameters are passed
&validateCaller();
# if your directives don't include a stage=3 parameter, perform the validation sequence
&validateAdmin() unless $FORM->{stage} eq "3" or $FORM->{aheadto} eq "2";
# but if your input comes from an approved source, and includes the stage=3 parameter, allow editing of the events database
if ($FORM->{stage} eq "3") {
&saveChanges();
}
# exit
exit;
# --------------- end main program block ----------------
# --------------- define subroutines ----------------
sub validateCaller { # authenticate program caller
my @allowed = ("adoula4u.com/cgi-bin/calupdate.cgi", "adoula4u.com/cgi-bin/admin.cgi");
print qq|${$templatehead}
<div class="copy">
<strong>Execution of this program has aborted.
<br>
<br>
Error:</strong>
<br>
Unauthorized Use of this program is prohibitted.
<br>
This program was called by an unrecognized Referrer and is now exiting.
<br>
<br>
Program called from $ENV->{HTTP_REFERER}, $ENV->{REMOTE_ADDR} at |. time.
qq| UTC.
<br>
Your IP address has been logged.
</div>
${$templatefoot}|
and exit unless (lc($ENV->{HTTP_REFERER}) =~ m/($allowed[0])|($allowed[1])/i);
} # end sub validateCaller
# get the file I want
sub suckFile {
if (wantarray()) {
open(FILE, $_[0]) or die "can't open $_[0] for reading: $!";
my @file = <FILE>;
close FILE;
return @file; }
elsif ((wantarray()) eq "") {
my $file;
open(FILE, $_[0]) or die "can't open $_[0] for reading: $!";
while (<FILE>) {
$file .= $_;
}
close FILE;
return \$file; }
else {
carp "Subroutine &suckFile() was called in void context"; }
} # end sub suckFile
sub parseSTDIN {
my $FORM = {};
my $buffer = '';
read STDIN, $buffer, $ENV->{CONTENT_LENGTH};
my @pairs = split (/&/, $buffer);
foreach my $pair (@pairs) {
my ($name, $value) = split /=/, $pair;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM->{$name} = $value; } # close foreach loop
return $FORM;
} # end sub parseSTDIN
sub default {
my $login_box = &make_Login();
print qq|${$templatehead}
<div class="copy">
${$login_box}
${$templatefoot}|;
exit;
} # end sub default
sub getEvents {
my $records;
open(EVDB,"./data/eventdb.txt") or die "can't open calendar of events database for reading: $!";
while (<EVDB>) {
chop;
my($r) = {};
( $r->{'recid'},
$r->{'eventname'},
$r->{'eventdate'},
$r->{'eventday'},
$r->{'eventtime'},
$r->{'eventlocation'},
$r->{'eventdesc'},
$r->{'contactinfo'},
$r->{'directions'},
$r->{'notes'},
$r->{'sponsorship'},
$r->{'legalinfo'},
$r->{'other'} ) = split /~=~~=~/, $_ if length($_) > 0; # don't waste cpu cycles on empty db lines
push(@$records, $r) if $r->{'recid'}; # don't stuff empty entries into our in-memory copy of the db
} # end while
close(EVDB);
# $records is now a reference to an anonymous array whose indicies are references to anonymous hashes containing
# one record each from the database. The new in-memory database is accessible via ' @{$records} '. Each record is
# accessible via the ${@{$records}->[$i]} syntax, while the individual record fields are accessible via the
# ${@{$records}->[$i]}{'fieldname'} syntax.
return $records;
} # end sub getEvents
sub make_Login {
my $login_box = qq|
<br>
<br>
In order to edit the Events that are currently displayed on the 'calendar' page of this website you will need to sign in below.
<br>
<br>
<form action="http://adoula4u.com/cgi-bin/calupdate.cgi" method="POST">
<table align=center cellspacing=1 cellpadding=4 border=1>
<tr>
<td class="default" bgcolor="#D7DAC8">
<font face"Arial"><strong>User name:</strong></font>
</td>
<td class="default" valign="middle">
<input type="text" name="usr" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#FFFFFF;">
</td>
</tr>
<tr>
<td class="default" bgcolor="#D7DAC8">
<font face"Arial"><strong>Password:</strong></font>
</td>
<td class="default" valign="middle">
<input type="password" name="pwd" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#FFFFFF;">
</td>
</tr>
<tr>
<td colspan=2 align=right bgcolor="#FFFFFF" background="http://adoula4u.com/images/news2.gif" style="background-repeat:no-repeat;">
<input type="submit" value="submit" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#D7DAC8;">
</td>
</tr>
</table>
</form>
</div>
|;
return \$login_box;
} # end sub make_Login
sub formatForAdmin {
my $events = &getEvents("./data/eventdb.txt");
my $formattedEvents = qq|
<div class="copy">
<form action="http://adoula4u.com/cgi-bin/calupdate.cgi" method="POST">
<input type="hidden" name="stage" value="3">
<div align="center"><font size="3" face="Arial"><strong>Want to add a new Event?</strong></font></div>
<hr size=1 color="#60062D" width=90% align="center">
<br>
<input type="text" size="30" name="eventname" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"> Event Name
<br>
<input type="text" size="30" name="eventday" style="color: #60062D; font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"> Event Day
<br>
<input type="text" size="30" name="eventdate" style="color: #60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"> Date ( MM/DD/YYYY )
<br>
<input type="text" size="30" name="eventtime" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color: #F1F3E5;"> Time
<br>
<input type="text" size="30" name="eventlocation" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"> Event Location
<br>
<input type="text" size="30" name="contactinfo" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"> Contact Information
<br>
<br>
Event Description:
<br>
<textarea name="eventdesc" ROWS="10" cols="70" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"></textarea>
<br>
<br>
Directions to this event:
<br>
<textarea name="directions" ROWS="6" cols="70" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"></textarea>
<br>
<br>
Sponsorship Info:
<br>
<textarea name="sponsorship" ROWS="6" cols="70" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"></textarea>
<br>
<br>
Legal Info:
<br>
<textarea name="legalinfo" ROWS="6" cols="70" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"></textarea>
<br>
<br>
Notes:
<br>
<textarea name="notes" ROWS="6" cols="70" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"></textarea>
<br>
<br>
Other:
<br>
<textarea name="other" ROWS="6" cols="70" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"></textarea>
<br>
<br>
<div align="center"><input type="submit" value="Submit New Event" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;"></div>
<br>
<br>
<br>
<div align="center"><font size="3" face="Arial"><strong>Event Database - Current Entries</strong></font></div>
<hr size=1 color="#60062D" width=90% align="center">
<ol>
|;
my $i = 0;
foreach (@{$events}) {
$formattedEvents .= qq|
<li> <input type="checkbox" name="kill$i" value="kill\_${@{$events}->[$i]}{'eventname'}">
<font size="1" face="Arial">Delete this event?</font> <input type="submit" value="delete" style="color:#60062D;font-family:Verdana,Arial,MS Sans Serif;font-size:10px;background-color:#F1F3E5;">
<ul>
<li><strong>Event:</strong> ${@{$events}->[$i]}{'eventname'}
<br>${@{$events}->[$i]}{'eventtime'}, ${@{$events}->[$i]}{'eventday'}, ${@{$events}->[$i]}{'eventdate'}</li>
<li><strong>Location:</strong> ${@{$events}->[$i]}{'eventlocation'}</li>
<li><strong>Contact Information:</strong> ${@{$events}->[$i]}{'contactinfo'}</li>
<li><strong>Sponsorship:</strong> ${@{$events}->[$i]}{'sponsorship'}</li>
<li><strong>Event Description:</strong>
<br>
${@{$events}->[$i]}{'eventdesc'}
</li>
<li><strong>Directions to this event:</strong>
<br>
${@{$events}->[$i]}{'directions'}
</li>
<li><strong>Notes:</strong> ${@{$events}->[$i]}{'notes'}</li>
<li><strong>Legal Info:</strong> ${@{$events}->[$i]}{'legalinfo'}</li>
<li><strong>Other:</strong> ${@{$events}->[$i]}{'other'}</li>
</ul>
</li>
<br>
<hr size=1 color="#60062D" width=90% align="left">
<br>
<br>|;
$i++;
}
$formattedEvents .= qq|
</ol>
</form>
</div>
|;
return \$formattedEvents;
} # end sub formatForAdmin
sub validateAdmin {
unless (open PWDDB, $adminpassfile) {
print "<br>Can't open pwddb for reading: $!\n";
exit;
}
my $pwd = <PWDDB>;
close PWDDB;
my $salt = "tommy";
my $comparegiven = crypt ($FORM->{pwd}, $salt);
if ($comparegiven ne $pwd) {
#print "<br>$comparegiven ne @pwd<br><br>";
print "Access Denied. Invalid password. You do not have access to the ";
print "administrative console of this program.";
exit;
}
if ($FORM->{usr} ne "usums") {
print "Access Denied. Invalid Username. You do not have access to the ";
print "administrative console of this program.";
exit;
} else {
&enter();
}
} # end sub validateAdmin
sub enter {
my $formattedEvents = &formatForAdmin();
print qq|
${$templatehead}
${$formattedEvents}
${$templatefoot}|;
exit;
} # end sub enter
sub saveChanges {
my $recid = &getUniqueID(rand);
my $oldrecs = &getEvents();
print ${$templatehead};
foreach my $key (keys %{$FORM}) {
# set empty values to 'null'
if ($FORM->{$key} eq '') {
$FORM->{$key} = "null"; }
# substitute carriage returns with HTML <br>'s for all input fields
$FORM->{$key} =~ s/\n/\<br\>/gsi;
# delete this record?
&killRec($oldrecs, $FORM->{$key}) if $key =~ m/kill/i;
}
sub killRec {
my $oldrecs = $_[0];
my $i = 0;
foreach (@{$oldrecs}) {
if ($_[1] eq "kill_${@{$oldrecs}->[$i]}{'eventname'}") {
${@{$oldrecs}->[$i]}{'eventname'} = 'killme'; }
$i++; }
}
if ($FORM->{eventname} ne 'null' and $FORM->{eventdate} ne 'null') {
my $newrec = {recid => ${$recid},
eventname => $FORM->{eventname},
eventdate => $FORM->{eventdate},
eventday => $FORM->{eventday},
eventtime => $FORM->{eventtime},
eventlocation => $FORM->{eventlocation},
eventdesc => $FORM->{eventdesc},
contactinfo => $FORM->{contactinfo},
directions => $FORM->{directions},
notes => $FORM->{notes},
sponsorship => $FORM->{sponsorship},
legalinfo => $FORM->{legalinfo},
other => $FORM->{other}};
push (@saveChanges::allrecs, $newrec);
}
my $n = 0;
foreach (@{$oldrecs}) {
push(@saveChanges::allrecs, $oldrecs->[$n]);
$n++; }
&overwriteFile(@saveChanges::allrecs);
my $formattedFAQs = &formatForAdmin();
print ${$formattedFAQs};
print ${$templatefoot};
exit;
} # end sub saveChanges
sub getUniqueID {
my $randed = rand;
$randed = crypt($randed, $_[0]);
$randed =~ s/(\W|\.)//gs;
return \$randed;
} # end sub getUniqueID
sub overwriteFile {
open(FILE, ">./data/eventdb.txt") or die "can't open eventDB for writing: $!";
my $i = 0;
foreach (@_) {
my $r = \%{$_[$i]};
unless ($r->{'eventname'} eq 'killme') {
print FILE join("~=~~=~",
$r->{'recid'},
$r->{'eventname'},
$r->{'eventdate'},
$r->{'eventday'},
$r->{'eventtime'},
$r->{'eventlocation'},
$r->{'eventdesc'},
$r->{'contactinfo'},
$r->{'directions'},
$r->{'notes'},
$r->{'sponsorship'},
$r->{'legalinfo'},
$r->{'other'});
print FILE "\n"; }
$i++; }
close FILE;
} # end sub overwriteFile
__END__