~;
}
$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 = ;
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 = ;
}
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~
$my_mesgSCRIPT ERROR!!!
There was an error in processing your request.
Following is the error message:
~;
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 = ;
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;
}
}