File Coverage

blib/lib/HTTP/MHTTP.pm

Criterion	Covered	Total	%
statement	26	36	72.2
branch	1	4	25.0
condition			n/a
subroutine	8	10	80.0
pod	4	4	100.0
total	39	54	72.2

package HTTP::MHTTP;
use strict;
require 5.005;
use Carp;
require DynaLoader;
require Exporter;
use MIME::Base64 qw(encode_base64);
use vars qw(@ISA $VERSION @EXPORT_OK);
$VERSION = '0.15';
@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.
Some support of HTTP 1.1 is available - sepcifically Transfer-Encoding = chunked and the Keep-Alive extensions.

Additionally - rudimentary SSL support can be compiled in.  This effectively enables negotiation of TLS, but does not validate the certificates.


=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_set_protocol()

  http_set_protocol(1);  # now operating in HTTP 1.1 mode

Set the protocol level to use - either HTTP 1.0 or 1.1 by passing 0 or 1 -
the default is 0 (HTTP 1.0).


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

Value < 0 are:
        -1 : an invalid action (HTTP verb) was supplied
        -2 : must supply an action (HTTP verb)
        -3 : must supply a url
        -4 : url must start with http:// or https://
        -5 : write of headers to socket failed
        -6 : write of data to socket was short
        -7 : failed to write last line to socket
        -8 : something wrong with the Conent-Length header
       -11 : SSL_CTX_new failed - abort everything
       -12 : SSL_new failed - abort everything
       -13 : SSL_connect failed - abort everything
       -14 : SSL_get_peer_certificate failed - abort everything
       -15 : X509_get_subject_name failed - abort everything
       -16 : X509_get_issuer_name failed - abort everything
       -17 : cant find the next chunk for Transfer-encoding
       -18 : cant find end headers
       -19 : You must supply a Host header for HTTP/1.1


=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 array ref of array ref header value pairs of the last call.
[ [ hdr, val], [hdr, val] ... ]


=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, [e-mail].


=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", "http_set_protocol" );
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(.*?)$/;
    $val =~ s/[\n\r]//g;
    push (@$headers, [$hdr, $val]);
    #$headers->{$hdr} = $val;
  }
  return $headers;

}


sub basic_authorization{
  my ( $user, $passwd ) = @_;
  return "Basic ".encode_base64( $user.':'.$passwd, "" );
}

1;