home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / LWP / Protocol / mailto.pm < prev    next >
Text File  |  1997-11-18  |  2KB  |  101 lines
  1. #
  2. # $Id: mailto.pm,v 1.1 1997/11/18 00:33:21 neeri Exp $
  3. #
  4. # This module implements the mailto protocol.  It is just a simple
  5. # frontend to the Unix sendmail program.  In the long run this module
  6. # will built using the Mail::Send module.
  7.  
  8. package LWP::Protocol::mailto;
  9.  
  10. require LWP::Protocol;
  11. require HTTP::Request;
  12. require HTTP::Response;
  13. require HTTP::Status;
  14.  
  15. use Carp;
  16.  
  17. @ISA = qw(LWP::Protocol);
  18.  
  19. sub request
  20. {
  21.     my($self, $request, $proxy, $arg, $size) = @_;
  22.  
  23.     my @text = ();
  24.     # check proxy
  25.     if (defined $proxy)
  26.     {
  27.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  28.                   'You can not proxy with mail';
  29.     }
  30.  
  31.     # check method
  32.     $method = $request->method;
  33.  
  34.     if ($method ne 'POST') {
  35.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  36.                   'Library does not allow method ' .
  37.                   "$method for 'mailto:' URLs";
  38.     }
  39.  
  40.     # check url
  41.     my $url = $request->url;
  42.  
  43.     my $scheme = $url->scheme;
  44.     if ($scheme ne 'mailto') {
  45.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  46.                   "LWP::file::request called for '$scheme'";
  47.     }
  48.     eval {
  49.         require Mail::Internet;
  50.     };
  51.     if($@) {
  52.      return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  53.                   "You don't have MailTools installed";
  54.     }
  55.     unless ($ENV{SMTPHOSTS}) {
  56.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  57.                   "You don't have SMTPHOSTS defined";
  58.     }
  59.     
  60.     my $mail = Mail::Internet->new or
  61.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  62.                   "Can't get a Mail::Internet object $!";
  63.  
  64.     my $addr = $url->encoded822addr;
  65.  
  66.     $mail->add(To => $addr);
  67.     $mail->add(split(/[:\n]/,$request->headers_as_string));
  68.     my $content = $request->content;
  69.     if (defined $content) {
  70.     my $contRef = ref($content) ? $content : \$content;
  71.     if (ref($contRef) eq 'SCALAR') {
  72.         @text = split("\n",$$contRef);
  73.         foreach (@text) {
  74.             $_ .= "\n";
  75.         }
  76.     } elsif (ref($contRef) eq 'CODE') {
  77.         # Callback provides data
  78.         my $d;
  79.         my $stuff = "";
  80.         while (length($d = &$contRef)) {
  81.         $stuff .= $d;
  82.         }
  83.         @text = split("\n",$stuff);
  84.         foreach (@text) {
  85.             $_ .= "\n";
  86.         }
  87.     }
  88.     }
  89.     $mail->body(\@text);
  90.     $mail->smtpsend;
  91.  
  92.     my $response = new HTTP::Response &HTTP::Status::RC_ACCEPTED,
  93.                      'Mail accepted by sendmail';
  94.     $response->header('Content-Type', 'text/plain');
  95.     $response->content("Mail sent to <$addr>\n");
  96.  
  97.     return $response;
  98. }
  99.  
  100. 1;
  101.