File Coverage

blib/lib/Net/Frame/Layer/UDPLite.pm
Criterion Covered Total %
statement 32 46 69.5
branch 2 18 11.1
condition n/a
subroutine 9 12 75.0
pod 7 7 100.0
total 50 83 60.2


line stmt bran cond sub pod time code
1             #
2             # $Id: UDPLite.pm 19 2009-05-23 13:57:13Z gomor $
3             #
4             package Net::Frame::Layer::UDPLite;
5 2     2   36445 use strict; use warnings;
  2     2   5  
  2         158  
  2         12  
  2         5  
  2         233  
6              
7             our $VERSION = '1.00';
8              
9 2     2   5127 use Net::Frame::Layer qw(:consts);
  2         368068  
  2         594  
10 2     2   23 use Exporter;
  2         5  
  2         805  
11             our @ISA = qw(Net::Frame::Layer Exporter);
12              
13             our %EXPORT_TAGS = (
14             consts => [qw(
15             )],
16             );
17             our @EXPORT_OK = (
18             @{$EXPORT_TAGS{consts}},
19             );
20              
21             our @AS = qw(
22             src
23             dst
24             coverage
25             checksum
26             );
27              
28             __PACKAGE__->cgBuildIndices;
29             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
30              
31 2     2   13 use Net::Frame::Layer qw(:subs);
  2         4  
  2         2209  
32              
33             sub new {
34 1     1 1 25 my $self = shift->SUPER::new(
35             src => getRandomHighPort(),
36             dst => getRandomHighPort(),
37             coverage => 0,
38             checksum => 0,
39             @_,
40             );
41 1         376 return $self;
42             }
43              
44 0     0 1 0 sub getLength { 8 }
45              
46             sub computeChecksums {
47 0     0 1 0 my $self = shift;
48 0         0 my ($h) = @_;
49              
50 0         0 my $phpkt;
51 0 0       0 if ($h->{type} eq 'IPv4') {
    0          
52 0 0       0 $phpkt = $self->SUPER::pack('a4a4CCn',
53             inetAton($h->{src}), inetAton($h->{dst}), 0, 17, $self->getLength,
54             ) or return;
55             }
56             elsif ($h->{type} eq 'IPv6') {
57 0 0       0 $phpkt = $self->SUPER::pack('a*a*NnCC',
58             inet6Aton($h->{src}),
59             inet6Aton($h->{dst}), $self->getLength, 0, 0, 17,
60             ) or return
61             }
62              
63 0 0       0 $phpkt .= $self->SUPER::pack('nnnn',
64             $self->src, $self->dst, $self->getLength, 0,
65             ) or return;
66              
67 0 0       0 if ($self->payload) {
68 0 0       0 $phpkt .= $self->SUPER::pack('a*', $self->payload)
69             or return;
70             }
71              
72 0         0 $self->checksum(inetChecksum($phpkt));
73              
74 0         0 return 1;
75             }
76              
77             sub pack {
78 1     1 1 7 my $self = shift;
79              
80 1 50       6 my $raw = $self->SUPER::pack("nnnn",
81             $self->src,
82             $self->dst,
83             $self->coverage,
84             $self->checksum,
85             ) or return;
86              
87 1         87 return $self->raw($raw);
88             }
89              
90             sub unpack {
91 1     1 1 9 my $self = shift;
92              
93 1 50       5 my ($src, $dst, $coverage, $checksum, $payload) =
94             $self->SUPER::unpack("nnnn a*", $self->raw)
95             or return;
96              
97 1         43 $self->src($src);
98 1         14 $self->dst($dst);
99 1         11 $self->coverage($coverage);
100 1         13 $self->checksum($checksum);
101 1         16 $self->payload($payload);
102              
103 1         10 return $self;
104             }
105              
106             our $Next = {
107             };
108              
109             sub encapsulate {
110 0     0 1 0 my $self = shift;
111 0         0 return $self->nextLayer;
112             }
113              
114             sub print {
115 2     2 1 20 my $self = shift;
116              
117 2         10 my $l = $self->layer;
118 2         30 my $buf = sprintf "$l:+src:%d dst:%d coverage:%d checksum:0x%04x",
119             $self->src,
120             $self->dst,
121             $self->coverage,
122             $self->checksum,
123             ;
124              
125 2         1447 return $buf;
126             }
127              
128             1;
129              
130             __END__