—package
HTTP::MHTTP;
use
strict;
require
5.005;
use
Carp;
require
DynaLoader;
require
Exporter;
$VERSION
=
'0.06'
;
@ISA
=
qw(DynaLoader Exporter)
;
sub
dl_load_flags { 0x01 }
HTTP::MHTTP->bootstrap(
$VERSION
);
# the supported request headers
my
$headers
= {
'Accept-Encoding'
=>
'0'
,
'Accept-Language'
=>
'1'
,
'Connection'
=>
'2'
,
'Cookie'
=>
'3'
,
'Host'
=>
'4'
,
'User-Agent'
=>
'5'
,
'Authorization'
=>
'6'
,
'Accept'
=>
'7'
,
'SOAPAction'
=>
'8'
,
'Content-Type'
=>
'9'
,
'Cache-control'
=>
'10'
,
'Cache-Control'
=>
'10'
,
'Accept-Charset'
=>
'11'
,
'Pragma'
=>
'12'
,
'Referrer'
=>
'13'
,
'Referer'
=>
'13'
,
'Keep-Alive'
=>
'14'
,
'If-Modified-Since'
=>
'15'
,
'Content-type'
=>
'16'
,
};
=head1 NAME
HTTP::MHTTP - this library provides reasonably low level access to the HTTP protocol, for perl. This does not replace LWP (what possibly could :-) but is a cut for speed.
It also supports all of HTTP 1.0, so you have GET, POST, PUT, HEAD, and DELETE.
=head1 SYNOPSIS
use HTTP::MHTTP;
http_init();
http_add_headers(
'User-Agent' => 'DVSGHTTP1/1',
'Accept-Language' => 'en-gb',
'Connection' => 'Keep-Alive',
);
if (http_call("GET", "http://localhost")){
if (http_status() == 200 ){
print http_response();
} else {
print "MSG: ".http_reason();
}
} else {
print "call failed \n";
}
=head1 DESCRIPTION
A way faster http access library that uses C extension based on mhttp
to do the calls.
=head2 http_init()
initialise the mhttp library - must be called once to reset all internals,
use http_reset() if you don't need to reset your headers before the next call.
=head2 http_reset()
reset the library internals for everything except the headers specified
previously, and the debug switch. Call http_init() if you need to reset
everything.
=head2 switch_debug()
switch_debug(<0 || 1>)
Toggle the internal debugging on and off by passing either > 1 or 0.
=head2 http_add_headers()
http_add_headers(
'User-Agent' => 'HTTP-MHTTP1/0',
'Host' => 'localhost',
'Accept-Language' => 'en-gb',
);
pass in header/value pairs that will be set on the next http_call().
=head2 http_body()
http_body("this is the body");
Set the body of the next request via http_call().
=head2 http_call()
my $rc = http_call("GET", "http://localhost");
Do an http request. Returns either 0 or 1 depending on whether the call was
successful - remember to still check the http_status() code though.
=head2 http_status()
Returns the last status code.
=head2 http_reason()
Returns the last reason code.
=head2 http_headers()
Returns the headers of the last call, as a single string.
=head2 http_split_headers()
Returns the split out hash of headers of the last call. Returns the
hash reference.
=head2 http_response_length()
Returns the length of the body of the last call.
=head2 http_response()
Returns the body of the last call.
=head2 basic_authorization()
my $pass = basic_authorization($user, $password);
Construct the basic authorization value to be passed in an "Authorization"
header.
=head1 COPYRIGHT
Copyright (c) 2003, Piers Harding. All Rights Reserved.
This module is free software. It may be used, redistributed
and/or modified under the same terms as Perl itself.
=head1 AUTHOR
Piers Harding, piers@ompa.net.
=head1 SEE ALSO
perl(1)
=cut
# export the open command, and initialise http::mhttp
my
@export_ok
= (
"http_reset"
,
"http_init"
,
"http_add_headers"
,
"http_status"
,
"http_reason"
,
"http_call"
,
"http_headers"
,
"http_split_headers"
,
"http_body"
,
"http_response"
,
"basic_authorization"
,
"switch_debug"
,
"http_response_length"
);
sub
import
{
my
(
$caller
) =
caller
;
my
(
$me
,
$debug
) =
@_
;
no
strict
'refs'
;
foreach
my
$sub
(
@export_ok
){
*{
"${caller}::${sub}"
} = \&{
$sub
};
}
}
sub
http_add_headers {
my
$hdrs
= {
@_
};
foreach
my
$header
(
keys
%$hdrs
){
if
(
exists
$headers
->{
$header
} ){
add_header(
$header
.
": "
.
$hdrs
->{
$header
});
}
else
{
warn
"Invalid header specified: $header - $hdrs->{$header} \n"
;
}
}
}
sub
http_split_headers {
my
$headers
= {};
foreach
my
$h
(
split
(/\n/,http_headers())){
next
unless
$h
=~ /:/;
my
(
$hdr
,
$val
) =
$h
=~ /^(.*?):\s(.*?)$/;
$headers
->{
$hdr
} =
$val
;
}
return
$headers
;
}
sub
basic_authorization{
my
(
$user
,
$passwd
) =
@_
;
return
"Basic "
.encode_base64(
$user
.
':'
.
$passwd
,
""
);
}
1;