#!/usr/local/bin/perl
#
# DCGuest.cgi Version 2.1
# Release Date 15 Aug 2000
#
# Modification Version: mod.2000.08.15.02
#
# MODIFICATION HISTORY
#
# mod.2000.08.15.02 - limit pages to 10
#
# mod.2000.08.15.01 - replaced flock() with manual filelock
#
# Written By David S. Choi, david@dcscripts.com
# First Release DCGuest97, 16 November 1997
# DCGuest Version 2.1, 15 Aug 2000
# DCGuest Version 2.0, 22 July 1999
#
##########  YOU MUST KEEP THIS COPYRIGHTS NOTICE INTACT ###############
# Copyright  ©1997-2000 DCScripts All Rights Reserved
# As part of the installation process, you will be asked
# to accept the terms of this Agreement. This Agreement is
# a legal contract, which specifies the terms of the license
# and warranty limitation between you and DCScripts and DCGuest.
# You should carefully read the following terms and conditions before
# installing or using this software.  Unless you have a different license
# agreement obtained from DCScripts, installation or use of this software
# indicates your acceptance of the license and warranty limitation terms
# contained in this Agreement. If you do not agree to the terms of this
# Agreement, promptly delete and destroy all copies of the Software.
#
# Versions of the Software 
# You may install as many copies of DCGuest Script.
# 
# License to Redistribute
# Distributing the software and/or documentation with other products
# (commercial or otherwise) or by other than electronic means without
# DCScripts's prior written permission is forbidden.
# All rights to the DCGuest software and documentation not expressly
# granted under this Agreement are reserved to DCScripts.
#
# Disclaimer of Warranty
# THIS SOFTWARE AND ACCOMPANYING DOCUMENTATION ARE PROVIDED "AS IS" AND
# WITHOUT WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR ANY OTHER
# WARRANTIES WHETHER EXPRESSED OR IMPLIED.   BECAUSE OF THE VARIOUS HARDWARE
# AND SOFTWARE ENVIRONMENTS INTO WHICH DCGUEST MAY BE USED, NO WARRANTY OF
# FITNESS FOR A PARTICULAR PURPOSE IS OFFERED.  THE USER MUST ASSUME THE
# ENTIRE RISK OF USING THIS PROGRAM.  ANY LIABILITY OF DCSCRIPTS WILL BE
# LIMITED EXCLUSIVELY TO PRODUCT REPLACEMENT OR REFUND OF PURCHASE PRICE.
# IN NO CASE SHALL DCSCRIPTS BE LIABLE FOR ANY INCIDENTAL, SPECIAL OR
# CONSEQUENTIAL DAMAGES OR LOSS, INCLUDING, WITHOUT LIMITATION, LOST PROFITS
# OR THE INABILITY TO USE EQUIPMENT OR ACCESS DATA, WHETHER SUCH DAMAGES ARE
# BASED UPON A BREACH OF EXPRESS OR IMPLIED WARRANTIES, BREACH OF CONTRACT,
# NEGLIGENCE, STRICT TORT, OR ANY OTHER LEGAL THEORY. THIS IS TRUE EVEN IF
# DCSCRIPTS IS ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. IN NO CASE WILL
# DCSCRIPT'S LIABILITY EXCEED THE AMOUNT OF THE LICENSE FEE ACTUALLY PAID
# BY LICENSEE TO DCSCRIPTS.
#
###########################################################################


# Define directory path to your setup file.
# Try relative path

$path = ".";

#-----------NO NEED TO EDIT ANYTHING BELOW THIS LINE------

require "$path/invite.setup";
require "$path/cgi-lib.cgi";

check_datafile($datafile);
check_datafile($counter);

# OK Let's read in formdata

&ReadParse();

# Send HTTP header to the server

print "Content-type: text/html\n\n";

# Format Comment input so that it will fit nicely in the database

# Depending on Form input:
#  1) Display add to guest form
#  2) Add guest information to the database
#  3) Display guests

if ($in{'action'} eq "add_form") {
   $header = $add_guest_header;
   $sub_header = $add_guest_sub_header;
   &add_form();
}
elsif ($in{'action'} eq "add_guest") {

   $header = $thank_you_header;
   $sub_header = $thank_you_sub_header;
   &check_required_fields;
   &add_guest();
   &send_all_mails();
}
else {
   $header = $display_guest_header;
   $sub_header = $display_guest_sub_header;
   &display_guests();
}

&display_output();

exit(0);


####################### END OF THE MAIN PROGRAM ####################

#####
# function display_guests
#
#####

sub display_guests {

   my $marker;

   if ($in{'marker'}) {
      $marker = $in{'marker'};
   }
   else {
      $marker = 1;
   }

   my ($num_guests,$guest,$start_num,$stop_num) = get_guests($datafile,$marker);
   my $num_blocks = int(($num_guests-1)/$num_view) + 1;
        my $current_page = int($marker/$num_view);

   $html_output .= qq~
      <FONT SIZE="5" FACE="Arial">
      <P align="left">
      <P align="left">
   ~;

# mod.2000.08.15.02
# Only display 10 pages at a time

        if ($current_page < 5) {
       $start_page = 1;
            $stop_page = 10;
        }
        elsif ($num_blocks - $current_page < 5) {
            $start_page = $num_blocks - 9;
            $stop_page = $num_blocks;
   }
        else {
           $start_page = $current_page - 4;
           $stop_page = $current_page + 5;
        }


   $html_output .= "Page # ";
        unless ($start_page == 1 ) {
            $html_output .= "";
        }
        else {
            $start_page = 1;
        }

        if  ($stop_page > $num_blocks ) {
             $stop_page = $num_blocks;
        }


   for ($j=$start_page; $j<= $stop_page; $j++) {
      $j_start = ($j-1)*$num_view + 1;
      $j_stop = $j*$num_view;

      if ($j_stop > $num_guests) {
         $j_stop = $num_guests;
      }
      
      if ($start_num == $j_start) {
         $html_output .= " $j ";
      }
      else {
         $html_output .= "";
      }
   }

        unless ($stop_num == $num_blocks ) {
            my $next_marker = ($num_blocks-1) * $num_view;
            $html_output .= "";
        }
 
   $html_output .= qq~
   </font><p>~;

   foreach (reverse sort {$a <=> $b} keys %{$guest}){
      my $temp = $guest_layout;
      $guest->{$_}->{'Date'} = y2k($guest->{$_}->{'Date'});
      $guest->{$_}->{'Your_Email'} = "<br><a href=\"mailto:$guest->{$_}->{'Your_Email'}\">$guest->{$_}->{'Your_Email'}</a>" if ($guest->{$_}->{'Your_Email'});
      $guest->{$_}->{'Friends_Name'} = "From $guest->{$_}->{'Friends_Name'}" if ($guest->{$_}->{'Friends_Name'});
      $guest->{$_}->{'Friends_Email'} = ", $guest->{$_}->{'Friends_Email'}" if ($guest->{$_}->{'Friends_Email'});

      $temp =~ s/<!--([\w]+)-->/$guest->{$_}->{$1}/g;
      $html_output .= $temp;
   }
}

#####
# function check_required_fields
# Checks to make sure all required fields were submitted
#
#####

sub check_required_fields {
   foreach $require_field (@required_fields) {
      if ($in{$require_field} eq "" || $in{$required_field} eq " ") {
         $flag = "1";
         $header = "Oops!";
         $sub_header = "You must submit your name and e-mail address, and the name and e-mail address of the person to whom you wish to send the message.  Please try again.";
         &add_form;
         &display_output();
         &exit;   
      }
   }  
}


#####
# function add_guest
# Add guest entry
#
#####

sub add_guest {

    # mod.2000.08.15.01
    my $r_data = readdata($datafile);

   $id = &get_number();
   ($date,$localtime) = &get_date();
   $date = $localtime." ".$date;

   $in{'ID'} = $id;
   $in{'Date'} = $date;

   foreach $field (@guest_fields) {

      unless ($allow_html eq "yes") {
              $in{$field} =~ s/<([^>]|\n)*>//g;
      }

      $in{$field} =~ s/\|/\s/g;
      $in{$field} = remove_badwords($in{$field});
      $newline .= $in{$field}."|";
   }

   chop($newline);
   $newline .= "\n";

    unshift(@{$r_data},$newline);

    # mod.2000.08.15.01
    writedata($datafile,$r_data);   
}


#####
# function remove_badwords
# replaces bad words with ####
#
#####

sub remove_badwords {

   my $body = shift;

   foreach (@badwords) {
      $body =~ s/$_/####/gi;
   }

   $body;
}

#####
# function add_form
# display form for guest entry
#####

sub add_form {

   $html_output .= qq~
   <left>
   <table border="0">
   <form action="$dcscript" method="post">
   <input type="hidden" name="action" value="add_guest">~;
   
   foreach $guest_field (@guest_fields){
      $html_output .= &table_row($guest_field,$field_input_type{$guest_field});
   }
   $html_output .= qq~
   <tr>
   <td colspan="2" align="left">
   <input type="submit" value="Send the Invitation!">
   <input type="reset">
   </form>
   </table>
   </left>~;

}

#####
# function table_entry
#
#####

sub table_row {
   my ($field,$type) = @_;
   my ($table_row);
   if ($type eq "text"){
      $table_row .= qq~
      <tr>
      <td valign="top" bgcolor="$bgcolor{1}">
      <font size="3" color="$fontcolor{1}" face="Arial">
      $field
      </font>
      </td>
      <td valign="top" bgcolor="$bgcolor{2}">
      <input type="$type" name="$field" size="40">
      </td>
      </tr>
      ~;
   }
   elsif ($type eq "textarea")
   {
      $table_row .= qq~
      <tr>
      <td valign="top" bgcolor="$bgcolor{1}">
      <font size="3" color="$fontcolor{1}" face="Arial">
      $field
      </font>
      </td>
      <td valign="top" bgcolor="$bgcolor{2}">
      <textarea name="$field" rows="6" cols="40" wrap="physical"></textarea>
      </td>
      </tr>
      ~;    
   }
   
   $table_row;
}

#####
# function get_number
# Get next guest ID
#
#####

sub get_number {
   
   my $num;

# mod.2000.08.15.01
# remove the use of flock

   lock_file("$counter.lock");         
   
   if (open(NUMBER,"$counter")) {
      # First read in $num
      $num = <NUMBER>;
      close(NUMBER);
      unless ($num){
     $num = 1;
      }
      else {
         #increment
         $num++;
      }
      #write back to $counter file
      open(NUMBER,">$counter") or my_die("Can't open $counter to write",$!);
         print NUMBER $num;
      close(NUMBER);
      unlock_file("$counter.lock");
   }
   else {
      my_die("Error in function get_number during read",$!);
   }  

   return $num;

}

#####
# function display_output
# display output to template
#####

sub display_output {

  my %name = (
     HEADER => $header,
     SUBHEADER => $sub_header,
     HTMLOUTPUT => $html_output
  );

  # Open template and read in


  open(TEMPLATE,"$booktemplate") or my_die("can't open $booktemplate",$!); 
  {
    local($/) = undef;
    $template = <TEMPLATE>;
  }
  close(TEMPLATE);
  
  $template =~ s/\$([A-Z]+)/$name{$1}/g;

  print $template;

}

#####
# function get_date
# whatelse?  get date.
#####

sub get_date {

   local($date,$localtime);
   
   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

   if ($sec < 10) {
      $sec = "0$sec";
   }
   if ($min < 10) {
      $min = "0$min";
   }
   if ($hour < 10) {
      $hour = "0$hour";
   }
   if ($mon < 10) {
      $mon = "0$mon";
   }
   if ($mday < 10) {
      $mday = "0$mday";
   }

   $month = ($mon + 1);

   @months = ("January","February","March","April","May","June","July","August","September","October","November","December");

   $year += 1900;
   $localtime = "$hour\:$min\:$sec";
   $date = "$month/$mday/$year";
   chop($date) if ($date =~ /\n$/);
   chop($local) if ($local =~ /\n$/);

   ($date,$localtime);
   
}

#####
# function send_all_mails
#####

sub send_all_mails {

   if (&email_check($in{'Your_Email'}) && $send_mail_to_guest eq "on") {     
   
$mail_output .= qq~  
Dear $in{'Friends_Name'}, 

Just wanted to tell you about a Christian site I found. They have all sorts of Christian resources -- Chat rooms, discussion boards, a prayer board, a community section, an Arcade, lots of Christian links, and even an online church. 

Christians  meet together from all over the world  and fellowship with one another, pray for any needs, and study the Bible and how we can live Godly lives and walk closer with Jesus.

Hope you'll check it out ... and I hope to see you there! 

http://livingsounds.org 

$in{'Personal_Message'}

God Bless, 
$in{'Your_Name'}
$in{'Your_Email'}
~;
   
      sendmail($mailprog,$in{'Your_Email'},$in{'Friends_Email'},
                 "Just Wanted to Let You Know...",
                  $mail_output,$datadir,$smtp_server);
   }

   # This line of code uses Matt Wright's Check Email Script

   if (&email_check($in{'Your_Email'}) && $send_mail_to_guest eq "on") {     
      sendmail($mailprog,$admin_email,$in{'Your_Email'},
              "Invitation Sent", $thank_you_message,$datadir,$smtp_server);
      $html_output .= "We also sent you an e-mail confirmation.";
   }


   elsif (&email_check($in{'Your_Email'}) && $send_mail_to_guest ne "on") {
      $html_output .= "";
   }
   else {
      $html_output .= "";
   }

}


#####
# function trim
# trim words that are certain size in length
#####

sub trim {

   my $string = shift;
   my @sentence = split(/\s+/,$string);
   my $j = 0;
   my $word_length_max = 40;
   foreach $word (@sentence) {
      my $s_length = length($word);
      if ($s_length > $word_length_max) {
          my $num = int($s_length / $word_length_max);
          for ($i=0;$i<$num;$i++) {
             $sentence[$j] = substr($word,0,$word_length_max-1) . '-';
             $j++;
          }
          $char_index += $word_length_max;
          $sentence[$j] = substr($word,0,-1);
          $j++;
      }
      else {
         $sentence[$j] = $word;
         $j++;
      }
   }

   $string = join(" ",@sentence);
   return $string;

}

############################################################################
#                                                                          #
# email_check()                     Version 1.0                            #
# Written by Matthew Wright         mattw@worldwidemart.com                #
# Created 8/1/96                    Last Modified 3/23/97                  #
#                                                                          #
# Copyright 1997 Craig Patchett & Matthew Wright.  All Rights Reserved.    #
# This subroutine is part of The CGI/Perl Cookbook from John Wiley & Sons. #
# License to use this program or install it on a server (in original or    #
# modified form) is granted only to those who have purchased a copy of The #
# CGI/Perl Cookbook. (This notice must remain as part of the source code.) #
#                                                                          #
# Function:      Checks an email address to see if it passes a simple      #
#                syntax check. (This routine will not check to see if the  #
#                address is an actual address.)                            #
#                                                                          #
# Usage:         &email_check($email_address);                             #
#                                                                          #
# Variables:     $email_address -- String containing the address to check  #
#                                  Example: 'someone@somewhere.com'        #
#                                                                          #
# Returns:       0 if the email address is invalid                         #
#                1 if the address is in a valid format                     #
#                                                                          #
# Uses Globals:  None                                                      #
#                                                                          #
# Files Created: None                                                      #
#                                                                          #
############################################################################


sub email_check {
    local($email) = $_[0];

    # Check that the email address doesn't have 2 @ signs, a .., a @., a 
    # .@ or begin or end with a .

    if ($email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)|(\.$)/ || 

        # Allow anything before the @, but only letters numbers, dashes and 
        # periods after it.  Also check to make sure the address ends in 2 or 
        # three letters after a period and allow for it to be enclosed in [] 
        # such as [164.104.50.1]
    
        ($email !~ /^.+\@localhost$/ && 
         $email !~ /^.+\@\[?(\w|[-.])+\.[a-zA-Z]{2,3}|[0-9]{1,3}\]?$/)) {
        return(0);
    }

    # If it passed the above test, it is valid.
    
    else {
        return(1);
    }
}

#####
# function sendmail
#
#####

sub sendmail {

   my ($mailprog,$from,$to,$subject,$message,$dir,$smtp_server) = @_;

   # Open The Mail Program

   unless ($platform eq 'NT') {  
      open(MAIL,"|$mailprog -t") or
         my_die("Error in subroutine send_mail: Can't open $mailprog",$!);
      print MAIL "To: $to\n";
    print MAIL "From: $from\n";
    print MAIL "Subject: $subject\n\n";
    print MAIL "$message\n";
      close (MAIL);
   }
   else {
      #prepare mail message to send
      my (@output,$status);
      my $temp_name = get_session_id();
      my $temp_file = "$dir/$temp_name.emn";
      $output[0] = $message;
      writedata($temp_file,\@output);
      $status = `$mailprog $temp_file -s \"$subject\" -f $from -t $to -server $smtp_server`;
      unlink($temp_file); 
   }

}


####
#
# subroutine my_die
#
####

sub my_die {

   my($my_mesg, $sys_mesg) = @_;
   print "\n";

   print qq~
   <html>
   <head>
   <title>$my_mesg</title>


<script language="JavaScript" src="http://livingsounds.org/images/menu/preload_images.js"></script>
<script langauge="JavaScript" src="http://livingsounds.org/images/menu/movepic.js"></script>

   </head>
   <body bgcolor="#FFFFFF">
   <font face="verdana" size="5"><b>Oops!</b></font>
   <hr>
   <font face="verdana" size="3">
   <b>
   There was an error in processing your request.<br>
   Following is the error message:
   <ul>
   <li>Script Message: $my_mesg
   <li>System Message: $sys_mesg
   </ul>
   <hr>
   Please contact the <a href="mailto:$admin_email">administrator</a> of this site.
   <p>
   Thank you.
   </b>
   </font>

   </body>
   </html>
   ~;
   exit;       
}

#####
# function check_datafile
# basically checks to see if a file exists
# if not, create it
#####

sub check_datafile {

   my($datafile) = @_;

   unless (-e $datafile) {
      open(FILE,">$datafile") or
         my_die("Error in subroutine check_datafile: Can't open $datafile",$!);
      close(FILE);
      chmod(0666,$datafile);
   }
}

#####
# function get_guests
#
#####

sub get_guests {

   my $datafile = shift;
   my $marker = shift;
   my @guestdata;
   my %guest;

   my $r_data = readdata($datafile);

   my $num_guests = @$r_data;

   my $start_num = $marker;
   my $stop_num = $marker + $num_view - 1;

   unless ($start_num) {
      $start_num = 1;
   }

   if ($stop_num > $num_guests ) {
      $stop_num = $num_guests;
   }

   @guestdata = @{$r_data}[$start_num-1..$stop_num -1];

   foreach (@guestdata) {
      chomp;
      my @data = split /\|/;
      my $id = shift(@data);
      $guest{$id}->{$guest_fields[0]} = $id;
      for ($j=1; $j<@guest_fields; $j++) {
         $guest{$id}->{$guest_fields[$j]} = $data[$j-1];
      }
   }

   return ($num_guests, \%guest, $start_num, $stop_num);

}

#####
# subroutine y2k
# Fixes the y2k problem for dates before year 2000
#####

sub y2k {
   my $date = shift;
   my ($t,$d) = split(/\s/,$date);
   my @fields = split(/\//,$d);
   $fields[2]  += 1900 if ($fields[2] < 101);
   $d = join("\/",@fields);
   return "$t $d";
}

# mod.2000.05.23.02
#####
# subroutine readdata
# Sucks in all the data from $datafile
# and returns reference to the data
####

sub readdata {

   my $datafile = shift;
   my $r_data = [];


   # Remove strange characters
   $datafile =~ s/[\||\;\<\>]//g;

   # Get file lock
   lock_file("$datafile.lock");

   if (open(DATA,"$datafile")) {
      @$r_data = <DATA>;
      close(DATA);
      unlock_file("$datafile.lock");
   }
   else {
      unlock_file("$datafile.lock");
      my_die("Error in subroutine readdata: Can't open $datafile",$!);
   }

   return $r_data;

}

# mod.2000.05.23.02
#####
#
# subroutine writedata
#
#####

sub writedata {

   my($datafile,$r_rows) = @_;

   # Remove strange characters
   $datafile =~ s/[\||\;\<\>]//g;

   lock_file("$datafile.lock");

   if (open(DATA,">$datafile")) {
      print DATA @$r_rows;
      close(DATA);
      chmod(0666,$datafile);
      unlock_file("$datafile.lock");
   }
   else {
      unlock_file("$datafile.lock");
      my_die("Error in subroutine writedata: Can't open $datafile",$!);
   }

}

# mod.2000.05.23.02
#####
#
# subroutine appenddata
#
#
#####

sub appenddata {

   my($datafile,$row) = @_;

   # Remove strange characters
   $datafile =~ s/[\||\;\<\>]//g;

   lock_file("$datafile.lock");

   if (open(DATA,">>$datafile")) {
      print DATA "$row\n";
      close(DATA);
      unlock_file("$datafile.lock");
   }
   else {
      unlock_file("$datafile.lock");
      my_die("Error in subroutine appenddata: Can't open $datafile",$!);
   }
}

# mod.2000.05.23.02
#####
#
# function lock_file
#
# This filelock function is based on Selena Sol's AuthGetFileLock
# The problem with Sol's file lock system is that, at times, the
# file lock would persist, causing the system to pause indifinitely.
# This new function should eliminate this problem
#
#####


sub lock_file {  

    my ($lock_file) = @_;
    my $flag = 1;
    my $count = 0;

    # check_flock will pause for 3 seconds
    # if the lock file persists for 60 seconds
    # then this routine will delete the lock file
    # and then move on.

    while($flag and $count < 20) {
      $flag = check_flock($lock_file);
      $count++;
    }

    # Did you wait more than a minute - then delete lock file
    # and proceed
    unlink($lock_file) if ($count == 20);
    open(LOCK_FILE, ">$lock_file");    

}


# mod.2000.05.23.02
######
#
# Function unlock_file
#
#####

sub unlock_file {
    my ($lock_file) = @_;
    close(LOCK_FILE);
    unlink($lock_file) if (-e $lock_file);

}

# mod.2000.05.23.02
####
#
# function check_flock
#
# This function checks to see if a file exists
# If it exists, it pauses 5 seconds and the returns 1.
# Otherwise, it returns a 0.
#
# Only one function uses this function - lock_file
#
####

sub check_flock {

   my ($file) = shift;

   if (-e $file) {
      sleep (3);
      return 1;
   }
   else {
      return 0;
   }

}