Hier ist übrigens noch das ganze Script.Ich danke schon jetzt für jeden Tipp .
Josef
#!/usr/bin/perl
############################################################################
#
# (c) Markus Wolf, 1998-2003
#
############################################################################
#
# gbook.cgi
# COPYRIGHT NOTICE
# Copyright 1998-2003 Markus Wolf
# All Rights Reserved.
# EMail: support@perlunity.de
# URL : http://www.perlunity.de
#
# gbook.cgi darf von jedermann kostenlos benutzt und geändert werden,
# solange dieser Copyright-Verweis und die restlichen Kommentare erhalten
# bleiben. Mit dem Einsatz dieses Skripts akzeptieren Sie, daß Markus Wolf
# von jeglicher Haftung und Gewährleistung hinsichtlich des Einsatzes
# befreit ist.
#
# Der Verkauf dieses Skripts, auch in modifizierter Form, ist ohne
# vorherige Absprache ausdrücklich untersagt. Mit anderen Worten: Fragen
# Sie mich, bevor Sie versuchen, mit meinem Skript Geld zu verdienen.
#
# Um dieses Skript über das Internet oder irgendein anderes Medium
# weiterzuverbreiten, benötigen Sie vorher meine Erlaubnis. In jeden
# Fall müssen der Copyright-Verweis und die restlichen Kommentare
# erhalten bleiben.
#
############################################################################
#
# - Adminmodus zum Löschen von Einträgen und Kommentarmöglichkeit
# - FileLocking
# - keine Reloadmöglichkeit
# - Eingabenpüfung
# - Design der Einträge über Templates anpassbar
# - Seitenweise Anzeige
#
###########################################################################
#
# Einbindung : http://mein.server.de/cgi-bin/gbook.cgi
# Löschenmod : http://mein.server.de/cgi-bin/gbook.cgi?func=admin
#
############################################################################
############################################################################
# Systemeinstellungen : BITTE ANPASSEN
############################################################################
#Wechsel in das aktuelle Verzeichnis
$0 =~ /^(.*)[\/\\].*/ && chdir ($1) ;
#Ausgabepuffer auschalten, Ausgabe beginnt sofort
$| = 1 ;
#Standard-Module
use CGI ;
use CGI::Carp qw(fatalsToBrowser) ;
use strict ;
#Komplette WWW-Adresse des GÄSTEBUCH-Scriptes inkl. Host
my $cgi_www="http://127.0.0.1/demo/_archiv/gast/cgi-bin/gbook/gbook.cgi" ;
#Grafikpfad-absolut (URL)
my $pic_dir="/demo/_archiv/gast/images/gbook" ;
#Titel des Gästebuches
my $title="Gästebuch - perl-archiv.de" ;
#Anzeige pro Seite (alles auf eine Seite: 100000 :-)) )
my $anzen=5 ;
#max. Länge (in Zeichen) für Gästebucheintrag (0 für keine Begrenzung)
my $max_length=200 ;
#max. Länge (in Zeichen) eines Wortes
my $max_word=40 ;
#Mail an Admin bei neuem Eintrag (1=ja/0=nein)
my $adminmail=1 ;
#Für Mailfunktion (0=Mail verschicken / 1=Mail speichern)
my $offline=1 ;
#Mailprogramm (nur Unix)
my $mailprog = "/usr/bin/sendmail" ;
#Mailempfänger
my $webmaster = "perl\@perl-archiv.de" ;
#File-Locking 0 für nein (WinXX)/1 für ja
my $lock=0 ;
#Zeitverschiebung in Stunden (-/+ möglich)
my $zeitverH=0 ;
#Paßwort für den Admin(Lösch)modus (unbedingt ändern)
my $pw = "pw" ;
############################################################################
# Hauptprogramm
############################################################################
my $query=new CGI ;
my %PARA=&parse_para() ;
if ($PARA{'func'} eq "form") {
&sign_form() ;
} elsif ($PARA{'func'} eq "new") {
&new() ;
} elsif ($PARA{'func'} eq "del") {
&del() ;
} elsif ($PARA{'func'} eq "redir") {
&redir() ;
} else {
&show() ;
}
############################################################################
# Ausgabe der Einträge
############################################################################
sub show {
my ($GUESTAMOUNT,$GUESTDATA)=&read_data() ;
$PARA{'action'} =~ s/\D//g ;
$PARA{'action'} ||= 0 ;
$PARA{'action'} = 0 if ($PARA{'action'}>$GUESTAMOUNT) ;
my $anzeige_von=$PARA{'action'} ;
my $anzan=$anzen ;
my $nocache=time ;
my ($out) ;
###
#Template laden
open (HTML , "< ./tmpl/gbook_lines.html") || die "Kann das File -./tmpl/gbook_lines.html- nicht laden : $! " ;
my @html=<HTML> ;
close(HTML) ;
my $html=join('',@html) ;
###
#Admin-Modus
if ($PARA{'func'} eq "admin") {
$out .= "<form method=\"post\" action=\"$cgi_www?func=del\">" ;
}
###
#Ausgabe der Einträge:
for my $x ($anzeige_von .. $anzeige_von+$anzan-1) {
last if ($x>=$GUESTAMOUNT) ;
my $html_tmp=$html ;
my $hp="keine Homepage" ;
my $em="keine E-Mail" ;
if ($GUESTDATA->[$x][4] =~ /http:\/\/.*\./) {
$hp="<a class=\"gb_link\" href=\"$GUESTDATA->[$x][4]\" target=\"new\">$GUESTDATA->[$x][4]</a>";
}
if ($GUESTDATA->[$x][2] =~ /.*\@.*\..*/) {
$em="<a class=\"gb_link\" href=\"mailto:$GUESTDATA->[$x][2]\">$GUESTDATA->[$x][2]</a>";
}
if ($PARA{'func'} eq "admin") {
$html_tmp =~ s/<!--admin-->/<input type=checkbox name=\"del_$GUESTDATA->[$x][0]\" value=\"1\"> /ig ;
}
if ($PARA{'func'} eq "admin") {
$html_tmp =~ s/<!--comment-->/Kommentar: <input type=text name=\"comment_$GUESTDATA->[$x][0]\" value=\"$GUESTDATA->[$x][6]\" size=50>/ig ;
}
if ($GUESTDATA->[$x][6]) {
$GUESTDATA->[$x][6]="<br>$GUESTDATA->[$x][6]<br>" ;
}
$html_tmp =~ s/<!--comment-->/$GUESTDATA->[$x][6]/ig ;
$html_tmp =~ s/<!--name-->/$GUESTDATA->[$x][1]/ig ;
$html_tmp =~ s/<!--text-->/$GUESTDATA->[$x][3]/ig ;
$html_tmp =~ s/<!--mail-->/$em/ig ;
$html_tmp =~ s/<!--www-->/$hp/ig ;
$html_tmp =~ s/<!--time-->/$GUESTDATA->[$x][5]/ig ;
$html_tmp =~ s/<!--pics-->/$pic_dir/ig ;
$out .= $html_tmp ;
}
###
#Admin-Modus
if ($PARA{'func'} eq "admin") {
$out .= qq~
<center>Paßwort: <input type=text name=pw size=10>
<input type=hidden value=\"$anzeige_von\" name=showid>
<input type=submit value=\"Einträge ändern/löschen\">
</form></center><br>
~ ;
}
###
#Blätteranzeige
my $anzeige_zurueck=$anzeige_von-$anzan ;
my $anzeige_weiter=$anzeige_von+$anzan ;
my $anzeige_von=$anzeige_von+1 ;
my $anzeige_bis=$anzeige_von+$anzan ;
$out .= qq(<table border=0 width=100% cellspacing=0 cellpadding=0 width=100%><tr><td>) ;
if($anzeige_zurueck >= 0) {
if ($PARA{'func'} eq "admin") {
$out .= qq(<a href="$cgi_www?func=admin&action=$anzeige_zurueck&nocache=$nocache" onmouseover="window.status='Vorherige $anzan ...';return true;" onmouseout="window.status='';return true;"><img src="$pic_dir/zurueck.gif" border=0 alt="Vorherige $anzan ..."></a>) ;
} else {
$out .= qq(<a href="$cgi_www?func=show&action=$anzeige_zurueck&nocache=$nocache" onmouseover="window.status='Vorherige $anzan ...';return true;" onmouseout="window.status='';return true;"><img src="$pic_dir/zurueck.gif" border=0 alt="Vorherige $anzan ..."></a>) ;
}
} else {
$out .= qq( ) ;
}
if ($anzeige_weiter>$GUESTAMOUNT) { $anzeige_bis=$GUESTAMOUNT ; }
$out .= qq~
</td><td align=center width=100% class=\"gb_status\"><b>$anzeige_von-$anzeige_bis \| $GUESTAMOUNT Einträge</b></td>
<td align=right>
~ ;
if($anzeige_weiter<$GUESTAMOUNT) {
if ($PARA{'func'} eq "admin") {
$out .= qq(<a href="$cgi_www?func=admin&action=$anzeige_weiter&nocache=$nocache" onmouseover="window.status='Nächste $anzan ...';return true;" onmouseout="window.status='';return true;"><img src="$pic_dir/weiter.gif" border=0 alt="Nächste $anzan ..."></a>) ;
} else {
$out .= qq(<a href="$cgi_www?func=show&action=$anzeige_weiter&nocache=$nocache" onmouseover="window.status='Nächste $anzan ...';return true;" onmouseout="window.status='';return true;"><img src="$pic_dir/weiter.gif" border=0 alt="Nächste $anzan ..."></a>) ;
}
} else {
$out .= qq( ) ;
}
$out .= qq(</td></tr></table>) ;
###
#Ausgabe
print $query->header('text/html');
print &parse_tmpl($out,$GUESTAMOUNT) ;
}
############################################################################
# Neuer Eintrag
############################################################################
sub new {
my %FM=&parse_form() ;
###
#Eingaben prüfen
if ( !$FM{'name'} ||
!$FM{'com'} ||
(length($FM{'com'})>$max_length && $max_length>0 ) ) {
&er_form(\%FM) ;
}
###
#Eingaben bereinigen
foreach my $key (keys %FM) {
###
#Sonderzeichen
$FM{$key} =~ s/\&/\&\;/g;
$FM{$key} =~ s/"/\"\;/g;
$FM{$key} =~ s/\cM\n/<BR>/g;
$FM{$key} =~ s/\n\cM/<BR>/g;
$FM{$key} =~ s/\cM/<BR>/g;
$FM{$key} =~ s/\n/<BR>/g;
$FM{$key} =~ s/\|/\//g;
###
#Wortlänge
my @text=split(/\s+/,$FM{$key});
my $textok ;
foreach my $word (@text){
if ( length($word) > $max_word ) {
my @chars=split(//,$word) ;
my $wordout="" ;
for(my $i=0; $i<= $#chars/$max_word; $i++) {
$wordout=$wordout." ".substr($word,$i*$max_word,$max_word);
}
$textok .= "$wordout " if ($wordout) ;
} else {
$textok .= "$word " if ($word) ;
}
}
$FM{$key} = $textok;
$FM{$key} =~ s/\s+/ /g;
$FM{$key} =~ s/\s+/ /g;
$FM{$key} =~ s/^\s+//g;
$FM{$key} =~ s/\s+$//g;
}
###
#Eintrag speichern
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time+(3600*$zeitverH));
my $datum = sprintf "%02d.%02d.%04d - %02d:%02d" , $mday , $mon+=1 ,$year+=1900 , $hour , $min ;
open (DATNEW , ">> ./data/gbook_data.txt") || die "Kann die Datei -./data/gbook_data.txt- nicht zum Schreiben öffnen: $! " ;
flock(DATNEW,2) if ($lock==1) ;
print DATNEW time."\|$FM{'name'}\|$FM{'email'}\|$FM{'com'}\|$FM{'url'}\|$datum\|\|$ENV{'REMOTE_ADDR'}\|\n" ;
close (DATNEW) ;
###
#Adminmail verschicken
&send_mail(\%FM) if ($adminmail==1) ;
###
#Aufruf des Scripts
print $query->redirect("$cgi_www?func=show&action=0&nocache=".time) ;
}
############################################################################
# Fehlerausgabe bei nicht ausgefüllten Feldern des Formulars
############################################################################
sub er_form {
my $FM=shift ;
my $errmark=" <font color=ff0000><b>X<\/b><\/font> " ;
my $x_hinweis="Ihr müßt mindestens die mit einem $errmark markierten Felder ausfüllen." ;
my $x_name=$errmark if (!$FM->{'name'}) ;
my $x_text=$errmark if (!$FM->{'com'}) ;
my ($x_mail,$x_url) ;
###
#Länge der Eingabe prüfen
if ( $max_length>0 && length($FM->{'com'})>$max_length ) {
$x_hinweis=qq(<font color=ff0000>Maximal zulässige Länge von $max_length Zeichen überschritten!</font><br> <br>) ;
}
###
#Fehler - Form wieder ausgeben
&sign_form($x_hinweis,$x_name,$x_mail,$x_url,$x_text) ;
exit ;
}
############################################################################
# Löschen eines Eintrages im Adminmodus
############################################################################
sub del {
my %FM=&parse_form() ;
###
#Passwort prüfen und Eintrag ggf. löschen
if ($FM{'pw'} eq $pw) {
my ($GUESTAMOUNT,$GUESTDATA)=&read_data() ;
open (DAT , "> ./data/gbook_data.txt") ;
flock(DAT,2) if ($lock==1) ;
for my $x (0...$GUESTAMOUNT-1) {
unless ($FM{'del_'.$GUESTDATA->[$x][0]} == 1) {
my $c = ( exists $FM{'comment_'.$GUESTDATA->[$x][0]} ? $FM{'comment_'.$GUESTDATA->[$x][0]} : $GUESTDATA->[$x][6] ) ;
print DAT "$GUESTDATA->[$x][0]|$GUESTDATA->[$x][1]|$GUESTDATA->[$x][2]|$GUESTDATA->[$x][3]|$GUESTDATA->[$x][4]|$GUESTDATA->[$x][5]|$c|$GUESTDATA->[$x][7]|\n" ;
}
} close(DAT) ;
}
###
#Für den Fall, dass das Script einfach mit DEL aufgerufen wird
$FM{'showid'}=0 if (!$FM{'showid'}) ;
###
#Aufruf des Scripts
print $query->redirect("$cgi_www?func=show&action=$FM{'showid'}&nocache=".time) ;
}
#############################################################################
#Ausgabe des Eintragsformulares
#############################################################################
sub sign_form {
my ($x_hinweis,$x_name,$x_mail,$x_url,$x_text)=@_ ;
my ($GUESTAMOUNT)=&read_data() ;
my %FM=&parse_form() ;
my ($out) ;
###
#Eingaben verarbeiten
$FM{'url'}="http://" unless ($FM{'url'}) ;
$FM{'com'} =~ s/\n//g ;
###
#Form aufbauen
$out = qq~
<form name="mail" method=POST action="$cgi_www?func=new">
<table border=0 cellspacing=3>
~ ;
if ($x_hinweis) {
$out .= qq~
<tr>
<td bgcolor="#f9f9f9"><br><font color="#ff0000"> Fehler:</font><br> <br></td>
<td> </td>
<td>$x_hinweis</td>
</tr>
~ ;
}
$out .= qq~
<tr>
<td bgcolor="#f9f9f9"> Name:</td>
<td>$x_name</td>
<td><input type=text name="name" size=44 maxlength=140 value="$FM{'name'}"></td>
</tr>
<tr>
<td bgcolor="#f9f9f9"> E-Mail:</td>
<td>$x_mail</td>
<td><input type=text name="email" size=44 maxlength=140 value="$FM{'email'}"></td>
</tr>
<tr>
<td valign=top bgcolor="#f9f9f9"> Text:<br><img src="$pic_dir/trenner.gif" border=0 width=120 height=1></td>
<td valign=top>$x_text</td>
<td><textarea name="com" rows=10 cols=33 wrap=virtual>$FM{'com'}</textarea><br></td>
</tr>
<tr>
<td bgcolor="#f9f9f9"> Homepage:</td>
<td>$x_url</td>
<td><input type=text name="url" value="$FM{'url'}" size=44 maxlength=140></td>
</tr>
<tr>
<td bgcolor="#f9f9f9"><img src="$pic_dir/trenner.gif" border=0 width=120 height=1></td>
<td> </td>
<td><br><br><input type=submit value="Ins Gästebuch eintragen ..."></td>
</tr>
</table>
</form>
~ ;
###
#Ausgabe
print $query->header('text/html') ;
print &parse_tmpl($out,$GUESTAMOUNT) ;
}
#############################################################################
# Umleitung der DD-Liste, wenn Javascript nicht funktioniert
#############################################################################
sub redir {
my %FM=&parse_form() ;
###
#Seite anzeigen
print $query->redirect( ( $FM{'links'} || $cgi_www ) ) ;
}
############################################################################
# Datendatei einlesen
############################################################################
sub read_data {
my @guest ;
my $guests=0 ;
###
#Daten einlesen
open (DAT , "< ./data/gbook_data.txt") || die "Kann das File -./data/gbook_data.txt- nicht öffnen: $! " ;
while ( my @data=split(/\|/,<DAT>) ) {
push ( @guest , [@data] ) ;
} close(DAT) ;
###
#Umkehrung der Reihenfolge
@guest=reverse @guest if ($PARA{'func'} ne "del") ;
$guests = $#guest+1 ;
###
#Rückgabe
return($guests,\@guest) ;
}
############################################################################
# TMPL verabeiten
############################################################################
sub parse_tmpl {
my ($in,$dd)=@_ ;
my ($ix2,$ix3) ;
my $nocache=time ;
###
#Template laden
open (HTML , "< ./tmpl/gbook_main.html") || die "Kann das File -./tmpl/gbook_main.html- nicht laden : $! " ;
my @tmpl=<HTML> ;
close(HTML) ;
my $tmpl = join('',@tmpl) ;
###
#DDliste
my $ddout=qq~
<select name="links" size=1 OnChange="jump(this.options[this.selectedIndex].value)">
<option value="$cgi_www?func=show&action=0&nocache=$nocache">Eintrag ...</option>
~ ;
for (my $ix=1 ; $ix <= $dd ; $ix+=$anzen) {
$ix2+=$anzen ;
$ix3=$ix-1 ;
$ix2=$dd if ($ix2 > $dd) ;
$ddout .= qq(<option value="$cgi_www?func=show&action=$ix3&nocache=$nocache">$ix - $ix2</option>\n) ;
}
###
#Werte einsetzen
$tmpl =~ s/\[PART:main\]/$in/ ;
$tmpl =~ s/\[PART:ddlist\]/$ddout<\/select>/ ;
$tmpl =~ s/\[PART:title\]/$title/g ;
$tmpl =~ s/\[PART:imagedir\]/$pic_dir/g ;
###
#Rückgabe
return($tmpl) ;
}
############################################################################
# Admin-Mail verschicken
############################################################################
sub send_mail {
my ($FM)=@_ ;
###
#Online/Offline
if($offline==1) {
open(MAIL,"> ./temp/mail.txt") ;
} else {
open(MAIL,"|$mailprog -t") ;
}
###
#Mail verschicken/speichern
print MAIL "To: $webmaster\n";
print MAIL "From: $FM->{'email'} ($FM->{'name'})\n";
print MAIL "Subject: neuer Gaestebuch-Eintrag\n\n";
print MAIL "---------------------------------------------------------------------------\n";
print MAIL "Name : $FM->{'name'}\n";
print MAIL "Mail : $FM->{'email'}\n";
print MAIL "URL : $FM->{'url'}\n";
print MAIL "---------------------------------------------------------------------------\n";
print MAIL "\n$FM->{'com'}\n\n";
print MAIL "---------------------------------------------------------------------------\n";
print MAIL "Browser: $ENV{'HTTP_USER_AGENT'}\n";
print MAIL "IP: $ENV{'REMOTE_ADDR'}\n";
print MAIL "---------------------------------------------------------------------------\n";
###
#Mail-Ende
close (MAIL) ;
}
############################################################################
# GET-Parameter auslesen und Umlaute/Sonderzeichen konvertieren
############################################################################
sub parse_para {
my %PARA ;
###
#Werte decodieren
foreach ( split(/\&/ , $ENV{'QUERY_STRING'}) ) {
my ($feldname,$wert) = split(/=/) ;
$feldname =~ s/\W//g ;
$PARA{$feldname} = $wert ;
$PARA{$feldname} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg ;
$PARA{$feldname} =~ tr/\+/ / ;
$PARA{$feldname} =~ s/\W/ /g ;
}
###
#Rückgabe
return(%PARA) ;
}
############################################################################
# POST-Formular auslesen und Umlaute/Sonderzeichen umwandeln
############################################################################
sub parse_form {
my %FM ;
###
#Werte verarbeiten
foreach my $fname ( $query->param ) {
$FM{$fname} = $query->param($fname) ;
$FM{$fname} =~ s/<([^>]|\n)*>/ /g;
$FM{$fname} =~ s/\|/\//g;
$FM{$fname} =~ s/\cM\n//g;
$FM{$fname} =~ s/\n\cM//g;
$FM{$fname} =~ s/\cM//g;
$FM{$fname} =~ s/\s+/ /g;
$FM{$fname} =~ s/^\s+//g;
$FM{$fname} =~ s/\s+$//g;
}
###
#Rückgabe
return(%FM) ;
}
#############################################################################
# ENDE
#############################################################################
Datum: 23.12.2005-21:38
Zeilenumbrüche
