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   4229448 use strict;
  3         9  
  3         101  
4 3     3   13 use warnings;
  3         6  
  3         100  
5 3     3   10 use base 'FusionInventory::Agent::SNMP';
  3         37  
  3         1074  
6              
7 3     3   1155 use FusionInventory::Agent::Tools;
  3         6  
  3         3151  
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 17     17 1 36765 my ($class, %params) = @_;
37              
38 17         23 my $self = {};
39 17         22 bless $self, $class;
40              
41             SWITCH: {
42 17 100       17 if ($params{file}) {
  17         39  
43             die "non-existing file '$params{file}'\n"
44 4 50       63 unless -f $params{file};
45             die "unreadable file '$params{file}'\n"
46 4 50       29 unless -r $params{file};
47 4         12 $self->{values} = _getIndexedValues($params{file});
48 4         6 $self->{file} = $params{file};
49 4         7 last SWITCH;
50             }
51              
52 13 50       26 if ($params{hash}) {
53 13         21 $self->{values} = $params{hash};
54 13         16 last SWITCH;
55             }
56             }
57              
58 17         33 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   5 my ($file) = @_;
83              
84 4         14 my $handle = getFileHandle(file => $file);
85              
86             # check first line
87 4         39 my $first_line = <$handle>;
88 4         14 seek($handle, 0, 0);
89              
90             # check first line for safety
91 4 50       25 die "invalid file format\n" unless $first_line =~ /^(\S+) = .*/;
92              
93 4 50       19 my $values = substr($first_line, 0, 1) eq '.' ?
94             _readNumericalOids($handle) :
95             _readSymbolicOids($handle) ;
96 4         22 close ($handle);
97              
98 4         22 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   5 my ($handle) = @_;
145              
146              
147 4         4 my ($values, $last_oid);
148 4         22 while (my $line = <$handle>) {
149              
150 41 100       119 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         70 my ($mib, $suffix, $type, $value) = ($1, $2, $3, $4);
159              
160 32 100       41 if ($prefixes{$mib}) {
161 31         35 my $oid = $prefixes{$mib} . '.' . $suffix;
162 31         61 $values->{$oid} = [ $type, $value ];
163 31         30 $last_oid = $oid;
164             } else {
165             # irrelevant OID
166 1         2 $last_oid = undef;
167             }
168              
169 32         67 next;
170             }
171              
172             # potential continuation
173 9 100 100     50 if ($line !~ /^$/ && $line !~ /= ""$/ && $last_oid) {
      66        
174 5 100 100     22 if ($values->{$last_oid}->[0] eq 'STRING' &&
175             $values->{$last_oid}->[1] !~ /"$/
176             ) {
177 2         3 chomp $line;
178 2         4 $values->{$last_oid}->[1] .= "\n" . $line;
179             next
180 2         6 }
181 3 50 66     12 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         25 $last_oid = undef;
191             }
192              
193 4         7 return $values;
194             }
195              
196             sub get {
197 110     110 1 1613 my ($self, $oid) = @_;
198              
199 110 50       131 return unless $oid;
200 110 100       221 return unless $self->{values}->{$oid};
201              
202             return _getSanitizedValue(
203             $self->{values}->{$oid}->[0],
204 15         33 $self->{values}->{$oid}->[1],
205             );
206             }
207              
208             sub walk {
209 69     69 1 328 my ($self, $oid) = @_;
210              
211 69 50       98 return unless $oid;
212              
213 69         49 my $values;
214 69         37 foreach my $key (keys %{$self->{values}}) {
  69         152  
215 195 100       1280 next unless $key =~ /^$oid\.(.+)/;
216             $values->{$1} = _getSanitizedValue(
217             $self->{values}->{$key}->[0],
218 42         78 $self->{values}->{$key}->[1]
219             );
220             }
221              
222 69         132 return $values;
223             }
224              
225             sub _getSanitizedValue {
226 57     57   75 my ($format, $value) = @_;
227              
228 57 100       131 if ($format eq 'Hex-STRING') {
    100          
    50          
229 1         7 $value =~ s/\s//g;
230 1         2 $value = "0x".$value;
231             } elsif ($format eq 'STRING') {
232 26         42 $value =~ s/^(?
233 26         35 $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 57         159 return $value;
245             }
246              
247             1;
248             __END__