home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / Mail / Mailer / smtp.pm < prev    next >
Encoding:
Text File  |  2008-07-29  |  1.9 KB  |  104 lines
  1. # Copyrights 1995-2008 by Mark Overmeer <perl@overmeer.net>.
  2. #  For other contributors see ChangeLog.
  3. # See the manual pages for details on the licensing terms.
  4. # Pod stripped from pm file by OODoc 1.05.
  5. use strict;
  6.  
  7. package Mail::Mailer::smtp;
  8. use vars '$VERSION';
  9. $VERSION = '2.04';
  10.  
  11. use base 'Mail::Mailer::rfc822';
  12.  
  13. use Net::SMTP;
  14. use Mail::Util qw(mailaddress);
  15. use Carp;
  16.  
  17. sub can_cc { 0 }
  18.  
  19. sub exec {
  20.     my ($self, $exe, $args, $to) = @_;
  21.     my %opt   = @$args;
  22.     my $host  = $opt{Server} || undef;
  23.     $opt{Debug} ||= 0;
  24.  
  25.     # for Net::SMTP we do not really exec
  26.     my $smtp = Net::SMTP->new($host, %opt)
  27.     or return undef;
  28.  
  29.     if($opt{Auth})
  30.     {   $smtp->auth(@{$opt{Auth}})
  31.            or return undef;
  32.     }
  33.  
  34.     ${*$self}{sock} = $smtp;
  35.  
  36.     $smtp->mail(mailaddress);
  37.     $smtp->to($_) for @$to;
  38.     $smtp->data;
  39.  
  40.     untie *$self if tied *$self;
  41.     tie *$self, 'Mail::Mailer::smtp::pipe', $self;
  42.     $self;
  43. }
  44.  
  45. sub set_headers($)
  46. {   my ($self, $hdrs) = @_;
  47.     $self->SUPER::set_headers
  48.      ( { From => "<" . mailaddress() . ">"
  49.        , %$hdrs
  50.        , 'X-Mailer' => "Mail::Mailer[v$Mail::Mailer::VERSION] Net::SMTP[v$Net::SMTP::VERSION]"
  51.        }
  52.      );
  53. }
  54.  
  55. sub epilogue()
  56. {   my $self = shift;
  57.     my $sock = ${*$self}{sock};
  58.  
  59.     $sock->dataend;
  60.     $sock->quit;
  61.  
  62.     delete ${*$self}{sock};
  63.     untie *$self;
  64. }
  65.  
  66. sub close(@)
  67. {   my ($self, @to) = @_;
  68.     my $sock = ${*$self}{sock};
  69.  
  70.     $sock && fileno $sock
  71.         or return 1;
  72.  
  73.     $self->epilogue;
  74.  
  75.     # Epilogue should destroy the SMTP filehandle,
  76.     # but just to be on the safe side.
  77.     $sock && fileno $sock
  78.         or return 1;
  79.  
  80.     close $sock
  81.         or croak 'Cannot destroy socket filehandle';
  82.  
  83.     1;
  84. }
  85.  
  86. package Mail::Mailer::smtp::pipe;
  87. use vars '$VERSION';
  88. $VERSION = '2.04';
  89.  
  90.  
  91. sub TIEHANDLE
  92. {   my ($class, $self) = @_;
  93.     my $sock = ${*$self}{sock};
  94.     bless \$sock, $class;
  95. }
  96.  
  97. sub PRINT
  98. {   my $self = shift;
  99.     my $sock = $$self;
  100.     $sock->datasend( @_ );
  101. }
  102.  
  103. 1;
  104.