Ver Mensaje Individual
  #1 (permalink)  
Antiguo 02/01/2008, 15:12
teamvipconnectz
 
Fecha de Ingreso: enero-2008
Mensajes: 3
Antigüedad: 17 años, 1 mes
Puntos: 0
AYUDA, envio de emails con PERL

Normalemnte 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 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&iacute; 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:
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;
}
No soy bueno programando en PERL, ¿alguien me puede ayudar con esto?