view release on metacpan or  search on metacpan

lib/AnyEvent/SMTP/Client.pm  view on Meta::CPAN

package AnyEvent::SMTP::Client;

=head1 NAME

AnyEvent::SMTP::Client - Simple asyncronous SMTP Client

=cut

use AnyEvent;
use common::sense;
m{# trying to cheat with cpants game ;)
use strict;
use warnings;
}x;

use base 'Object::Event';

use AnyEvent::Handle;
use AnyEvent::Socket;
use AnyEvent::DNS;
use AnyEvent::Util;

use Sys::Hostname;
use Mail::Address;

use AnyEvent::SMTP::Conn;

our $VERSION = $AnyEvent::SMTP::VERSION;use AnyEvent::SMTP ();

# vvv This code was partly derived from AnyEvent::HTTP vvv
our $MAXCON = 10; # Maximum number of connections to any host
our %MAXCON;      # Maximum number of connections to concrete host
our $ACTIVE = 0;  # Currently active connections
our %ACTIVE;
my %CO_SLOT;      # number of open connections, and wait queue, per host

sub _slot_schedule;
sub _slot_schedule($) {
	my $host = shift;
	my $mc = exists $MAXCON{$host} ? $MAXCON{$host} : $MAXCON;
	while (!$mc or ( $mc > 0 and $CO_SLOT{$host}[0] < $mc )) {
		if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
			# somebody wants that slot
			++$CO_SLOT{$host}[0];
			++$ACTIVE;
			++$ACTIVE{$host};
			$cb->(AnyEvent::Util::guard {
				--$ACTIVE;
				--$ACTIVE{$host} > 0 or delete $ACTIVE{$host};
				--$CO_SLOT{$host}[0];
				#warn "Release slot (have $ACTIVE) by @{[ (caller)[1,2] ]}\n";
				_slot_schedule $host;
			});
		} else {
			# nobody wants the slot, maybe we can forget about it
			delete $CO_SLOT{$host} unless $CO_SLOT{$host}[0];
			last;
		}
	}
}

# wait for a free slot on host, call callback
sub _get_slot($$) {
	push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
	_slot_schedule $_[0];
}

sub _tcp_connect($$$;$) {
	my ($host,$port,$cb,$pr) = @_;
	#warn "Need slot $host (have $ACTIVE)";
	_get_slot $host, sub {
		my $sg = shift;
		#warn "Have slot $host (have $ACTIVE)";
		tcp_connect($host,$port,sub {
			$cb->(@_,$sg);
		}, $pr);
	}
}
# ^^^ This code was partly derived from AnyEvent::HTTP ^^^



=head1 SYNOPSIS

    use AnyEvent::SMTP::Client 'sendmail';
    
    sendmail
        from => 'mons@cpan.org',
        to   => 'mons@cpan.org', # SMTP host will be detected from addres by MX record
        data => 'Test message '.time().' '.$$,
        cb   => sub {
            if (my $ok = shift) {
                warn "Successfully sent";
            }
            if (my $err = shift) {
                warn "Failed to send: $err";
            }
        }
    ;

=head1 DESCRIPTION

Asyncronously connect to SMTP server, resolve MX, if needed, then send HELO => MAIL => RCPT => DATA => QUIT and return responce

=head1 FUNCTIONS

=head2 sendmail ... , cb => $cb->(OK,ERR)

Argument names are case insensitive. So, it may be calles as

    sendmail From => ..., To => ..., ...