File Coverage

blib/lib/Net/Frame/Layer/PPP.pm
Criterion Covered Total %
statement 50 51 98.0
branch 3 6 50.0
condition 1 2 50.0
subroutine 16 17 94.1
pod 6 6 100.0
total 76 82 92.6


line stmt bran cond sub pod time code
1             #
2             # $Id: PPP.pm,v 7609c9d085d3 2018/03/15 15:17:19 gomor $
3             #
4             package Net::Frame::Layer::PPP;
5 2     2   7578 use strict;
  2         10  
  2         58  
6 2     2   10 use warnings;
  2         4  
  2         58  
7              
8 2     2   486 use Net::Frame::Layer qw(:consts);
  2         9  
  2         793  
9             require Exporter;
10             our @ISA = qw(Net::Frame::Layer Exporter);
11              
12             our %EXPORT_TAGS = (
13             consts => [qw(
14             NF_PPP_HDR_LEN
15             NF_PPP_PROTOCOL_IPv4
16             NF_PPP_PROTOCOL_DDP
17             NF_PPP_PROTOCOL_IPX
18             NF_PPP_PROTOCOL_IPv6
19             NF_PPP_PROTOCOL_CDP
20             NF_PPP_PROTOCOL_PPPLCP
21             )],
22             );
23             our @EXPORT_OK = (
24             @{$EXPORT_TAGS{consts}},
25             );
26              
27 2     2   16 use constant NF_PPP_HDR_LEN => 4;
  2         5  
  2         132  
28 2     2   28 use constant NF_PPP_PROTOCOL_IPv4 => 0x0021;
  2         7  
  2         106  
29 2     2   12 use constant NF_PPP_PROTOCOL_DDP => 0x0029;
  2         5  
  2         86  
30 2     2   10 use constant NF_PPP_PROTOCOL_IPX => 0x002b;
  2         4  
  2         110  
31 2     2   16 use constant NF_PPP_PROTOCOL_IPv6 => 0x0057;
  2         6  
  2         149  
32 2     2   15 use constant NF_PPP_PROTOCOL_CDP => 0x0207;
  2         4  
  2         88  
33 2     2   10 use constant NF_PPP_PROTOCOL_PPPLCP => 0xc021;
  2         5  
  2         172  
34              
35             our @AS = qw(
36             address
37             control
38             protocol
39             );
40             __PACKAGE__->cgBuildIndices;
41             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
42              
43 2     2   14 no strict 'vars';
  2         5  
  2         923  
44              
45             sub new {
46             shift->SUPER::new(
47 1     1 1 23 address => 0xff,
48             control => 0x03,
49             protocol => NF_PPP_PROTOCOL_IPv4,
50             @_,
51             );
52             }
53              
54 0     0 1 0 sub getLength { NF_PPP_HDR_LEN }
55              
56             sub pack {
57 1     1 1 384 my $self = shift;
58              
59 1 50       11 $self->[$__raw] = $self->SUPER::pack('CCn', $self->[$__address],
60             $self->[$__control], $self->[$__protocol])
61             or return undef;
62              
63 1         3 $self->[$__raw];
64             }
65              
66             sub unpack {
67 1     1 1 5 my $self = shift;
68              
69 1 50       6 my ($address, $control, $protocol, $payload) =
70             $self->SUPER::unpack('CCn a*', $self->[$__raw])
71             or return undef;
72              
73 1         3 $self->[$__address] = $address;
74 1         2 $self->[$__control] = $control;
75 1         2 $self->[$__protocol] = $protocol;
76 1         2 $self->[$__payload] = $payload;
77              
78 1         3 $self;
79             }
80              
81             our $Next = {
82             NF_PPP_PROTOCOL_IPv4() => 'IPv4',
83             NF_PPP_PROTOCOL_DDP() => 'DDP',
84             NF_PPP_PROTOCOL_IPX() => 'IPX',
85             NF_PPP_PROTOCOL_IPv6() => 'IPv6',
86             NF_PPP_PROTOCOL_CDP() => 'CDP',
87             NF_PPP_PROTOCOL_PPPLCP() => 'PPPLCP',
88             };
89              
90             sub encapsulate {
91 1     1 1 9 my $self = shift;
92              
93 1 50       4 return $self->[$__nextLayer] if $self->[$__nextLayer];
94              
95 1   50     7 return $Next->{$self->[$__protocol]} || NF_LAYER_UNKNOWN;
96             }
97              
98             sub print {
99 1     1 1 6 my $self = shift;
100              
101 1         8 my $l = $self->layer;
102 1         43 sprintf "$l: address:0x%02x control:0x%02x protocol:0x%04x",
103             $self->[$__address], $self->[$__control], $self->[$__protocol];
104             }
105              
106             1;
107              
108             __END__