home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / smtp.pm < prev    next >
Encoding:
Perl POD Document  |  2002-05-23  |  1.7 KB  |  85 lines
  1. package Mail::Mailer::smtp;
  2. use vars qw(@ISA);
  3. use Net::SMTP;
  4. use Mail::Util qw(mailaddress);
  5. use Carp;
  6.  
  7. require Mail::Mailer::rfc822;
  8. @ISA = qw(Mail::Mailer::rfc822);
  9.  
  10. sub can_cc { 0 }
  11.  
  12. sub exec {
  13.     my($self, $exe, $args, $to) = @_;
  14.     my %opt   = @$args;
  15.     my $host  = $opt{Server} || undef;
  16.     $opt{Debug} ||= 0;
  17.  
  18.     # for Net::SMTP we do not really exec
  19.     my $smtp = Net::SMTP->new($host, %opt)
  20.     or return undef;
  21.  
  22.     ${*$self}{'sock'} = $smtp;
  23.  
  24.     $smtp->mail(mailaddress());
  25.     my $u;
  26.     foreach $u (@$to) {
  27.     $smtp->to($u);
  28.     }
  29.     $smtp->data;
  30.     untie(*$self) if tied *$self;
  31.     tie *$self, 'Mail::Mailer::smtp::pipe',$self;
  32.     $self;
  33. }
  34.  
  35. sub set_headers {
  36.     my($self,$hdrs) = @_;
  37.     $self->SUPER::set_headers({
  38.     From => "<" . mailaddress() . ">",
  39.     %$hdrs,
  40.     'X-Mailer' => "Mail::Mailer[v$Mail::Mailer::VERSION] Net::SMTP[v$Net::SMTP::VERSION]"
  41.     })
  42. }
  43.  
  44. sub epilogue {
  45.     my $self = shift;
  46.     my $sock = ${*$self}{'sock'};
  47.     $sock->dataend;
  48.     $sock->quit;
  49.     delete ${*$self}{'sock'};
  50.     untie(*$self);
  51. }
  52.  
  53. sub close {
  54.     my($self, @to) = @_;
  55.     my $sock = ${*$self}{'sock'};
  56.     if ($sock && fileno($sock)) {
  57.         $self->epilogue;
  58.         # Epilogue should destroy the SMTP filehandle,
  59.         # but just to be on the safe side.
  60.         if ($sock && fileno($sock)) {
  61.             close $sock
  62.                 or croak 'Cannot destroy socket filehandle';
  63.         }
  64.     }
  65.     1;
  66. }
  67.  
  68. package Mail::Mailer::smtp::pipe;
  69.  
  70. sub TIEHANDLE {
  71.     my $pkg = shift;
  72.     my $self = shift;
  73.     my $sock = ${*$self}{'sock'};
  74.     return bless \$sock;
  75. }
  76.  
  77. sub PRINT {
  78.     my $self = shift;
  79.     my $sock = $$self;
  80.     $sock->datasend( @_ );
  81. }
  82.  
  83.  
  84. 1;
  85.