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


line stmt bran cond sub pod time code
1 2     2   40979 use strict;
  2         5  
  2         102  
2 2     2   13 use warnings;
  2         4  
  2         120  
3              
4             package Net::IMP::HTTP::Request;
5 2     2   23 use base 'Net::IMP::Base';
  2         3  
  2         1059  
6 2     2   5932 use fields qw(dispatcher pos);
  2         3  
  2         53  
7 2     2   168 use Net::IMP::HTTP;
  2         3  
  2         237  
8 2     2   15 use Net::IMP;
  2         2  
  2         239  
9 2     2   14 use Carp 'croak';
  2         2  
  2         1063  
10              
11              
12             # just define a typical set, maybe need to be redefined in subclass
13             sub RTYPES {
14 0     0 0 0 my $factory = shift;
15 0         0 return (IMP_PASS, IMP_PREPASS, IMP_REPLACE, IMP_DENY, IMP_LOG)
16             }
17              
18             sub INTERFACE {
19 1     1 0 3041 my $factory = shift;
20 1         4 my @rt = $factory->RTYPES;
21             return (
22 1         8 [ IMP_DATA_HTTPRQ, \@rt ],
23             [ IMP_DATA_STREAM, \@rt, 'Net::IMP::Adaptor::STREAM2HTTPReq' ],
24             );
25             }
26              
27             # we can overide data to handle the types directly, but per default we
28             # dispatch to seperate methods
29             sub data {
30 0     0 1   my ($self,$dir,$data,$offset,$type) = @_;
31              
32 0 0         $self->{pos}[$dir] = $offset if $offset;
33 0           $self->{pos}[$dir] += length($data);
34              
35 0   0       my $disp = $self->{dispatcher} ||= {
36             IMP_DATA_HTTPRQ_HEADER+0 => [
37             $self->can('request_hdr'),
38             $self->can('response_hdr'),
39             ],
40             IMP_DATA_HTTPRQ_CONTENT+0 => [
41             $self->can('request_body'),
42             $self->can('response_body'),
43             ],
44             IMP_DATA_HTTPRQ_DATA+0 => $self->can('any_data')
45             };
46 0 0         my $sub = $disp->{$type+0} or croak("cannot dispatch type $type");
47 0 0         if ( ref($sub) eq 'ARRAY' ) {
48 0 0         $sub = $sub->[$dir] or croak("cannot dispatch type $type dir $dir");
49 0           $sub->($self,$data,$offset);
50             } else {
51 0           $sub->($self,$dir,$data,$offset);
52             }
53             }
54              
55             sub offset {
56 0     0 0   my ($self,$dir) = @_;
57 0   0       return $self->{pos}[$dir] // 0;
58             }
59              
60              
61             ###########################################################################
62             # public interface
63             # most of these methods need to be implemented in subclass
64             ###########################################################################
65              
66             for my $subname (
67             'request_hdr', # ($self,$hdr)
68             'request_body', # ($self,$data,[$offset])
69             'response_hdr', # ($self,$hdr)
70             'response_body', # ($self,$data,[$offset])
71             'any_data', # ($self,$dir,$data,[$offset])
72             ) {
73 2     2   16 no strict 'refs';
  2         4  
  2         209  
74 0     0     *$subname = sub { croak("$subname needs to be implemented in $_[0]") }
75             }
76              
77              
78             1;
79             __END__