#!/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__