File Coverage

blib/lib/Net/Frame/Layer/LLTD/Tlv.pm
Criterion Covered Total %
statement 22 26 84.6
branch 3 6 50.0
condition n/a
subroutine 6 8 75.0
pod 5 5 100.0
total 36 45 80.0


line stmt bran cond sub pod time code
1             #
2             # $Id: Tlv.pm,v 1.2 2007/03/15 18:24:19 gomor Exp $
3             #
4             package Net::Frame::Layer::LLTD::Tlv;
5 9     9   179 use strict;
  9         16  
  9         302  
6 9     9   47 use warnings;
  9         12  
  9         257  
7              
8 9     9   47 use Net::Frame::Layer qw(:consts :subs);
  9         14  
  9         6460  
9             our @ISA = qw(Net::Frame::Layer);
10              
11             our @AS = qw(
12             type
13             length
14             value
15             );
16             __PACKAGE__->cgBuildIndices;
17             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
18              
19             sub new {
20             shift->SUPER::new(
21 1     1 1 24 type => 0,
22             length => 0,
23             value => '',
24             @_,
25             );
26             }
27              
28 0     0 1 0 sub getLength { 2 + shift->length }
29              
30             sub pack {
31 1     1 1 226 my $self = shift;
32              
33 1 50       6 $self->raw($self->SUPER::pack('CCa*',
34             $self->type, $self->length, $self->value,
35             )) or return undef;
36              
37 1         69 $self->raw;
38             }
39              
40             sub unpack {
41 1     1 1 12 my $self = shift;
42              
43 1 50       3 my ($type, $length, $tail) = $self->SUPER::unpack('CC a*', $self->raw)
44             or return undef;
45              
46 1         23 my $bLen = $length;
47 1 50       7 my ($value, $payload) = $self->SUPER::unpack("a$bLen a*", $tail)
48             or return undef;
49              
50 1         13 $self->type($type);
51 1         10 $self->length($length);
52 1         9 $self->value($value);
53              
54 1         12 $self->payload($payload);
55              
56 1         9 $self;
57             }
58              
59             sub print {
60 0     0 1   my $self = shift;
61              
62 0           my $l = $self->layer;
63 0           sprintf "$l: type:%02x length:%02x value:%s",
64             $self->type, $self->length, CORE::unpack('H*', $self->value);
65             }
66              
67             1;
68              
69             __END__