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 ce68fbcc7f6d 2019/05/23 05:58:40 gomor $
3             #
4             package Net::Frame::Layer::PPP;
5 2     2   4734 use strict;
  2         7  
  2         45  
6 2     2   9 use warnings;
  2         3  
  2         45  
7              
8 2     2   336 use Net::Frame::Layer qw(:consts);
  2         5  
  2         396  
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   22 use constant NF_PPP_HDR_LEN => 4;
  2         4  
  2         117  
28 2     2   9 use constant NF_PPP_PROTOCOL_IPv4 => 0x0021;
  2         10  
  2         90  
29 2     2   9 use constant NF_PPP_PROTOCOL_DDP => 0x0029;
  2         3  
  2         68  
30 2     2   8 use constant NF_PPP_PROTOCOL_IPX => 0x002b;
  2         4  
  2         89  
31 2     2   10 use constant NF_PPP_PROTOCOL_IPv6 => 0x0057;
  2         4  
  2         81  
32 2     2   11 use constant NF_PPP_PROTOCOL_CDP => 0x0207;
  2         2  
  2         65  
33 2     2   8 use constant NF_PPP_PROTOCOL_PPPLCP => 0xc021;
  2         3  
  2         137  
34              
35             our @AS = qw(
36             address
37             control
38             protocol
39             );
40             __PACKAGE__->cgBuildIndices;
41             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
42              
43 2     2   11 no strict 'vars';
  2         3  
  2         670  
44              
45             sub new {
46             shift->SUPER::new(
47 1     1 1 20 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 307 my $self = shift;
58              
59 1 50       10 $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 4 my $self = shift;
68              
69 1 50       7 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         3 $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 7 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 5 my $self = shift;
100              
101 1         5 my $l = $self->layer;
102 1         44 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__