#!/usr/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/dcguest.setup";
require "$path/cgi-lib.pl";

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

if ($in{'Comment'}) {
   $in{'Comment'} =~ s/</&lt;/g;
   $in{'Comment'} =~ s/>/&gt;/g;
   $in{'Comment'} =~ s/\cM//g;
   $in{'Comment'} =~ s/\n\n/<P>/g;
   $in{'Comment'} =~ s/\r\n/<P>/g;
   $in{'Comment'} =~ s/\n/<br>/g;
}


# 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="2" FACE="Verdana">
      <P align="center">
      Barzellette visualizate $start_num-$stop_num su un totale di $num_guests barzellette
      <P align="center">
   ~;

# 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 .= "Pagina  ";
        unless ($start_page == 1 ) {
            $html_output .= " <a href=\"$dcscript?marker=1\">Prima</a> ... ";
        }
        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 .= " <a href=\"$dcscript?marker=$j_start\">$j</a> ";
      }
   }

        unless ($stop_num == $num_blocks ) {
            my $next_marker = ($num_blocks-1) * $num_view;
            $html_output .= "... <a href=\"$dcscript?marker=$next_marker\">Ultima</a>";
        }
 
   $html_output .= qq~
   </font><p>~;

   foreach (reverse sort {$a <=> $b} keys %{$guest}){
      my $temp = $guest_layout;
      $guest->{$_}->{'Date'} = y2k($guest->{$_}->{'Date'});
      unless ($guest->{$_}->{'Homepage'} =~ /^http/ or $guest->{$_}->{'Homepage'} eq "") {
         $guest->{$_}->{'Homepage'} = 'http://' . $guest->{$_}->{'Homepage'};
      }
      $guest->{$_}->{'Email'} = "<br><a href=\"mailto:$guest->{$_}->{'Email'}\">$guest->{$_}->{'Email'}</a>" if ($guest->{$_}->{'Email'});
      $guest->{$_}->{'Location'} = "From $guest->{$_}->{'Location'}" if ($guest->{$_}->{'Location'});
      $guest->{$_}->{'Country'} = ", $guest->{$_}->{'Country'}" if ($guest->{$_}->{'Country'});
      $guest->{$_}->{'Homepage'} = "<br><a href=\"$guest->{$_}->{'Homepage'}\">$guest->{$_}->{'Homepage'}</a>" if ($guest->{$_}->{'Homepage'});

      $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 = "ERROR!!";
         $sub_header = "You must at least submit Name and Comment.  Please try again.";
         &add_form;
         &display_output();
         &exit;   
      }
   }  
}





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

sub remove_badwords {

   my $body = shift;

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

   $body;
}



#####
# 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="$fontsize{1}" color="$fontcolor{1}" face="$fontface{1}">
      $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="$fontsize{1}" color="$fontcolor{1}" face="$fontface{1}">
      $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 ($send_mail_to_admin eq "on") {
   
$mail_output .= qq~  
You have a new entry in your guestbook:
   
Name: $in{'Name'}
Email: $in{'Email'}
Location: $in{'Location'}
Country: $in{'Country'}
URL: http://$in{'Homepage'}
Time: $date
   
Comments: $in{'Comment'}
~;
   
      sendmail($mailprog,$in{'Email'},$admin_email,
                 "New Entry in your Guestbook",
                  $mail_output,$datadir,$smtp_server);
   }

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

   if (&email_check($in{'Email'}) && $send_mail_to_guest eq "on") {     
      sendmail($mailprog,$admin_email,$in{'Email'},
              "Thank you for signing our guestbook", $thank_you_message,$datadir,$smtp_server);
      $html_output .= "We also sent you an e-mail to thank you.";
   }
   elsif (&email_check($in{'Email'}) && $send_mail_to_guest ne "on") {
      $html_output .= "";
   }
   else {
      $html_output .= "Note that we can't send you a thank you note
                  via e-mail because your e-mail address was invalid";
   }

}


#####
# 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>
   </head>
   <body bgcolor="#FFFFFF">
   <font face="verdana" size="5"><b>SCRIPT ERROR!!!</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;
   }

}