<html>
<head>
<title>Guestbook</title> 
<script runat=server language=perl>
  local $/ = "\0";
  for( param( 'delete' )) {
    last unless $_;
    my( $file, $rand ) = split ':';
    open FILE, $file or last;
    chop( my $key = <FILE> );
    close FILE;
    unlink $file if "$rand $ENV{REMOTE_ADDR}" eq $key;
  }

  my( $submitted, $date, $i, $rand, @files );
  my( $name, $from, $mail, $home, $title, $text, $html ) =
    (param( 'name' ), param( 'from' ), param( 'mail' ), param( 'home' ),
     param( 'title' ), param( 'text' ), param( 'html' ));
  $home ||= 'http://';
  opendir DIR, '.';
  @files = sort { $a <=> $b } grep /^[0-9]+$/, readdir DIR;

  # The following line determines which fields must be filled out.
  if( $name && $title && $text ) {
    foreach( \( $text, $name, $mail, $home, $site, $title ) ) {
      if( $i or ! $html ) {
	$$_ =~ s/&/&amp;/;
	$$_ =~ s/</&lt;/;
	$$_ =~ s/>/&gt;/;
      } else {
	$$_ =~ s!</?([a-z]+).*?>!
	  my $match = $&;
	  $1 =~ /^(?:[abip]|br|img|small|su[bp])$/ ? $match : '';
	!ge;
      }
    }
    $from =~ s/^\240 *//;
    $home = '' if $home eq 'http://';
    unless( $html ) {
      $text =~ s/\s+$//s;
      $text =~ s/\n\n+/\n<p>/g;
      $text =~ s/\n/<br>\n/g;
    }
    $text = "\0$title\0$name\0$from\0$mail\0$home\0$text\0";
    $^T = time;
    foreach( grep { 1 > -M } @files ) {
      local $/ = undef;
      open FILE, $_;
      <FILE> =~ /\0.+\0/;
      $text = '', last if $text eq $&;
    }
    if( $text ) {
      do {
	push @files, $files[-1] + 1;
	open FILE, "> $files[-1]";
      } until( flock FILE, 6 );		# LOCK_EX | LOCK_NB
      print FILE $rand = rand 10, ' ', $ENV{REMOTE_ADDR}, $text,
	scalar localtime;
      close FILE;
      $submitted = 1;
    }
    ( $name, $mail, $title, $text ) = ();
    $home = 'http://';
  }
  closedir DIR;
</script>
<body>
<h1>Guestbook</h1>
Already &<$#files + 1>; entries. <a href='#entry'>Add an entry.</a>
<script runat=server language=perl>
    if( $submitted ) {
</script>
<h2 align=center>Thank you for signing my guestbook!</h2> Click <a
href="?delete=&<$files[-1], ':', $rand>;">here</a> if you want to delete what
you just submitted.  You can then use your browser&#39;s back-button to go to
the filled out form, change what you typed, and resubmit it.  Unless you have
frequently changing IP-numbers you can also bookmark the above link, and
delete from the same machine at some later moment.
<script runat=server language=perl>
    }
</script>
<hr align=left width=200>

<script runat=server language=perl>
  foreach( reverse @files ) {
    open STDIN, $_;
    my( $key, $title, $name, $from, $mail, $home, $text, $date ) = <>;
    chop( $title, $name, $from, $mail, $home, $text );
</script>
<big><b>&<$title>;</b></big><br>
&nbsp &nbsp - <i>by 
<script runat=server language=perl>
    if( $mail ) {
</script>
<a href='mailto:&<$mail>;'>&<$name>;</a>
<script runat=server language=perl>
    } else {
</script>
<u>&<$name>;</u>
<script runat=server language=perl>
    }
    if( $home ) {
</script>
(<a href='&<$home>;'>Homepage</a>)
<script runat=server language=perl>
    }
</script>
&<$from ? 'from ' : '', $from>;
on &<substr( $date, 4, 7 ), substr( $date, -4 )>;
at &<substr( $date, 11, 5 )>;</i><br>
&<$text>;<hr align=left width=200>
<script runat=server language=perl>
  }
</script>

<form method=post>
<h2><a name=entry>Add an Entry</a></h2>
Underlined fields must be filled out.
<table>
<tr><td><u>Title</u><td> <input type=text name=title size=50 value="&<$title>;">
<tr><td><u>Name</u><td> <input type=text name=name size=30 value="&<$name>;">
<tr><td>From<td> <select name=from size=1>
  <option>
  <option>Africa
  <option>America
  <option>&nbsp; Argentina
  <option>&nbsp; Brazil
  <option>&nbsp; Canada
  <option>&nbsp; Mexico
  <option>&nbsp; United States
  <option>Asia
  <option>&nbsp; China
  <option>&nbsp; India
  <option>&nbsp; Indonesia
  <option>&nbsp; Japan
  <option>Australia
  <option>Europe
  <option>&nbsp; France
  <option>&nbsp; Germany
  <option>&nbsp; Italy
  <option>&nbsp; Russia
  <option>&nbsp; Spain
  <option>&nbsp; United Kingdom
  <option>Oceania
</select>
<tr><td>Mail<td> <input type=text name=mail size=30 value="&<$mail>;">
<tr><td>Homepage<td> <input type=text name=home size=30 value="&<$home>;">
<tr><td><u>Text</u>
  <td><input type=checkbox name=html value=checked &<$html>;>
  <small>HTML (Tags a, img, p, br, b, i, small, sub and sup are
  allowed.)</small><br>
  <textarea name=text cols=50 rows=5 wrap=virtual>&<$text>;</textarea>
<tr><td><td><input type=submit value=" Submit Entry ">
  <input type=reset value=" Reset Form ">
</table>
</form>
</html>
<!--

=head1 NAME

guestbook.phtml - display and accept guestbook entries

=head1 SYNOPSIS

On a L<web-iPerl> enabled server copy to some web-directory where the
web-server has write permissions.  Can also be called C<index.phtml>, if that
is configured, thus making the directory's URL be the guestbook-handler.

=head1 DESCRIPTION

Bits of Perl in this document are marked up in sgml style.

The Perl-script section in the head handles deletion of a previously submitted
message, when requested.  It then cleans up the submitted values, if any, and
stores them in a numbered file (1 for the oldest submission, then 2 ...)  as a
null-delimited record, unless the identical text has been submitted in the
last day.  You can expire entries simply by deleting these files.

The next Perl-script section outputs the entries newest first.  To inverse the
order change C<foreach( reverse @files )> to C<foreach( @files )>.  The display
part of the entries, contained within a loop over all files, uses snippets of
Perl to decide how to display a field or whether to add decoration to a field
depending on whether it has a value.  An alternative way of conditionally
adding just one word is shown in the case of the from-field.

The form itself has Perl-expression entities containing the previous form
contents if not all was properly filled out.  The reset-button alas restores
these values rather than clearing out the form.  The text-field can optionally
contain a small range of useful HTML tags which are not disruptive, though
C<E<lt>img ...E<gt>> without size restriction might be debatable.  Otherwise
single and multiple newlines mean line and paragraph breaks.

You can edit the layout of this page to suit your needs.  The form elements
which do not suit your taste can be omitted or replaced with other
single-value form elements of the same name without touching the Perl code.

It should be possible to put the various parts of this file into two or three
web-iPerl HTML-files, if you'd rather separate submission and thanks.  Best
make copies of the file and strip away what isn't needed for that particular
functionality.


=head1 SEE ALSO

L<Text::iPerl>, L<iperl>, L<web-iPerl>, L<iPerl.el>, L<perl>,
http://beam.to/iPerl/

=cut

-->
