home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / hostmgr.zip / SENDER.PM < prev    next >
Text File  |  1999-01-25  |  31KB  |  1,167 lines
  1. # Mail::Sender.pm version 0.6.7
  2. #
  3. # Copyright (c) 1997 Jan Krynicky <Jenda@Krynicky.cz>. All rights reserved.      
  4. # This program is free software; you can redistribute it and/or
  5. # modify it under the same terms as Perl itself.
  6.  
  7. package Mail::Sender;
  8. require Exporter;
  9. @ISA = (Exporter);
  10. @EXPORT = qw();   #&new);
  11. @EXPORT_OK = qw(@error_str);
  12.  
  13. $Mail::Sender::VERSION='0.6.7';
  14. $Mail::Sender::ver=$Mail::Sender::VERSION;
  15.  
  16. use strict 'vars';
  17. use FileHandle;
  18. use Socket;
  19. use File::Basename;
  20.  
  21. use MIME::Base64;
  22. use MIME::QuotedPrint;
  23.                     # if you do not use MailFile or SendFile you may
  24.                     # comment out these lines.
  25.                     #MIME::Base64 and MIME::QuotedPrint may be found at CPAN.
  26. my $chunksize=1024*3;
  27.  
  28. #internals
  29.  
  30. sub HOSTNOTFOUND {
  31.  $!=2;
  32.  $Mail::Sender::Error="The SMTP server $_[0] was not found.";
  33.  return -1;
  34. }
  35.  
  36. sub SOCKFAILED {
  37.  $!=5;
  38.  $Mail::Sender::Error='socket() failed';
  39.  return -2;
  40. }
  41.  
  42. sub CONNFAILED {
  43.  $!=5;
  44.  $Mail::Sender::Error='connect() failed';
  45.  return -3;
  46. }
  47.  
  48. sub SERVNOTAVAIL {
  49.  $!=40;
  50.  $Mail::Sender::Error='Service not available';
  51.  return -4;
  52. }
  53.  
  54. sub COMMERROR {
  55.  $!=5;
  56.  $Mail::Sender::Error='Unspecified communication error';
  57.  return -5;
  58. }
  59.  
  60. sub USERUNKNOWN {
  61.  $!=2;
  62.  $Mail::Sender::Error="Local user \"$_[0]\" unknown on host \"$_[1]\"";
  63.  return -6;
  64. }
  65.  
  66. sub TRANSFAILED {
  67.  $!=5;
  68.  $Mail::Sender::Error='Transmission of message failed';
  69.  return -7;
  70. }
  71.  
  72. sub TOEMPTY {
  73.  $!=14;
  74.  $Mail::Sender::Error="Argument \$to empty";
  75.  return -8;
  76. }
  77.  
  78. sub NOMSG {
  79.  $!=22;
  80.  $Mail::Sender::Error="No message specified";
  81.  return -9;
  82. }
  83.  
  84. sub NOFILE {
  85.  $!=22;
  86.  $Mail::Sender::Error="No file name specified";
  87.  return -10;
  88. }
  89.  
  90. sub FILENOTFOUND {
  91.  $!=2;
  92.  $Mail::Sender::Error="File \"$_[0]\" not found";
  93.  return -11;
  94. }
  95.  
  96. sub NOTMULTIPART {
  97.  $!=40;
  98.  $Mail::Sender::Error="Not available in singlepart mode";
  99.  return -12;
  100. }
  101.  
  102. @Mail::Sender::Errors = ('OK',
  103.               'not available in singlepart mode',
  104.               'file not found',
  105.               'no file name specified in call to MailFile or SendFile',
  106.               'no message specified in call to MailMsg or MailFile',
  107.               'argument $to empty',
  108.               'transmission of message failed',
  109.               'local user $to unknown on host $smtp',
  110.               'unspecified communication error',
  111.               'service not available',
  112.               'connect() failed',
  113.               'socket() failed',
  114.               '$smtphost unknown'
  115.              );
  116.  
  117. =head1 NAME
  118.  
  119. Mail::Sender - module for sending mails with attachments through an SMTP server
  120.  
  121. Version 0.6.7
  122.  
  123. =head1 SYNOPSIS
  124.  
  125.  use Mail::Sender;
  126.  $sender = new Mail::Sender
  127.   {smtp => 'mail.yourdomain.com', from => 'your@address.com'};
  128.  $sender->MailFile({to => 'some@address.com',
  129.   subject => 'Here is the file',
  130.   msg => "I'm sending you the list you wanted.",
  131.   file => 'filename.txt'});
  132.  
  133. =head1 DESCRIPTION
  134.  
  135. C<Mail::Sender> provides an object oriented interface to sending mails.
  136. It doesn't need any outer program. It connects to a mail server
  137. directly from Perl, using Socket.
  138.  
  139. Sends mails directly from Perl through a socket connection. 
  140.  
  141. =head1 CONSTRUCTORS
  142.  
  143. =over 2
  144.  
  145. =item C<new Mail::Sender ([from [,replyto [,to [,smtp [,subject [,headers [,boundary]]]]]]])>
  146.  
  147. =item new Mail::Sender {[from => 'somebody@somewhere.com'] , [to => 'else@nowhere.com'] [...]}
  148.  
  149. =item .
  150.  
  151. Prepares a sender. This doesn't start any connection to the server. You
  152. have to use C<$Sender->Open> or C<$Sender->OpenMultipart> to start
  153. talking to the server.
  154.  
  155. The parameters are used in subsequent calls to C<$Sender->Open> and
  156. C<$Sender->OpenMultipart>. Each such call changes the saved variables.
  157. You can set C<smtp>,C<from> and other options here and then use the info
  158. in all messages.
  159.  
  160.  from      = the senders e-mail address
  161.  
  162.  replyto   = the reply-to address
  163.  
  164.  to        = the recipient's address(es)
  165.  
  166.  cc        = address(es) to send a copy (carbon copy)
  167.  
  168.  bcc       = address(es) to send a copy (blind carbon copy)
  169.              these adresses will not be visible in the mail!
  170.  
  171.  smtp      = the IP or domain addres of you SMTP (mail) server
  172.  
  173.  subject   = the subject of the message
  174.  
  175.  headers   = the additional headers
  176.  
  177.  boundary  = the message boundary
  178.  
  179.  
  180.  return codes:
  181.   ref to a Mail::Sender object =  success
  182.   -1 = $smtphost unknown
  183.   -2 = socket() failed
  184.   -3 = connect() failed
  185.   -4 = service not available
  186.   -5 = unspecified communication error
  187.   -6 = local user $to unknown on host $smtp
  188.   -7 = transmission of message failed
  189.   -8 = argument $to empty
  190.   -9 = no message specified in call to MailMsg or MailFile
  191.   -10 = no file name specified in call to SendFile or MailFile
  192.   -11 = file not found
  193.   -12 = not available in singlepart mode
  194.    Mail::Sender::Error contains a textual description of last error.
  195.  
  196. =back
  197.  
  198. =cut
  199. #package main;
  200. sub new {
  201.  my $this = shift;
  202.  my $class = ref($this) || $this;
  203.  my $self = {};
  204.  bless $self, $class;
  205.  return $self->initialize(@_);
  206. }
  207. #package Mail::Sender;
  208.  
  209. sub initialize {
  210.  my $self = shift;
  211.  
  212.  delete $self->{buffer};
  213.  $self->{'proto'} = (getprotobyname('tcp'))[2];
  214.  $self->{'port'} = getservbyname('smtp', 'tcp');  # was (..)[2]
  215.  
  216.  $self->{'boundary'} = 'Message-Boundary-9140';
  217.  
  218.  if ($#_ < 0) {return $self;}
  219.  if (ref $_[0] eq 'HASH') {
  220.   my $key;
  221.   my $hash=$_[0];
  222.   foreach $key (keys %$hash) {
  223.    $self->{lc $key}=$hash->{$key};
  224.   }
  225.  } else {
  226.   ($self->{'from'}, $self->{'reply'}, $self->{'to'}, $self->{'smtp'},
  227.    $self->{'subject'}, $self->{'headers'}, $self->{'boundary'}
  228.   ) = @_;
  229.  }
  230.  
  231.  $self->{'fromaddr'} = $self->{'from'};
  232.  $self->{'replyaddr'} = $self->{'reply'};
  233.  
  234. # $self->{'to'} =~ s/[ \t]+/, /g if ($self->{'to'}); # pack spaces and add comma
  235.  $self->{'to'} =~ s/[ \t]+/ /g if ($self->{'to'}); # pack spaces and add comma
  236.  $self->{'to'} =~ s/,,/,/g;
  237.  
  238.  $self->{'cc'} =~ s/[ \t]+/ /g if ($self->{'to'}); # pack spaces and add comma
  239.  $self->{'cc'} =~ s/,,/,/g;
  240.  
  241.  $self->{'bcc'} =~ s/[ \t]+/ /g if ($self->{'to'}); # pack spaces and add comma
  242.  $self->{'bcc'} =~ s/,,/,/g;
  243.  
  244.  $self->{'fromaddr'} =~ s/.*<([^\s]*?)>/$1/ if ($self->{'fromaddr'}); # get from email address
  245.  if ($self->{'replyaddr'}) {
  246.   $self->{'replyaddr'} =~ s/.*<([^\s]*?)>/$1/; # get reply email address
  247.   $self->{'replyaddr'} =~ s/^([^\s]+).*/$1/; # use first address
  248.  }
  249.  $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp
  250.  $self->{'smtp'} =~ s/\s+$//g;
  251.  
  252.  $self->{'smtpaddr'} = ($self->{'smtp'} =~
  253.  /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
  254.  ? pack('C4',$1,$2,$3,$4)
  255.  : (gethostbyname($self->{'smtp'}))[4];
  256.  
  257.  $self->{'boundary'} =~ tr/=/-/;
  258.  
  259.  if (!defined($self->{'smtpaddr'})) { return $self->{'error'}=HOSTNOTFOUND($self->{smtp}); }
  260.  
  261.  return $self;
  262. }
  263.  
  264. =head1 METHODS
  265.  
  266. =over 2
  267.  
  268. =item C<Open([from [, replyto [, to [, smtp [, subject [, headers]]]]]])>
  269.  
  270. =item Open({[from => "somebody@somewhere.com"] , [to => "else@nowhere.com"] [...]})
  271.  
  272. =item .
  273.  
  274. Opens a new message. If some parameters are unspecified or empty, it uses
  275. the parameters passed to the "C<$Sender=new Mail::Sender(...)>";
  276.  
  277. see C<new Mail::Sender> for info about the parameters.
  278.  
  279. =cut
  280.  
  281. sub Open {
  282.  my $self = shift;
  283.  if ($self->{'socket'}) {
  284.   if ($self->{'error'}) {
  285.    $self->Cancel;
  286.   } else {
  287.    $self->Close;
  288.   }
  289.  }
  290.  delete $self->{'error'};
  291.  my %changed;
  292.  $self->{multipart}=0;
  293.  
  294.  if (ref $_[0] eq 'HASH') {
  295.   my $key;
  296.   my $hash=$_[0];
  297.   foreach $key (keys %$hash) {
  298.    $self->{lc $key}=$hash->{$key};
  299.    $changed{$key}=1;
  300.   }
  301.  } else {
  302.   my ($from, $reply, $to, $smtp, $subject, $headers ) = @_;
  303.  
  304.   if ($from) {$self->{'from'}=$from;$changed{'from'}=1;}
  305.   if ($reply) {$self->{'reply'}=$reply;$changed{'reply'}=1;}
  306.   if ($to) {$self->{'to'}=$to;$changed{'to'}=1;}
  307.   if ($smtp) {$self->{'smtp'}=$smtp;$changed{'smtp'}=1;}
  308.   if ($subject) {$self->{'subject'}=$subject;$changed{'subject'}=1;}
  309.   if ($headers) {$self->{'headers'}=$headers;$changed{'headers'}=1;}
  310.  }
  311.  
  312.  $self->{'to'} =~ s/[ \t]+/ /g if ($changed{to}); 
  313.  $self->{'to'} =~ s/,,/,/g if ($changed{to});
  314.  $self->{'cc'} =~ s/[ \t]+/ /g if ($changed{cc}); 
  315.  $self->{'cc'} =~ s/,,/,/g if ($changed{cc});
  316.  $self->{'bcc'} =~ s/[ \t]+/ /g if ($changed{bcc}); 
  317.  $self->{'bcc'} =~ s/,,/,/g if ($changed{bcc});
  318.  
  319.  $self->{'boundary'} =~ tr/=/-/ if $changed{boundary};
  320.  
  321.  if ($changed{from}) {
  322.   $self->{'fromaddr'} = $self->{'from'};
  323.   $self->{'fromaddr'} =~ s/.*<([^\s]*?)>/$1/; # get from email address
  324.  }
  325.  
  326.  if ($changed{reply}) {
  327.   $self->{'replyaddr'} = $self->{'reply'};
  328.   $self->{'replyaddr'} =~ s/.*<([^\s]*?)>/$1/; # get reply email address
  329.   $self->{'replyaddr'} =~ s/^([^\s]+).*/$1/; # use first address
  330.  }
  331.  
  332.  if ($changed{smtp}) {
  333.   $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp
  334.   $self->{'smtp'} =~ s/\s+$//g;
  335.   $self->{'smtpaddr'} = ($self->{'smtp'} =~
  336.   /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
  337.   ? pack('C4',$1,$2,$3,$4)
  338.   : (gethostbyname($self->{'smtp'}))[4];
  339.  }
  340.  
  341.  if (!$self->{'to'}) { return $self->{'error'}=TOEMPTY; }
  342.  
  343.  if (!defined($self->{'smtpaddr'})) { return $self->{'error'}=HOSTNOTFOUND($self->{smtp}); }
  344.  
  345.  my $s = &FileHandle::new(FileHandle);
  346.  $self->{'socket'} = $s;
  347.  
  348.  if (!socket($s, AF_INET, SOCK_STREAM, $self->{'proto'})) { 
  349.    return $self->{'error'}=SOCKFAILED; }
  350.  
  351.  if (!connect($s, pack('Sna4x8', AF_INET, $self->{'port'}, $self->{'smtpaddr'}))) { 
  352.    return $self->{'error'}=CONNFAILED; }
  353.  
  354.  my($oldfh) = select($s); $| = 1; select($oldfh);
  355.  
  356.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=SERVNOTAVAIL; }
  357.  
  358.  print $s "helo localhost\r\n";
  359.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
  360.  
  361.  print $s "mail from: <$self->{'fromaddr'}>\r\n";
  362.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
  363.  
  364.  foreach (split(/, */, $self->{'to'}),split(/, */, $self->{'cc'}),split(/, */, $self->{'bcc'})) {
  365.  
  366.   if (/<(.*)>/) {
  367.    print $s "rcpt to: $1\r\n";
  368.   } else {
  369.    print $s "rcpt to: <$_>\r\n";
  370.   }
  371.  
  372.   $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=USERUNKNOWN($self->{to}, $self->{smtp}); }
  373.  }
  374.  
  375.  print $s "data\r\n";
  376.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
  377.  
  378.  print $s "To: $self->{'to'}\r\n";
  379.  print $s "From: $self->{'from'}\r\n";
  380.  print $s "Cc: $self->{'cc'}\r\n";
  381.  print $s "Reply-to: $self->{'replyaddr'}\r\n" if $self->{'replyaddr'};
  382.  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;
  383.  if ($self->{'headers'}) {print $s $self->{'headers'},"\r\n"};
  384.  print $s "Subject: $self->{'subject'}\r\n\r\n";
  385.  
  386.  return $self;
  387. }
  388.  
  389.  
  390. =item C<OpenMultipart([from [, replyto [, to [, smtp [, subject [, headers [, boundary]]]]]]])>
  391.  
  392. =item OpenMultipart({[from => "somebody@somewhere.com"] , [to => "else@nowhere.com"] [...]})
  393.  
  394. =item .
  395.  
  396. Opens a multipart message. If some parameters are unspecified or empty, it uses
  397. the parameters passed to the C<$Sender=new Mail::Sender(...)>.
  398.  
  399. see C<new Mail::Sender> for info about the parameters.
  400.  
  401. =cut
  402. sub OpenMultipart {
  403.  my $self = shift;
  404.  if ($self->{'socket'}) {
  405.   if ($self->{'error'}) {
  406.    $self->Cancel;
  407.   } else {
  408.    $self->Close;
  409.   }
  410.  }
  411.  delete $self->{'error'};
  412.  my %changed;
  413.  $self->{'multipart'}=1;
  414.  
  415.  if (ref $_[0] eq 'HASH') {
  416.   my $key;
  417.   my $hash=$_[0];
  418.   foreach $key (keys %$hash) {
  419.    $self->{lc $key}=$hash->{$key};
  420.    $changed{$key}=1;
  421.   }
  422.  } else {
  423.   my ($from, $reply, $to, $smtp, $subject, $headers, $boundary) = @_;
  424.  
  425.   if ($from) {$self->{'from'}=$from;$changed{'from'}=1;}
  426.   if ($reply) {$self->{'reply'}=$reply;$changed{'reply'}=1;}
  427.   if ($to) {$self->{'to'}=$to;$changed{'to'}=1;}
  428.   if ($smtp) {$self->{'smtp'}=$smtp;$changed{'smtp'}=1;}
  429.   if ($subject) {$self->{'subject'}=$subject;$changed{'subject'}=1;}
  430.   if ($headers) {$self->{'headers'}=$headers;$changed{'headers'}=1;}
  431.   if ($boundary) {
  432.    $self->{'boundary'}=$boundary;
  433.   }
  434.  }
  435.  
  436.  $self->{'to'} =~ s/[ \t]+/ /g if ($changed{to}); 
  437.  $self->{'to'} =~ s/,,/,/g if ($changed{to});
  438.  $self->{'cc'} =~ s/[ \t]+/ /g if ($changed{cc}); 
  439.  $self->{'cc'} =~ s/,,/,/g if ($changed{cc});
  440.  $self->{'bcc'} =~ s/[ \t]+/ /g if ($changed{bcc}); 
  441.  $self->{'bcc'} =~ s/,,/,/g if ($changed{bcc});
  442.  $self->{'boundary'} =~ tr/=/-/ if $changed{boundary};
  443.  
  444.  if ($changed{from}) {
  445.   $self->{'fromaddr'} = $self->{'from'};
  446.   $self->{'fromaddr'} =~ s/.*<([^\s]*?)>/$1/; # get from email address
  447.  }
  448.  
  449.  if ($changed{reply}) {
  450.   $self->{'replyaddr'} = $self->{'reply'};
  451.   $self->{'replyaddr'} =~ s/.*<([^\s]*?)>/$1/; # get reply email address
  452.   $self->{'replyaddr'} =~ s/^([^\s]+).*/$1/; # use first address
  453.  }
  454.  
  455.  if ($changed{smtp}) {
  456.   $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp
  457.   $self->{'smtp'} =~ s/\s+$//g;
  458.   $self->{'smtpaddr'} = ($self->{'smtp'} =~
  459.   /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
  460.   ? pack('C4',$1,$2,$3,$4)
  461.   : (gethostbyname($self->{'smtp'}))[4];
  462.  }
  463.  
  464.  if (!$self->{'to'}) { return $self->{'error'}=TOEMPTY; }
  465.  
  466.  if (!defined($self->{'smtpaddr'})) { return $self->{'error'}=HOSTNOTFOUND($self->{smtp}); }
  467.  
  468.  my $s = &FileHandle::new(FileHandle);
  469.  $self->{'socket'} = $s;
  470.  
  471.  if (!socket($s, AF_INET, SOCK_STREAM, $self->{'proto'})) { 
  472.    return $self->{'error'}=SOCKFAILED; }
  473.  
  474.  if (!connect($s, pack('Sna4x8', AF_INET, $self->{'port'}, $self->{'smtpaddr'}))) { 
  475.    return $self->{'error'}=CONNFAILED; }
  476.  
  477.  my($oldfh) = select($s); $| = 1; select($oldfh);
  478.  
  479.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=SERVNOTAVAIL; }
  480.  
  481.  print $s "helo localhost\r\n";
  482.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
  483.  
  484.  print $s "mail from: <$self->{'fromaddr'}>\r\n";
  485.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
  486.  
  487.  foreach (split(/, */, $self->{'to'}),split(/, */, $self->{'cc'}),split(/, */, $self->{'bcc'})) {
  488.   if (/<(.*)>/) {
  489.    print $s "rcpt to: $1\r\n";
  490.   } else {
  491.    print $s "rcpt to: <$_>\r\n";
  492.   }
  493.   $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=USERUNKNOWN($self->{to}, $self->{smtp}); }
  494.  }
  495.  
  496.  print $s "data\r\n";
  497.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=COMMERROR; }
  498.  
  499. # print $s "MIME-Version: 1.0\r\n";
  500.  print $s "To: $self->{'to'}\r\n";
  501.  print $s "Cc: $self->{'cc'}\r\n" if $self->{'cc'};
  502.  print $s "From: $self->{'from'}\r\n";
  503.  print $s "Reply-to: $self->{'replyaddr'}\r\n" if $self->{'replyaddr'};
  504.  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;
  505.  print $s "Subject: $self->{'subject'}\r\n";
  506.  if ($self->{'headers'}) {print $s $self->{'headers'},"\r\n"};
  507.  print $s "MIME-Version: 1.0\r\nContent-type: Multipart/Mixed;\r\n\tboundary=$self->{'boundary'}\r\n";
  508.  print $s "\r\n"; 
  509.  
  510.  return $self;
  511. }
  512.  
  513.  
  514. =item C<MailMsg([from [, replyto [, to [, smtp [, subject [, headers]]]]]], message)>
  515.  
  516. =item MailMsg({[from => "somebody@somewhere.com"]
  517.                [, to => "else@nowhere.com"] [...], msg => "Message"})
  518.  
  519. =item .
  520.  
  521. Sends a message. If a mail in $sender is opened it gets closed
  522. and a new mail is created and sent. $sender is then closed.
  523. If some parameters are unspecified or empty, it uses
  524. the parameters passed to the "C<$Sender=new Mail::Sender(...)>";
  525.  
  526. see C<new Mail::Sender> for info about the parameters.
  527.  
  528. =cut
  529.  
  530. sub MailMsg {
  531.  my $self = shift;
  532.  my $msg;
  533.  if (ref $_[0] eq 'HASH') {
  534.   my $hash=$_[0];
  535.   $msg=$hash->{msg};
  536.   delete $hash->{msg}
  537.  } else {
  538.   $msg = pop;
  539.  }
  540.  return $self->{'error'}=NOMSG unless $msg;
  541.  
  542.  ref $self->Open(@_)
  543.  and
  544.  $self->SendEx($msg)
  545.  and
  546.  $self->Close >= 0
  547.  and
  548.  return $self;
  549. }
  550.  
  551.  
  552. =item C<MailFile([from [, replyto [, to [, smtp [, subject [, headers]]]]]], message, file(s))>
  553.  
  554. =item MailFile({[from => "somebody@somewhere.com"]
  555.                [, to => "else@nowhere.com"] [...],
  556.                msg => "Message", file => "File"})
  557.  
  558. =item .
  559.  
  560. Sends one or more files by mail. If a mail in $sender is opened it gets closed
  561. and a new mail is created and sent. $sender is then closed.
  562. If some parameters are unspecified or empty, it uses
  563. the parameters passed to the "C<$Sender=new Mail::Sender(...)>";
  564.  
  565. The C<file> parameter may be a "filename", a "list, of, file, names" or a \@list of file names.
  566.  
  567. see C<new Mail::Sender> for info about the parameters.
  568.  
  569. =cut
  570.  
  571. sub MailFile {
  572.  my $self = shift;
  573.  my $msg;
  574.  my $file;my $desc;
  575.  my @files;
  576.  if (ref $_[0] eq 'HASH') {
  577.   my $hash = $_[0];
  578.   $msg = $hash->{msg};
  579.   delete $hash->{msg};
  580.   $file=$hash->{file};
  581.   delete $hash->{file};
  582.   $desc=$hash->{description};
  583.   delete $hash->{description};
  584.  } else {
  585.   $desc=pop if ($#_ >=2);
  586.   $file = pop;
  587.   $msg = pop;
  588.  }
  589.  return $self->{'error'}=NOMSG unless $msg;
  590.  return $self->{'error'}=NOFILE unless $file;
  591.  
  592.  if (ref $file eq 'ARRAY') {
  593.   @files=@$file;
  594.  } elsif ($file =~ /,/) {
  595.   @files=split / *, */,$file;
  596.  } else {
  597.   @files = ($file);
  598.  }
  599.  foreach $file (@files) {
  600.   return $self->{'error'}=FILENOTFOUND($file) unless ($file =~ /^&/ or -e $file);
  601.  }
  602.  
  603.  ref $self->OpenMultipart(@_)
  604.  and
  605.  ref $self->Body
  606.  and
  607.  $self->SendEx($msg)
  608.  or return undef;
  609.  foreach $file (@files) {
  610.   my $cnt;
  611.   my $filename = basename $file;
  612.   $self->Part({encoding => 'BASE64',
  613.                disposition => "attachment; filename=\"$filename\"",
  614.                ctype => "application/octet-stream; name=\"$filename\"; type=Unknown",
  615.                description => $desc});
  616.  
  617. #print "Opening $file\n";
  618.                
  619.   open SENDFILE_4563, "<$file";binmode SENDFILE_4563;
  620.   while (read SENDFILE_4563, $cnt, $chunksize) {
  621.    $self->Send(encode_base64($cnt));
  622.   }
  623.   close SENDFILE_4563;
  624.  }
  625.  $self->Close;
  626.  return $self;
  627. }
  628.  
  629.  
  630.  
  631. =item C<Send(@strings)>
  632.  
  633. Prints the strings to the socket. Doesn't add any end-of-line characters.
  634. You should use C<\r\n> as the end-of-line.
  635.  
  636. =cut
  637. sub Send {
  638.  my $self = shift;
  639.  my $s;#=FileHandle::new FileHandle;
  640.  $s = $self->{'socket'};
  641.  print $s @_;
  642.  return 1;
  643. }
  644.  
  645. =item C<SendLine(@strings)>
  646.  
  647. Prints the strings to the socket. Add the end-of-line character at the end.
  648.  
  649. =cut
  650. sub SendLine {
  651.  my $self = shift;
  652.  my $s;#=FileHandle::new FileHandle;
  653.  $s = $self->{'socket'};
  654.  print $s (@_,"\r\n");
  655.  return 1;
  656. }
  657.  
  658. =item C<SendEnc(@strings)>
  659.  
  660. Prints the strings to the socket. Doesn't add any end-of-line characters.
  661. You should use C<\r\n> as the end-of-line.
  662. Encodes the text using the selected encoding (Base64/Quoted-printable)
  663.  
  664. =cut
  665. sub SendEnc {
  666.  my $self = shift;
  667.  my $code = $self->{code};
  668.  my $s;#=FileHandle::new FileHandle;
  669.  $s = $self->{'socket'};
  670.  my $str;
  671.  if (defined $self->{buffer}) {
  672.   $str=(join '',($self->{buffer},@_));
  673.  } else {
  674.   $str=join '',@_;
  675.  }
  676.  my ($len,$blen);
  677.  $len = length $str;
  678.  if (($blen=($len % 57)) >0) {  #was 3
  679.   $self->{buffer} = substr($str,($len-$blen),$blen);
  680.   $str=substr $str,0,$len-$blen;
  681.  } else {
  682.   delete $self->{buffer};
  683.  }
  684.  print $s (&$code($str));
  685.  return 1;
  686. }
  687.  
  688. =item C<SendLineEnc(@strings)>
  689.  
  690. Prints the strings to the socket. Add the end-of-line character at the end.
  691. Encodes the text using the selected encoding (Base64/Quoted-printable)
  692.  
  693. Do NOT mix up Send[Line][Ex] and Send[Line]Enc! SendEnc does some buffering
  694. necessary for correct Base64 encoding, and Send is not aware of that!
  695.  
  696. Ussage of Send[Line][Ex] in non 7BIT parts not recommended.
  697. Using Send(encode_base64($string)) may, but may NOT work!
  698. In particular if you use several such to create one part,
  699. the data is very likely to get crippled.
  700.  
  701. =cut
  702. sub SendLineEnc {
  703.  my $self = shift;
  704.  return $self->SendEnc(@_,"\r\n");
  705. }
  706.  
  707. =item C<SendEx(@strings)>
  708.  
  709. Prints the strings to the socket. Doesn't add any end-of-line characters.
  710. Changes all end-of-lines to C<\r\n>.
  711.  
  712. =cut
  713. sub SendEx {
  714.  my $self = shift;
  715.  my $s;#=FileHandle::new FileHandle;
  716.  $s = $self->{'socket'};
  717.  my $str;
  718.  foreach $str (@_) {
  719.   $str =~ s/\n/\r\n/; 
  720.  }
  721.  print $s @_;
  722.  return 1;
  723. }
  724.  
  725. =item C<SendLineEx(@strings)>
  726.  
  727. Prints the strings to the socket. Doesn't add any end-of-line characters.
  728. Changes all end-of-lines to C<\r\n>.
  729.  
  730. =cut
  731. sub SendLineEx {
  732.  my $self = shift;
  733.  my $s;#=FileHandle::new FileHandle;
  734.  $s = $self->{'socket'};
  735.  my $str;
  736.  foreach $str (@_) {
  737.   $str =~ s/\n/\r\n/; 
  738.  }
  739.  print $s (@_,"\r\n");
  740.  return 1;
  741. }
  742.  
  743.  
  744. =item Part( I<description>, I<ctype>, I<encoding>, I<disposition>, I<autocode>);
  745.  
  746. =item Part( { [description => "desc"] , [ctype], [encoding], [disposition]});
  747.  
  748.  Prints a part header for the multipart message.
  749.  The undef or empty variables are ignored.
  750.  
  751. =over 2
  752.  
  753. =item description
  754.  
  755. The title for this part.
  756.  
  757. =item ctype
  758.  
  759. the content type (MIME type) of this part. May contain some other
  760. parameters, such as B<charset> or B<name>.
  761.  
  762. Defaults to "application/octet-stream".
  763.  
  764. =item encoding
  765.  
  766. the encoding used for this part of message. Eg. Base64, Uuencode, 7BIT
  767. ...
  768.  
  769. Defaults to "7BIT".
  770.  
  771. =item disposition
  772.  
  773. This parts disposition. Eg: 'attachment; filename="send.pl"'.
  774.  
  775. Defaults to  "attachment".
  776.  
  777. =back
  778.  
  779. =cut
  780. sub Part {
  781.  my $self = shift;
  782.  if (! $self->{'multipart'}) { return $self->{'error'}=NOTMULTIPART; }
  783.  
  784.  my ($description, $ctype, $encoding, $disposition);
  785.  if (ref $_[0] eq 'HASH') {
  786.   my $hash=$_[0];
  787.   $description=$hash->{description};
  788.   $ctype=$hash->{ctype};
  789.   $encoding=$hash->{encoding};
  790.   $disposition=$hash->{disposition};
  791.  } else {
  792.   ($description, $ctype, $encoding, $disposition) = @_;
  793.  }
  794.  
  795.  $ctype="application/octet-stream" unless $ctype;
  796.  $disposition = "attachment" unless $disposition;
  797.  $encoding="7BIT" unless $encoding;
  798.  
  799.  my $code;
  800.  if ($encoding =~ /Base64/i) {
  801.   $code=\&encode_base64;
  802.  } elsif ($encoding =~ /Quoted-printable/i) {
  803.   $code=\&encode_qp;
  804.  } else {
  805.   $code=sub{return $_[0];};
  806.  }
  807.  
  808.  $self->{'code'}=$code;
  809.  
  810.  if ($self->{buffer}) {
  811.   my $code = $self->{code};
  812.   my $s=$self->{"socket"};
  813.   print $s (&$code($self->{buffer}));
  814.   delete $self->{buffer};
  815.  }
  816.  
  817.  $self->Send("\r\n--$self->{'boundary'}\r\n");
  818.  $self->Send("Content-type: $ctype\r\n");
  819.  if ($description) {$self->Send("Content-description: $description\r\n");}
  820.  $self->Send("Content-transfer-encoding: $encoding\r\n");
  821.  $self->Send("Content-disposition: $disposition\r\n");
  822.  $self->SendLine;
  823.  return 1;
  824. }
  825.  
  826.  
  827. =item Body([charset [, encoding [, content-type]]]);
  828.  
  829. Sends the head of the multipart message body. You can specify the
  830. charset and the encoding. Default is "US-ASCII","7BIT",'text/plain'.
  831.  
  832. If you pass undef or zero as the parameter, this function uses the default
  833. value:
  834.  
  835.     Body(0,0,'text/html');
  836.  
  837. =cut
  838. sub Body {
  839.  my $self = shift;
  840.  if (! $self->{'multipart'}) { return $self->{'error'}=NOTMULTIPART; }
  841.  my $charset = shift || 'US-ASCII';
  842.  my $encoding = shift || '7BIT';
  843.  my $conttype = shift || 'text/plain';
  844.  $self->Part("Mail message body","$conttype; charset=$charset",
  845.              $encoding, 'inline');
  846.  return $self;
  847. } 
  848.  
  849. =item SendFile( I<description>, I<ctype>, I<encoding>, I<disposition>, I<file>);
  850.  
  851. =item SendFile( { [description => "desc"] , [ctype => "ctype"], [encoding => "encoding"],
  852.               [disposition => "disposition"], file => "file"});
  853.  
  854.  Sends a file as a separate part of the mail mesage. Only in multipart mode.
  855.  
  856. =over 2
  857.  
  858. =item description
  859.  
  860. The title for this part.
  861.  
  862. =item ctype
  863.  
  864. the content type (MIME type) of this part. May contain some other
  865. parameters, such as B<charset> or B<name>.
  866.  
  867. Defaults to "application/octet-stream".
  868.  
  869. =item encoding
  870.  
  871. the encoding used for this part of message. Eg. Base64, Uuencode, 7BIT
  872. ...
  873.  
  874. Defaults to "Base64".
  875.  
  876. =item disposition
  877.  
  878. This parts disposition. Eg: 'attachment; filename="send.pl"'.
  879.  
  880. Defaults to  "attachment".
  881.  
  882. =item file
  883.  
  884. The name of the file to send or a 'list, of, names' or a
  885. ['reference','to','a','list','of','filenames']. Each file will be sent as
  886. a separate part.
  887.  
  888. =back
  889.  
  890. =cut
  891. sub SendFile {
  892.  my $self = shift;
  893.  if (! $self->{'multipart'}) { return $self->{'error'}=NOTMULTIPART; }
  894.  
  895.  my ($description, $ctype, $encoding, $disposition, $file, @files);
  896.  if (ref $_[0] eq 'HASH') {
  897.   my $hash=$_[0];
  898.   $description=$hash->{description};
  899.   $ctype=$hash->{ctype};
  900.   $encoding=$hash->{encoding};
  901.   $disposition=$hash->{disposition};
  902.   $file=$hash->{file};
  903.  } else {
  904.   ($description, $ctype, $encoding, $disposition, $file) = @_;
  905.  }
  906.  return ($self->{'error'}=NOFILE) unless $file;
  907.  
  908.  if (ref $file eq 'ARRAY') {
  909.   @files=@$file;
  910.  } elsif ($file =~ /,/) {
  911.   @files=split / *, */,$file;
  912.  } else {
  913.   @files = ($file);
  914.  }
  915.  foreach $file (@files) {
  916.   return $self->{'error'}=FILENOTFOUND($file) unless ($file =~ /^&/ or -e $file);
  917.  }
  918.  
  919.  $ctype="application/octet-stream" unless $ctype;
  920.  $disposition = "attachment" unless $disposition;
  921.  $encoding='Base64' unless $encoding;
  922.  
  923.  my $code;
  924.  if ($encoding =~ /Base64/i) {
  925.   $code=\&encode_base64;
  926.  } elsif ($encoding =~ /Quoted-printable/i) {
  927.   $code=\&encode_qp;
  928.  } else {
  929.   $code=sub{return $_[0];};
  930.  }
  931.  $self->{'code'}=$code;
  932.  
  933.  if ($self->{buffer}) {
  934.   my $code = $self->{code};
  935.   my $s=$self->{'socket'};
  936.   print $s (&$code($self->{buffer}));
  937.   delete $self->{buffer};
  938.  }
  939.  
  940.  foreach $file (@files) {
  941.   my $cnt='';
  942.   my $name=  basename $file;
  943.   $self->Send("\r\n--$self->{'boundary'}\r\n");
  944.   $self->Send("Content-type: $ctype; name=\"$name\"; type=Unknown\r\n");
  945.   if ($description) {$self->Send("Content-description: $description\r\n");}
  946.   $self->Send("Content-transfer-encoding: $encoding\r\n");
  947.   $self->Send("Content-disposition: $disposition; filename=\"$name\"\r\n");
  948.   $self->SendLine;
  949.   open SENDFILE_4563, "<$file";binmode SENDFILE_4563;
  950.   while (read SENDFILE_4563, $cnt, $chunksize) {
  951.    $self->Send(&$code($cnt));
  952.   }
  953. #  $self->Send("==\n");
  954.   close SENDFILE_4563;
  955.  }
  956.  $self->SendLine();
  957.  return 1;
  958. }
  959.  
  960.  
  961. =item Close;
  962.  
  963. Close and send the mail. This method should be called automaticaly when destructing
  964. the object, but you should call it yourself just to be sure it gets called.
  965. And you should do it as soon as posible to close the connection and free the socket.
  966.  
  967. The mail is being sent to server, but is not processed by the server
  968. till the sender object is closed!
  969.  
  970. =cut
  971. sub Close {
  972.  my $self = shift;
  973.  my $s;#=new FileHandle;
  974.  $s = $self->{'socket'};
  975.  return 1 unless $s;
  976.  if ($self->{buffer}) {
  977.   my $code = $self->{code};
  978.   print $s (&$code($self->{buffer}));
  979.   delete $self->{buffer};
  980.  }
  981.  if ($self->{'multipart'}) { print $s "\r\n--",$self->{'boundary'},"--\r\n";}
  982.  print $s "\r\n.\r\n";
  983.  
  984.  $_ = <$s>; if (/^[45]/) { close $s; return $self->{'error'}=TRANSFAILED; }
  985.  
  986.  print $s "quit\r\n";
  987.  $_ = <$s>;
  988.  
  989.  close $s;
  990.  delete $self->{'socket'};
  991.  return 1;
  992. }
  993.  
  994. =item Cancel;
  995.  
  996. Cancel an opened message.
  997.  
  998. SendFile and other methods may set $sender->{'error'}.
  999. In that case "undef $sender" calls $sender->Cancel not $sender->Close!!!
  1000.  
  1001. =cut
  1002. sub Cancel {
  1003.  my $self = shift;
  1004.  my $s;#=new FileHandle;
  1005.  $s = $self->{'socket'};#      print "\$sender->Cancel() called\n";
  1006.  close $s;
  1007.  delete $self->{'socket'};
  1008.  delete $self->{'error'};
  1009.  return 1;
  1010. }
  1011.  
  1012. sub DESTROY {
  1013.  my $self = shift;
  1014.  if (defined $self->{'socket'}) {
  1015.   if ($self->{'error'}) {
  1016.    $self->Cancel;
  1017.   } else {
  1018.    $self->Close;
  1019.   }
  1020.  }
  1021. }
  1022.  
  1023.  
  1024. =item @Mail::Sender::Errors
  1025.  
  1026. Contains the description of errors returned by functions in Mail::Sender.
  1027.  
  1028. Ussage: @Mail::Sender::Errors[$sender->{error}]
  1029.  
  1030. =back
  1031.  
  1032. =head1 EXAMPLES
  1033.  
  1034.  use Mail::Sender;
  1035.  
  1036.  #$sender = new Mail::Sender { from => 'somebody@somewhere.com',
  1037.     smtp => 'ms.chipnet.cz', boundary => 'This-is-a-mail-boundary-435427'};
  1038.  # # if you do not care about errors.
  1039.  # # otherwise use
  1040.  #
  1041.  ref ($sender = new Mail::Sender { from => 'somebody@somewhere.com',
  1042.        smtp => 'ms.chipnet.cz', boundary => 'This-is-a-mail-boundary-435427'})
  1043.  or die "Error($sender) : $Mail::Sender::Error\n";
  1044.  
  1045.  $sender->Open({to => 'friend@other.com', subject => 'Hello dear friend'});
  1046.  $sender->SendLine("How are you?");
  1047.  $sender->SendLine;
  1048.  $sender->Send(<<'*END*');
  1049.  I've found these jokes.
  1050.  
  1051.   Doctor, I feel like a pack of cards.
  1052.   Sit down and I'll deal with you later.
  1053.  
  1054.   Doctor, I keep thinking I'm a dustbin.
  1055.   Don't talk rubbish.
  1056.  
  1057.  Hope you like'em. Jenda
  1058.  *END*
  1059.  
  1060.  $sender->Close;
  1061.  
  1062.  $sender->Open({to => 'mama@home.org, papa@work.com',
  1063.                 cc => 'somebody@somewhere.com',
  1064.                 subject => 'Sorry, I'll come later.'});
  1065.  $sender->SendLine("I'm sorry, but due to a big load of work,
  1066.     I'll come at 10pm at best.");
  1067.  $sender->SendLine("\nHi, Jenda");
  1068.  
  1069.  $sender->Close;
  1070.  
  1071.  $sender->OpenMultipart({to => 'Perl-Win32-Users@activeware.foo',
  1072.                          subject => 'Mail::Sender.pm - new module'});
  1073.  $sender->Body;
  1074.  $sender->Send(<<'*END*');
  1075.  Here is a new module Mail::Sender.
  1076.  It provides an object based interface to sending SMTP mails.
  1077.  It uses a direct socket connection, so it doesn't need any
  1078.  additionl program.
  1079.  
  1080.  Enjoy, Jenda
  1081.  *END*
  1082.  $sender->SendFile(
  1083.   {description => 'Perl module Mail::Sender.pm',
  1084.    ctype => 'application/x-zip-encoded',
  1085.    encoding => 'Base64',
  1086.    disposition => 'attachment; filename="Sender.zip"; type="ZIP archive"',
  1087.    file => 'sender.zip'
  1088.   });
  1089.  $sender->Close;
  1090.  
  1091.  _END_
  1092.  
  1093.  
  1094. If everything you need is to send a simple message you may use:
  1095.  
  1096.  use Mail::Sender;
  1097.  
  1098.  ref ($sender = new Mail::Sender({from => 'somebody@somewhere.com',smtp
  1099.  => 'ms.chipnet.cz'})) or die "$Mail::Sender::Error\n";
  1100.  
  1101.  (ref ($sender->MailMsg({to =>'Jenda@Krynicky.cz', subject => 'this is a test',
  1102.                          msg => "Hi Johnie.\nHow are you?"}))
  1103.   and print "Mail sent OK."
  1104.  )
  1105.  or die "$Mail::Sender::Error\n";
  1106.  
  1107. If you want to attach some files:
  1108.  
  1109.  use Mail::Sender;
  1110.  
  1111.  ref ($sender = new Mail::Sender({from => 'somebody@somewhere.com',smtp
  1112.  => 'mail.yourdomain.com'})) or die "$Mail::Sender::Error\n";
  1113.  
  1114.  (ref ($sender->MailFile(
  1115.   {to =>'you@address.com', subject => 'this is a test',
  1116.    msg => "Hi Johnie.\nI'm sending you the pictures you wanted.",
  1117.    file => 'image1.jpg,image2.jpg'
  1118.   }))
  1119.   and print "Mail sent OK."
  1120.  )
  1121.  or die "$Mail::Sender::Error\n";
  1122.  
  1123. If you want to send a HTML mail:
  1124.  
  1125.  use Mail::Sender;
  1126.  open IN, $htmlfile or die "Cannot open $htmlfile : $!\n";
  1127.  $sender = new Mail::Sender {smtp => 'mail.yourdomain.com'};
  1128.  $sender->Open({ from => 'your@address.com', to => 'other@address.com', subject => 'HTML test',
  1129.         headers => "MIME-Version: 1.0\r\nContent-type: text/html\r\nContent-Transfer-Encoding: 7bit"
  1130.  }) or die $Mail::Sender::Error,"\n";
  1131.  
  1132.  while (<IN>) { $sender->Send($_) };
  1133.  close IN;
  1134.  $sender->Close();
  1135.  
  1136.  
  1137. DO NOT mix Open(Multipart)|Send(Line)(Ex)|Close with MailMsg or MailFile.
  1138. Both Send(Msg/File) close any Open-ed mail. Do not try this:
  1139.  
  1140.  $sender = new Mail::Sender ...;
  1141.  $sender->OpenMultipart...;
  1142.  $sender->Body;
  1143.  $sender->Send("...");
  1144.  $sender->MailFile({file => 'something.ext');
  1145.  $sender->Close;
  1146.  
  1147. This WON'T work!!!
  1148.  
  1149. =head1 DISCLAIMER
  1150.  
  1151. This module is based on SendMail.pm Version : 1.21 that appeared in
  1152. Perl-Win32-Users@activeware.com mailing list. I don't remember the name
  1153. of the poster and it's not mentioned in the script. Thank you mr. C<undef>.
  1154.  
  1155. =head1 AUTHOR
  1156.  
  1157. Jan Krynicky <Jenda@Krynicky.cz>
  1158.  
  1159. =head1 COPYRIGHT
  1160.  
  1161. Copyright (c) 1997 Jan Krynicky <Jenda@Krynicky.cz>. All rights reserved.
  1162. This program is free software; you can redistribute it and/or
  1163. modify it under the same terms as Perl itself.
  1164.  
  1165. =cut
  1166.  
  1167.