view release on metacpan or  search on metacpan

lib/Test/Reporter/Transport/Net/SMTP/Authen.pm  view on Meta::CPAN

use strict;
use warnings;
package Test::Reporter::Transport::Net::SMTP::Authen;
use base 'Test::Reporter::Transport::Net::SMTP';
use vars qw/$VERSION/;
$VERSION = '1.02';
$VERSION = eval $VERSION;
use Exporter 'import';
our @EXPORT_OK=qw(install);

sub install($$$){
    my ($smtp, $user, $password) = @_;
    if ( @_ != 3){
	croak( "Usage: install(\$smtp_server, \$user, \$password)" );
    };	
    unless( $ENV{PERL_CPAN_REPORTER_DIR} ||  $ENV{HOME} ){
	require Carp;
	croak( "Please define your enviroment variable PERL_CPAN_REPORTER_DIR or HOME" );
    }
    my $reporter_folder = $ENV{PERL_CPAN_REPORTER_DIR} ||= $ENV{HOME} . '/.cpanreporter';
    require File::Path;
    require Carp;
    File::Path->import('mkpath');
    mkpath( $reporter_folder );
    open my $fh , '>', $reporter_folder .'/config.ini' or Carp::croak( "Can't write config.ini in $reporter_folder $!");
    $a = select ($fh);
    print "edit_report=no\n";
    print "email_from=$user\n";
    print "send_report=yes\n";
    print "smtp_server=$smtp\n";
    print "transport=Net::SMTP::Authen User $user Password $password\n";
    close $fh or Carp::croak ("Can't finish write $reporter_folder/config.ini $!");
    select $a;
    print STDERR "Writen $reporter_folder/config.ini .\n\tType cpan <CR>\n";
    print STDERR 	"\to conf test_report 1\n";
    print STDERR 	"\to conf commit\n";
}

sub new {
    my ($class, @args) = @_;
    bless { args => \@args } => $class;
}

sub _net_class {
    my ($self) = @_;
    my $class = ref $self ? ref $self : $self;
    my ($net_class) = ($class =~ /^Test::Reporter::Transport::(.+)\z/);
	return 'Net::SMTP' if $net_class eq 'Net::SMTP::Authen';
    return $net_class;
}

sub _perform_auth{
    my $self = shift;
    my $transport = shift;
    my $args = $$self{args};
    my %opts = ( @$args );
    
    my ($user_name) = $opts{'User'} || $opts{'Username'};
    my ($password) = $opts{'Password'} || $opts{'Pass'};
    die "No user_name" unless $user_name;
    return 1 if ($self->_net_class() eq 'Net::SMTP::TLS');
    return $transport->auth($user_name, $password);		
}


sub send {
    my ($self, $report, $recipients) = @_;
    $recipients ||= [];

    my $helo          = $report->_maildomain(); # XXX: tight -- rjbs, 2008-04-06
    my $from          = $report->from();
    my $via           = $report->via();
    my @tmprecipients = ();
    my @bad           = ();
    my $smtp;

    my $mx;

    my $transport = $self->_net_class;

    # Sorry.  Tight coupling happened before I got here. -- rjbs, 2008-04-06
    for my $server (@{$report->{_mx}}) {
        eval {
            $smtp = $transport->new(
                $server,
                Hello   => $helo,
                Timeout => $report->timeout(),
                Debug   => $report->debug(),
                $report->transport_args(),
            );
        };

        if (defined $smtp) {
            $mx = $server;
            last;
        }
    }

    die "Unable to connect to any MX's: $@" unless $mx && $smtp;

    my $cc_str;