#!/usr/bin/perl -T use strict ; use warnings ; use CGI qw/:standard/ ; use CGI::Carp 'fatalsToBrowser' ; use Fcntl ':flock' ; # import LOCK_* constants use POSIX 'strftime' ; use Regexp::Common qw/ URI /; use constant THEFILE => '/srv/www/data/guestbook/guestbook' ; #use constant MAX_LINES => 20 ; if (update(param('name'),param('message'))) { print redirect(url()) ; exit ; } print header(-type=>'text/html', -expires=>'now'), messages() ; sub update { my $name = shift ; my $message = shift ; return unless $name and $message ; return if $message =~ /a href=|url=/i ; $name =~ s!\s+! !g ; $message =~ s!\n! !g ; my $time = strftime '%F %T', localtime ; open TEXT,'>>', THEFILE or die "$!"; flock TEXT, LOCK_EX ; print TEXT "[$time] <$name> $message\n" ; flock TEXT, LOCK_UN ; close TEXT ; return 1 ; } sub messages { my $message = param('message') ; my @lines ; if (open TEXT,'<', THEFILE) { flock TEXT, LOCK_SH ; while () { my ($datetime, $name, $text) = /\[(.+?)\] <(.+?)> (.*)/ ; $_ = $text ; s!&!&!g ; s!!>!g ; s!\b($RE{URI})\b!$1!g ; #s!(http://)?((?:[^\d\W\s]\w+\.)+\w{2,3}\b(?:/[^/\s]*)*)(?= |$)!$1$2!g ; $_ = "

$name $datetime

" ; push @lines, $_ ; #shift @lines if @lines > MAX_LINES ; } flock TEXT, LOCK_UN ; close TEXT ; } my $lines = join '

', reverse @lines ; return " Guestbook

Kreiger's guestbook

Feel free to add a comment.

Home

$lines

" ; }