sender.pm

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

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

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

=item .

Opens a multipart 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 OpenMultipart {
 my $self = shift;
 if ($self->{'socket'}) {
  if ($self->{'error'}) {
   $self->Cancel;
  } else {
   $self->Close;
  }
 }
 delete $self->{'error'};
 my %changed;
 $self->{'multipart'}=1;

 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, $boundary) = @_;

  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;}
  if ($boundary) {
   $self->{'boundary'}=$boundary;
  }
 }

 $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 "MIME-Version: 1.0\r\n";
 print $s "To: $self->{'to'}\r\n";
 print $s "Cc: $self->{'cc'}\r\n" if $self->{'cc'};
 print $s "From: $self->{'from'}\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;
 print $s "Subject: $self->{'subject'}\r\n";
 if ($self->{'headers'}) {print $s $self->{'headers'},"\r\n"};
 print $s "MIME-Version: 1.0\r\nContent-type: Multipart/Mixed;\r\n\tboundary=$self->{'boundary'}\r\n";
 print $s "\r\n"; 
 
 return $self;
}


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

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

=item .

Sends a message. If a mail in $sender is opened it gets closed
and a new mail is created and sent. $sender is then closed.
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 MailMsg {
 my $self = shift;
 my $msg;
 if (ref $_[0] eq 'HASH') {
  my $hash=$_[0];
  $msg=$hash->{msg};
  delete $hash->{msg}
 } else {
  $msg = pop;
 }
 return $self->{'error'}=NOMSG unless $msg;

 ref $self->Open(@_)
 and
 $self->SendEx($msg)
 and
 $self->Close >= 0
 and
 return $self;
}


=item C<MailFile([from [, replyto [, to [, smtp [, subject [, headers]]]]]], message, file(s))>

=item MailFile({[from => "[e-mail]"]
               [, to => "[e-mail]"] [...],
               msg => "Message", file => "File"})

=item .

Sends one or more files by mail. If a mail in $sender is opened it gets closed
and a new mail is created and sent. $sender is then closed.
If some parameters are unspecified or empty, it uses
the parameters passed to the "C<$Sender=new Mail::Sender(...)>";

The C<file> parameter may be a "filename", a "list, of, file, names" or a \@list of file names.

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

=cut

sub MailFile {
 my $self = shift;
 my $msg;
 my $file;my $desc;
 my @files;
 if (ref $_[0] eq 'HASH') {
  my $hash = $_[0];
  $msg = $hash->{msg};
  delete $hash->{msg};
  $file=$hash->{file};
  delete $hash->{file};
  $desc=$hash->{description};
  delete $hash->{description};
 } else {
  $desc=pop if ($#_ >=2);
  $file = pop;
  $msg = pop;
 }
 return $self->{'error'}=NOMSG unless $msg;
 return $self->{'error'}=NOFILE unless $file;

 if (ref $file eq 'ARRAY') {
  @files=@$file;
 } elsif ($file =~ /,/) {
  @files=split / *, */,$file;
 } else {
  @files = ($file);
 }
 foreach $file (@files) {
  return $self->{'error'}=FILENOTFOUND($file) unless ($file =~ /^&/ or -e $file);
 }

 ref $self->OpenMultipart(@_)
 and
 ref $self->Body
 and
 $self->SendEx($msg)
 or return undef;
 foreach $file (@files) {
  my $cnt;
  my $filename = basename $file;
  $self->Part({encoding => 'BASE64',
               disposition => "attachment; filename=\"$filename\"",
               ctype => "application/octet-stream; name=\"$filename\"; type=Unknown",
               description => $desc});

#print "Opening $file\n";
               
  open SENDFILE_4563, "<$file";binmode SENDFILE_4563;
  while (read SENDFILE_4563, $cnt, $chunksize) {
   $self->Send(encode_base64($cnt));
  }
  close SENDFILE_4563;
 }
 $self->Close;
 return $self;
}



=item C<Send(@strings)>

Prints the strings to the socket. Doesn't add any end-of-line characters.
You should use C<\r\n> as the end-of-line.

=cut
sub Send {
 my $self = shift;
 my $s;#=FileHandle::new FileHandle;
 $s = $self->{'socket'};
 print $s @_;
 return 1;
}

=item C<SendLine(@strings)>

Prints the strings to the socket. Add the end-of-line character at the end.

=cut
sub SendLine {
 my $self = shift;
 my $s;#=FileHandle::new FileHandle;
 $s = $self->{'socket'};
 print $s (@_,"\r\n");
 return 1;
}

=item C<SendEnc(@strings)>

Prints the strings to the socket. Doesn't add any end-of-line characters.
You should use C<\r\n> as the end-of-line.
Encodes the text using the selected encoding (Base64/Quoted-printable)

=cut
sub SendEnc {
 my $self = shift;
 my $code = $self->{code};
 my $s;#=FileHandle::new FileHandle;
 $s = $self->{'socket'};
 my $str;
 if (defined $self->{buffer}) {
  $str=(join '',($self->{buffer},@_));
 } else {
  $str=join '',@_;
 }
 my ($len,$blen);
 $len = length $str;
 if (($blen=($len % 57)) >0) {  #was 3
  $self->{buffer} = substr($str,($len-$blen),$blen);
  $str=substr $str,0,$len-$blen;
 } else {
  delete $self->{buffer};
 }
 print $s (&$code($str));
 return 1;
}

=item C<SendLineEnc(@strings)>

Prints the strings to the socket. Add the end-of-line character at the end.
Encodes the text using the selected encoding (Base64/Quoted-printable)

Do NOT mix up Send[Line][Ex] and Send[Line]Enc! SendEnc does some buffering
necessary for correct Base64 encoding, and Send is not aware of that!

Ussage of Send[Line][Ex] in non 7BIT parts not recommended.
Using C<Send(encode_base64($string))> may, but may NOT work!
In particular if you use several such to create one part,
the data is very likely to get crippled.

=cut
sub SendLineEnc {
 my $self = shift;
 return $self->SendEnc(@_,"\r\n");
}

=item C<SendEx(@strings)>

Prints the strings to the socket. Doesn't add any end-of-line characters.
Changes all end-of-lines to C<\r\n>.

=cut
sub SendEx {
 my $self = shift;
 my $s;#=FileHandle::new FileHandle;
 $s = $self->{'socket'};
 my $str;
 foreach $str (@_) {
  $str =~ s/\n/\r\n/; 
 }
 print $s @_;
 return 1;
}

=item C<SendLineEx(@strings)>

Prints the strings to the socket. Doesn't add any end-of-line characters.
Changes all end-of-lines to C<\r\n>.

=cut
sub SendLineEx {
 my $self = shift;
 my $s;#=FileHandle::new FileHandle;
 $s = $self->{'socket'};
 my $str;
 foreach $str (@_) {
  $str =~ s/\n/\r\n/; 
 }
 print $s (@_,"\r\n");
 return 1;
}


=item Part( I<description>, I<ctype>, I<encoding>, I<disposition>, I<autocode>);

=item Part( { [description => "desc"] , [ctype], [encoding], [disposition]});

 Prints a part header for the multipart message.
 The undef or empty variables are ignored.

=over 2

=item description

The title for this part.

=item ctype

the content type (MIME type) of this part. May contain some other
parameters, such as B<charset> or B<name>.

Defaults to "application/octet-stream".

=item encoding

the encoding used for this part of message. Eg. Base64, Uuencode, 7BIT
...

Defaults to "7BIT".

=item disposition

This parts disposition. Eg: 'attachment; filename="send.pl"'.

Defaults to  "attachment".

=back