PERL - Constant subroutine CGI::XHTML_DTD redefined

rene_rinke · 29. April 2008

Hallo!

Ich habe folgendes Problem: Der von mir programmierte Nachrichtenserver ist nun voll funktionsfähig. Es gibt nur ein kleines Problem. Immer wenn das Ausgabe-Skript "output.pl" aufgerufen kann man folgendes im Errorlog des APACHE-Servers lesen:

[Tue Apr 29 09:10:30 2008] [error] [client 153.96.228.102] Constant subroutine CGI::XHTML_DTD redefined at D:/Perl/lib/constant.pm line 103.

An der angesprochenen Datei wurde nie etwas geändert und ich weiß absolut nicht, was ich damit anfangen soll. Ich habe das Internet schon nach dieser Fehlermeldung durchsucht, finde aber keine wirklichen Präzedenzfälle.

Das Skript sieht folgendermaßen aus:

#!D:/Perl/bin/perl.exe

use warnings;
use dbi;
use cgi;
use cgi::cookie;

my $dbh = DBI->connect ('dbi:mysql:database=imefraunhofer;host=localhost', '*****', '*****'); #Verbindung mit Datenbank aufbauen

my $text_mode = "none";
my $text_name = "";
my $text_nummer = "";
my $text_address = "0.0.0.0";
my $text_datum ="";
my $text_loeschen = "";
my $text_meldung = "";
my $text_voll = "0";
my $text_wichtig = "0";
my $visitor = "0";
my @admin = ('*', '**', '***', '****'); #Benutzer mit Adminrechten (bearbeiten und löschen aller Einträge)

my $cgi = new CGI;
$text_mode = $cgi->param('mode');
$text_nummer = $cgi->param('nummer');
$text_datum = $cgi->param('datum');
$text_loeschen = $cgi->param('loeschen');
$text_meldung = $cgi->param('meldung');
$text_voll = $cgi->param('voll');
$text_wichtig = $cgi->param('wichtig');

if (!defined $text_mode) { $text_mode = "none" }

my %cookies = fetch CGI::Cookie;
my $cgi2 = CGI->new();
my $cookie = $cgi2->cookie('user');

# Name und Adresse aus Cookie lesen, wenn Cookie vorhanden, ansonsten Besuchermodus
if( $cookie ){
$text_name = $cookies{user}->value;
}
else {
$visitor=1;
}

# Standartanzeige, Anzeige für alte und Anzeige für zukunftige Einträge, unterscheidung findet in der PresentForm statt
if ($text_mode eq "none" || $text_mode eq "old" || $text_mode eq "future") {
&CreateHeader;
&PresentForm;
exit(0);
}

# Fulltext (Popup mit Text über 240 zeichen)
if ($text_mode eq "fulltext") {
&CreateHeader;
&PresentShortForm;
exit(0);
}

$dbh->disconnect; #Datenbankverbindung trennen

exit(0);

#----------------------------------------

sub PresentForm
{
#Zeigt aktuelle Meldungen an (Anfangsseite)

my $aktuell;
my $datum;
my $dbabfrage;
my $dbabfrage2;
my $dbabfrage3;
my $del;
my $ex;
my $i =grep /$text_name/, @admin; #Testvariable, ob ein Admin eingeloggt ist
my $index_anchor;
my $length;
my $meldung;
my $name;
my $nummer;
my $uhrzeit;
my $val;
my $voll;
my $wichtig;

my (@acttime) = localtime(time); #Zeitermittlung (zur Einblendung der "Neu!"-Meldung)

print <<EOF
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML><HEAD>
<TITLE> Aktuelle Informationen </TITLE>
</HEAD>
<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#770000" VLINK="#007700" ALINK="#995500" onload="go()">
EOF
;

print <<EOF

<INPUT TYPE="button" VALUE="Info eingeben oder ändern" onClick="window.location='../cgi-bin3/input.pl?mode=eingabe'" />
EOF
;

# Ausgabe des Links für Aktuelle Seiten
$aktuell = "/apache/htdocs/aktuell.htm";
if (-e $aktuell) {
print '                ';
print '<a href="http://infoserver.ime.fraunhofer.de/aktuell.htm">Infoserver aktuell</a>';
}

# auf der aktuellen Seite wird der Link zu älteren/zukünftigen Einträge ausgegeben, auf der Seite für zukünftige bzw. alte Einträge der Link zu aktuellen
if ($text_mode eq "none")
{
print '                ';
print '<a href="http://infoserver.ime.fraunhofer.de/cgi-bin/output.pl?mode=old">Ältere Einträge</a>',"\n\n";
unless ($visitor==1){
print '                ';
print '<a href="http://infoserver.ime.fraunhofer.de/cgi-bin/output.pl?mode=future">Zukünftige Einträge</a>',"\n\n";
}
} elsif ($text_mode eq "future" || $text_mode eq "old") {
print '                ';
print '<a href="http://infoserver.ime.fraunhofer.de/cgi-bin/output.pl">nur Aktuelle Einträge anzeigen</a>',"\n\n";
}

#Suchen und löschen aller bis CURDATE (heute) gültigen Datenbankeinträge;

$dbabfrage = $dbh->do ("DELETE FROM newsscript WHERE Exp <= CURDATE() AND Loeschen=1");

#Ausgeben aller gültigen Einträge

if ($text_mode eq "old") {
$dbabfrage2 = $dbh->selectall_arrayref ("SELECT Nummer, Name, Meldung, Datum, Uhrzeit, Voll FROM newsscript WHERE CURDATE() >= Datum AND Exp <= CURDATE() ORDER BY Wichtig DESC, Datum DESC, Uhrzeit DESC");
} elsif ($text_mode eq "none") {
$dbabfrage2 = $dbh->selectall_arrayref ("SELECT Nummer, Name, Meldung, Datum, Uhrzeit, Voll FROM newsscript WHERE Exp > CURDATE() AND CURDATE() >= Datum ORDER BY Wichtig DESC, Datum DESC, Uhrzeit DESC");
} elsif ($text_mode eq "future") {
if ($i == 1){
$dbabfrage2 = $dbh->selectall_arrayref ("SELECT Nummer, Name, Meldung, Datum, Uhrzeit, Voll FROM newsscript WHERE CURDATE() < Datum ORDER BY Wichtig DESC, Datum DESC, Uhrzeit DESC");
} else {
$dbabfrage2 = $dbh->selectall_arrayref ("SELECT Nummer, Name, Meldung, Datum, Uhrzeit, Voll FROM newsscript WHERE CURDATE() < Datum AND Name='$text_name' ORDER BY Wichtig DESC, Datum DESC, Uhrzeit DESC");
}
}

$dbabfrage3 = $dbh->prepare ("UPDATE newsscript SET wichtig=0 WHERE (Exp < CURDATE() AND Wichtig=1)"); #setzt bei allen abgelaufenen Beiträgen wichtig auf 0, damit beim Anzeigen nicht über aktuellen Meldungen stehen
$dbabfrage3->execute ();
$dbabfrage3->finish();

for my $row2 (@$dbabfrage2)
{
($nummer, $name, $meldung, $datum, $uhrzeit,$voll)=@$row2;
my @sep = split(/-/, $datum);
print '<hr>';
if (($sep[0])==($acttime[5]+1900) and ($sep[1])==($acttime[4]+1) and ($sep[2])==$acttime[3]){ #Einblendung der "Neu!"-Meldung
print '<blink>Neu!   </blink>';
}
$datum = dateform ($datum);

#unterscheidung zwischen Vor- und Nachname oder nur Nachname
if (grep /\./, $name) {
($vorname, $nachname)= split (/\./,$name);
$vorname = umlinname(ucfirst($vorname));
$nachname = umlinname(ucfirst($nachname));
print "$vorname $nachname schrieb am $datum um $uhrzeit Uhr: ";
} else { $name= umlinname(ucfirst($name)); print "$name schrieb am $datum um $uhrzeit Uhr: ";}

$meldung = umlinname(ucfirst($meldung));
$meldung = nl2br ($meldung);
$length = length($meldung);
if ($voll == "1") { #wenn angegeben, nicht kürzen
print "$meldung ";
} elsif ($length <= 240) {
print "$meldung ";
} else {
$meldung = substr $meldung, 0, 240;

$index_anchor = rindex $meldung, " "; #Kontrollmechanismen:
if ($index_anchor == 238) { $meldung = substr $meldung, 0, 238; } # an Trennstelle suchen und ggf. entfernen

#schließt alle durch das Kürzen offengebliebenen html-tags
my @liste = $meldung =~ /<([a-zA-Z].?)>/mg;
foreach (@liste)
{
my $tag = "<$_>";
my $tagend = "</$_>";
if (((grep /$tagend/, $meldung) < (grep /$tag/, $meldung)) and ($tag ne " ")) { $meldung = "$meldung</$_>"; }
}

print "$meldung";

#Zeigt vollständige Meldung (240+ Zeichen) im neuen Fenster an; etwas komplex weil zur Verwendung mit und ohne Javascript geeignet
print ' <a href="http://infoserver.ime.fraunhofer.de/cgi-bin/output.pl?mode=fulltext&nummer=', $nummer, '" target="_blank" onclick="return (window.open(', "'http://infoserver.ime.fraunhofer.de/cgi-bin/output.pl?mode=fulltext&nummer=", $nummer, "' ,'Bild','width=640,height=520,scrollbars=yes,resizable=yes')==null);\">... mehr ...</a> ";
$text_nummer=$nummer;
}

#"bearbeiten" und "löschen" nur möglich als Autor des Textes oder Admin; niemals als Besucher
unless ($visitor==1)
{
if (($i == 1) or ($text_name eq $name)){
print "<a href='http://infoserver.ime.fraunhofer.de/cgi-bin3/input.pl?mode=aendern&nummer=" , $nummer, "'",">Datensatz ändern?</a> ";
print "<a href='http://infoserver.ime.fraunhofer.de/cgi-bin3/input.pl?mode=abfrageloeschen&nummer=" , $nummer, "'",">Datensatz löschen?</a> ";
}
}
}

&CreateFooter;

}

#----------------------------------------

sub PresentShortForm
{
#gibt die volle Meldung (mehr als 240 Zeichen) aus

my $datum;
my $dbabfrage;
my $meldung;
my $name;
my $uhrzeit;

print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">',"\n\n";
print '<HTML><HEAD>';
print '<TITLE> Aktuelle Informationen </TITLE>';
print '<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">';
print "</HEAD>\n\n";
print '<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#770000" VLINK="#007700" ALINK="#995500">',"\n\n";

my $sqlstring = "SELECT Name, Meldung, Datum, Uhrzeit FROM newsscript WHERE Nummer = $text_nummer;";
($name, $meldung, $datum, $uhrzeit)= $dbh->selectrow_array ($sqlstring);

print '<a href="javascript:window.print()">Diese Seite drucken</a>';

my ($vorname, $nachname)= split (/\./,$name);
$vorname = umlinname(ucfirst($vorname));
$nachname = umlinname(ucfirst($nachname));
$meldung = umlinname(ucfirst($meldung));
$meldung = nl2br ($meldung);
$datum = dateform ($datum);
print " <hr>$vorname $nachname schrieb am $datum um $uhrzeit Uhr: ";
print "$meldung";
print " <hr>";

&CreateFooter;
}
#----------------------------------------

sub umlinname
{
#konvertiert die ae/ue/oe aus den Benutzernamen in richtige Umlaute

my $text = shift || return;
# "aue" und "eue" vor Konvertierung schützen
$text =~ s/aue/aXuXe/g;
$text =~ s/eue/eXuXe/g;

$text =~ s/ae/ä/g;
$text =~ s/oe/ö/g;
$text =~ s/ue/ü/g;
$text =~ s/Ae/Ä/g;
$text =~ s/Oe/Ö/g;
$text =~ s/Ue/Ü/g;
$text =~ s/szz/ß/g;
$text =~ s/''/'/g;

# "aue" und "eue" vor Konvertierung schützen
$text =~ s/aXuXe/aue/g;
$text =~ s/eXuXe/eue/g;

return $text;
}
#----------------------------------------

sub nl2br
{
#konvertiert die Zeilenumbrüche in einem aus der Datenbank gelesenen Text zu HTML

my $text = shift || return;
$text=~ s/\015\012|\015|\012/ /g;
return $text;
}
#----------------------------------------

sub dateform
{
#konvertiert das Datumsformat von YYYY-MM-DD zu DD.MM.YYYY

my $datum = shift || return;
my @sep = split(/-/, $datum);
$datum=("$sep[2].$sep[1].$sep[0]");
return $datum;
}

#----------------------------------------

sub CreateHeader
{
# gibt einen HTTP-Header aus

print "Content-type: text/html; charset=iso-8859-1\n\n";

}

#----------------------------------------

sub CreateFooter
{
# gibt den HTML-Fuss aus

print '</BODY></HTML>';
}

#----------------------------------------

Die Verweise auf andere Dateien funktionieren fehlerfrei (Die anderen Skripte geben auch nicht die oben genannte Fehlermeldung zurück.).

Ich hoffe, dass mir jemand helfen kann! Vielen Dank im Vorraus, Rene.

rene_rinke · 29. April 2008

nach einiger Recherche und fleißigem auskommentieren weiß ich nun, dass die Fehlermeldung durch den Aufruf

Code:

use cgi::cookie

hervorgerufen wird. Das Problem hierbei ist, dass ich diesen Aufruf benötige um es dem User zu ermöglichen seine eigenen Einträge zu editieren bzw. zu löschen.
Wenn ich die gesamten Cookie-Befehle rauskommentiere gibt es zwar keine Fehlermeldung, aber dafür auch keine Cookies! Es wäre sehr nett, wenn ein Cookie-Master sich mal hierzu äußern könnte!

renee · 29. April 2008

Du könntest aus

use CGI::Cookie;

ein

BEGIN{
no warnings "redefine";
use CGI::Cookie;
}

machen.

Generell solltest Du Dir angewöhnen bei den Modulen die richtige Groß- und Kleinschreibung zu verwenden.

Also

use CGI;
use CGI::Cookie;

Auf einem Windows-System mag das funktionieren, aber auf einem Linux-System funktioniert es nicht mit den "falschen" Modulnamen.

Hat zwar nix mit dem Problem zu tun, aber man sollte sich angewöhnen "use strict" zu verwenden. (siehe auch http://wiki.perl-community.de/bin/view/Wissensbasis/UseStrict)

PERL - Constant subroutine CGI::XHTML_DTD redefined

rene_rinke

Grünschnabel

rene_rinke

Grünschnabel

renee

Erfahrenes Mitglied

Neue Beiträge