sender.pm

这个社区是虚拟社区使用的程序

# Mail::Sender.pm version 0.6.7
#
# Copyright (c) 1997 Jan Krynicky <[e-mail]>. All rights reserved.      
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Mail::Sender;
require Exporter;
@ISA = (Exporter);
@EXPORT = qw();   #&new);
@EXPORT_OK = qw(@error_str);

$Mail::Sender::VERSION='0.6.7';
$Mail::Sender::ver=$Mail::Sender::VERSION;

use strict 'vars';
use FileHandle;
use Socket;
use File::Basename;

#use MIME::Base64;
#use MIME::QuotedPrint;
                    # if you do not use MailFile or SendFile you may
                    # comment out these lines.
                    #MIME::Base64 and MIME::QuotedPrint may be found at CPAN.
my $chunksize=1024*3;

#internals

sub HOSTNOTFOUND {
 $!=2;
 $Mail::Sender::Error="The SMTP server $_[0] was not found.";
 return -1;
}

sub SOCKFAILED {
 $!=5;
 $Mail::Sender::Error='socket() failed';
 return -2;
}

sub CONNFAILED {
 $!=5;
 $Mail::Sender::Error='connect() failed';
 return -3;
}

sub SERVNOTAVAIL {
 $!=40;
 $Mail::Sender::Error='Service not available';
 return -4;
}

sub COMMERROR {
 $!=5;
 $Mail::Sender::Error='Unspecified communication error';
 return -5;
}

sub USERUNKNOWN {
 $!=2;
 $Mail::Sender::Error="Local user \"$_[0]\" unknown on host \"$_[1]\"";
 return -6;
}

sub TRANSFAILED {
 $!=5;
 $Mail::Sender::Error='Transmission of message failed';
 return -7;
}

sub TOEMPTY {
 $!=14;
 $Mail::Sender::Error="Argument \$to empty";
 return -8;
}

sub NOMSG {
 $!=22;
 $Mail::Sender::Error="No message specified";
 return -9;
}

sub NOFILE {
 $!=22;
 $Mail::Sender::Error="No file name specified";
 return -10;
}

sub FILENOTFOUND {
 $!=2;
 $Mail::Sender::Error="File \"$_[0]\" not found";
 return -11;
}

sub NOTMULTIPART {
 $!=40;
 $Mail::Sender::Error="Not available in singlepart mode";
 return -12;
}

@Mail::Sender::Errors = ('OK',
              'not available in singlepart mode',
              'file not found',
              'no file name specified in call to MailFile or SendFile',
              'no message specified in call to MailMsg or MailFile',
              'argument $to empty',
              'transmission of message failed',
              'local user $to unknown on host $smtp',
              'unspecified communication error',
              'service not available',
              'connect() failed',
              'socket() failed',
              '$smtphost unknown'
             );

=head1 NAME

Mail::Sender - module for sending mails with attachments through an SMTP server

Version 0.6.7

=head1 SYNOPSIS

 use Mail::Sender;
 $sender = new Mail::Sender
  {smtp => 'mail.yourdomain.com', from => '[e-mail]'};
 $sender->MailFile({to => '[e-mail]',
  subject => 'Here is the file',
  msg => "I'm sending you the list you wanted.",
  file => 'filename.txt'});

=head1 DESCRIPTION

C<Mail::Sender> provides an object oriented interface to sending mails.
It doesn't need any outer program. It connects to a mail server
directly from Perl, using Socket.

Sends mails directly from Perl through a socket connection. 

=head1 CONSTRUCTORS

=over 2

=item C<new Mail::Sender ([from [,replyto [,to [,smtp [,subject [,headers [,boundary]]]]]]])>

=item new Mail::Sender {[from => '[e-mail]'] , [to => '[e-mail]'] [...]}

=item .

Prepares a sender. This doesn't start any connection to the server. You
have to use C<$Sender->Open> or C<$Sender->OpenMultipart> to start
talking to the server.

The parameters are used in subsequent calls to C<$Sender->Open> and
C<$Sender->OpenMultipart>. Each such call changes the saved variables.
You can set C<smtp>,C<from> and other options here and then use the info
in all messages.

 from      = the senders e-mail address

 replyto   = the reply-to address

 to        = the recipient's address(es)

 cc        = address(es) to send a copy (carbon copy)

 bcc       = address(es) to send a copy (blind carbon copy)
             these adresses will not be visible in the mail!

 smtp      = the IP or domain addres of you SMTP (mail) server

 subject   = the subject of the message

 headers   = the additional headers

 boundary  = the message boundary


 return codes:
  ref to a Mail::Sender object =  success
  -1 = $smtphost unknown
  -2 = socket() failed
  -3 = connect() failed
  -4 = service not available
  -5 = unspecified communication error
  -6 = local user $to unknown on host $smtp
  -7 = transmission of message failed
  -8 = argument $to empty
  -9 = no message specified in call to MailMsg or MailFile
  -10 = no file name specified in call to SendFile or MailFile
  -11 = file not found
  -12 = not available in singlepart mode
   Mail::Sender::Error contains a textual description of last error.

=back

=cut
#package main;
sub new {
 my $this = shift;
 my $class = ref($this) || $this;
 my $self = {};
 bless $self, $class;
 return $self->initialize(@_);
}
#package Mail::Sender;

sub initialize {
 my $self = shift;

 delete $self->{buffer};
 $self->{'proto'} = (getprotobyname('tcp'))[2];
 $self->{'port'} = getservbyname('smtp', 'tcp');  # was (..)[2]

 $self->{'boundary'} = 'Message-Boundary-9140';

 if ($#_ < 0) {return $self;}
 if (ref $_[0] eq 'HASH') {
  my $key;
  my $hash=$_[0];
  foreach $key (keys %$hash) {
   $self->{lc $key}=$hash->{$key};
  }
 } else {
  ($self->{'from'}, $self->{'reply'}, $self->{'to'}, $self->{'smtp'},
   $self->{'subject'}, $self->{'headers'}, $self->{'boundary'}
  ) = @_;
 }

 $self->{'fromaddr'} = $self->{'from'};
 $self->{'replyaddr'} = $self->{'reply'};

# $self->{'to'} =~ s/[ \t]+/, /g if ($self->{'to'}); # pack spaces and add comma
 $self->{'to'} =~ s/[ \t]+/ /g if ($self->{'to'}); # pack spaces and add comma
 $self->{'to'} =~ s/,,/,/g;

 $self->{'cc'} =~ s/[ \t]+/ /g if ($self->{'to'}); # pack spaces and add comma
 $self->{'cc'} =~ s/,,/,/g;

 $self->{'bcc'} =~ s/[ \t]+/ /g if ($self->{'to'}); # pack spaces and add comma
 $self->{'bcc'} =~ s/,,/,/g;

 $self->{'fromaddr'} =~ s/.*<([^\s]*?)>/$1/ if ($self->{'fromaddr'}); # get from email address
 if ($self->{'replyaddr'}) {
  $self->{'replyaddr'} =~ s/.*<([^\s]*?)>/$1/; # get reply email address
  $self->{'replyaddr'} =~ s/^([^\s]+).*/$1/; # use first address
 }
 $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp
 $self->{'smtp'} =~ s/\s+$//g;

 $self->{'smtpaddr'} = ($self->{'smtp'} =~
 /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
 ? pack('C4',$1,$2,$3,$4)
 : (gethostbyname($self->{'smtp'}))[4];

 $self->{'boundary'} =~ tr/=/-/;
 
 if (!defined($self->{'smtpaddr'})) { return $self->{'error'}=HOSTNOTFOUND($self->{smtp}); }

 return $self;
}

=head1 METHODS

=over 2

=item C<Open([from [, replyto [, to [, smtp [, subject [, headers]]]]]])>

=item Open({[from => "[e-mail]"] , [to => "[e-mail]"] [...]})

=item .

Opens a new message. If some parameters are unspecified or empty, it uses
the parameters passed to the "C<$Sender=new Mail::Sender(...)>";

see C<new Mail::Sender> for info about the parameters.

=cut

sub Open {
 my $self = shift;
 if ($self->{'socket'}) {
  if ($self->{'error'}) {
   $self->Cancel;
  } else {
   $self->Close;
  }
 }
 delete $self->{'error'};
 my %changed;
 $self->{multipart}=0;

 if (ref $_[0] eq 'HASH') {
  my $key;
  my $hash=$_[0];
  foreach $key (keys %$hash) {
   $self->{lc $key}=$hash->{$key};
   $changed{$key}=1;
  }
 } else {
  my ($from, $reply, $to, $smtp, $subject, $headers ) = @_;

  if ($from) {$self->{'from'}=$from;$changed{'from'}=1;}
  if ($reply) {$self->{'reply'}=$reply;$changed{'reply'}=1;}
  if ($to) {$self->{'to'}=$to;$changed{'to'}=1;}
  if ($smtp) {$self->{'smtp'}=$smtp;$changed{'smtp'}=1;}
  if ($subject) {$self->{'subject'}=$subject;$changed{'subject'}=1;}
  if ($headers) {$self->{'headers'}=$headers;$changed{'headers'}=1;}
 }

 $self->{'to'} =~ s/[ \t]+/ /g if ($changed{to}); 
 $self->{'to'} =~ s/,,/,/g if ($changed{to});
 $self->{'cc'} =~ s/[ \t]+/ /g if ($changed{cc}); 
 $self->{'cc'} =~ s/,,/,/g if ($changed{cc});
 $self->{'bcc'} =~ s/[ \t]+/ /g if ($changed{bcc}); 
 $self->{'bcc'} =~ s/,,/,/g if ($changed{bcc});

 $self->{'boundary'} =~ tr/=/-/ if $changed{boundary};

 if ($changed{from}) {
  $self->{'fromaddr'} = $self->{'from'};
  $self->{'fromaddr'} =~ s/.*<([^\s]*?)>/$1/; # get from email address
 }

 if ($changed{reply}) {
  $self->{'replyaddr'} = $self->{'reply'};
  $self->{'replyaddr'} =~ s/.*<([^\s]*?)>/$1/; # get reply email address
  $self->{'replyaddr'} =~ s/^([^\s]+).*/$1/; # use first address
 }

 if ($changed{smtp}) {
  $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp
  $self->{'smtp'} =~ s/\s+$//g;
  $self->{'smtpaddr'} = ($self->{'smtp'} =~
  /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
  ? pack('C4',$1,$2,$3,$4)
  : (gethostbyname($self->{'smtp'}))[4];
 }

 if (!$self->{'to'}) { return $self->{'error'}=TOEMPTY; }
 
 if (!defined($self->{'smtpaddr'})) { return $self->{'error'}=HOSTNOTFOUND($self->{smtp}); }

 my $s = &FileHandle::new(FileHandle);
 $self->{'socket'} = $s;
 
 if (!socket($s, AF_INET, SOCK_STREAM, $self->{'proto'})) { 
   return $self->{'error'}=SOCKFAILED; }
 
 if (!connect($s, pack('Sna4x8', AF_INET, $self->{'port'}, $self->{'smtpaddr'}))) { 
   return $self->{'error'}=CONNFAILED; }
 
 my($oldfh) = select($s); $| = 1; select($oldfh);
 
 $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=SERVNOTAVAIL; }
 
 print $s "helo localhost\r\n";
 $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
 
 print $s "mail from: <$self->{'fromaddr'}>\r\n";
 $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
 
 foreach (split(/, */, $self->{'to'}),split(/, */, $self->{'cc'}),split(/, */, $self->{'bcc'})) {

  if (/<(.*)>/) {
   print $s "rcpt to: $1\r\n";
  } else {
   print $s "rcpt to: <$_>\r\n";
  }

  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=USERUNKNOWN($self->{to}, $self->{smtp}); }
 }
 
 print $s "data\r\n";
 $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
 
 print $s "To: $self->{'to'}\r\n";
 print $s "From: $self->{'from'}\r\n";
 print $s "Cc: $self->{'cc'}\r\n";
 print $s "Reply-to: $self->{'replyaddr'}\r\n" if $self->{'replyaddr'};
 print $s "X-Mailer: Perl Mail::Sender Version $Mail::Sender::ver Jan Krynicky  <Jenda\@Krynicky.cz> Czech Republic\r\n" unless defined $Mail::Sender::NO_X_MAILER;
 if ($self->{'headers'}) {print $s $self->{'headers'},"\r\n"};
 print $s "Subject: $self->{'subject'}\r\n\r\n";
 
 return $self;
}