| Net-DRI documentation | Contained in the Net-DRI distribution. |
Net::DRI::Transport::SMTP - SMTP transport for Net::DRI
The following options are available at creation:
For now, support questions should be sent to:
<netdri@dotandco.com>
Please also see the SUPPORT file in the distribution.
http://www.dotandco.com/services/software/Net-DRI/
Patrick Mevzek, <netdri@dotandco.com>
Copyright (c) 2006,2007,2009 Patrick Mevzek <netdri@dotandco.com>. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
See the LICENSE file that comes with this distribution for more details.
| Net-DRI documentation | Contained in the Net-DRI distribution. |
## Domain Registry Interface, SMTP Transport ## ## Copyright (c) 2006,2007,2009 Patrick Mevzek <netdri@dotandco.com>. All rights reserved. ## ## This file is part of Net::DRI ## ## Net::DRI is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2 of the License, or ## (at your option) any later version. ## ## See the LICENSE file that comes with this distribution for more details. # # # #################################################################################################### package Net::DRI::Transport::SMTP; use strict; use warnings; use base qw/Net::DRI::Transport/; ## we are a subclass use Net::SMTP; use Email::Valid; use Net::DRI::Exception; our $VERSION=do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); };
#################################################################################################### sub new { my ($class,$ctx,$rp)=@_; my %opts=%$rp; my $self=$class->SUPER::new($ctx,\%opts); ## We are now officially a Net::DRI::Transport instance $self->has_state(0); ## We could be stateful by keeping a live connection to the SMTP host. But it would be useful only for high volumes $self->is_sync(0); $self->name('smtp'); $self->version('0.1'); $self->current_state(0); ## Now deal with specifics for this transport my %t; $t{smtphost}=exists($opts{smtphost})? $opts{smtphost} : 'localhost'; $t{cc}=$opts{cc} if (exists($opts{cc}) && Email::Valid->rfc822($opts{cc})); ## Will be added as Cc: to all messages $t{bcc}=$opts{bcc} if (exists($opts{bcc}) && Email::Valid->rfc822($opts{bcc})); ## Ditto as Bcc: $self->{transport}=\%t; ## Bless again, but now in this package bless($self,$class); return $self; } #################################################################################################### sub end { } sub send { my ($self,$ctx,$tosend)=@_; $self->SUPER::send($ctx,$tosend,\&_send,undef); } sub _send { my ($self,$count,$tosend)=@_; my $rt=$self->{transport}; my $mime=$tosend->as_mime(); my $head=$mime->head(); $head->add('Cc',$rt->{cc}) if exists($rt->{cc}); $head->add('Bcc',$rt->{bcc}) if exists($rt->{bcc}); my %rcpts=map { $_ => 1 } map { $head->get_all($_) } ('To','Cc','Bcc'); $head->delete('Bcc'); my $smtp=Net::SMTP->new($rt->{smtphost}); my $ok=$smtp->mail($head->get('From'),Bits=>8) && $smtp->to(keys(%rcpts)) && $smtp->data($mime->stringify()) && $smtp->quit(); Net::DRI::Exception->die(0,'transport/socket',4,'Unable to send message') unless $ok; return 1; } sub receive { my ($self,$ctx,$count)=@_; } #################################################################################################### 1;