#!c:/usr/bin/perl -w
# ---------------------------------------------------
# MODULE
# ---------------------------------------------------
use strict;
use warnings;
use diagnostics;
use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser warningsToBrowser/;
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
use Data::Dumper;
use vars;
# ---------------------------------------------------
# KONSTANTEN
# ---------------------------------------------------
use constant UNIX => 0; # Unix y/n
# ---------------------------------------------------
# VARIABLEN
# ---------------------------------------------------
$| = 1;
my $cgi = CGI->new();
my $query = $cgi->Vars; #extract parameters
my $index_file = 'c:/apache/cgi-bin/cms/1_3/txt/index.txt'; # nr. | key | pfad
my $index = 'c:/apache/cgi-bin/cms/1_3/html/index.html';
# ---- TEMPLATE
my %subs = (); # global hash for &substitute substitute_key => value
# ---- SETTINGS
$subs{relative_url} = $cgi->url(-relative=>1);
$subs{full_url} = $cgi->url(-full=>1);
$subs{self} = $cgi->url(-relative=>1) . '?action=';
$subs{domain} = '127.0.0.1';
# ---- SENDMAIL-SETTINGS
my $mailto = 'trash@mail.net';
my $kontakt_subject = 'Feedback von Webseite';
my $Sendmail_Prog = "/usr/sbin/sendmail";
# -- folowing variable: format of the outgoing Message
my $mailtext = qq~
Von: $query->{name}
Email: $query->{email}
Firma (optional): $query->{firma}
Text:
$query->{text}
~;
# ---- LAST SETTINGS
my $kontakt_submit = qq~
Intergastro Service - Kontakt
&
&
&
Ihre Nachricht wurde verschickt. Vielen Dank für Ihr Interesse.
Sollten Sie nicht automatisch weiter geleitet werden bitte hier klicken.
~;
# ---------------------------------------------------
# LOGIK
# ---------------------------------------------------
print $cgi->header(-charset=>'UTF-8',
-expires=>'+1s',
-type=>'text/html',
);
warningsToBrowser(1);
if($query->{action}){
if( $query->{action} eq "kontakt" ){
if( $query->{submit} ){
if( $query->{name} eq "" || $query->{email} eq "" || $query->{text} eq "" || $query->{email} !~ /^[\w\d][\w\d\.\-]*\@([\w\d\-]+\.)+[a-zA-Z]{2,4}$/ ){
$subs{error} .= qq~Bitte überprüfen Sie ihre Eingabe!
~;
my @keys = qw(name email firma text);
foreach( @keys ) {
$_ = "" if !defined;
$subs{$_} = $query->{$_};
}
zeigeSeite('kontakt');
}else{ # Kontakt erfolgreich
open(MAIL,"|$Sendmail_Prog -t") || print qq~Mailprogramm konnte nicht gestartet werden
~;
print MAIL "To: $mailto\n";
print MAIL "Subject: $kontakt_subject\n\n";
print MAIL "$mailtext\n";
close(MAIL) || print qq~Fehler beim Mailversenden!
~;
print $kontakt_submit;
}
}else{ #erstaufruf
zeigeSeite('kontakt');
}
}else{
zeigeSeite($query->{action});
}
}else{
zeigeSeite('index');
}
exit( 0 );
# ---------------------------------------------------
# SUBS
# ---------------------------------------------------
sub zeigeSeite{
my $key = $_[0]; #Schlüsselwort für Aufzurufende Seite in /txt/index.txt
my $pfad = 0;
my @index = extractFile( $index_file );
# print;
foreach (@index){
chomp $_;
if($_ =~ m/$key\.igs/ig){
$pfad = (split /\t/,$_)[2];
last;
}
}
if($pfad eq 0){ print errorSeite( $query->{action}, "zeigeSeite: $!" ); exit( 1 ); } # -> Fehlerseite?
my @inhalt = extractFile( $pfad );
foreach (@inhalt){
chomp $_;
}
# ---------------------------------------------------
# DYN. INHALT
$subs{titel} = (split/\|/, $inhalt[0])[2];
$subs{keywords} = (split/\|/, $inhalt[1])[2];
$subs{desc} = (split/\|/, $inhalt[2])[2];
$subs{page_topic} = (split/\|/, $inhalt[3])[2];
my $page = (split/\|/, $inhalt[4])[2];
$subs{inhalt} = join"",substitute( extractFile( $page ) ); # CONTENT auselesen & serialisieren
# $subs{inhalt} =~ s/\n/ /g;
print substitute( extractFile( $index ) ); # SUBSTITUTION IN INDEX.HTML
# print;
} #ZeigeSeite
# --------------------------------------------------------
sub extractFile{
# ---- usage
# my @extractedFile = extractFile( "FileName" ); # dieing if file doesn't exists
my $file = $_[0];
open(DAT, "$file") || die "$! ($file)";
my @inhalt = ;
close(DAT);
return @inhalt;
} #extractFile
# --------------------------------------------------------
sub substitute{
# ---- usage
# my @substitutedFile = substitute( @contentToSubstitute ); # substitute-keywords must be added to %subs (global %hash)
my @err = (); # array für fehler
my @file = @_;
foreach my $eintrag( @file ){
if( $eintrag =~ /\%\%(.*)\%\%/ ){
my $keyword = $1;
unless( exists $subs{$keyword} ){ push @err, "Wert nicht gesetzt: $keyword\n"; $subs{$keyword} = ""; }
unless( $eintrag =~ s/\Q$&\E/$subs{$keyword}/g ){ print STDERR "Fehler beim ersetzen!\n"; }
print STDERR "ersetzte: $& mit $eintrag\n";
}
}
print STDERR @err;
return @file;
} #substitute
# --------------------------------------------------------
sub errorSeite {
my ($action, $fehler) = @_;
$cgi->delete_all();
my $msg = qq~
&
Ein Fehler ist aufgetreten. Sie werden automatisch zur Startseite umgeleitet.
Sollten Sie nicht automatisch umgeleitet werden klicken Sie bitte hier!
&
&
&
Hinweise für den Webmaster:
Aktion: $action
Fehler: $fehler
~;
return ($msg);
} #errorSeite