#!/usr/bin/perl -w use CGI qw(:standard); use CGI::Carp qw(fatalsToBrowser); use CGI::Cookie; use Data::Dumper; use POSIX qw(strftime); use strict; my $fetchdate = param("date"); my %cookies = fetch CGI::Cookie; my $stylesheet; if ($cookies{'css'} eq undef) { $stylesheet = 'default' } else { $stylesheet = $cookies{'css'}->value } sub error { my($error) = @_; print "Content-type:text/html\n\n"; print qq( I'm sorry Dave, I'm afraid I can't do that.

back

     
 

The scripts have generated an error!

They say: $error

  
     

back

); exit; } sub cleantext { my($cleaned) = @_; $cleaned =~ s#&#&#g; $cleaned =~ s#<#<#g; $cleaned =~ s#>#>#g; $cleaned =~ s#\n#
#g; $cleaned; } my $posttime = strftime("%c",gmtime); my $newcomment = cleantext(param("newcomment")); my $newname = cleantext(param("newname")); my $newemail = cleantext(param("newemail")); my $newhome = cleantext(param("newhome")); if ($newname !~ /\S/ or $newcomment !~ /\S/) { &error("Invalid name or comment text") } if ($newemail =~ /\S/) { $newemail =~ s#\.#.#g; $newemail =~ s#\@#@#g; $newemail = "($newemail) "; } if ($newhome =~ /\S/) { $newhome = "http://$newhome" if $newhome !~ /http:\/\//; $newname = qq($newname) } my $newline = qq(

$newname ${newemail}said: $newcomment
$posttime GMT

); open(COMMENTFILE, ">>../httpdocs/comments/$fetchdate.cmt"); print COMMENTFILE "$newline\n"; close(COMMENTFILE); print "Content-type:text/html\nStatus: 303 See Other\nLocation: /cgi-bin/makepage.cgi?date=$fetchdate\n\n"; print qq( Updated Page

The page has been updated. Please click here.

);