Envío de emails con Perl
Publicado: 2008-01-02 20:41 @903Normalmente al enviar un email desde un CGI se utiliza el /usr/bin/sendmail que es siempre referenciado al servidor local. Pero yo quiero utilizar un servidor SMTP externo para esta tarea.
El código que estoy manejando es el siguiente:
He encontrado esta función para hacer el envio mediante Net::SMTP pero no sé cómo adaptarlo al código anterior para poder enviar mails desde mi proveedor de email hosting o SMTP externo. SI ALGUIEN PUEDE AYUDARME, SE LO AGRADECERÉ.
No soy bueno programando en Perl, ¿alguien me puede ayudar con esto?
Espero haber publicado este mensaje en el lugar indicado, sino es así ofrezco una disculpa.
El código que estoy manejando es el siguiente:
Using perl Syntax Highlighting
sub sendmail {
my ( $mday, $mon, $year ) = ltime();
my ( $to, $subject, $message, $path, $name, $idx, $username, $html_flag ) =
@_;
my ($email) = $to;
#$username =~ /^\s*([a-zA-ZáéíóúÁÉÍÓÚ\S]{1,20})\s*([a-zA-ZáéíóúÁÉÍÓÚ\S]{0,20}).*$/;
$username =~ /^\s*([a-zA-ZáéíóúÁÉÍÓÚüÜ\S]*)\s*([a-zA-ZáéíóúÁÉÍÓÚüÜ\S]*).*$/;
$secname = $2;
$secname =~ tr/A-Z/a-z/;
$secname =~ tr/ÁÉÍÓÚ/áéíóú/;
$secname = "\u$secname";
$username = $1;
$username =~ tr/A-Z/a-z/;
$username =~ tr/ÁÉÍÓÚ/áéíóú/;
$username = "\u$username";
my ( $fromars, $namears, $unlink ) = ( getarlist("$path/$path.cfg") );
$fromaddr = "$namears<$fromars>";
if ( $unlink == 1 && $html_flag == 1 ) {
$unlink =
"\r\n\r\n <br><p><a href='"
. $scripturl
. "?mode=r&a="
. $path . "&e="
. $to
. "'>Click Aquí para "
. "dejar de recibir mensajes</a></p>\n";
}
elsif ( $unlink == 1 && $html_flag == 0 ) {
$unlink =
"\r\nClick en el link para dejar de recibir "
. "mensajes:\r\n"
. $scripturl
. "?mode=r&a="
. $path . "&e="
. $to;
}
$to =~ s/@/\@/;
if ( $secname ne "" ) { $secname = " " . $secname }
if ( open( IN, "$path/users.txt" ) ) {
while (<IN>) {
~/^(.+)\|(.+)\|(.+)\|(.+)\|(.+)\|(.+)\|(.+)\|(.+)\|(.+)/;
chomp($_);
if ( $to eq $2 ) {
$ip = $5;
$adminname = $6;
$adminmail = $7;
$adminid = $8;
$adminsub = $9;
}
}
}
close(IN);
$to = '"' . $username . $secname . '" <' . $to . ">";
$name =~ /.*\.(.*)/;
my ($real) = "upfile" . $idx . "." . $1;
$path = $path . "/" . $real;
my ($current) = $mday . "/" . $mon . "/" . $year;
#if($fromaddr !~ m/^\"/){
# $formaddr = '"' . $formaddr . '"';
#}
# Parse the DATEXY where Y is an int (days in the future) ABA
while ( $message =~ m/\[DATEX(\d+)\]/i ) {
my $dayTmp = $1;
my @tmpDate = ltime($dayTmp);
my $thisdate = $tmpDate[0] . "/" . $tmpDate[1] . "/" . $tmpDate[2];
$message =~ s/\[DATEX(\d+)?\]/$thisdate/i;
# this is just a debug
## print STDERR "futuredate: $thisdate\n";
}
while ( $subject =~ m/\[DATEX(\d+)\]/i ) {
my $dayTmp = $1;
my @tmpDate = ltime($dayTmp);
my $thisdate = $tmpDate[0] . "/" . $tmpDate[1] . "/" . $tmpDate[2];
$subject =~ s/\[DATEX(\d+)\]/$thisdate/i;
}
$message =~ s/\[FIRSTNAME\]/$username/gie;
$message =~ s/\[EMAIL\]/$email/gie;
$message =~ s/\[DATE\]/$current/gie; # ABA
$message =~ s/\[FULLNAME\]/$username.$secname/gie;
$message =~ s/\[IP\]/$ip/gie;
$message =~ s/\[ADMINNAME\]/$adminname/gie;
$message =~ s/\[ADMINMAIL\]/$adminmail/gie;
$message =~ s/\[ADMINID\]/$adminid/gie;
$message =~ s/\[ADMINSUB\]/$adminsub/gie;
$message .= "\n\n$unlink\n\n";
$subject =~ s/\[FIRSTNAME\]/$username/gie;
$subject =~ s/\[EMAIL\]/$email/gie;
$subject =~ s/\[DATE\]/$current/gie;
$subject =~ s/\[FULLNAME\]/$username.$secname/gie;
$subject =~ s/\[IP\]/$ip/gie;
$subject =~ s/\[ADMINNAME\]/$adminname/gie;
$subject =~ s/\[ADMINMAIL\]/$adminmail/gie;
$subject =~ s/\[ADMINID\]/$adminid/gie;
$subject =~ s/\[ADMINSUB\]/$adminsub/gie;
my ($mime) = &mimeformat($name);
my $typeHelper = "";
if ( $html_flag eq "1" ) {
$send_type = "text/html";
$typeHelper = "Content-Type: text/html; charset=ISO-8859-15";
}
else {
$send_type = "TEXT";
$typeHelper = "Content-Type: text/plain; charset=ISO-8859-15";
}
require ParseSpecial;
# Here I fix the addresses
$fromaddr = FixAddr($fromaddr);
$to = FixAddr($to);
print STDERR "-------------------\n";
print STDERR "FROMADDR" . ParseSpecial(FixAddr($fromaddr)) . "\n";
print STDERR "-------------------\n";
my $msg = MIME::Lite->new(
Type => 'multipart/mixed' ,
From => ParseSpecial(FixAddr($fromaddr)),
To => ParseSpecial($to) ,
Content-Type => $typeHelper ,
Subject => ParseSpecial($subject) ,
Type => $send_type,
Encoding => "quoted-printable",
Data => $message
);
$msg->attr( "content-type.charset" => "ISO-8859-15" );
#$msg->build(Subject => ParseSpecial($subject) ,
# Data => $message ,
# From => ParseSpecial($fromaddr),
# To => ParseSpecial($to) ,
# Encoding => "quoted-printable" ,
# Content-Type => $typeHelper ,
# #Type => 'multipart/mixed'
# );
## print STDERR "Pasé por acá ABACO\n"; # debug
if ( $name ne "" ) {
$msg->attach(
Type => $mime->[0],
Encoding => $mime->[1],
Filename => $name,
Path => $path,
);
$msg->attr( "content-type.charset" => "ISO-8859-15" );
## print STDERR "Pasé por aquí ABA934\n"; # debug
}
MIME::Lite->send( 'sendmail', $mailprog );
$msg->send;
}
my ( $mday, $mon, $year ) = ltime();
my ( $to, $subject, $message, $path, $name, $idx, $username, $html_flag ) =
@_;
my ($email) = $to;
#$username =~ /^\s*([a-zA-ZáéíóúÁÉÍÓÚ\S]{1,20})\s*([a-zA-ZáéíóúÁÉÍÓÚ\S]{0,20}).*$/;
$username =~ /^\s*([a-zA-ZáéíóúÁÉÍÓÚüÜ\S]*)\s*([a-zA-ZáéíóúÁÉÍÓÚüÜ\S]*).*$/;
$secname = $2;
$secname =~ tr/A-Z/a-z/;
$secname =~ tr/ÁÉÍÓÚ/áéíóú/;
$secname = "\u$secname";
$username = $1;
$username =~ tr/A-Z/a-z/;
$username =~ tr/ÁÉÍÓÚ/áéíóú/;
$username = "\u$username";
my ( $fromars, $namears, $unlink ) = ( getarlist("$path/$path.cfg") );
$fromaddr = "$namears<$fromars>";
if ( $unlink == 1 && $html_flag == 1 ) {
$unlink =
"\r\n\r\n <br><p><a href='"
. $scripturl
. "?mode=r&a="
. $path . "&e="
. $to
. "'>Click Aquí para "
. "dejar de recibir mensajes</a></p>\n";
}
elsif ( $unlink == 1 && $html_flag == 0 ) {
$unlink =
"\r\nClick en el link para dejar de recibir "
. "mensajes:\r\n"
. $scripturl
. "?mode=r&a="
. $path . "&e="
. $to;
}
$to =~ s/@/\@/;
if ( $secname ne "" ) { $secname = " " . $secname }
if ( open( IN, "$path/users.txt" ) ) {
while (<IN>) {
~/^(.+)\|(.+)\|(.+)\|(.+)\|(.+)\|(.+)\|(.+)\|(.+)\|(.+)/;
chomp($_);
if ( $to eq $2 ) {
$ip = $5;
$adminname = $6;
$adminmail = $7;
$adminid = $8;
$adminsub = $9;
}
}
}
close(IN);
$to = '"' . $username . $secname . '" <' . $to . ">";
$name =~ /.*\.(.*)/;
my ($real) = "upfile" . $idx . "." . $1;
$path = $path . "/" . $real;
my ($current) = $mday . "/" . $mon . "/" . $year;
#if($fromaddr !~ m/^\"/){
# $formaddr = '"' . $formaddr . '"';
#}
# Parse the DATEXY where Y is an int (days in the future) ABA
while ( $message =~ m/\[DATEX(\d+)\]/i ) {
my $dayTmp = $1;
my @tmpDate = ltime($dayTmp);
my $thisdate = $tmpDate[0] . "/" . $tmpDate[1] . "/" . $tmpDate[2];
$message =~ s/\[DATEX(\d+)?\]/$thisdate/i;
# this is just a debug
## print STDERR "futuredate: $thisdate\n";
}
while ( $subject =~ m/\[DATEX(\d+)\]/i ) {
my $dayTmp = $1;
my @tmpDate = ltime($dayTmp);
my $thisdate = $tmpDate[0] . "/" . $tmpDate[1] . "/" . $tmpDate[2];
$subject =~ s/\[DATEX(\d+)\]/$thisdate/i;
}
$message =~ s/\[FIRSTNAME\]/$username/gie;
$message =~ s/\[EMAIL\]/$email/gie;
$message =~ s/\[DATE\]/$current/gie; # ABA
$message =~ s/\[FULLNAME\]/$username.$secname/gie;
$message =~ s/\[IP\]/$ip/gie;
$message =~ s/\[ADMINNAME\]/$adminname/gie;
$message =~ s/\[ADMINMAIL\]/$adminmail/gie;
$message =~ s/\[ADMINID\]/$adminid/gie;
$message =~ s/\[ADMINSUB\]/$adminsub/gie;
$message .= "\n\n$unlink\n\n";
$subject =~ s/\[FIRSTNAME\]/$username/gie;
$subject =~ s/\[EMAIL\]/$email/gie;
$subject =~ s/\[DATE\]/$current/gie;
$subject =~ s/\[FULLNAME\]/$username.$secname/gie;
$subject =~ s/\[IP\]/$ip/gie;
$subject =~ s/\[ADMINNAME\]/$adminname/gie;
$subject =~ s/\[ADMINMAIL\]/$adminmail/gie;
$subject =~ s/\[ADMINID\]/$adminid/gie;
$subject =~ s/\[ADMINSUB\]/$adminsub/gie;
my ($mime) = &mimeformat($name);
my $typeHelper = "";
if ( $html_flag eq "1" ) {
$send_type = "text/html";
$typeHelper = "Content-Type: text/html; charset=ISO-8859-15";
}
else {
$send_type = "TEXT";
$typeHelper = "Content-Type: text/plain; charset=ISO-8859-15";
}
require ParseSpecial;
# Here I fix the addresses
$fromaddr = FixAddr($fromaddr);
$to = FixAddr($to);
print STDERR "-------------------\n";
print STDERR "FROMADDR" . ParseSpecial(FixAddr($fromaddr)) . "\n";
print STDERR "-------------------\n";
my $msg = MIME::Lite->new(
Type => 'multipart/mixed' ,
From => ParseSpecial(FixAddr($fromaddr)),
To => ParseSpecial($to) ,
Content-Type => $typeHelper ,
Subject => ParseSpecial($subject) ,
Type => $send_type,
Encoding => "quoted-printable",
Data => $message
);
$msg->attr( "content-type.charset" => "ISO-8859-15" );
#$msg->build(Subject => ParseSpecial($subject) ,
# Data => $message ,
# From => ParseSpecial($fromaddr),
# To => ParseSpecial($to) ,
# Encoding => "quoted-printable" ,
# Content-Type => $typeHelper ,
# #Type => 'multipart/mixed'
# );
## print STDERR "Pasé por acá ABACO\n"; # debug
if ( $name ne "" ) {
$msg->attach(
Type => $mime->[0],
Encoding => $mime->[1],
Filename => $name,
Path => $path,
);
$msg->attr( "content-type.charset" => "ISO-8859-15" );
## print STDERR "Pasé por aquí ABA934\n"; # debug
}
MIME::Lite->send( 'sendmail', $mailprog );
$msg->send;
}
Coloreado en 0.006 segundos, usando GeSHi 1.0.8.4
He encontrado esta función para hacer el envio mediante Net::SMTP pero no sé cómo adaptarlo al código anterior para poder enviar mails desde mi proveedor de email hosting o SMTP externo. SI ALGUIEN PUEDE AYUDARME, SE LO AGRADECERÉ.
Using perl Syntax Highlighting
=pod
Send message via SMTP, using Net::SMTP.
The optional ARGS are sent into Net::SMTP::new(): usually, these are
MAILHOST, OPTION=>VALUE, ...
Note that the list of recipients is taken from the
"To", "Cc" and "Bcc" fields.
Returns true on success, false or exception on error.
=cut
### Provided by Andrew McRae. Version 0.2 anm 09Sep97
### Copyright 1997 Optimation New Zealand Ltd.
### May be modified/redistributed under the same terms as Perl.
#
sub send_by_smtp {
my ($self, @args) = @_;
### We need the "From:" and "To:" headers to pass to the SMTP mailer:
my $hdr = $self->fields();
my $from = $self->get('From');
my $to = $self->get('To');
### Sanity check:
defined($to) or croak "send_by_smtp: missing 'To:' address\n";
### Get the destinations as a simple array of addresses:
my @to_all = extract_addrs($to);
if ($AUTO_CC) {
foreach my $field (qw(Cc Bcc)) {
my $value = $self->get($field);
push @to_all, extract_addrs($value) if defined($value);
}
}
### Create SMTP client:
require Net::SMTP;
my $smtp = MIME::Lite::SMTP->new(@args)
or croak "Failed to connect to mail server: $!\n";
$smtp->mail($from)
or croak "SMTP MAIL command failed: $!\n";
$smtp->to(@to_all)
or croak "SMTP RCPT command failed: $!\n";
$smtp->data()
or croak "SMTP DATA command failed: $!\n";
### MIME::Lite can print() to anything with a print() method:
$self->print_for_smtp($smtp);
$smtp->dataend();
$smtp->quit;
1;
}
Send message via SMTP, using Net::SMTP.
The optional ARGS are sent into Net::SMTP::new(): usually, these are
MAILHOST, OPTION=>VALUE, ...
Note that the list of recipients is taken from the
"To", "Cc" and "Bcc" fields.
Returns true on success, false or exception on error.
=cut
### Provided by Andrew McRae. Version 0.2 anm 09Sep97
### Copyright 1997 Optimation New Zealand Ltd.
### May be modified/redistributed under the same terms as Perl.
#
sub send_by_smtp {
my ($self, @args) = @_;
### We need the "From:" and "To:" headers to pass to the SMTP mailer:
my $hdr = $self->fields();
my $from = $self->get('From');
my $to = $self->get('To');
### Sanity check:
defined($to) or croak "send_by_smtp: missing 'To:' address\n";
### Get the destinations as a simple array of addresses:
my @to_all = extract_addrs($to);
if ($AUTO_CC) {
foreach my $field (qw(Cc Bcc)) {
my $value = $self->get($field);
push @to_all, extract_addrs($value) if defined($value);
}
}
### Create SMTP client:
require Net::SMTP;
my $smtp = MIME::Lite::SMTP->new(@args)
or croak "Failed to connect to mail server: $!\n";
$smtp->mail($from)
or croak "SMTP MAIL command failed: $!\n";
$smtp->to(@to_all)
or croak "SMTP RCPT command failed: $!\n";
$smtp->data()
or croak "SMTP DATA command failed: $!\n";
### MIME::Lite can print() to anything with a print() method:
$self->print_for_smtp($smtp);
$smtp->dataend();
$smtp->quit;
1;
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
No soy bueno programando en Perl, ¿alguien me puede ayudar con esto?
Espero haber publicado este mensaje en el lugar indicado, sino es así ofrezco una disculpa.