Jo, ich habe mir mal sowas gemacht.
Da musst du noch die Felder aus deinem Formular in das Data::FormValidator-Profil eingeben und die die CMS-Klasse von cms.berlios.de besorgen.
Die Dateien sind in Folgender Ordung abzulegen:
* Im Verz. cgi-bin/pm/
CMS.pm
ProjektXYZ.pm
* dort das Unterverz. CMS/ (großgeschrieben!)
welches die Datei Feedback.pm beinhaltet
Im Folgenden nun dieses:
1. das formluar.cgi
2. Feedback.pm
3. ProjektXYZ.pm
4. FB_Form.html
5. FB_MailSuccError.html1. formluar.cgi
#!/Perl/bin/perl
use strict;
use warnings;
use diagnostics;
use CGI::Carp qw( fatalsToBrowser );
use FindBin();
use lib qw(../pm);
use ProjektXYZ;
use CMS::Feedback;my $pd = ProjektEHB->new();
my $webapp = CMS::Feedback->new(
$pd->get_pdata(),
);
$webapp->run();
exit(0);
2. Feedback.pm
package CMS::Feedback;
use base 'CMS';use strict;
use warnings;
use diagnostics;
use vars qw($VERSION);
use CGI::Carp qw( fatalsToBrowser );
use Data::FormValidator;
use Data::Dumper; # dev. only
my $VERSION = '0.31';
# 0.31
# a) dfv_profile in FB_dtv_profile umbenannt um Konflikte mit anderen Profilen in ProjektXy.pm zu vermeiden
# b) _decodeEntities wieder angemacht um HTML-Tags zu unterbinden
sub setup {
my $self = shift;
$self->start_mode('showForm');
$self->mode_param('rm');
$self->run_modes([qw(showForm validate showErrorForm sendMail showMailError showMailSuccess AUTOLOAD)]);
my $q = $self->query();
# Array für zu substituierende Variablen initiieren
unless( defined($self->param('subst')) ){
$self->param('subst', []);
}
} # /setup
sub _decodeEntities {
my $self = shift;
my $string = shift or return '';
$string =~ s/__/_ _/g;
$string =~ s/\&/&/g; #&
$string =~ s/"/"/g; #"
$string =~ s/\'/'/g; #'
$string =~ s/</</g; #<
$string =~ s/>/>/g; #>
# $string =~ s/\n/<br>/g; #\n
return $string;
} # /_decodeEntitites
sub _createMailText {
my $self = shift;
my $q = shift or return '_createMailText: Fehler beim erstellen der eMail, kein CGI-Objekt uebergeben';
if( ( defined($self->param('FB_MailTemplate.tmpl'))
and -e $self->tmpl_path().$self->param('FB_MailTemplate.tmpl') )
or -e $self->tmpl_path().'FB_MailTemplate.tmpl' ) {
#create the text wchich will be sent to $self->param('FeedbackEmpfaenger')
my %d = $q->Vars();
$self->param(\%d);
push @{$self->param('subst')}, keys(%d);
my $t = $self->load_tmpl($self->param('FB_MailTemplate.tmpl') || 'FB_MailTemplate.tmpl');
return $t->output();
}else{
# -----[ create the text by script, using $dfv_profile(req.+opt.) ]-----
my $full_url = $q->url(-full=>1,);
my $sendText = "$full_url - feedback\n Diese Mail wurde automatisch erstellt, da noch kein FB_MailTemplate eingerichtet wurde.\n";
my @params = ();
foreach( qw(required optional require_some optional_regexp) ){
if( exists $self->param('FB_dfv_profile')->{$_}
and defined $self->param('FB_dfv_profile')->{$_}
and ref($self->param('FB_dfv_profile')->{$_}) eq "ARRAY" ){
push @params, @{$self->param('FB_dfv_profile')->{$_}};
}
}
# -----[ required_regexp ]-----
my $ding = $self->param('FB_dfv_profile')->{'required_regexp'};
$ding =~ s/\(.*\:([\w\|\&]+)\)/$1/g;
my @results = split /\&|\|/, $ding;
#print STDERR Data::Dumper::Dumper( @results );
push @params, @results;
$sendText .= '+------------------------'."\n";
foreach( @params ){
next if $_ eq 'rm';
$sendText .= '|'.$_.": ";
if( defined($q->param($_)) and $q->param($_) ne "" ){
$sendText .= $q->param($_)."\n";
}else{
$sendText .= '--[keine Angabe]--'."\n";
}
$sendText .= '+------------------------'."\n";
}
# print STDERR $sendText;
return $sendText;
}
} # /_createMailtext
sub _pushQuery2Subst { # v0.1
my $self = shift;
my $q = shift || $self->query();
my %d = $q->Vars();
$self->param(\%d);
push @{$self->param('subst')}, keys(%d);
return 1;
} # /pushQuery2Subst
sub _showError {
my $self = shift;
my $q = $self->query();
my $ft = undef; # ft = fehlerText
# get the error-messages
my $msg = $self->_checkRequirements({'getMsg'=>1});
foreach( @{$msg} ){
$ft .= $_ . $q->br();
}
my $rt = undef; # rt = returnText
# create a nice text
$rt = $q->h1({-class=>'error'},'Fehler: die angeforderte Anwendung kann nicht ausgeführt werden!');
$rt .= $q->p('Folgende Foraussetzungen für die Ausführung der Anwendung sind nicht erfüllt:');
$rt .= $q->p($ft);
return $rt;
} # /_showError
sub _checkRequirements {
my $self = shift;
my $p = shift || {'getMsg' => 0};
my @msg = ();
my $f = 0; # f = fehler, 0 = kein Fehler, 1 = fehler
# check trivial params
foreach my $param ( qw(FeedbackEmpfaenger FB_dfv_profile) ){
unless( defined($self->param($param)) ){
# print STDERR 4;
push @msg, "Parameter [$param] nicht angegeben";
$f = 1;
}else{
unless( $self->param($param) ne "" ) {
# print STDERR 5;
push @msg, "Parameter [$param] ist leer";
$f = 1;
} # /unless
}
} # /foreach
# check files
foreach my $datei( qw(FB_MailSuccError.html FB_Form.html) ){
unless( defined($self->param($datei)) ) {
# print STDERR 1;
unless( -e $self->tmpl_path().$datei ) {
# print STDERR 2;
$f = 1;
push @msg, "Datei [$datei] wurde nicht gefunden";
}
}else{
unless( -e $self->tmpl_path().$self->param($datei) ) {
# print STDERR 3;
$f = 1;
my $angegeb = $self->param($datei);
push @msg, "die angegebene Datei [$datei => '$angegeb'] existiert nicht";
} # /unless
}
} # /foreach
if( $p->{'getMsg'} ){
return \@msg;
}else{
return $f;
}
} # /_checkRequirements
sub showForm {
my $self = shift;
return $self->_showError() if $self->_checkRequirements();
$self->param('Rm' => 'validate'); # add the wanted runmode to self
push @{$self->param('subst')}, 'Rm'; # to set it in the template
my $t = $self->load_tmpl($self->param('FB_Form.html') || 'FB_Form.html');
my ($head, $body) = $self->_parseHeadBody( $t->output() || 'no content', 1 );
return $body;
} # /showForm
sub validate {
my $self = shift;
my $q = $self->query();
my $results = Data::FormValidator->check({$q->Vars()}, $self->param('FB_dfv_profile'));
#print STDERR __LINE__;
if( $results->has_missing() # This method returns true if the results contains missing fields.
or $results->has_invalid() # This method returns true if the results contains fields with invalid data.
or $results->has_unknown() ){ # This method returns true if the results contains unknown fields.
# Fehler, redirect to showErrorForm
# $q->param( $self->mode_param() => 'showErrorForm' );
# $self->_redir($q->url(-relative=>1,-query=>1));
return $self->showErrorForm($q);
#print STDERR Data::Dumper::Dumper( $q->url(-relative=>1,-query=>1) );
return "redirecting to ".$q->url(-relative=>1,-query=>1);
}else{ # ok, redirect to showReview
return $self->sendMail($q);
# $q->param( $self->mode_param() => 'sendMail' );
# $self->_redir($q->url(-relative=>1,-query=>1));
}
return 'validate';
} # /validate
sub showErrorForm {
my $self = shift;
my $q = shift || $self->query();
my $results = Data::FormValidator->check({$q->Vars()}, $self->param('FB_dfv_profile'));
$q->param('Nachricht' => $self->_decodeEntities($q->param('Nachricht')) );
my $data = []; # Arrayref für <TMPL_LOOP FehlerLoop>
if ( $results->has_missing() ) { # get the name of the first missing field
my $feld = $results->missing()->[0];
if( $feld =~ m/__(\w*)/ ){
my $found = $1;
$feld =~ s/__$found/ $found/g;
}
push @{$data}, { 'Error' => "Bitte überprüfen Sie das Feld $feld" };
}elsif( $results->has_invalid() ) { # get the name of 1st invalid field
# push @{$data}, { 'Error' => $results->msgs()->{ $results->invalid()->[0] } };
push @{$data}, { 'Error' => $results->msgs()->{ ($results->invalid())[0] } };
}elsif( $results->has_unknown() ){ # get 1st found unknown field
my @ref = $results->unknown();
push @{$data}, { 'Error' => "Unbekanntes Feld: " . $ref[0] };
}else{
push @{$data}, { 'Error' => 'dev: Kein Fehler!? <= back from review ' };
}
$self->param('FehlerLoop' => $data);
push @{$self->param('subst')}, 'FehlerLoop';
$self->param('Rm' => 'validate'); # add the wanted runmode to self
push @{$self->param('subst')}, 'Rm'; # to set it in the template
$self->_pushQuery2Subst($q);
#print STDERR Data::Dumper::Dumper( \%d );
# -- Ausgabe
my $t = $self->load_tmpl($self->param('FB_Form.html') || 'FB_Form.html');
my ($head, $body) = $self->_parseHeadBody( $t->output() || 'no content', 1 );
return $body;
} # showErrorForm
sub sendMail {
my $self = shift;
my $q = shift || $self->query();
my $results = Data::FormValidator->check({$q->Vars()}, $self->param('FB_dfv_profile'));
if( $results->has_missing()
or $results->has_invalid() ) {
# Fehler, redirect to showErrorForm
return $self->showErrorForm($q);
# $q->param( $self->mode_param() => 'showErrorForm' );
# $self->_redir($q->url(-relative=>1,-query=>1));
# return "redirecting to form";
}
my $fehler = 0; # negativ-Annahme, kein Fehler vorausgesetzt
my $sendText = $self->_createMailText($q);
my $sendmailProg = $self->param('sendmail') || '/usr/sbin/sendmail';
open(MAIL,"|$sendmailProg -t") or $fehler = 1;
unless( $fehler ){
print MAIL "To: ".$self->param('FeedbackEmpfaenger')."\n";
print MAIL "Subject: ".$self->param('FeedbackBetreff')."\n\n";
print MAIL "$sendText\n";
close(MAIL) or $fehler = 1;
}
if( $fehler ){
# do some error specific handling like saving the mail to webspace
return $self->showMailError($q);
# $q->param( $self->mode_param() => 'showMailError' );
# print STDERR Data::Dumper::Dumper($q->url(-relative=>1,-query=>1));
# $self->_redir($q->url(-relative=>1,-query=>1));
return 'an error occured';
}else{
# no errors occured, send the sucess-text
return $self->showMailSuccess($q);
# $q->param( $self->mode_param() => 'showMailSuccess' );
# $self->_redir($q->url(-relative=>1,-query=>1));
# return 'work done, redir to showSuccess';
}
return 'sendMail';
} #/sendMail
sub showMailError {
my $self = shift;
my $q = shift || $self->query();
$self->param('Nachricht' => $self->_decodeEntities($self->param('Nachricht')));
$self->_pushQuery2Subst($q);
$self->param( 'FehlerLoop' => [{'Error' => 'Fehler beim absenden der Nachricht' }] );
push @{$self->param('subst')}, 'FehlerLoop';
my $t = $self->load_tmpl($self->param('FB_MailSuccError.html') || 'FB_MailSuccError.html');
my ($head, $body) = $self->_parseHeadBody( $t->output() || 'no content', 1 );
return $body;
} # /showMailError
sub showMailSuccess {
my $self = shift;
$self->param('Nachricht' => $self->_decodeEntities($self->param('Nachricht')));
$self->_pushQuery2Subst($self->query());
my $t = $self->load_tmpl($self->param('FB_MailSuccError.html') || 'FB_MailSuccError.html');
my ($head, $body) = $self->_parseHeadBody( $t->output() || 'no content', 1 );
return $body;
} #/showSuccess
1;
3. ProjektXYZ.pm
package ProjektXYZ;# ---------------------------------------------------------------------------- #
# Do not change anything below until it is allowed by a notice !!!!!!!!!!!!!!! #
# ---------------------------------------------------------------------------- #
use 5.006;
use strict;
use warnings;
use Data::Dumper; # dev.
require Exporter;
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use TestModul ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.02';
# Preloaded methods go here.
# ---------------------------------------------------------------------------- #
# Change here #
# ---------------------------------------------------------------------------- #
our $data = {
TMPL_PATH => 'c:/Apache/cgi-bin/html/',
PARAMS => {
# ---- [ ] -----
'Grafik' => 'http://DOMAIN/grafiken/',
'index_template' => 'main_template.html',
# 'index_c' => 'index.html',
'subst' => [qw(FB)],
'FB' => 'feedback.cgi',
# ---- [ Feedback - Settings ] -----
# 'FB_Form.html' => 'FB_Form.html',
'FeedbackEmpfaenger' => 'mail@web.net',
'FeedbackBetreff' => 'Feedback von der Webseite',
# 'FeedbackPostfach' => 'C:/apache/cgi-bin/ehb/Postfach/Feedback',
# 'sendmail' => '/your/own/path/to/sendmail', # get it from your provider
'FB_dfv_profile' => {
# dev: go2success back rm <= unknon fields? müssen die rein?
optional => ['Firma'],
required => ['Name', 'eMail', 'Nachricht', 'rm'],
constraints => {
# name a constraint, useful for returning error messages
eMail => {
name => 'emailValid',
constraint => qr/^[\w\d][\w\d\.\-]*\@([\w\d\-]+\.)+[a-zA-Z]{2,4}$/,
},
}, # /contraints
msgs => {
# set a custom error prefix, defaults to none
prefix=> '',
# Set your own "Missing" message, defaults to "Missing"
missing => 'Fehlend!',
# Default invalid message, default's to "Invalid"
invalid => 'Ungültig!',
# message seperator for multiple messages
# Defaults to ' '
invalid_seperator => '',
# formatting string, default given above.
'format' => 'Fehler: %s',
# Error messages, keyed by constraint name
# Your constraints must be named to use this.
constraints => {
'emailValid' => 'Bitte geben Sie eine gültige eMail-Adresse ein.',
# ...
}, # /constraints
# This token will be included in the hash if there are
# any errors returned. This can be useful with templating
# systems like HTML::Template
# The 'prefix' setting does not apply here.
# defaults to undefined
any_errors => 'FehlerLoop',
}, # /msgs
}, # /dfv_profile
# ---- [ ] -----
}, # /PARAMS
};
# --------------------------------------------------------
# Konstruktor
# --------------------------------------------------------
sub new {
my $self=shift;
my $addParams = shift || {};
$self->_addParams($addParams);
my $ref = {
'data' => $data,
};
bless($ref, $self); # nicht &bless schreiben!
return $ref;
} # /new
# --------------------------------------------------------
# Methoden (private)
# --------------------------------------------------------
sub _addParams {
my $self = shift;
my $addParams = shift || {};
while( my ($key, $val) = each %{$addParams} ){
$data->{'PARAMS'}->{$key} = $val;
}
return 1;
} # /_addParams
# --------------------------------------------------------
# Methoden (public)
# --------------------------------------------------------
sub get_pdata {
my $self = shift;
return $self->{'data'};
} # /get_pdata
# --------------------------------------------------------
sub addParams {
my $self = shift;
my $addParams = shift || {};
while( my ($key, $val) = each %{$addParams} ){
$data->{'PARAMS'}->{$key} = $val;
}
return 1;
} # /_addParams
1;
4. FB_Form.html
<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Kontakt</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
<style type="text/css">
/*<
Formular an --->e-mail + http://
