File Coverage

blib/lib/Net/TacacsPlus/Packet/AccountReplyBody.pm
Criterion Covered Total %
statement 32 32 100.0
branch 2 2 100.0
condition n/a
subroutine 9 9 100.0
pod 3 3 100.0
total 46 46 100.0


line stmt bran cond sub pod time code
1             package Net::TacacsPlus::Packet::AccountReplyBody;
2              
3             =head1 NAME
4              
5             Net::TacacsPlus::Packet::AccountReplyBody - Tacacs+ accounting reply body
6              
7             =head1 DESCRIPTION
8              
9             The accounting REPLY packet body
10              
11             The response to an accounting message is used to indicate that the
12             accounting function on the daemon has completed and securely
13             committed the record. This provides the client the best possible
14             guarantee that the data is indeed logged.
15              
16              
17              
18             1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8
19              
20             +----------------+----------------+----------------+----------------+
21             | server_msg len | data len |
22             +----------------+----------------+----------------+----------------+
23             | status | server_msg ...
24             +----------------+----------------+----------------+----------------+
25             | data ...
26             +----------------+
27              
28             =cut
29              
30              
31             our $VERSION = '1.10';
32              
33 10     10   60 use strict;
  10         20  
  10         578  
34 10     10   72 use warnings;
  10         23  
  10         889  
35              
36 10     10   228 use 5.006;
  10         33  
  10         475  
37 10     10   60 use Net::TacacsPlus::Constants 1.03;
  10         215  
  10         83  
38 10     10   63 use Carp::Clan;
  10         20  
  10         89  
39              
40 10     10   2511 use base qw{ Class::Accessor::Fast };
  10         22  
  10         5148  
41              
42             __PACKAGE__->mk_accessors(qw{
43             status
44             server_msg
45             data
46             });
47              
48             =head1 METHODS
49              
50             =over 4
51              
52             =item new( somekey => somevalue)
53              
54             Construct tacacs+ authorization response body object
55              
56             Parameters:
57              
58             'raw_body' : raw body
59            
60             or
61            
62             status : status of the reply
63             server_msg : message from server
64             data : payload
65              
66             =cut
67              
68             sub new()
69             {
70 2     2 1 1198 my $class = shift;
71 2         10 my %params = @_;
72            
73             #let the class accessor contruct the object
74 2         23 my $self = $class->SUPER::new(\%params);
75              
76 2 100       37 if ($params{'raw_body'}) {
77 1         6 $self->decode($params{'raw_body'});
78 1         3 delete $self->{'raw_body'};
79 1         5 return $self;
80             }
81              
82 1         5 return $self;
83             }
84              
85             =item decode($raw_data)
86              
87             Extract status, server_msg and data from raw packet.
88              
89             =cut
90              
91             sub decode {
92 1     1 1 2 my ($self, $raw_data) = @_;
93            
94 1         3 my ($server_msg_len, $data_len, $payload);
95            
96             (
97 1         9 $server_msg_len,
98             $data_len,
99             $self->{'status'},
100             $payload,
101             ) = unpack("nnCa*", $raw_data);
102            
103             (
104 1         16 $self->{'server_msg'},
105             $self->{'data'}
106             ) = unpack("a".$server_msg_len."a".$data_len,$payload);
107             }
108              
109             =item raw()
110              
111             returns binary representation of Accounting Reply Body
112              
113             =cut
114              
115             sub raw {
116 1     1 1 5634 my $self = shift;
117            
118 1         21 return pack('nnCa*a*',
119             length($self->{'server_msg'}),
120             length($self->{'data'}),
121             $self->{'status'},
122             $self->{'server_msg'},
123             $self->{'data'},
124             );
125             }
126              
127              
128             =back
129              
130             =cut
131              
132             1;