File Coverage

blib/lib/HTTP/HeaderParser/XS.pm

Criterion	Covered	Total	%
statement	39	58	67.2
branch	3	18	16.6
condition	3	18	16.6
subroutine	11	14	78.5
pod	0	6	0.0
total	56	114	49.1

package HTTP::HeaderParser::XS;

use 5.008;
use strict;
use warnings;
use Carp;

require Exporter;
use AutoLoader;

our @ISA = qw( Exporter );

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use HTTPHeaders ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	H_REQUEST
	H_RESPONSE
	M_DELETE
	M_GET
	M_OPTIONS
	M_POST
	M_PUT
    M_HEAD
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	H_REQUEST
	H_RESPONSE
	M_DELETE
	M_GET
	M_OPTIONS
	M_POST
	M_PUT
    M_HEAD
);

our $VERSION = '0.20';

our $HTTPCode = {
    200 => 'OK',
    204 => 'No Content',
    206 => 'Partial Content',
    304 => 'Not Modified',
    400 => 'Bad request',
    403 => 'Forbidden',
    404 => 'Not Found',
    416 => 'Request range not satisfiable',
    500 => 'Internal Server Error',
    501 => 'Not Implemented',
    503 => 'Service Unavailable',
};

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.

    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&HTTP::HeaderParser::XS::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
	no strict 'refs';
	# Fixed between 5.005_53 and 5.005_61
#XXX	if ($] >= 5.00561) {
#XXX	    *$AUTOLOAD = sub () { $val };
#XXX	}
#XXX	else {
	    *$AUTOLOAD = sub { $val };
#XXX	}
    }
    goto &$AUTOLOAD;
}

require XSLoader;
XSLoader::load('HTTP::HeaderParser::XS', $VERSION);

# create a very bare response to send to a user (mostly used internally)
sub new_response {
    my $code = $_[1];

    my $msg = $HTTPCode->{$code} || "";
    my $hdr = HTTP::HeaderParser::XS->new(\"HTTP/1.0 $code $msg\r\n\r\n");
    return $hdr;
}

# do some magic to determine content length
sub content_length {
    my HTTP::HeaderParser::XS $self = $_[0];

    if ($self->isRequest()) {
        return 0 if $self->getMethod() == M_HEAD();
    } else {
        my $code = $self->getStatusCode();
        if ($code == 304 || $code == 204 || ($code >= 100 && $code <= 199)) {
            return 0;
        }
    }

    if (defined (my $clen = $self->getHeader('Content-length'))) {
        return $clen+0;
    }

    return undef;
}

sub set_version {
    my HTTP::HeaderParser::XS $self = $_[0];
    my $ver = $_[1];

    die "Bogus version" unless $ver =~ /^(\d+)\.(\d+)$/;

    my ($ver_ma, $ver_mi) = ($1, $2);
    $self->setVersionNumber($ver_ma * 1000 + $ver_mi);

    return $self;
}

sub clone {
    return HTTP::HeaderParser::XS->new( $_[0]->to_string_ref );
}

sub code {
    my HTTP::HeaderParser::XS $self = shift;

    my ($code, $msg) = @_;
    $msg ||= $self->http_code_english($code);
    $self->setCodeText($code, $msg);
}

sub http_code_english {
    my HTTP::HeaderParser::XS $self = shift;
    if (@_) {
        return $HTTPCode->{shift()} || "";
    } else {
        return "" unless $self->response_code;
        return $HTTPCode->{$self->response_code} || "";
    }
}

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__