Flohmarkt - Perl/CGI-Archiv

#!/usr/bin/perl ############################################################################ # # (c) Markus Wolf, 2000 # ############################################################################ # # fm_main.cgi # COPYRIGHT NOTICE # Copyright 2000 Markus Wolf # All Rights Reserved. # EMail: perl@perl-archiv.de # URL : http://www.perl-archiv.de # # fm.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: Bitte 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. # # Wer den Copyrighthinweis bei der Ausgabe nicht haben will, kann diesen gegen # eine Lizenzgebühr von DM 58,- rausnehmen. Einfach ein Mail an # perl@perl-archiv.de, dann gibt es eine Rechnung. # ############################################################################ # # In diesem Script muß normalerweise nicht geändert werden. # Bis auf das Layout :-)) . # ############################################################################ # # Aufbau der Datendatei # # 0 id # 1 rubrik # 2 titel # 3 com # 4 username # 5 tel # 6 mail # 7 datum # 8 dauer # 9 paßwort # 10 url # ############################################################################ ############################################################################ # Anwendung starten ############################################################################ sub start_fm { #Time-Modul use Time::Local ; use CGI::Carp qw(fatalsToBrowser) ; #Parameter verarbeiten @para = split(/&/ , $ENV{'QUERY_STRING'}); #Aktuelle Zeit &datum_zeit() ; if ($para[0] eq "read") { #Listen &htmlhead() ; &read() ; &htmlfoot() ; } elsif ($para[0] eq "new") { #Neue Anzeige &new() ; &redir("$cgi_host$cgi_add/$cgi_nam?read&$FM{'rubrik'}") ; } elsif ($para[0] eq "form") { #Form: neue Anzeige &htmlhead() ; &form() ; &htmlfoot2("$cgi_add/$cgi_nam") ; } elsif ($para[0] eq "delform") { #Form: Anzeige löschen &htmlhead() ; &delform() ; &htmlfoot2("$cgi_add/$cgi_nam") ; } elsif ($para[0] eq "delad") { #Anzeige löschen &htmlhead() ; &delad() ; &htmlfoot2("$cgi_add/$cgi_nam") ; } elsif ($para[0] eq "update") { #Anzeige löschen &htmlhead() ; &update() ; &htmlfoot2("$cgi_add/$cgi_nam") ; } elsif ($para[0] eq "search") { #Suche &htmlhead() ; &parse_form() ; &search() ; &htmlfoot2($url_start) ; } elsif ($para[0] eq "redir") { #Umleiten &redir() ; } else { #Startseite &htmlhead() ; &show() ; &htmlfoot2($url_start); } } ############################################################################ # Ausgabe der Übersichtsseite ############################################################################ sub show { my %MARK ; my %anzrub ; my @lines ; my @html_tmp ; my $rubrik ; my $link ; my $new ; my $html_out ; my $back_stat=0 ; open (HTML , "< $html_tmpl") || die "Kann Schablonendatei ($html_tmpl) nicht zum Lesen öffnen." ; @html_tmp=; close(HTML) ; $html_out = join (' ' , @html_tmp) ; ### #Anzahl und Alter bestimmen open (DAT , "<$dat_file") || die "Kann Datenfile ($dat_file) nicht zum Lesen öffnen." ; while ($line=) { @fm_set = split(/\|/ , $line) ; #Zeit checken next unless ($fm_set[7] =~ /^\d\d\.\d\d\.\d\d\d\d/) ; $back_stat=&check_date($fm_set[7]) ; if ($back_stat <= $fm_set[8]) { $anzrub{$fm_set[1]}++ ; $anzges++ ; } if ($back_stat < $alter) { $NEU_MARK{$fm_set[1]}++ ; $MARK{$fm_set[1]}=1 ; } } close (DAT) ; ### #Ausgabe der Rubriken foreach $rubrik (keys %rub) { if ($MARK{$rubrik}) { $new = "($anzrub{$rubrik} | $NEU_MARK{$rubrik} neu)" ; } else { $anzrub{$rubrik}=0 if !$anzrub{$rubrik} ; $new = "($anzrub{$rubrik})" ; } if($anzrub{$rubrik}>0) { $link = "

$rub{$rubrik} $new"; } else { $anzrub{$rubrik}=0; $link = "

$rub{$rubrik} $new" ; } $html_out =~ s//$link/i ; } print "$html_out

" ; } ############################################################################ # Auflistung der Anzeigen ############################################################################ sub read { my @data_set ; my @lines ; my $i=0 ; my $line ; my @lines_tmp ; $para[2]=1 if (!$para[2]) ; ### #Verarbeitung der Datendatei open (DAT , "< $dat_file") || die "Kann Datenfile ($dat_file) nicht zum Lesen öffnen." ; @lines_tmp= ; close (DAT) ; ### #Bearbeitung der Daten foreach $line (@lines_tmp) { @data_set = split(/\|/,$line) ; next if ( ($data_set[7] !~ /^\d\d\.\d\d\.\d\d\d\d/) || (&check_date($data_set[7])) > $data_set[8] ) ; push (@lines, [ @data_set ] ) if ($para[1] eq $data_set[1]) ; } undef @lines_tmp ; @lines=reverse @lines ; unshift(@lines , " ") ; ### #Variablen für Blättervorgang my $anzeige_zurueck = $para[2]-$anzan ; my $anzeige_weiter = $para[2]+$anzan ; my $anzeige_von = $para[2] ; my $anzeige_bis = $para[2]+$anzan-1 ; my $gesanz = $#lines ; $anzeige_bis = $gesanz if ($anzeige_bis>$gesanz) ; ### #Ausgabe der Einträge print "" ; for $y ($anzeige_von .. $anzeige_bis) { if ($para[1] eq "$lines[$y][1]") { $lines[$y][3] = " \;" if (!$lines[$y][3]) ; undef $name ; if ($lines[$y][4] && $lines[$y][6]) { $name="$lines[$y][4]" ; } elsif (!$lines[$y][4] && $lines[$y][6]) { $name="$lines[$y][6]" ; } elsif ($lines[$y][4] && !$lines[$y][6]) { $name="$lines[$y][6]" ; } $tel = ( $lines[$y][5] ? " | T. $lines[$y][5]" : "" ) ; $url = ( $lines[$y][10] =~ /http:\/\/.*\..*/ig ? " | $lines[$y][10]" : "" ) ; print qq~ ~ ; $i++; } } print "" if ($i==0) ; print <<"EOM" ;

$lines[$y][2]	$lines[$y][7] (edit)
$lines[$y][3]
$name$url$tel

Keine Anzeigen in dieser Rubrik vorhanden.

EOM ### #zurück if($anzeige_zurueck>=0) { print <<"EOM" ;

EOM } else { print <<"EOM" ; EOM } ### #Status $anzeige_bis=$gesanz if ($anzeige_weiter>$gesanz) ; print <<"EOM" ;

$anzeige_von-$anzeige_bis ($gesanz Anzeigen) | aufgeben - bearbeiten/löschen

EOM ### #weiter if($anzeige_weiter<=$gesanz) { print <<"EOM" ;

EOM } else { print <<"EOM" ; EOM } } ############################################################################ # Durchsuchen der Anzeigen ############################################################################ sub search { my @data_set ; my @lines ; my @sr ; my $i=0 ; my $line ; $para[2]=1 if (!$para[2]) ; ### #Suche in den Einträge print "" ; open (DAT , "< $dat_file") || die "Kann Datenfile ($dat_file) nicht zum Lesen öffnen." ; while($line=) { push (@sr , $line) if ($line =~ /.*$FM{'sbeg'}.*\|.*\|.*\|$/ig) ; } close (DAT) ; ### #Ausgabe der Einträge foreach $line (reverse @sr) { @data_set = split(/\|/ , $line) ; $data_set[3] = " \;" if (!$data_set[3]) ; undef $name ; if ($data_set[4] && $data_set[6]) { $name="$data_set[4]" ; } elsif (!$data_set[4] && $data_set[6]) { $name="$data_set[6]" ; } elsif ($data_set[4] && !$data_set[6]) { $name="$data_set[6]" ; } $tel = ( $data_set[5] ? " | T. $data_set[5]" : "" ) ; $url = ( $data_set[10] =~ /http:\/\/.*\..*/ig ? " | $data_set[10]" : "" ) ; print qq~ ~ ; $i++; } ### #Statuszeile if ($i==0) { print "" ; } elsif ($i==1) { print "" ; } else { print "" ; } ### #Abschluß print <<"EOM" ;

$rub{$data_set[1]} $data_set[2]	$data_set[7] (bearbeiten/löschen)
$data_set[3]
$name$url$tel

Keine Anzeigen zu diesem Suchbegriff vorhanden.
Es wurde $i Anzeige gefunden.
Es wurden $i Anzeigen gefunden.

EOM } ############################################################################ # Neue Anzeige aufgeben ############################################################################ sub new { my $id ; ### #ID holen open (ID , "+<./id.txt" ) || die "Kann ID-File (id.txt) nicht zum Schreiben/Lesen öffnen." ; &LockFile(ID) ; $id= ; $id++ ; seek(ID,0,0); print ID $id ; close (ID) ; ### #Form auslesen &parse_form() ; ### #Schreiben open (DAT , ">> $dat_file") || die "Kann Datenfile ($dat_file) nicht zum Anhängen des neuen Eintrags öffnen." ; &LockFile(DAT); print DAT "$id|$FM{'rubrik'}|$FM{'titel'}|$FM{'com'}|$FM{'username'}|$FM{'tel'}|$FM{'email'}|$ndate|$FM{'dauer'}|$FM{'pw'}|$FM{'url'}|\n" ; close (DAT) ; ### #Adminmail &send_mail($id) ; } ############################################################################ # Anzeige editieren ############################################################################ sub update { my $id ; my @lines ; my $pwc ; my $update=0 ; ### #Form auslesen &parse_form() ; ### #Verarbeitung if ($FM{'id'} > 0) { ### #Daten lesen open (DAT , "< $dat_file") || die "Kann Datenfile ($dat_file) nicht zum Lesen öffnen." ; @lines = ; close (DAT) ; ### #Anzeige ändern open (DAT , "> $dat_file") || die "Kann Datenfile ($dat_file) nicht zum Editieren des intrags öffnen." ; &LockFile(DAT); foreach $line (@lines) { @rec_set=split(/\|/ , $line) ; if ($rec_set[0] eq $FM{'id'}) { #PW verschlüsseln $pwc=crypt($rec_set[9],$rec_set[9]) ; if ( $pwc eq $FM{'pwc'} ) { #Zeile neu schreiben print DAT "$rec_set[0]|$FM{'rubrik'}|$FM{'titel'}|$FM{'com'}|$FM{'username'}|$FM{'tel'}|$FM{'email'}|$ndate|$FM{'dauer'}|$FM{'pw'}|$FM{'url'}|\n" ; $update=1 ; } else { #Zeile wieder schreiben print DAT $line ; } } else { #alte Zeile wieder schreiben print DAT $line ; } } ### #Adminmail &send_mail($id) ; } ### #Ausgabe if ($update==1) { #OK print qq~

Kleinanzeige wurde editiert

Die Kleinanzeige mit der ID $FM{'id'} wurde editiert.

~ ; } else { #Fehler print qq~

Fehler: Kleinanzeige könnte nicht editiert werden

Die Kleinanzeige mit der ID $FM{'id'} kann nicht editiert werden.
Das Paßwort oder die ID ist falsch oder existiert nicht.

Versuchen Sie es bitte nocheinmal.

~ ; } } ############################################################################ # HTML-Kopf ausgeben ############################################################################ sub htmlhead { my $rubrik ; print "Content-Type: text/html\n\n" ; print <<"EOM"; Flohmarkt - Perl/CGI-Archiv

Kleinanzeigenmarkt - Bereich: $bereich

EOM if ($para[0] eq "read" || $para[0] eq "search") { $rub{$para[1]}="Suchergebnis" if ($para[0] eq "search") ; print <<"EOM" ;

$rub{$para[1]}

EOM } } ############################################################################ # HTML-Fuss für die Auflistung ############################################################################ sub htmlfoot { print <<"EOM" ;

EOM } ############################################################################ # HTML-Fuß für alle Seiten ausser Auflistung ############################################################################ sub htmlfoot2 { my $anz=keys %rub ; my $anzahl=0 ; my $back_link=$_[0] ; if ($anzges) { $anzahl="$anzges Anzeigen in" ; } else { $anzahl="" ; } print <<"EOM" ;

EOM } ############################################################################ # Ausgabe des Formulars für einen neuen Eintrag ausgeben ############################################################################ sub form { my @rec_set=@_ ; my $rubrik ; my %zeiten=("7","1 Woche","14","2 Wochen","21","3 Wochen","30","1 Monat","60","2 Monate","90","3 Monate","120","4 Monate","150","5 Monate"); #URL $rec_set[10]="http://" if ($rec_set[10] !~ /http:/i) ; print <<"EOM" ; EOM ### #Form: Admin/New if ($FM{'admin'}) { $pwc=crypt($rec_set[9],$rec_set[9]) ; print qq(

\n\n\n) ; $id_out = qq( - ID $rec_set[0]) ; } else { print qq() ; } ### #Ausgabe print <<"EOM" ;

Kleinanzeige aufgeben/ändern$id_out

Name:

E-Mail:

Telefon:

Paßwort:

Titel:

URL:

Rubrik:

EOM } ############################################################################ # Ausgabe des Formulars für das Löschen einer Anzeige ############################################################################ sub delform { print <<"EOM" ;

Kleinanzeige bearbeiten/löschen

EOM } ############################################################################ # Anzeige löschen ############################################################################ sub delad { my @lines ; my @rec_set ; my $line ; my $del=0 ; #Form auslesen &parse_form() ; ### #Löschen/Admin if ($FM{'admin'} eq "admin") { #Anzeige suchen open (DAT , "< $dat_file") || die "Kann Datenfile ($dat_file) nicht zum Lesen öffnen." ; while ($line=) { @rec_set=split(/\|/ , $line) ; if ($rec_set[0] eq $FM{'id'} && ($rec_set[9] eq $FM{'pw'} || $master eq $FM{'pw'})) { &form(@rec_set) ; $del=1 ; last ; } } #Nicht korrekt unless ($del==1) { print qq~

Fehler: Kleinanzeige kann nicht editiert werden

Die Kleinanzeige mit der ID $FM{'id'} kann nicht editiert werden.
Das Paßwort oder die ID ist falsch oder existiert nicht.

Versuchen Sie es bitte nocheinmal.

~ ; } } else { #### #Hier ist ein kritischer Punkt #Wird während dieser Zeit eine neue Anzeige aufgegeben #fällt diese beim folgenden Löschvorgang wieder raus #aber ich habe hierfür keine Lösung #### open (DAT , "< $dat_file") || die "Kann Datenfile ($dat_file) nicht zum Lesen öffnen." ; @lines= ; close(DAT) ; open (DAT , "> $dat_file") || die "Kann Datenfile ($dat_file) nicht zum Schreiben öffnen." ; &LockFile(DAT) ; foreach $line (@lines) { @rec_set=split(/\|/ , $line) ; if ($rec_set[0] eq $FM{'id'} && ($rec_set[9] eq $FM{'pw'} || $master eq $FM{'pw'})) { $del=1 ; } else { print DAT "$line" ; } } close (DAT) ; if ($del==1) { #Gelöscht print qq~

Kleinanzeige gelöscht

Die Kleinanzeige mit der ID $FM{'id'} wurde erfolgreich gelöscht.

~ ; } else { #Nicht gelöscht print qq~

Fehler: Kleinanzeige konnte nicht gelöscht werden

Die Kleinanzeige mit der ID $FM{'id'} wurde nicht gelöscht.
Das Paßwort oder die ID ist falsch oder existiert nicht.

Versuchen Sie es bitte nocheinmal.

~ ; } } } ############################################################################ # Formulardaten auslesen ############################################################################ sub parse_form { my $buffer ; my @paare ; my $paar ; my $val1 ; my $val2 ; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @paare = split(/&/, $buffer); foreach $paar (@paare){ ($val1, $val2) = split(/=/, $paar); $val1 =~ tr/+/ /; $val1 =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $val2 =~ tr/+/ /; $val2 =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $val2 =~ s/<([^>]|\n)*>/ /g; $val2 =~ s/\&/\&\;/g; $val2 =~ s/"/\"\;/g; $val2 =~ s//\>\;/g; $val2 =~ s/\|/ /g; $val2 =~ s/\cM\n/
/g; $val2 =~ s/\n\cM/
/g; $val2 =~ s/\cM/
/g; $val2 =~ s/\n/
/g; $val2 =~ s/
\s\s\s+/

/g; $val2 =~ s/
\t/

/g; $val2 =~ s/\s+/ /g; $val2 =~ s/
\s/
/g; $val2 =~ s/\s
/
/g; $val2 =~ s/

/

/g; $val2 =~ s/

>/g; $val2 =~ s/
>/
>/g; $val2 =~ s/
>//g; $val2 =~ s/
/ /g; $val2 =~ s//
>/g; $val2 =~ s/\s+/ /g; $val2 =~ s/^\s+//g; $val2 =~ s/\s+$//g; $FM{$val1} = $val2; } } ############################################################################ # File vor gemeinsamen Zugriff schützen ############################################################################ sub LockFile { local(*DATEI=@_) ; flock(DATEI,2) if ($lock==1) ; } ############################################################################ # Mails verschicken ############################################################################ sub send_mail { my $id=$_[0] ; #Mail an Betreiber &send_mail_away($webmaster,$FM{'email'},"mail_an_betreiber.txt",$id) ; #Mail an Eintragenden if ($FM{'email'} =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || $FM{'email'} !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) { warn "Falsche E-Mail-Adresse: $FM{'email'}" ; } else { &send_mail_away($FM{'email'},$webmaster,"mail_an_inserent.txt",$id) ; } } ############################################################################ # Eigentliche Mail ############################################################################ sub send_mail_away { my $mailto=shift ; my $mailfrom=shift ; my $text=shift ; my $id=shift ; if($offline==1) { open(MAIL,"> ./$text") || die "Kann Mail1-File (mail1.txt) nicht zum Schreiben öffnen." ; } else { open(MAIL,"|$mailprog -t") ; } print MAIL "To: $mailto\n"; print MAIL "From: $mailfrom\n"; print MAIL "Subject: neue Kleinanzeige (ID $id) - $cgi_host\n\n"; print MAIL "---------------------------------------------------------------------------\n"; print MAIL "Name: $FM{'username'}\n"; print MAIL "Mail: $FM{'email'}\n"; print MAIL "Telelfon: $FM{'tel'}\n"; print MAIL "Datum: $ndate\n"; print MAIL "---------------------------------------------------------------------------\n"; print MAIL "Rubrik: $rub{$FM{'rubrik'}}\n"; print MAIL "Titel. $FM{'titel'}\n"; print MAIL "Dauer: $FM{'dauer'}\n"; print MAIL "Paßwort: $FM{'pw'}\n"; print MAIL "\n$FM{'com'}\n"; print MAIL "\n---------------------------------------------------------------------------\n"; close (MAIL); } ############################################################################ # Datum prüfen ############################################################################ sub check_date { my $tocheck=$_[0] ; my $tocheck2 ; my $datcheck2 ; my $back_stat ; my $tag ; my $monat ; my $jahr ; $tag = substr($tocheck , 0,2) ; $monat = substr($tocheck , 3,2) - 1 ; $jahr = substr($tocheck , 6,4) ; $tocheck2 = timelocal(0, 0, 0, $tag, $monat, $jahr) ; $tag = substr($datcheck , 6,2) ; $monat = substr($datcheck , 4,2) - 1 ; $jahr = substr($datcheck , 0,4) ; $datcheck2 = timelocal(0, 0, 0, $tag, $monat, $jahr) ; #Rückgabe $back_stat=int(($datcheck2-$tocheck2)/86400) ; return ($back_stat) ; } ############################################################################ # aktuelle Datum und Zeit ermitteln ############################################################################ sub datum_zeit { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time+($zeitverH*3600)); $mon = $mon+1; $year = 1900+$year; $min = "0$min" if ($min < 10) ; $hour = "0$hour" if ($hour < 10) ; $mon = "0$mon" if ($mon < 10) ; $mday = "0$mday" if ($mday < 10) ; $ndate = "$mday.$mon.$year - $hour:$min"; $datcheck = "$year$mon$mday" ; } ############################################################################ # Umleitung ############################################################################ sub redir { my %MAILFORM ; my @paare ; my $buffer ; my $paar ; my $feldname ; my $wert ; if ($ENV{'CONTENT_LENGTH'} && $para[0] eq "redir") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}) ; @paare = split(/&/, $buffer); foreach $paar (@paare) { ($feldname, $wert) = split(/=/, $paar); $feldname =~ tr/+/ /; $feldname =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $wert =~ tr/+/ /; $wert =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $MAILFORM{$feldname} = $wert; } } $MAILFORM{'links'}=$_[0] if (!$MAILFORM{'links'}) ; print "Location: $MAILFORM{'links'}\n\r\n\r"; print "Content-Type: text/html\n\n" ; print "Seite wird geladen " ; } ############################################################################ # ENDE ############################################################################ 1 ;