| |
send mail perl
#!perl
#
# - DOCUMENT CREATED BY BACKDOOR FREESTYLE TECHNOLOGIES 11.02.00 16:27:20 - info@backdoor.ch -
#
BEGIN {
$ROOT='J:/zinggschir/v1/root';
unshift (@INC,'I:/robot/code/bft-sendmail/cgi-lib/Lib');
}
$|=1;
use strict;
use CGI qw(:standard);
use Net::SMTP;
use vars qw(@ISA $VERSION $ROOT $query $smtp %ENV);
$VERSION = "1.0";
sub Version {$VERSION;}
#+++++++++++++++++++++++++
# debug options
open (STDERR,">>stderr.txt");
#+++++++++++++++++++++++++
$query = new CGI;
#+++++++++++++++++++++++++
# get the configuration file
my $cfg_file;
my $file = join('',$ROOT,$query->param('tp') );
open (H,$file) or warn "CAN'T OPEN MAIL-TEMPLATE FILE IN: $file";
while (<H>){
next if /^#/;
$cfg_file .= $_;
}
close(H);
#+++++++++++++++++++++++++
# parse configuration's parmeters&values
my ($CNT,%CFG);
parseConfig($cfg_file,$CNT,%CFG);
#+++++++++++++++++++++++++
# control for empty fields
my @fields;
$_ = controlFields(@fields);
#+++++++++++++++++++++++++
# send mail or return error page
if ($_ eq '1') {
returnErrorPage(@fields);
} elsif ($_ eq '0') {
mailToBeSend();
} else {
warn "WRONG CONTROL VALUE: $_";
}
#+++++++++++++++++++++++++
# end of script execution
close STDERR;
exit(0);
#+++++++++++++++++++++++++
#+++++++++++++++++++++++++
# routine pour retourner une page d'erreur
# insertion de messages d'erreurs
sub returnErrorPage {
my $fields = shift;
my $tp;
my $file = join('',$ROOT,$CFG{'Redirect-error'});
open (H,$file) or warn "CAN'T OPEN MAIL-TEMPLATE FILE: $file";
while (<H>){
$tp .= $_;
}
close(H);
foreach ($query->param) {
my $v = $query->param($_);
$tp =~ s/%%$_%%/$v/g;
}
foreach (@$fields) {
$tp =~ s/%%ERR_MARK_$_%%/$CFG{'Err-mark'}/g;
}
$tp =~ s/%%ERRORMSG%%/$CFG{'Errormsg'}/g;
$tp =~ s/%%(.*?)%%//g;
print $query->header;
print $tp;
return;
}
#+++++++++++++++++++++++++
sub mailToBeSend {
foreach ($query->param) {
my $v = $query->param($_);
$CNT =~ s/_[$_]_/_$v_/g;
}
my $host = $CFG{'SMTP-host'};
my $From = $CFG{From};
my $To = $CFG{To};
smtpSendmail($host,$From,$To,$CNT);
my $redirect = $CFG{'Redirect-success'};
$_ = 'http://'.$ENV{'HTTP_HOST'}.$redirect;
print $query->redirect($_);
return;
}
#+++++++++++++++++++++++++
sub smtpSendmail {
my ($host,$From,$To,$cnt) = @_;
$smtp = Net::SMTP->new("$host",
Hello=> "$host",
Timeout=>'30',
Debug=>'1');
$smtp->mail($From);
$smtp->to($To);
$smtp->data();
$smtp->datasend($$cnt);
$smtp->dataend();
$smtp->quit;
return;
}
#+++++++++++++++++++++++++
#
sub parseConfig {
my ($tp,$cnt,$cfg) = @_;
foreach ( split (/,/,$query->param('use') ) ){
if(/^BFT-CNT/){
($$cnt=$$tp )=~ s/(.*)<$_>(.*?)</BFT-CNT>(.*)/$2/gsm;
} elsif(/^BFT-CFG/){
$$tp =~ m/(.*?)<$_>(.*?)</BFT-CFG>(.*?)/gsm;
foreach ( split (/n/,$2) ) {
/^(.*?)="(.*)"$/;
$$cfg{$1}=$2;
}
}
}
return;
}
#+++++++++++++++++++++++++
sub controlFields {
my $fields = shift;
my $e = 0;
foreach ( split (/,/,$CFG{'Required'}) ){
next if ($query->param($_));
push @$fields,$_;
$e = 1;
}
return $e;
}
1;
__END__
=pod
=head1 NAME
bft-sendmail.cgi
=head1 SYNOPSIS
use File::XXX; (...)
=head1 DESCRIPTION
=head1 EXAMPLES
=head1 SEE ALSO
siteEngine documentation
=head1 BUGS
This section intentionally left blank.
=head1 HISTORY
=head1 DISCUSSION
=head1 AUTHOR
This code can be used and modified freely,
We do request that this copyright notice remain attached to the file.
You may modify this module as you wish.
If you redistribute a modified version, please attach a note listing the modifications you have made.
Address bug reports and comments to info@backdoor.ch
freeCopyright 1999, backdoor freestyle technologies
=cut
#
# - DOCUMENT CREATED BY BACKDOOR FREESTYLE TECHNOLOGIES - info@backdoor.ch -
#
1
|