File Coverage

blib/lib/FusionInventory/Agent/SNMP/Mock.pm
Criterion Covered Total %
statement 72 107 67.2
branch 27 52 51.9
condition 10 26 38.4
subroutine 10 13 76.9
pod 5 5 100.0
total 124 203 61.0


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::SNMP::Mock;
2              
3 3     3   5978351 use strict;
  3         12  
  3         115  
4 3     3   26 use warnings;
  3         11  
  3         144  
5 3     3   16 use base 'FusionInventory::Agent::SNMP';
  3         84  
  3         1883  
6              
7 3     3   1898 use FusionInventory::Agent::Tools;
  3         10  
  3         4911  
8              
9             my %prefixes = (
10             'iso' => '.1',
11             'SNMPv2-MIB::sysDescr' => '.1.3.6.1.2.1.1.1',
12             'SNMPv2-MIB::sysObjectID' => '.1.3.6.1.2.1.1.2',
13             'SNMPv2-MIB::sysUpTime' => '.1.3.6.1.2.1.1.3',
14             'SNMPv2-MIB::sysContact' => '.1.3.6.1.2.1.1.4',
15             'SNMPv2-MIB::sysName' => '.1.3.6.1.2.1.1.5',
16             'SNMPv2-MIB::sysLocation' => '.1.3.6.1.2.1.1.6',
17             'SNMPv2-SMI::mib-2' => '.1.3.6.1.2.1',
18             'SNMPv2-SMI::enterprises' => '.1.3.6.1.4.1',
19             'IF-MIB::ifIndex' => '.1.3.6.1.2.1.2.2.1.1',
20             'IF-MIB::ifDescr' => '.1.3.6.1.2.1.2.2.1.2',
21             'IF-MIB::ifType' => '.1.3.6.1.2.1.2.2.1.3',
22             'IF-MIB::ifMtu' => '.1.3.6.1.2.1.2.2.1.4',
23             'IF-MIB::ifSpeed' => '.1.3.6.1.2.1.2.2.1.5',
24             'IF-MIB::ifPhysAddress' => '.1.3.6.1.2.1.2.2.1.6',
25             'IF-MIB::ifLastChange' => '.1.3.6.1.2.1.2.2.1.9',
26             'IF-MIB::ifInOctets' => '.1.3.6.1.2.1.2.2.1.10',
27             'IF-MIB::ifInErrors' => '.1.3.6.1.2.1.2.2.1.14',
28             'IF-MIB::ifOutOctets' => '.1.3.6.1.2.1.2.2.1.16',
29             'IF-MIB::ifOutErrors' => '.1.3.6.1.2.1.2.2.1.20',
30             'IF-MIB::ifName' => '.1.3.6.1.2.1.31.1.1.1.1',
31             'HOST-RESOURCES-MIB::hrDeviceDescr' => '.1.3.6.1.2.1.25.3.2.1.3',
32             'NET-SNMP-MIB::netSnmpAgentOIDs' => '.1.3.6.1.4.1.8072.3.2',
33             );
34              
35             sub new {
36 16     16 1 43139 my ($class, %params) = @_;
37              
38 16         62 my $self = {};
39 16         33 bless $self, $class;
40              
41             SWITCH: {
42 16 100       23 if ($params{file}) {
  16         51  
43             die "non-existing file '$params{file}'\n"
44 4 50       72 unless -f $params{file};
45             die "unreadable file '$params{file}'\n"
46 4 50       49 unless -r $params{file};
47 4         11 $self->{values} = _getIndexedValues($params{file});
48 4         9 $self->{file} = $params{file};
49 4         7 last SWITCH;
50             }
51              
52 12 50       32 if ($params{hash}) {
53 12         30 $self->{values} = $params{hash};
54 12         25 last SWITCH;
55             }
56             }
57              
58 16         47 return $self;
59             }
60              
61             sub switch_vlan_context {
62 0     0 1 0 my ($self, $vlan_id) = @_;
63              
64 0 0       0 $self->{oldvalues} = $self->{values} unless $self->{oldvalues};
65              
66 0         0 my $file = $self->{file} . '@' . $vlan_id;
67 0 0 0     0 if (-r $file && -f $file) {
68 0         0 $self->{values} = _getIndexedValues($file);
69             } else {
70 0         0 delete $self->{values};
71             }
72             }
73              
74             sub reset_original_context {
75 0     0 1 0 my ($self) = @_;
76              
77 0         0 $self->{values} = $self->{oldvalues};
78 0         0 delete $self->{oldvalues};
79             }
80              
81             sub _getIndexedValues {
82 4     4   7 my ($file) = @_;
83              
84 4         14 my $handle = getFileHandle(file => $file);
85              
86             # check first line
87 4         40 my $first_line = <$handle>;
88 4         18 seek($handle, 0, 0);
89              
90             # check first line for safety
91 4 50       23 die "invalid file format\n" unless $first_line =~ /^(\S+) = .*/;
92              
93 4 50       17 my $values = substr($first_line, 0, 1) eq '.' ?
94             _readNumericalOids($handle) :
95             _readSymbolicOids($handle) ;
96 4         28 close ($handle);
97              
98 4         24 return $values;
99             }
100              
101             sub _readNumericalOids {
102 0     0   0 my ($handle) = @_;
103              
104 0         0 my ($values, $last_oid);
105 0         0 while (my $line = <$handle>) {
106              
107 0 0       0 if ($line =~ /^
108             (\S+) \s
109             = \s
110             (?:Wrong \s Type \s \(should \s be \s [^:]+\): \s)?
111             ([^:]+): \s
112             (.*)
113             /x
114             ) {
115 0         0 my ($oid, $type, $value) = ($1, $2, $3);
116 0         0 $values->{$oid} = [ $type, $value ];
117 0         0 $last_oid = $oid;
118 0         0 next;
119             }
120              
121             # potential continuation
122 0 0 0     0 if ($line !~ /^$/ && $line !~ /= ""$/ && $last_oid) {
      0        
123 0 0 0     0 if ($values->{$last_oid}->[0] eq 'STRING' &&
124             $values->{$last_oid}->[1] !~ /"$/
125             ) {
126 0         0 chomp $line;
127 0         0 $values->{$last_oid}->[1] .= "\n" . $line;
128 0         0 next;
129             }
130 0 0       0 if ($values->{$last_oid}->[0] eq 'Hex-STRING') {
131 0         0 chomp $line;
132 0         0 $values->{$last_oid}->[1] .= $line;
133 0         0 next;
134             }
135             }
136              
137 0         0 $last_oid = undef;
138             }
139              
140 0         0 return $values;
141             }
142              
143             sub _readSymbolicOids {
144 4     4   6 my ($handle) = @_;
145              
146              
147 4         5 my ($values, $last_oid);
148 4         27 while (my $line = <$handle>) {
149              
150 41 100       172 if ($line =~ /^
151             ([^.]+) \. ([\d.]+) \s
152             = \s
153             (?:Wrong \s Type \s \(should \s be \s [^:]+\): \s)?
154             ([^:]+): \s
155             (.*)
156             /x
157             ) {
158 32         97 my ($mib, $suffix, $type, $value) = ($1, $2, $3, $4);
159              
160 32 100       62 if ($prefixes{$mib}) {
161 31         60 my $oid = $prefixes{$mib} . '.' . $suffix;
162 31         87 $values->{$oid} = [ $type, $value ];
163 31         51 $last_oid = $oid;
164             } else {
165             # irrelevant OID
166 1         2 $last_oid = undef;
167             }
168              
169 32         106 next;
170             }
171              
172             # potential continuation
173 9 100 100     61 if ($line !~ /^$/ && $line !~ /= ""$/ && $last_oid) {
      66        
174 5 100 100     28 if ($values->{$last_oid}->[0] eq 'STRING' &&
175             $values->{$last_oid}->[1] !~ /"$/
176             ) {
177 2         4 chomp $line;
178 2         7 $values->{$last_oid}->[1] .= "\n" . $line;
179             next
180 2         6 }
181 3 50 66     14 if ($values->{$last_oid}->[0] eq 'Hex-STRING' &&
182             $line =~ /^([A-F0-9]{2})( [A-F0-9]{2})?/
183             ) {
184 0         0 chomp $line;
185 0         0 $values->{$last_oid}->[1] .= $line;
186             next
187 0         0 }
188             }
189              
190 7         32 $last_oid = undef;
191             }
192              
193 4         9 return $values;
194             }
195              
196             sub get {
197 87     87 1 1976 my ($self, $oid) = @_;
198              
199 87 50       166 return unless $oid;
200 87 100       348 return unless $self->{values}->{$oid};
201              
202             return _getSanitizedValue(
203             $self->{values}->{$oid}->[0],
204 14         41 $self->{values}->{$oid}->[1],
205             );
206             }
207              
208             sub walk {
209 55     55 1 433 my ($self, $oid) = @_;
210              
211 55 50       104 return unless $oid;
212              
213 55         57 my $values;
214 55         63 foreach my $key (keys %{$self->{values}}) {
  55         169  
215 167 100       1412 next unless $key =~ /^$oid\.(.+)/;
216             $values->{$1} = _getSanitizedValue(
217             $self->{values}->{$key}->[0],
218 42         105 $self->{values}->{$key}->[1]
219             );
220             }
221              
222 55         172 return $values;
223             }
224              
225             sub _getSanitizedValue {
226 56     56   101 my ($format, $value) = @_;
227              
228 56 100       182 if ($format eq 'Hex-STRING') {
    100          
    50          
229 1         8 $value =~ s/\s//g;
230 1         3 $value = "0x".$value;
231             } elsif ($format eq 'STRING') {
232 25         49 $value =~ s/^(?
233 25         45 $value =~ s/(?
234             } elsif ($format eq 'OID') {
235 0 0       0 if ($value =~ /^ ([^.]+) (\.[\d.]+)? $/x) {
236 0         0 my $prefix = $1;
237 0   0     0 my $suffix = $2 || '';
238             $value = $prefixes{$prefix} ?
239 0 0       0 $prefixes{$prefix} . $suffix :
240             $prefix . $suffix;
241             }
242             }
243              
244 56         224 return $value;
245             }
246              
247             1;
248             __END__