home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Acorn User 10
/
AU_CD10.iso
/
Updates
/
Perl
/
Perl_Libs
/
site_perl
/
LWP
/
Protocol
/
mailto.pm
< prev
next >
Wrap
Text File
|
1996-04-09
|
2KB
|
88 lines
#
# $Id: mailto.pm,v 1.7 1996/04/09 15:44:38 aas Exp $
#
# This module implements the mailto protocol. It is just a simple
# frontend to the Unix sendmail program. In the long run this module
# will built using the Mail::Send module.
package LWP::Protocol::mailto;
require LWP::Protocol;
require HTTP::Request;
require HTTP::Response;
require HTTP::Status;
use Carp;
@ISA = qw(LWP::Protocol);
$SENDMAIL = "/usr/lib/sendmail";
sub request
{
my($self, $request, $proxy, $arg, $size) = @_;
# check proxy
if (defined $proxy)
{
return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
'You can not proxy with mail';
}
# check method
$method = $request->method;
if ($method ne 'POST') {
return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
'Library does not allow method ' .
"$method for 'mailto:' URLs";
}
# check url
my $url = $request->url;
my $scheme = $url->scheme;
if ($scheme ne 'mailto') {
return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
"LWP::file::request called for '$scheme'";
}
unless (-x $SENDMAIL) {
return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
"You don't have $SENDMAIL";
}
open(SENDMAIL, "| $SENDMAIL -oi -t") or
return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
"Can't run $SENDMAIL: $!";
my $addr = $url->encoded822addr;
$request->header('To', $addr);
print SENDMAIL $request->headers_as_string;
print SENDMAIL "\n";
my $content = $request->content;
if (defined $content) {
my $contRef = ref($content) ? $content : \$content;
if (ref($contRef) eq 'SCALAR') {
print SENDMAIL $$contRef;
} elsif (ref($contRef) eq 'CODE') {
# Callback provides data
my $d;
while (length($d = &$contRef)) {
print SENDMAIL $d;
}
}
}
close(SENDMAIL);
my $response = new HTTP::Response &HTTP::Status::RC_ACCEPTED,
'Mail accepted by sendmail';
$response->header('Content-Type', 'text/plain');
$response->content("Mail sent to <$addr>\n");
return $response;
}
1;