#!/usr/bin/perl ## ## xmlbook.pl - simple xml based guestbook ## Copyright (c) 2001 Leo Fellermayr ## ## $Id: xmlbook.pl,v 0.01 2001/06/18 14:00:11 leo Exp $ use CGI_Lite; use IO::File; use MIME::QuotedPrint; use Time::localtime; use HTML::Entities; use XML::Parser; use XML::Writer; use Net::SMTP; my $xmlbook = '/wwwroot/prinzess.dyndns.org/serverdata/xmlbook.xml'; # full path to xml file my $php_script = 'http://prinzess.dyndns.org/guestbook/index.php'; my %message; my %form; my $textbuffer; # ================ write_message ($xmlfile, \%message) # # This writes all messages from the given hash to the xml base # sub write_message ($$) { my ($xmlfile, $message) = @_; umask 002; $xmlfile = new IO::File (">$xmlfile") or die $!; my $xml = new XML::Writer ( DATA_MODE => 1, DATA_INDENT => 2, OUTPUT => $xmlfile ); $xml->xmlDecl ("ISO-8859-1", "no"); $xml->doctype ("xmlbook", "", "xmlbook.dtd"); $xml->startTag("xmlbook"); foreach (@{$$message{all}}) { $xml->startTag ("entry", "date" => $$_{date}); $xml->emptyTag ("author", "name" => encode_qp ($$_{name}), "mail" => encode_qp($$_{mail}), "ort" => encode_qp($$_{ort})); $xml->startTag ("text"); $xml->characters (encode_qp ($$_{text})); $xml->endTag ("text"); $xml->endTag("entry"); } $xml->endTag ("xmlbook"); $xml->end; $xmlfile->close(); } # ================ datestr $unixdate # # Creates a german date and time string like "18.06.2001 11:43" # from a unix style epoch string # sub datestr ($) { my $unixdate = shift; my $tm = localtime ($unixdate); my $result = sprintf ("%02d.%02d.%04d %02d:%02d", $tm->mday, $tm->mon + 1, $tm->year + 1900, $tm->hour, $tm->min); return $result; } # ================ new_message ($xmlfile, \%form) # # Adds the supplied CGI form to the bottom of the xml base. # sub new_message ($$) { my ($xmlfile, $form) = @_; $form{date} = time (); chomp $form{text}; my $msg; if (-s $xmlfile) { $msg = parse_message ($xmlfile); } push @{$$msg{all}}, \%form; write_message ($xmlfile, $msg); ## send notify to the webmaster $smtp = Net::SMTP->new('localhost'); $smtp->mail('xmlbook@prinzess.dyndns.org'); $smtp->to('leo@prinzess.dyndns.org'); $smtp->data(); $smtp->datasend("From: Gaestebuch \n"); $smtp->datasend("To: Leonhard Fellermayr \n"); $smtp->datasend("Subject: Neuer Gaestebucheintrag\n\n"); $smtp->datasend("E-Mail: $form{mail}\n\n"); $smtp->datasend("Nachricht:\n\n$form{text}\n"); $smtp->dataend(); $smtp->quit(); } # ================ parse_message $xmlfile # # Parses $xmlfile and returns a reference to the hash which contains the # complete guestbook data. # sub parse_message ($) { %message = (); $textbuffer = ""; sub StartTag { my ($expat, $element) = @_; if ($element eq "entry") { $message{date} = $_{date}; } if ($element eq "author") { $message{name} = decode_qp($_{name}); $message{mail} = decode_qp($_{mail}); $message{ort} = decode_qp($_{ort}); } } sub Text { my $expat = shift; $textbuffer = $_; } sub EndTag { my ($expat, $element) = @_; if ($element eq "text") { $message{text} = decode_qp($textbuffer); } if ($element eq "entry") { my %this = %message; push @{$message{all}}, \%this; } } my $xmlfile = shift; my $xml = new XML::Parser(Style => 'Stream', ErrorContext => 2); $xml->parsefile ($xmlfile); @{$message{all}} = sort { $$b{date} <=> $$a{date} } @{$message{all}}; return (\%message); } # ================ main program # # ----- get parameters from CGI interface my $CGI = new CGI_Lite; $CGI->set_platform('unix'); %form = $CGI->parse_form_data; $form{action} ||= "list"; # default action => list # ========== action = new (posted form) if (($ENV{REQUEST_METHOD} eq "POST") and (lc $form{action} eq "new")) { new_message ($xmlbook, \%form); print "Location: $php_script\n\n"; } # ========== action = list (default) elsif (lc $form{action} eq "list") { print "Content-type: text/html\n\n"; print "\n"; my $msg; if (-s $xmlbook) { $msg = parse_message ($xmlbook); } foreach (@{$$msg{all}}) { my %thismsg = ( date => $$_{date}, name => encode_entities($$_{name}), mail => $$_{mail}, ort => encode_entities($$_{ort}), text => encode_entities($$_{text}) ); # convert line breaks to
's $thismsg{text} =~ s/\n/
\n/g; $qpmail = $thismsg{mail}; $qpmail =~ s/\@/ at /g; $qpmail =~ s/\./ dot /g; $qpmail =~ s/\-/ dash /g; print "\n"; print "\n"; $date = datestr($thismsg{date}); print "\n"; } print "
$thismsg{text}
von $thismsg{name} <$qpmail>
$thismsg{ort} - $date

\n"; } # ========== prevent other actions else { print "Content-type: text/html\n\n"; print "Falscher Parameter action angegeben!\n"; }