sender.pm

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

=cut
sub Part {
 my $self = shift;
 if (! $self->{'multipart'}) { return $self->{'error'}=NOTMULTIPART; }
 
 my ($description, $ctype, $encoding, $disposition);
 if (ref $_[0] eq 'HASH') {
  my $hash=$_[0];
  $description=$hash->{description};
  $ctype=$hash->{ctype};
  $encoding=$hash->{encoding};
  $disposition=$hash->{disposition};
 } else {
  ($description, $ctype, $encoding, $disposition) = @_;
 }

 $ctype="application/octet-stream" unless $ctype;
 $disposition = "attachment" unless $disposition;
 $encoding="7BIT" unless $encoding;

 my $code;
 if ($encoding =~ /Base64/i) {
  $code=\&encode_base64;
 } elsif ($encoding =~ /Quoted-printable/i) {
  $code=\&encode_qp;
 } else {
  $code=sub{return $_[0];};
 }

 $self->{'code'}=$code;

 if ($self->{buffer}) {
  my $code = $self->{code};
  my $s=$self->{"socket"};
  print $s (&$code($self->{buffer}));
  delete $self->{buffer};
 }

 $self->Send("\r\n--$self->{'boundary'}\r\n");
 $self->Send("Content-type: $ctype\r\n");
 if ($description) {$self->Send("Content-description: $description\r\n");}
 $self->Send("Content-transfer-encoding: $encoding\r\n");
 $self->Send("Content-disposition: $disposition\r\n");
 $self->SendLine;
 return 1;
}


=item Body([charset [, encoding [, content-type]]]);

Sends the head of the multipart message body. You can specify the
charset and the encoding. Default is "US-ASCII","7BIT",'text/plain'.

If you pass undef or zero as the parameter, this function uses the default
value:

    Body(0,0,'text/html');

=cut
sub Body {
 my $self = shift;
 if (! $self->{'multipart'}) { return $self->{'error'}=NOTMULTIPART; }
 my $charset = shift || 'US-ASCII';
 my $encoding = shift || '7BIT';
 my $conttype = shift || 'text/plain';
 $self->Part("Mail message body","$conttype; charset=$charset",
             $encoding, 'inline');
 return $self;
} 

=item SendFile( I<description>, I<ctype>, I<encoding>, I<disposition>, I<file>);

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

 Sends a file as a separate part of the mail mesage. Only in multipart mode.

=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 "Base64".

=item disposition

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

Defaults to  "attachment".

=item file

The name of the file to send or a 'list, of, names' or a
['reference','to','a','list','of','filenames']. Each file will be sent as
a separate part.

=back

=cut
sub SendFile {
 my $self = shift;
 if (! $self->{'multipart'}) { return $self->{'error'}=NOTMULTIPART; }
 
 my ($description, $ctype, $encoding, $disposition, $file, @files);
 if (ref $_[0] eq 'HASH') {
  my $hash=$_[0];
  $description=$hash->{description};
  $ctype=$hash->{ctype};
  $encoding=$hash->{encoding};
  $disposition=$hash->{disposition};
  $file=$hash->{file};
 } else {
  ($description, $ctype, $encoding, $disposition, $file) = @_;
 }
 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);
 }

 $ctype="application/octet-stream" unless $ctype;
 $disposition = "attachment" unless $disposition;
 $encoding='Base64' unless $encoding;

 my $code;
 if ($encoding =~ /Base64/i) {
  $code=\&encode_base64;
 } elsif ($encoding =~ /Quoted-printable/i) {
  $code=\&encode_qp;
 } else {
  $code=sub{return $_[0];};
 }
 $self->{'code'}=$code;

 if ($self->{buffer}) {
  my $code = $self->{code};
  my $s=$self->{'socket'};
  print $s (&$code($self->{buffer}));
  delete $self->{buffer};
 }

 foreach $file (@files) {
  my $cnt='';
  my $name=  basename $file;
  $self->Send("\r\n--$self->{'boundary'}\r\n");
  $self->Send("Content-type: $ctype; name=\"$name\"; type=Unknown\r\n");
  if ($description) {$self->Send("Content-description: $description\r\n");}
  $self->Send("Content-transfer-encoding: $encoding\r\n");
  $self->Send("Content-disposition: $disposition; filename=\"$name\"\r\n");
  $self->SendLine;
  open SENDFILE_4563, "<$file";binmode SENDFILE_4563;
  while (read SENDFILE_4563, $cnt, $chunksize) {
   $self->Send(&$code($cnt));
  }
#  $self->Send("==\n");
  close SENDFILE_4563;
 }
 $self->SendLine();
 return 1;
}


=item Close;

Close and send the mail. This method should be called automaticaly when destructing
the object, but you should call it yourself just to be sure it gets called.
And you should do it as soon as posible to close the connection and free the socket.

The mail is being sent to server, but is not processed by the server
till the sender object is closed!

=cut
sub Close {
 my $self = shift;
 my $s;#=new FileHandle;
 $s = $self->{'socket'};
 return 1 unless $s;
 if ($self->{buffer}) {
  my $code = $self->{code};
  print $s (&$code($self->{buffer}));
  delete $self->{buffer};
 }
 if ($self->{'multipart'}) { print $s "\r\n--",$self->{'boundary'},"--\r\n";}
 print $s "\r\n.\r\n";
 
 $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=TRANSFAILED; }
 
 print $s "quit\r\n";
 $_ = <$s>;
 
 close $s;
 delete $self->{'socket'};
 return 1;
}

=item Cancel;

Cancel an opened message.

SendFile and other methods may set $sender->{'error'}.
In that case "undef $sender" calls $sender->Cancel not $sender->Close!!!

=cut
sub Cancel {
 my $self = shift;
 my $s;#=new FileHandle;
 $s = $self->{'socket'};#      print "\$sender->Cancel() called\n";
 close $s;
 delete $self->{'socket'};
 delete $self->{'error'};
 return 1;
}

sub DESTROY {
 my $self = shift;
 if (defined $self->{'socket'}) {
  if ($self->{'error'}) {
   $self->Cancel;
  } else {
   $self->Close;
  }
 }
}


=item @Mail::Sender::Errors

Contains the description of errors returned by functions in Mail::Sender.

Ussage: @Mail::Sender::Errors[$sender->{error}]

=back

=head1 EXAMPLES

 use Mail::Sender;
 
 #$sender = new Mail::Sender { from => '[e-mail]',
    smtp => 'ms.chipnet.cz', boundary => 'This-is-a-mail-boundary-435427'};
 # # if you do not care about errors.
 # # otherwise use
 #
 ref ($sender = new Mail::Sender { from => '[e-mail]',
       smtp => 'ms.chipnet.cz', boundary => 'This-is-a-mail-boundary-435427'})
 or die "Error($sender) : $Mail::Sender::Error\n";
 
 $sender->Open({to => '[e-mail]', subject => 'Hello dear friend'});
 $sender->SendLine("How are you?");
 $sender->SendLine;
 $sender->Send(<<'*END*');
 I've found these jokes.

  Doctor, I feel like a pack of cards.
  Sit down and I'll deal with you later.
 
  Doctor, I keep thinking I'm a dustbin.
  Don't talk rubbish.
 
 Hope you like'em. Jenda
 *END*
 
 $sender->Close;
 
 $sender->Open({to => '[e-mail], [e-mail]',
                cc => '[e-mail]',
                subject => 'Sorry, I'll come later.'});
 $sender->SendLine("I'm sorry, but due to a big load of work,
    I'll come at 10pm at best.");
 $sender->SendLine("\nHi, Jenda");
 
 $sender->Close;
 
 $sender->OpenMultipart({to => '[e-mail]',
                         subject => 'Mail::Sender.pm - new module'});
 $sender->Body;
 $sender->Send(<<'*END*');
 Here is a new module Mail::Sender.
 It provides an object based interface to sending SMTP mails.
 It uses a direct socket connection, so it doesn't need any
 additionl program.
 
 Enjoy, Jenda
 *END*
 $sender->SendFile(
  {description => 'Perl module Mail::Sender.pm',
   ctype => 'application/x-zip-encoded',
   encoding => 'Base64',
   disposition => 'attachment; filename="Sender.zip"; type="ZIP archive"',
   file => 'sender.zip'
  });
 $sender->Close;
 
 _END_


If everything you need is to send a simple message you may use:

 use Mail::Sender;

 ref ($sender = new Mail::Sender({from => '[e-mail]',smtp
 => 'ms.chipnet.cz'})) or die "$Mail::Sender::Error\n";

 (ref ($sender->MailMsg({to =>'[e-mail]', subject => 'this is a test',
                         msg => "Hi Johnie.\nHow are you?"}))
  and print "Mail sent OK."
 )
 or die "$Mail::Sender::Error\n";

If you want to attach some files:

 use Mail::Sender;

 ref ($sender = new Mail::Sender({from => '[e-mail]',smtp
 => 'mail.yourdomain.com'})) or die "$Mail::Sender::Error\n";

 (ref ($sender->MailFile(
  {to =>'[e-mail]', subject => 'this is a test',
   msg => "Hi Johnie.\nI'm sending you the pictures you wanted.",
   file => 'image1.jpg,image2.jpg'
  }))
  and print "Mail sent OK."
 )
 or die "$Mail::Sender::Error\n";

If you want to send a HTML mail:

 use Mail::Sender;
 open IN, $htmlfile or die "Cannot open $htmlfile : $!\n";
 $sender = new Mail::Sender {smtp => 'mail.yourdomain.com'};
 $sender->Open({ from => '[e-mail]', to => '[e-mail]', subject => 'HTML test',
        headers => "MIME-Version: 1.0\r\nContent-type: text/html\r\nContent-Transfer-Encoding: 7bit"
 }) or die $Mail::Sender::Error,"\n";

 while (<IN>) { $sender->Send($_) };
 close IN;
 $sender->Close();


DO NOT mix Open(Multipart)|Send(Line)(Ex)|Close with MailMsg or MailFile.
Both Send(Msg/File) close any Open-ed mail. Do not try this:

 $sender = new Mail::Sender ...;
 $sender->OpenMultipart...;
 $sender->Body;
 $sender->Send("...");
 $sender->MailFile({file => 'something.ext');
 $sender->Close;

This WON'T work!!!

=head1 DISCLAIMER

This module is based on SendMail.pm Version : 1.21 that appeared in
[e-mail] mailing list. I don't remember the name
of the poster and it's not mentioned in the script. Thank you mr. C<undef>.

=head1 AUTHOR

Jan Krynicky <[e-mail]>

=head1 COPYRIGHT

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.

=cut