view release on metacpan or  search on metacpan

lib/AxKit2/HTTPHeaders.pm  view on Meta::CPAN

# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#

# Some code is Copyright 2005, Six Apart, Ltd, used with permission, and licensed
# under the same terms as Perl itself.

package AxKit2::HTTPHeaders;

=head1 NAME

AxKit2::HTTPHeaders - HTTP Request and Response header class

=head1 DESCRIPTION

This class parses and encapsulates HTTP headers, including the request/response
line (e.g. I<GET / HTTP/1.0>).

=head1 API

=cut

use strict;
use warnings;
no  warnings qw(deprecated);

use AxKit2::Utils qw(uri_decode uri_encode http_date);

use fields (
            'headers',      # href; lowercase header -> comma-sep list of values
            'origcase',     # href; lowercase header -> provided case
            'hdorder',      # aref; order headers were received (canonical order)
            'method',       # scalar; request method (if GET request)
            'uri',          # scalar; request URI (if GET request)
            'file',         # scalar; request File
            'querystring',  # scalar: request querystring
            'mime_type',    # scalar: request file mime type
            'path_info',    # scalar: request path-info
            'params',       # parsed params
            'paramkeys',    # all parsed param keys
            'type',         # 'res' or 'req'
            'code',         # HTTP response status code
            'codetext',     # status text that for response code
            'ver',          # version (string) "1.1"
            'vernum',       # version (number: major*1000+minor): "1.1" => 1001
            'responseLine', # first line of HTTP response (if response)
            'requestLine',  # first line of HTTP request (if request)
            'parsed_cookies',  # parsed cookie data
            'lame'          # HTTP/0.9
            );

our $HTTPCode = {
    200 => 'OK',
    204 => 'No Content',
    206 => 'Partial Content',
    302 => 'Found',
    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',
};

=head2 C<< CLASS->new( STRREF, IS_RESPONSE, IS_LAME ) >>

Construct a new header object from the given C<STRREF>. Assumes the header is
a response header if C<IS_RESPONSE> is set. Assumes C<HTTP/0.9> if C<IS_LAME> is
set.

=cut

sub new {
    my AxKit2::HTTPHeaders $self = shift;
    $self = fields::new($self) unless ref $self;

    my ($hstr_ref, $is_response, $lame) = @_;
    # hstr: headers as a string ref

    my $absoluteURIHost = undef;

    my @lines = split(/\r?\n/, $$hstr_ref);

    $self->{headers}    = {};
    $self->{origcase}   = {};
    $self->{hdorder}    = [];
    $self->{paramkeys}  = [];
    $self->{params}     = {};
    $self->{method}     = undef;
    $self->{uri}        = undef;
    $self->{type}       = ($is_response ? "res" : "req");
    $self->{lame}       = $lame;

    # check request line
    if ($is_response) {
        $self->{responseLine} = (shift @lines) || "";

        # check for valid response line
        return fail("Bogus response line") unless
            $self->{responseLine} =~ m!^HTTP\/(\d+)\.(\d+)\s+(\d+)\s+(.+)$!;

        my ($ver_ma, $ver_mi, $code) = ($1, $2, $3);
        $self->code($code, $4);

        # version work so we know what version the backend spoke
        unless (defined $ver_ma) {
            ($ver_ma, $ver_mi) = (0, 9);
        }
        $self->{ver} = "$ver_ma.$ver_mi";
        $self->{vernum} = $ver_ma*1000 + $ver_mi;
    }
    elsif ($lame) {
        $self->{requestLine} = (shift @lines) || "";
        $self->{requestLine} =~ /^GET ([^ ]+)$/m
            || die "Strange program interaction - not a lame request at all";
        
        $self->{method} = 'GET';
        $self->{uri} = $1;