File Coverage

blib/lib/HTTP/Client.pm

Criterion	Covered	Total	%
statement	34	65	52.3
branch	2	18	11.1
condition	1	12	8.3
subroutine	9	21	42.8
pod	16	16	100.0
total	62	132	46.9

package HTTP::Client;

use 5.006;
use strict;
use warnings;
use Carp;
use HTTP::Lite;

our $VERSION = '1.57';

#array of headers sendable for requests.

my @request_headers = qw(
Accept Accept-Charset Accept-Encoding Accept-Language
Authorization Expect From Host
If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
Max-Forwards Proxy-Authorization Range Referer TE User-Agent
);

my $http = HTTP::Lite->new; #make new HTTP::Lite object.
#class constructor
sub new {
   my $class    = shift;
   my $self     = {};
   $self->{agent} = shift; #user agent
   $self->{from } = shift;
   bless $self, $class;
}

sub get {
   my $self = shift;
   my $uri = shift;
   $uri =~ s/#//; #get rid of fragment, according to RFC 2616
   my $request;

   $http->reset();
   $request = $http->request($uri) or croak "Can't get $uri; may be a result of a bad hostname: $!"; #get it.
   my $fullmessage = $http->status . ' ' . $http->status_message; #full status message.
   #give them the body of the request if it has a body and sent an OK response.
   return $http->body if ($http->body and $fullmessage =~ /200 OK/);
   #return the message if the message isn't 200 OK, and there is no body.
   return $fullmessage unless ($fullmessage eq '200 OK' and $http->body);
}


sub response_headers {
   my $self = shift;
   #gather all response headers.
   my @headers = $http->headers_array;
   return @headers;
}


sub agent {
   my $self  = shift;
   my $agent = shift; #user agent
   #send useragent header if they supplied one.
   $agent = $self->{agent} if ($self->{agent} and not $agent);
   $http->add_req_header('User-Agent', $agent) if ($agent);
   #return the current one if they didn't supply the useragent.
   return $http->get_req_header('User-Agent')         unless ($agent);
}

sub from {
   my $self = shift;
   my $from = shift;
   $from = $self->{from} if ($self->{from} and not $from);
   $http->add_req_header('From', $from) if ($from); #set the from header.
   $http->get_req_header('From')        unless ($from);
}

##
## Methods to get response headers
##

sub status_message {
   my $self = shift;
   my $fullmessage = $http->status . ' ' . $http->status_message;
   return $fullmessage;
}

sub server           { my $self = shift; $http->get_header('Server')           }
sub content_type     { my $self = shift; $http->get_header('Content-Type')     }
sub last_modified    { my $self = shift; $http->get_header('Last-Modified')    }
sub protocol         { my $self = shift; $http->protocol                       }
sub content_encoding { my $self = shift; $http->get_header('Content-Encoding') }
sub content_length   { my $self = shift; $http->get_header('Content-Length')   }
sub warning          { my $self = shift; $http->get_header('Warning')          }
sub title            { my $self = shift; $http->get_header('Title')            }
sub date             { my $self = shift; $http->get_header('Date')             }
sub host             { my $self = shift; $http->get_header('Host')             }

1;

__END__