File Coverage

blib/lib/Net/IMP/HTTP/Request.pm

Criterion	Covered	Total	%
statement	27	41	65.8
branch	0	8	0.0
condition	0	4	0.0
subroutine	9	13	69.2
pod	1	4	25.0
total	37	70	52.8

use strict;
use warnings;

package Net::IMP::HTTP::Request;
use base 'Net::IMP::Base';
use fields qw(dispatcher pos);
use Net::IMP::HTTP;
use Net::IMP;
use Carp 'croak';


# just define a typical set, maybe need to be redefined in subclass
sub RTYPES {
    my $factory = shift;
    return (IMP_PASS, IMP_PREPASS, IMP_REPLACE, IMP_DENY, IMP_LOG)
}

sub INTERFACE {
    my $factory = shift;
    my @rt = $factory->RTYPES;
    return (
	[ IMP_DATA_HTTPRQ, \@rt ],
	[ IMP_DATA_STREAM, \@rt, 'Net::IMP::Adaptor::STREAM2HTTPReq' ],
    );
}

# we can overide data to handle the types directly, but per default we
# dispatch to seperate methods
sub data {
    my ($self,$dir,$data,$offset,$type) = @_;

    $self->{pos}[$dir] = $offset if $offset;
    $self->{pos}[$dir] += length($data);

    my $disp = $self->{dispatcher} ||= {
	IMP_DATA_HTTPRQ_HEADER+0  => [
	    $self->can('request_hdr'),
	    $self->can('response_hdr'),
	],
	IMP_DATA_HTTPRQ_CONTENT+0 => [
	    $self->can('request_body'),
	    $self->can('response_body'),
	],
	IMP_DATA_HTTPRQ_DATA+0 => $self->can('any_data')
    };
    my $sub = $disp->{$type+0} or croak("cannot dispatch type $type");
    if ( ref($sub) eq 'ARRAY' ) {
	$sub = $sub->[$dir] or croak("cannot dispatch type $type dir $dir");
	$sub->($self,$data,$offset);
    } else {
	$sub->($self,$dir,$data,$offset);
    }
}

sub offset {
    my ($self,$dir) = @_;
    return $self->{pos}[$dir] // 0;
}


###########################################################################
# public interface
# most of these methods need to be implemented in subclass
###########################################################################

for my $subname (
    'request_hdr',        # ($self,$hdr)
    'request_body',       # ($self,$data,[$offset])
    'response_hdr',       # ($self,$hdr)
    'response_body',      # ($self,$data,[$offset])
    'any_data',           # ($self,$dir,$data,[$offset])
) {
    no strict 'refs';
    *$subname = sub { croak("$subname needs to be implemented in $_[0]") }
}


1;
__END__