#!/usr/bin/perl
# Don't use the -w switch. Use the warnings pragma. That way you can disable it where needed.
use strict;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
my $query = new CGI;
use constant DATA_FILE => 'testfile.txt';
use constant DELIMITER => '|';
# I cleaned up all the stuff at the front and jump right into the script.
my ( $input, $errors ) = Process_Input($query);
if (@$errors) {
Display_Error_Page($errors);
}
else {
Store_Data(
$input->{name}, $input->{name1},
$input->{comments}, Format_Date_Time(),
);
my $data = Load_Data();
Display_Main_Page($data);
}
exit; # not strictly necessary, but the exit communicates that
# we are at the end of application logic rather nicely.
# This replaces part of the big if/elsif/block.
# We build up a list of bad fields in @errors.
# Also, accepted field data from the query are stored in a hash.
sub Process_Input {
my $q = shift;
my %input;
my @errors;
foreach my $field (qw(name name1 comments)) {
my $value = $query->param($field);
if ( defined $value and length $value ) {
$input{$field} = $value;
}
else {
$input{$field} = undef;
push @errors, $field;
}
}
return \%input, \@errors;
}
# A very simple routine to reduce some repeated code.
# It could be extended by adding named arguments with
# sensible defaults:
# * content_type => content type to use.
# * title => title of page
# * heading => heading to put at top of page
# * footer => stuff to display at bottom of page
# * body => a string or array ref of stuff to put between
# the heading and the footer.
# Or you could move up to a proper templating system.
#
sub Print_Page {
print "Content-type:text/html\n\n";
print join "\n", @_;
return;
}
# Renamed from Writing_to_file for these reasons:
# * Data store may not always be a file.
# * The name was grammatically weird (I don't know the correct term, sorry).
# Write_To_File would have been better, but see the first reason.
#
# Fixed open() statement.
# Used 3 argument open
# Used lexical filehandle.
# Reformatted the 'or die' clause.
# Used low precedence 'or'.
# Fixed error message and included $! to get real error.
#
# Consider making the file path the first argument of this routine. Gets rid
# of a global--it's a constant, but still it's a global.
sub Store_Data {
my @input_to_file = @_;
open( my $data, '>>', DATA_FILE )
or die "Error opening file: $!";
# This is the source of your problem.
# The serialization you are using does not escape '\n', and so entries
# with line breaks are treated at separate one field entries.
#
# One solution would be to fix your serialization routine to escape
# '\n' and '|' and also make sure that whatever you use to mark your
# escapes is also escaped. For example, if you use '\', to escape '|' so
# that '|' becomes '\|', and use '\n' for new lines, the you'll also need
# to escape '\' as '\\'.
#
# The other option would be to use a library to serialize your data.
# Text::CSV, a db file, YAML, or DBD::SQLite would all be good options.
print $data join( DELIMITER, @input_to_file ), "\n";
close($data);
}
# Fixed the case of the routine name to be consistent.
# Changed name to Display_Main_Page, because it may be going to anything, not
# just a browser.
#
# This routine requires a reference to a two dimension array for its argument.
#
sub Display_Main_Page {
my $data = shift;
Print_Page(
"Guestbook",
map( Format_Data_Row($_), @$data ),
"Back to Guestbook
",
"",
);
return;
}
# Build a two-dimensional array of data
# and return a reference to it.
# Result looks like:
# my $data = [
# [ 'Bob', 'Smith', 'foo bar baz', '12:12:23 Wed Aug 6, 2008' ],
# [ 'John', 'Smith', 'foo bar baz', '22:42:23 Wed Aug 6, 2008' ],
# ];
#
# Consider making the file path the first argument of this routine. Gets rid
# of a global--it's a constant, but still it's a global.
sub Load_Data {
open( my $data, '<', DATA_FILE )
or die "Error opening file: $!";
my @data_from_file = map Process_Data_Line($_), <$data>;
close($data);
return \@data_from_file;
}
# Process one line of data into an array ref
sub Process_Data_Line {
my $line = shift;
chomp $line; # clean up those pesky line ends.
# Your original regex used a hard coded '|' for the delimeter. If someone
# changed the $delimeter variable at the top of the file, you'd have an
# instant bug. Consistency is key, if you are going to use configuration
# constants (which is a good idea), use them everywhere.
#
# The need muck about with an intermediary string to form my regex is one
# thing that sucks about use constant.
#
# There is all sorts of discussion about the relative merits of constant
# vs. Readonly and the other options. Much of it in relation to the
# recommendation in PBP to use Readonly. Search around on perlmonks and
# you'll find it.
my $split_regex = '[' . DELIMITER . ']';
my @fields = split( /$split_regex/, $line );
return \@fields;
}
# Format a row of data from your data array.
sub Format_Data_Row {
my $row = shift || [];
my $formatted_text = join '
', '', # Get leading
@$row, '_' x 100, # Big delimiter, why not an
?
''; # Add a trailing
return $formatted_text;
}
# All the cluttery date time formatting stuff is now in a sub where it can be
# ignored until you decide to use a library like DateTime to do your dirty
# work.
#
# Made all your variable names use a consistent style:
# lower_case_names_with_underscores
sub Format_Date_Time {
my $time = shift || time;
my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @week_days = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
my ($second, $minute, $hour,
$day_of_month, $month, $year_offset,
$day_of_week, $day_of_year, $daylight_savings
) = localtime($time);
my $year = 1900 + $year_offset;
my $the_time
= "$hour:$minute:$second, $week_days[$day_of_week] $months[$month] $day_of_month, $year";
return $the_time;
}
# This replaces the rest of the big if/elsif block.
# This version will display all missing fields in the error page.
sub Display_Error_Page {
my $errors = shift;
my %field_description = (
name => 'first name',
name1 => 'last name',
comments => 'comments',
);
my $missing_fields = join ", ", map { $field_description{$_} } @$errors;
Print_Page(
"Guestbook",
"You have missed some required fields: $missing_fields",
"Back to Guestbook
",
"",
);
return;
}