File Coverage

blib/lib/Net/IMP/HTTP/Example/AddXFooHeader.pm
Criterion Covered Total %
statement 18 35 51.4
branch 0 8 0.0
condition 0 3 0.0
subroutine 6 9 66.6
pod 2 3 66.6
total 26 58 44.8


line stmt bran cond sub pod time code
1 1     1   780 use strict;
  1         2  
  1         34  
2 1     1   5 use warnings;
  1         2  
  1         33  
3              
4             package Net::IMP::HTTP::Example::AddXFooHeader;
5 1     1   5 use base 'Net::IMP::HTTP::Connection';
  1         1  
  1         146  
6 1     1   5 use fields qw(pos1);
  1         2  
  1         7  
7 1     1   51 use Net::IMP;
  1         1  
  1         112  
8 1     1   6 use Net::IMP::HTTP;
  1         1  
  1         318  
9              
10 0     0 0   sub RTYPES { ( IMP_PASS, IMP_PREPASS, IMP_REPLACE ) }
11             sub new_analyzer {
12 0     0 1   my ($factory,%args) = @_;
13 0           my $analyzer = $factory->SUPER::new_analyzer(%args);
14              
15             # we are not interested in request data, only response
16             # but for http we need to see requests to pair with responses
17 0           $analyzer->run_callback([IMP_PREPASS,0,IMP_MAXOFFSET]);
18 0           return $analyzer;
19             }
20              
21             # data supports IMP_DATA_HTTP and IMP_DATA_HTTPRQ interface
22             sub data {
23 0     0 1   my ($self,$dir,$data,$offset,$type) = @_;
24              
25             # request are handled by the pass maxoffset in new_analyzer
26 0 0         if ( $dir == 0 ) {
27             # if we speak httprq we can make the prepass to a pass
28 0 0         $self->run_callback([IMP_PASS,0,IMP_MAXOFFSET])
29             if $type == IMP_DATA_HTTPRQ_HEADER;
30 0           return;
31             }
32              
33 0           $self->{pos1} += length($data);
34 0 0 0       if ( $type == IMP_DATA_HTTP_HEADER
35             or $type == IMP_DATA_HTTPRQ_HEADER ) {
36 0           $data =~s{\n}{\nX-Foo: bar\r\n};
37 0           my @rv = [
38             IMP_REPLACE,
39             1,
40             $self->{pos1},
41             $data
42             ];
43 0 0         if ( $type == IMP_DATA_HTTPRQ_HEADER ) {
44             # for httprq interface we can pass until end of request (maxoffset)
45 0           push @rv, [ IMP_PASS,1,IMP_MAXOFFSET ];
46             }
47 0           $self->run_callback(@rv);
48              
49             } else {
50             # for http we might get more requests
51             # these might be chunking etc so we probably don't know their length
52             # therefore we can pass only data we get until we get the next
53             # response header
54 0           $self->run_callback([ IMP_PASS,1,$self->{pos1} ]);
55             }
56             }
57              
58              
59             1;
60             __END__