El codigo que estoy manejando es el siguiente:
Código:
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;
}
He encontrado esta funcion para hacer el envio mediante Net::SMTP pero no se como adaptarlo al codigo anterior para poder enviar mails desde mi proveedor de email hosting o SMTP externo. SI ALGUIEN PUEDE AYUDARME, SE LO AGRADECERÉ.
Código:
No soy bueno programando en PERL, ¿alguien me puede ayudar con esto? 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;
}
