#! /usr/bin/perl use warnings; use strict; use CGI (); use CGI::Carp qw(fatalsToBrowser); use Fcntl ':flock'; use HTML::Template (); use FindBin        (); # die folgenden Module werden direkt in den Modulen geladen # require URI::Find::Schemeless; # require HTML::Entities; # require Mail::RFC822::Address; # ------------------------------------------------------------ # Fuer die Konfiguration Konstanten verwenden # ------------------------------------------------------------ # wo liegt das Cascading Style Sheet fuer das Layout use constant CSS_URL => '/styles/Default.css'; # wie viele Eintraege sollen pro Seite angezeigt werden? use constant MAX_SHOW_ENTRIES => 10; # Die Variable $FindBin::Bin enthaelt den absoluten Pfad des ausgefuehrten # Scriptes. Ich verwende sie, um so einem absoluten Pfad zu erhalten, weil # manche Webserver mit relativen Pfadangaben Schwierigkeiten haben, und da # vom htdocs-Verzeichnis ausgehen. Und auf diese Weise vermeide ich diese # potentiellen Probleme am einfachsten. # wo werden die Gaestebucheintraege abgespeichert? use constant GB_DATA_FILE => "$FindBin::Bin/data/guestbook.txt"; # wo liegen die Templates? use constant TEMPLATE_DIR => "$FindBin::Bin/templates"; # wie sind die Dateinamen der Templates? use constant TEMPLATE_FILES => {     showguestbook => TEMPLATE_DIR . "/guestbook_show.templ",     addguestbook  => TEMPLATE_DIR . "/guestbook_add.templ", }; use constant GUESTBOOK_FIELDS => [qw(nick email homepage subject text date)]; # ------------------------------------------------------------ # Hauptprogramm # ------------------------------------------------------------ # neues CGI-Objekt erzeugen my $cgi = CGI::->new(); # aktion abfragen; wenn keine Vorhanden, dann guestbook verwenden my $action = $cgi->param('action') || 'guestbook'; if ( $action eq 'guestbookadd' ) {     &AddGuestbookEntry($cgi); }    # if elsif ( $action eq 'guestbooksave' ) {     &SaveNewGuestbookEntry($cgi); }    # elsif else {    # Standardvorgehen: zeige das Gaestebuch an     &ShowGuestbook($cgi); }    # else # ------------------------------------------------------------ sub SaveNewGuestbookEntry {     my ($cgi) = @_;     my %data = ();     foreach ( @{&GUESTBOOK_FIELDS} ) {         $data{$_} = $cgi->param($_) || '';         $data{$_} =~ s/^\s*//;         $data{$_} =~ s/\s*$//;     }    # foreach     unless ( $data{nick} ) {         $data{message} .= "
Der Name muß angegeben werden";     }    # unless     unless ( $data{subject} ) {         $data{message} .= "
Der Betreff muß angegeben werden";     }    # unless     unless ( $data{text} ) {         $data{message} .= "
Der Text muß angegeben werden";     }    # unless     if ( $data{email} ) {    # Ueberpruefe die Email-Adresse         require Mail::RFC822::Address;         unless ( &Mail::RFC822::Address::valid( $data{email} ) ) {             $data{message} .=               "
Diese Email-Adresse ist fehlerhaft (nicht RFC822-Konform)";         }                     # else     }    # if     if ( $data{message} ) {         &AddGuestbookEntry( $cgi, \%data );     }    # if     else {         require URI::Find::Schemeless;         require HTML::Entities;         # neues URI::Find::Schemeless-Objekt erstellen und ihm als Callback         # die Aktion mitgeben, die fuer jede gefundene URI ausgefuehrt werden         # soll (fuer genauere Infos siehe [URL=http://www.fabiani.net/]http://www.fabiani.net/[/URL] -> Tips&Tricks         # -> Urls in HTML-Links umwandeln         my $finder = URI::Find::Schemeless->new(             sub {                  my ( $uri, $originalUri ) = @_;                  return ( ''                        . &HTML::Entities::encode_entities($originalUri)                        . '' );               }    # sub         );         # allgemeine Umwandlungen         foreach ( @{&GUESTBOOK_FIELDS} ) {             #     $data{$_} =~ s//>/g;             #     $data{$_} =~ s/\&/&/g;             #     $data{$_} =~ s/\"/"/g; $data{$_} =~ s/\'/'/g;             # ersetze Sonderzeichen wie < > & ' " durch deren Codes             $data{$_} = &CGI::escapeHTML( $data{$_} );             # ersetze Zeilenumbruecke durch
            $data{$_} =~ s/\r? /
/g;             # ersetze URIs durch HTML-Links             $finder->find( \$data{$_} );         }    # foreach         # erzeuge email-link         if ( $data{email} ) {             $data{email} = qq~$data{email}~;         }    # if         # ermittle Datum und Uhrzeit         my @time = localtime(time);         $time[4]++;         $time[5] += 1900;         $data{date} =           sprintf( "%02i.%02i.%04i %02i\:%02i", @time[ 3 .. 5, 2, 1 ] );         &SaveNewEntryToFile( $cgi, \%data )           and &ShowGuestbook($cgi);     } }    # SaveNewGuestbookEntry # ------------------------------------------------------------ sub SaveNewEntryToFile {     my ( $cgi, $data ) = @_;     my $string = join ( "",         map    { "$_: $data->{$_} " }           grep { $data->{$_} } @{&GUESTBOOK_FIELDS} );     unless ( open( GB, ">>" . GB_DATA_FILE ) ) {         &PrintErrorPage( $cgi, "Konnte Datei nicht oeffnen: $!" );         exit;     }    # unless     else {         flock( GB, LOCK_EX );         print( GB "$string " );         close(GB);     }    # else     return 1; }    # SaveNewEntryToFile # ------------------------------------------------------------ sub AddGuestbookEntry {     my ( $cgi, $data ) = @_;     # gib den HTML-Header aus     print $cgi->header( -type => 'text/html', -expires => '+5s' );     # lese das Template ein:     my $template = HTML::Template->new(         filename     &nbs p;    => TEMPLATE_FILES->{addguestbook},         die_on_bad_params => 0,     );     $template->param(         # Url des Scriptes und CSS-Stylesheet         SELF_URL => $ENV{SCRIPT_NAME} || '',         CSS_URL  => CSS_URL,         # eine eventuelle Fehlermeldung         MESSAGE => $data->{message} || '',         # Die Daten im Falle eines Fehlers         NICK     => $data->{nick}     || '',         EMAIL    => $data->{email}    || '',         HOMEPAGE => $data->{homepage} || '',         SUBJECT  => $data->{subject}  || '',         TEXT     => $data->{text}     || '',     );     print $template->output; }    # AddGuestbookEntry # ------------------------------------------------------------ sub ShowGuestbook {     my ($cgi) = @_;     # $startId ist der offset zur letzten Nachricht     # also 0 entspricht der letzten Nachricht, 1 der vorletzten usw.     my $startId = $cgi->param('id') || 0;     $startId > 0 or $startId = 0;     # gib den HTML-Header aus     print $cgi->header( -type => 'text/html', -expires => '+5s' );     # lese die Gaestebucheintraege von der Datei ein und gebe sie als     # Arrayreferenz zurueck     my ( $entries, $entriesCount, $x, $y ) = &ReadEntriesFromFile($startId);     # lese das Template ein:     my $template = HTML::Template->new(         filename     &nbs p;    => TEMPLATE_FILES->{showguestbook},         die_on_bad_params => 0,     );     $template->param(         # Url des Scriptes und CSS-Stylesheet         SELF_URL => $ENV{SCRIPT_NAME} || '',         CSS_URL  => CSS_URL,         # Daten         ENTRIES_COUNT => $entriesCount + 1,         GBDATA         => $entries,         # fuer die Navigation         SHOW_LINK_NEWER => $y < $entriesCount,         SHOW_LINK_OLDER => $x > 0,         OLDER_START_ID  => $entriesCount - $x + 1,         NEWER_START_ID  => $entriesCount - $y - MAX_SHOW_ENTRIES,     );     print $template->output;     #    print "$entriesCount: $x/$y:$startId "; }    # ShowGuestbook # ------------------------------------------------------------ sub ReadEntriesFromFile {     my ($startId) = @_;     my @entries = ();     my $entryId = 1;     unless ( open( GB, GB_DATA_FILE ) ) {         &PrintErrorPage( $cgi, "Konnte Datei nicht oeffnen: $!" );     }    # unless     else {         # blockweises Einlesen: eine "Zeile" enthaelt nun einen Block,         # der durch eine Leerzeile vom naechsten getrennt ist         local $/ = " ";         while () {             # splitte den Block an den Zeilenumbruechen auf             my @lines = split ( / /, $_ );             # wenn da keine Daten herauskommen, weiter mit dem naechsten Block             next unless scalar @lines;             my %entry = ();             foreach my $line (@lines) {                  # trenne Namen: Wert                  my ( $key, $value ) = split ( /\s*:\s+/, $line, 2 );                  # print "$entryId: $key: $value ";                  # ueberpruefe, ob fuer diesen Namen schon ein Wert vorhanden                  # ist, wenn ja, gib einen Fehler aus, wenn nein, fuegen den                  # Namen und den WErt zum Hash %entry hinzu                  if ( exists $entry{$key} ) {                      &PrintErrorPage( $cgi, "Format der Datei ungueltig" );                      exit 0;                  }    # if                  else {                      $entry{$key} = $value;                  }    # else             }    # foreach             # id des Eintrages hinzufuegen             $entry{id} = $entryId;             # Eintrag an den Anfang von @entries hinzufuegen             unshift ( @entries, \%entry );             # erhoehe EntryId             $entryId++;         }    # while         close(GB);     }    # else     # finde heraus, welche Eintraege angezeigt werden sollen (von $x bis $y)     my $count = $#entries;     my $y     = $count - $startId;     my $x     = ( $y > MAX_SHOW_ENTRIES ) ? $y - MAX_SHOW_ENTRIES + 1 : 0;     # und werfe die anderen weg     @entries = @entries[ $count - $y .. $count - $x ];     # gib eine Arrayreferenz der Eintraege zurueck sowie deren Anzahl und     # deren Grenzen     return ( \@entries, $count, $x, $y ); }    # ReadEntriesFromFile # ------------------------------------------------------------ sub PrintErrorPage {     my ( $cgi, $errorMessage ) = @_;     print "Fehler: $errorMessage "; }    # PrintErrorPage # ------------------------------------------------------------ show:   SELF_URL   CSS_URL   SHOW_LINK_NEWER   SHOW_LINK_OLDER   OLDER_START_ID   NEWER_START_ID   ENTRIES_COUNT   GBDATA     ID (Automatisch)     NICK (Pflichtfeld)     EMAIL (optional)     HOMEPAGE (optional)     DATE (Automatisch)     SUBJECT (Pflichtfeld)     TEXT (Pflichtfeld)