File Coverage

blib/lib/Net/Inspect/Flow.pm
Criterion Covered Total %
statement 26 66 39.3
branch 2 16 12.5
condition 1 3 33.3
subroutine 7 14 50.0
pod 2 3 66.6
total 38 102 37.2


line stmt bran cond sub pod time code
1              
2             ############################################################################
3             # base class for packet flows
4             ############################################################################
5              
6 1     1   10 use strict;
  1         3  
  1         40  
7 1     1   9 use warnings;
  1         2  
  1         66  
8              
9             package Net::Inspect::Flow;
10 1     1   1287 use fields qw(upper_flow);
  1         3387  
  1         7  
11              
12             sub new {
13 30     30 1 1102 my ($class,$flow) = @_;
14 30 100       81 if ( ! ref($class)) {
15             # create new
16 2         7 my $self = fields::new($class);
17 2         193 $self->{upper_flow} = $flow;
18 2         5 return $self;
19             } else {
20 28         82 my $self = fields::new(ref($class));
21             $self->{upper_flow} = $flow
22 28   33     2678 || ( $class->{upper_flow} && $class->{upper_flow}->new ); # clone
23 28         74 return $self;
24             }
25             }
26              
27             sub new_any {
28 0     0 1   shift;
29 0           return Net::Inspect::Flow::Any->new(@_)
30             }
31              
32             # does nothing per default
33       0 0   sub expire {}
34              
35             package Net::Inspect::Flow::Any;
36 1     1   286 use Digest::MD5 'md5_hex';
  1         3  
  1         88  
37 1     1   15 use fields qw(flows);
  1         3  
  1         7  
38              
39             sub new {
40 0     0     my ($class,@methods) = @_;
41 0 0         if (@methods) {
42 0           my $clname = "Net::Inspect::Flow::Any::".
43             md5_hex(join("\0",sort @methods));
44 0 0         if ( ! UNIVERSAL::can($clname,'new') ) {
45             # dynamically create class
46 0 0         eval "package $clname; use base 'Net::Inspect::Flow::Any';1"
47             or die $@;
48 0           for my $method (@methods) {
49 1     1   203 no strict 'refs';
  1         3  
  1         552  
50 0           *{ "${clname}::$method" } = sub {
51 0     0     my $self = shift;
52 0           for my $flow (@{$self->{flows}}) {
  0            
53 0 0         if ( wantarray ) {
54 0 0         my @rv = $flow->$method(@_) or next;
55             return @rv
56 0           } else {
57 0 0         defined( my $rv = $flow->$method(@_)) or next;
58 0           return $rv
59             }
60             }
61 0           return;
62 0           };
63             }
64             }
65 0           return $clname->new;
66             }
67              
68              
69 0 0         if ( ! ref $class ) {
70 0           my $self = fields::new($class);
71 0           $self->{flows} = [];
72 0           return $self
73             } else {
74 0           my $self = fields::new(ref($class));
75             # clone attached flows
76 0           $self->{flows} = [ map { $_->new } @{ $class->{flows} } ];
  0            
  0            
77 0           return $self;
78             }
79             }
80              
81             sub attach {
82 0     0     my ($self,$flow) = @_;
83 0           push @{ $self->{flows} }, $flow;
  0            
84             }
85              
86             sub detach {
87 0     0     my ($self,$flow) = @_;
88 0           @{ $self->{flows} } = grep { $_ != $flow } @{ $self->{flows} };
  0            
  0            
  0            
89             }
90              
91             sub attached {
92 0     0     my $self = shift;
93 0           return @{ $self->{flows} }
  0            
94             }
95              
96             1;
97              
98             __END__