File Coverage

blib/lib/Device/Cisco/NXAPI.pm
Criterion Covered Total %
statement 172 225 76.4
branch 5 14 35.7
condition 3 14 21.4
subroutine 27 35 77.1
pod 9 10 90.0
total 216 298 72.4


line stmt bran cond sub pod time code
1             package Device::Cisco::NXAPI;
2              
3 6     6   186991 use 5.006;
  6         17  
4 6     6   20 use strict;
  6         9  
  6         96  
5 6     6   17 use warnings;
  6         8  
  6         128  
6              
7 6     6   2716 use Moose;
  6         1778592  
  6         36  
8 6     6   32264 use Modern::Perl;
  6         44198  
  6         33  
9 6     6   4205 use LWP::UserAgent;
  6         184622  
  6         188  
10 6     6   42 use HTTP::Request;
  6         7  
  6         145  
11 6     6   3530 use Data::Dumper;
  6         29037  
  6         314  
12 6     6   625 use JSON;
  6         8403  
  6         47  
13 6     6   730 use Carp;
  6         7  
  6         272  
14 6     6   2850 use List::MoreUtils qw( natatime );
  6         40662  
  6         30  
15 6     6   5298 use Params::Validate qw(:all);
  6         13017  
  6         977  
16 6     6   29 use URI;
  6         6  
  6         125  
17              
18 6     6   2503 use Device::Cisco::NXAPI::Test;
  6         14  
  6         13127  
19              
20              
21             =head1 NAME
22              
23             Device::Cisco::NXAPI - Interact with the NX-API (Nexus 9K Switches)
24              
25             =head1 VERSION
26              
27             Version 0.01
28              
29             =cut
30              
31             our $VERSION = '0.01';
32              
33              
34             =head1 SYNOPSIS
35              
36             This module provides methods to make API calls and extract information from devices that support the NX-API.
37             This is predominantly the Nexus 9K range of switches in NXOS mode (not in ACI mode).
38              
39             use Device::Cisco::NXAPI;
40              
41             my $switch_api = Device::Cisco::NXAPI->new(uri => "https://192.168.1.1:8080", username => "admin", password => "admin");
42              
43             my @route_info = $switch_api->routes(vrf => "CustVRF");
44             my %version_info = $switch_api->version();
45              
46             =cut
47              
48             has 'user_agent' => ( is => 'rw', isa => 'LWP::UserAgent', default => sub { LWP::UserAgent->new });
49             has 'http_request' => ( is => 'rw', isa => 'HTTP::Request');
50             has 'uri' => ( is => 'ro', isa => 'Str', required => 1);
51             has 'username' => ( is => 'ro', isa => 'Str', required => 1);
52             has 'password' => ( is => 'ro', isa => 'Str', required => 1);
53             has 'debug' => ( is => 'ro', isa => 'Bool', default => 0);
54              
55             =head1 CONSTRUCTOR
56            
57             This method constructs a new C<Device::Cisco::NXAPI> object.
58            
59             my $switch_api = Device::Cisco::NXAPI->new(
60             # Mandatory parameters:
61             uri => '', # URI of the switch to connect to.
62             username => '', # Username to logon to the switch
63             password => '', # Password to logon to the switch
64              
65             # Optional Parameters
66             debug => (0 | 1), # Output debugging information to stderr
67             );
68              
69             =cut
70              
71             sub BUILD {
72 5     5 0 17618 my $self = shift;
73            
74 5         149 my $uri = URI->new($self->uri);
75 5 50 33     26483 croak "Only http:// or https:// supported." if !($uri->scheme eq 'http' or $uri->scheme eq 'https');
76              
77 5         394 $self->http_request(HTTP::Request->new(POST => $uri->scheme.$uri->host_port."/ins"));
78 5         129 $self->http_request()->content_type("application/json-rpc");
79 5         352 $self->user_agent()->credentials($uri->host_port, 'Secure Zone', $self->username, $self->password);
80             }
81              
82             =head1 METHODS
83            
84             =head2 tester()
85              
86             Returns a B<Device::Cisco::NXAPI::Test> object for the switch. This object can be used to run test
87             cases against the switch.
88              
89             =cut
90              
91             sub tester {
92 5     5 1 1117 my $self = shift;
93 5         54 return Device::Cisco::NXAPI::Test->new(switch => $self);
94             }
95              
96             =head2 version()
97              
98             my %version_info = $switch->version()
99              
100             Returns a hash consisting of system information. There are no arguments to this method.
101              
102             The structure returned is as follows:
103              
104             (
105             'kern_uptm_secs' => 17,
106             'kickstart_ver_str' => '7.0(3)I2(2b)',
107             'kick_file_name' => 'bootflash:///nxos.7.0.3.I2.2b.bin',
108             'rr_ctime' => ' Mon Dec 19 04:57:51 2016',
109             'kern_uptm_days' => 0,
110             'kick_tmstmp' => '02/29/2016 05:21:45',
111             'host_name' => 'switch',
112             'cpu_name' => 'Intel(R) Core(TM) i3- CPU @ 2.50GHz',
113             'kern_uptm_hrs' => 0,
114             'manufacturer' => 'Cisco Systems, Inc.',
115             'rr_sys_ver' => '11.3(2h)',
116             'mem_type' => 'kB',
117             'bootflash_size' => 7906304,
118             'kern_uptm_mins' => 5,
119             'bios_cmpl_time' => '10/12/2015',
120             'bios_ver_str' => '07.41',
121             'proc_board_id' => 'SAL1911BCSU',
122             'kick_cmpl_time' => ' 2/28/2016 21:00:00',
123             'header_str' => 'Cisco Nexus Operating System (NX-OS) Software',
124             'rr_reason' => 'Reset Requested by CLI command reload',
125             'memory' => 16401952,
126             'chassis_id' => 'Nexus9000 C9372PX chassis',
127             'rr_usecs' => 832622,
128             'rr_service' => 'PolicyElem Ch reload'
129             );
130              
131             =cut
132              
133             sub version {
134 0     0 1 0 my $self = shift;
135              
136 0         0 my $ret = $self->_send_cmd("show version");
137 0         0 _fixup_returned_structure($ret);
138 0         0 return %{ $ret };
  0         0  
139             }
140              
141             =head2 routes( %options )
142              
143             my @routes = $switch->routes(
144             vrf => '',
145             af => 'ipv4 | ipv6',
146             );
147              
148             my $first_route = $routes[0]->{prefix};
149              
150             Returns a list of HASHREFs with information on the routes present in the a VRFs routing table. The 'vrf =>' argument
151             determines the VRF, and if not specified the global routing table is used. The 'vrf => all' will return routes from
152             all routing tables on the switch.
153              
154             The structure returned is as follows:
155              
156             (
157             {
158             'prefix' => '1.1.1.0/24' # The prefix of the route
159             'vrf' => 'other_vrf', # VRF the route is in.
160             'paths' => [ # Paths to next-hop (multiple paths in the case of ECMP)
161             {
162             'clientname' => 'direct', # Protocol (e.g. direct, local, static, ospf)
163             'uptime' => 'P28DT19H43M28S', # Time the route has been in the routing table
164             'ipnexthop' => '2.2.2.1', # Next hop IP for the path
165             'ifname' => 'Eth1/1' # Egress interface for the path
166             }
167             ],
168             },
169             )
170              
171             =cut
172              
173             sub routes {
174 12     12 1 15 my $self = shift;
175 12         264 my %args = validate(@_,
176             {
177             vrf => { default => 'default', type => SCALAR | UNDEF },
178             af => { default => 'ipv4', type => SCALAR | UNDEF },
179             }
180             );
181              
182             my $per_af_command = {
183             ipv4 => "show ip route vrf $args{vrf}",
184             ipv6 => "show ipv6 route vrf $args{vrf}",
185 12   33     109 }->{ $args{af} } // croak "Unknown address-family: $args{af}";
186              
187 12         55 my $ret = $self->_send_cmd($per_af_command);
188 12         1069 _fixup_returned_structure($ret);
189 12         17 return _modify_returned_route_structure($ret);
190             }
191              
192             sub _modify_returned_route_structure {
193 12     12   9 my $route_structure = shift;
194 12         9 my @ret_routes;
195              
196 12         11 for my $vrf (@{ $route_structure->{vrf} }) {
  12         18  
197 24         37 my $vrf_name = $vrf->{'vrf-name-out'};
198            
199 24         22 for my $addr_family (@{ $vrf->{addrf} }) {
  24         30  
200 24         26 my $address_family = $addr_family->{addrf};
201              
202 24         17 for my $prefix (@{ $addr_family->{prefix} }) {
  24         31  
203 120         90 my %prefix_info;
204              
205 120         156 $prefix_info{vrf} = $vrf_name;
206 120         155 $prefix_info{prefix} = $prefix->{ipprefix};
207              
208             # The format of the paths structure is not great. It's a single array of hashrefs,
209             # with 2 hashrefs for every IPv4 path and 3 HASHREFs for every IPv6 path.
210             #
211             # We first need to decide on how we iterate through the array:
212             my $path_iteration_num = {
213             ipv4 => 2,
214             ipv6 => 3,
215 120         167 }->{ $address_family };
216              
217             # Create the iterator
218 120         118 my $path_iterate = natatime $path_iteration_num, @{ $prefix->{path} };
  120         284  
219 120         263 while (my @path = $path_iterate->()) {
220              
221             # Merge either the 2 or 3 HASHREFs into a single HASH
222 124         96 my %merged_path_entry = map { %{ $_ } } @path;
  248         140  
  248         749  
223              
224             # Take a slice of the keys and vals that we want
225 124         326 my %path_entry = %merged_path_entry{ 'ipnexthop', 'uptime', 'ifname', 'clientname' };
226              
227 124         86 push @{ $prefix_info{paths} }, \%path_entry;
  124         454  
228             }
229              
230 120         313 push @ret_routes, \%prefix_info;
231             }
232              
233             }
234             }
235 12         219 return @ret_routes;
236             }
237              
238             =head2 arp( %options )
239              
240             my @arp_table = $switch->arp(
241             vrf => '',
242             );
243              
244             Returns a list of HASREFs containing the ARP table information. The B<vrf> argument specifies the VRF to
245             retrieve the ARP entries from. If no argument is specified the global routing table is used. If B<all> is
246             specified as the VRF, ARP entries from all routing tables are returned.
247              
248             The structure returned is as follows:
249              
250             (
251             {
252             'ifname' => 'mgmt0', # Egress interface
253             'vrf' => 'management', # VRF
254             'mac' => '0009.0fe9.9b39', # MAC address
255             'ip' => '10.47.64.4', # IP address
256             'time-stamp' => '00:01:20' # Entry timeout
257             }
258             )
259              
260             =cut
261              
262             sub arp {
263 6     6 1 6 my $self = shift;
264 6         47 my %args = validate(@_,
265             {
266             vrf => { default => 'default', type => SCALAR | UNDEF },
267             }
268             );
269              
270 6         26 my $ret = $self->_send_cmd("show ip arp vrf $args{vrf}");
271 6         154 _fixup_returned_structure($ret);
272              
273 6         12 return _modify_returned_arp_structure($ret);
274             }
275              
276             sub _modify_returned_arp_structure {
277 6     6   5 my $arp_structure = shift;
278 6         4 my @ret_arp;
279              
280 6         6 for my $vrf (@{ $arp_structure->{vrf} }) {
  6         8  
281 6         11 my $vrf_name = $vrf->{'vrf-name-out'};
282              
283 6         7 for my $adjacency (@{ $vrf->{adj} }) {
  6         8  
284             # Add the VRF and rename some of the keys to
285             # consistent values
286 30         32 $adjacency->{vrf} = $vrf_name; # Add the VRF name
287 30         37 $adjacency->{ip} = delete $adjacency->{'ip-addr-out'};
288 30         39 $adjacency->{ifname} = delete $adjacency->{'intf-out'};
289              
290 30         39 push @ret_arp, $adjacency;
291             }
292             }
293 6         27 return @ret_arp;
294             }
295              
296            
297              
298             =head2 vlans()
299              
300             my @vlan_info = $switch->vlans();
301              
302             Returns a list of HASHREFs containing information on the current layer 2 VLANs configured on the device.
303             This method has no arguments.
304              
305             The data structure returned is as follows:
306              
307             (
308             {
309             'id' => '1',
310             'utf_id' => '1',
311             'name' => 'default',
312             'admin_state' => 'noshutdown',
313             'vlan_state' => 'active'
314             'interfaces' => [
315             'Ethernet1/3-22',
316             'Ethernet1/26-44',
317             'Ethernet1/47-54'
318             ],
319             },
320             )
321              
322              
323             =cut
324              
325             sub vlans {
326 0     0 1 0 my $self = shift;
327              
328 0         0 my $ret = $self->_send_cmd("show vlan");
329 0         0 _fixup_returned_structure($ret);
330 0         0 return _modify_returned_vlan_structure($ret);
331             }
332              
333             sub _modify_returned_vlan_structure {
334 0     0   0 my $vlan_structure = shift;
335 0         0 my @ret_vlans;
336              
337 0         0 for my $vlan (@{ $vlan_structure->{vlanbrief} }) {
  0         0  
338 0         0 my @vlan_keys = (
339             ['vlanshowbr-shutstate', 'admin_state'],
340             ['vlanshowbr-vlanstate', 'vlan_state'],
341             ['vlanshowbr-vlanid', 'id'],
342             ['vlanshowbr-vlanname', 'name'],
343             ['vlanshowplist-ifidx', 'interfaces'],
344             ['vlanshowbr-vlanid-utf', 'utf_id'],
345             );
346              
347             # Rename the keys
348 0         0 my %renamed_vlan = map { $_->[1] => $vlan->{$_->[0]} } @vlan_keys;
  0         0  
349              
350             # The interfaces are in comma seperated form - split this out into an array
351 0         0 my @split_interfaces = split ',', $renamed_vlan{interfaces};
352 0         0 $renamed_vlan{interfaces} = \@split_interfaces;
353              
354 0         0 push @ret_vlans, \%renamed_vlan;
355             }
356 0         0 return @ret_vlans;
357             }
358              
359             =head2 physical_interfaces()
360              
361             my @interface_info = $switch->physical_interfaces();
362              
363             Returns a list of HASHREFs containing information on the physical interfacee state.
364              
365             The structure returned is as follows:
366              
367             (
368             {
369             'name' => 'Ethernet1/5',
370             'mac' => '84b8.020f.15d4',
371             'speed' => 'auto-speed',
372             'admin_state' => 'up',
373             'op_state' => 'down',
374             'fps_in' => '0',
375             'fps_out' => '0',
376             'bps_in' => '0',
377             'bps_out' => '0',
378             'bytes_in' => 0,
379             'bytes_out' => 0,
380             'packets_in' => 0,
381             'packets_out' => 0,
382             'last_link_flap' => 'never'
383             'errors' => {
384             'ignored_frames' => '0',
385             'bad_protocol' => '0',
386             'runts' => 0,
387             'crc_errors' => '0',
388             'no_carrier' => '0',
389             'in_errors' => '0',
390             'collisions' => '0',
391             'lost_carrier' => '0',
392             'dribbles' => '0',
393             'overruns' => '0',
394             'bad_frames' => '0',
395             'no_buffer' => 0,
396             'late_collisions' => '0',
397             'underruns' => '0',
398             'out_errors' => '0',
399             'babbles' => '0',
400             'out_discards' => '0',
401             'in_discards' => '0'
402             },
403             }
404             )
405              
406             =cut
407              
408             sub physical_interfaces {
409 11     11 1 9 my $self = shift;
410              
411 11         20 my $ret = $self->_send_cmd('show interfaces');
412 11         2191 _fixup_returned_structure($ret);
413 11         20 return _modify_returned_phy_int_structure($ret);
414             }
415              
416             sub _modify_returned_phy_int_structure {
417 11     11   8 my $int_structure = shift;
418 11         7 my @ret_interfaces;
419              
420 11         9 for my $interface (@{ $int_structure->{interface} }) {
  11         15  
421             # The following structure is used to rename the keys
422             # in the returned structure to better names.
423 66         275 my @eth_info_keys = (
424             ['interface', 'name'],
425             ['admin_state', 'admin_state'],
426             ['state', 'op_state'],
427             ['eth_inbytes', 'bytes_in'],
428             ['eth_outbytes', 'bytes_out'],
429             ['eth_inpkts', 'packets_in'],
430             ['eth_outpkts', 'packets_out'],
431             ['eth_outrate1_bits', 'bps_out'],
432             ['eth_outrate1_pkts', 'fps_out'],
433             ['eth_inrate1_bits', 'bps_in'],
434             ['eth_inrate1_pkts', 'fps_in'],
435             ['eth_bia_addr', 'mac'],
436             ['eth_speed', 'speed'],
437             ['eth_link_flapped', 'last_link_flap'],
438             );
439              
440 66         317 my @eth_err_keys = (
441             ['eth_bad_eth', 'bad_frames'],
442             ['eth_overrun', 'overruns'],
443             ['eth_runts', 'runts'],
444             ['eth_nobuf', 'no_buffer'],
445             ['eth_lostcarrier', 'lost_carrier'],
446             ['eth_ignored', 'ignored_frames'],
447             ['eth_coll', 'collisions'],
448             ['eth_crc', 'crc_errors'],
449             ['eth_nocarrier', 'no_carrier'],
450             ['eth_outerr', 'out_errors'],
451             ['eth_inerr', 'in_errors'],
452             ['eth_indiscard', 'in_discards'],
453             ['eth_outdiscard', 'out_discards'],
454             ['eth_babbles', 'babbles'],
455             ['eth_latecoll', 'late_collisions'],
456             ['eth_underrun', 'underruns'],
457             ['eth_dribble', 'dribbles'],
458             ['eth_bad_proto', 'bad_protocol'],
459             );
460              
461             # We extract out the relevant keys and translate them to better names
462             # We also move the interface errors to a sub-tree
463 66   50     74 my %renamed_info = map { $_->[1] => $interface->{$_->[0] // ''} } @eth_info_keys;
  924         1929  
464 66         129 my %renamed_errors = map { $_->[1] => $interface->{$_->[0]} } @eth_err_keys;
  1188         1706  
465 66         144 $renamed_info{errors} = \%renamed_errors;
466            
467 66         254 push @ret_interfaces, \%renamed_info;
468             }
469              
470 11         470 return @ret_interfaces;
471             }
472              
473             =head2 bgp_peers( %options )
474              
475             my @bgp_peers = $switch->bgp_peers(
476             vrf => '',
477             af => 'ipv4 | ipv6'
478             );
479              
480             This function retrieves information on the BGP peers configured on the device. If B<vrf> is not specified,
481             the peer info relating to the default routing table is retrieved. If B<vrf> is specified as 'all', peer info
482             from all VRFs (including the global routing table) is returned.
483              
484             The structure returned is as follows:
485             (
486             {
487             'capabilitiessent' => '0',
488             'state' => 'Idle',
489             'updatesrecvd' => '0',
490             'up' => 'false',
491             'index' => '1',
492             'updatessent' => '0',
493             'keepaliverecvd' => '0',
494             'holdtime' => '180',
495             'resettime' => 'never',
496             'neighbor' => '1.1.1.1',
497             'lastread' => 'never',
498             'opensrecvd' => '0',
499             'peerresettime' => 'never',
500             'bytesrecvd' => '0',
501             'notificationsrcvd' => '0',
502             'msgrecvd' => '0',
503             'rtrefreshrecvd' => '0',
504             'rtrefreshsent' => '0',
505             'version' => '4',
506             'firstkeepalive' => 'false',
507             'remoteas' => '65001',
508             'keepalivesent' => '0',
509             'notificationssent' => '0',
510             'bytessent' => '0',
511             'remote-id' => '0.0.0.0',
512             'keepalivetime' => '60',
513             'peerresetreason' => 'No error',
514             'restarttime' => '00:00:01',
515             'lastwrite' => 'never',
516             'connsestablished' => '0',
517             'connsdropped' => '0',
518             'resetreason' => 'No error',
519             'recvbufbytes' => '0',
520             'connattempts' => '0',
521             'elapsedtime' => '00:05:24',
522             'sentbytesoutstanding' => '0',
523             'msgsent' => '0',
524             'openssent' => '0'
525             },
526             )
527              
528             =cut
529              
530             sub bgp_peers {
531 1     1 1 2 my $self = shift;
532 1         20 my %args = validate(@_,
533             {
534             vrf => { default => 'default', type => SCALAR | UNDEF },
535             af => { default => 'ipv4', type => SCALAR | UNDEF, regex => qr{(ipv4|ipv6)} }
536             }
537             );
538            
539 1         18 my $user_args = "vrf $args{vrf} $args{af}";
540              
541 1         5 my $ret = $self->_send_cmd("show bgp $user_args neighbors");
542 1         72 _fixup_returned_structure($ret);
543 1         4 return _modify_returned_bgp_peer_structure($ret);
544             }
545              
546             sub _modify_returned_bgp_peer_structure {
547 1     1   1 my $bgp_peer_structure = shift;
548 1         2 my @ret_bgp_peers;
549              
550 1         1 for my $bgp_peer (@{ $bgp_peer_structure->{neighbor} }) {
  1         2  
551 1         7 my @extracted_keys = (
552             'up',
553             'state',
554             'resettime',
555             'resetreason',
556             'peerresetreason',
557             'neighbor',
558             'remoteas',
559             'remote-id',
560             'version',
561             'holdtime',
562             'keepalivetime',
563             'connsdropped',
564             'connsestablished',
565             'restarttime',
566             'firstkeepalive',
567             'sentbytesoutstanding',
568             'msgsent',
569             'msgrecvd',
570             'bytessent',
571             'bytesrecvd',
572             'updatessent',
573             'updatesrecvd',
574             'openssent',
575             'opensrecvd',
576             'notificationssent',
577             'notificationsrcvd',
578             'rtrefreshsent',
579             'keepaliverecvd',
580             'connattempts',
581             'lastread',
582             'rtrefreshrecvd',
583             'index',
584             'peerresettime',
585             'recvbufbytes',
586             'capabilitiessent',
587             'elapsedtime',
588             'lastwrite',
589             'keepalivesent',
590             );
591              
592 1         1 my %peer_info = %{ $bgp_peer }{ @extracted_keys };
  1         31  
593 1         3 push @ret_bgp_peers, \%peer_info;
594             }
595 1         13 return @ret_bgp_peers;
596             }
597              
598              
599             =head2 bgp_rib( %options )
600              
601             my $bgp_rib_ref = $switch->bgp_rib(
602             vrf => '',
603             af => 'ipv4 | ipv6'
604             );
605              
606             Returns information on the BGP Routinng Information Base (RIB). If B<vrf =>> is not specified, the global routing table is returned.
607             If B<vrf =>> is set to 'all', the RIB for all VRFs, including the global routing table, is returned.
608              
609             If B<af =>> is not specied, the RIB for the IPv4 address family is returned.
610              
611             The structure returned is as follows:
612              
613             (
614             {
615             'prefix' => '1.2.3.0/24',
616             'paths' => [
617             {
618             'pathnr' => '0',
619             'ipnexthop' => '0.0.0.0',
620             'weight' => '32768',
621             'best' => '>',
622             'metric' => '',
623             'origin' => 'i',
624             'aspath' => '',
625             'localpref' => '100',
626             'type' => 'l',
627             'status' => '*'
628             }
629             ],
630             'vrf' => 'default'
631             },
632             )
633              
634              
635             =cut
636             sub bgp_rib {
637 4     4 1 5 my $self = shift;
638 4         54 my %args = validate(@_,
639             {
640             vrf => { default => 'default', type => SCALAR | UNDEF },
641             af => { default => 'ipv4', type => SCALAR | UNDEF, regex => qr{(ipv4|ipv6)} }
642             }
643             );
644              
645 4         54 my ($vrf, $addr_family);
646              
647 4         10 my %address_families = (
648             ipv4 => "ip unicast",
649             ipv6 => "ipv6 unicast",
650             all => "all",
651             );
652              
653 4         6 $vrf = "vrf ".$args{vrf};
654 4         4 $addr_family = $address_families{ $args{af} };
655              
656 4         15 my $ret = $self->_send_cmd("show bgp $vrf $addr_family");
657 4         150 _fixup_returned_structure($ret);
658 4         9 return _modify_returned_bgp_rib_structure($ret);
659             }
660              
661             sub _modify_returned_bgp_rib_structure {
662 4     4   3 my $bgp_structure = shift;
663 4         3 my @ret_bgp_rib;
664              
665 4         4 for my $vrf (@{ $bgp_structure->{vrf} }) {
  4         6  
666 4         8 my $vrf_name = $vrf->{'vrf-name-out'};
667              
668 4         6 for my $afi (@{ $vrf->{afi} }) {
  4         5  
669 4         4 for my $safi (@{ $afi->{safi} }) {
  4         5  
670 4         3 for my $rd (@{ $safi->{rd} }) {
  4         5  
671 4         2 for my $prefix (@{ $rd->{prefix} }) {
  4         6  
672 8         6 my %bgp_prefix;
673              
674 8         11 $bgp_prefix{vrf} = $vrf_name;
675 8         12 $bgp_prefix{prefix} = $prefix->{ipprefix};
676 8         9 $bgp_prefix{paths} = $prefix->{path};
677              
678              
679 8         18 push @ret_bgp_rib, \%bgp_prefix;
680             }
681             }
682             }
683             }
684             }
685 4         28 return @ret_bgp_rib;
686             }
687              
688              
689             =head2 cdp_neighbours()
690              
691             Returns a list of HASHREFs containing the current CDP information visible on the switch.
692              
693             The structure returned is as follows:
694              
695             (
696             {
697             'platform_id' => 'cisco WS-C2960X-24TD-L',
698             'intf_id' => 'mgmt0',
699             'port_id' => 'GigabitEthernet1/0/3',
700             'ifindex' => 83886080,
701             'ttl' => 179,
702             'device_id' => 'hostname',
703             'capability' => 'IGMP_cnd_filtering'
704             }
705             )
706              
707             =cut
708              
709             sub cdp_neighbours {
710 0     0 1 0 my $self = shift;
711              
712 0         0 my $ret = $self->_send_cmd("show cdp neighbors detail");
713 0         0 _fixup_returned_structure($ret);
714 0         0 return _modify_returned_cdp_structure($ret);
715             }
716              
717             sub _modify_returned_cdp_structure {
718 0     0   0 my $cdp_structure = shift;
719              
720 0         0 return @{ $cdp_structure->{cdp_neighbor_brief_info} };
  0         0  
721             }
722              
723              
724             sub _send_cmd {
725 0     0   0 my $self = shift;
726 0         0 my $command = shift;
727              
728 0         0 my $json = $self->_gen_cmd($command);
729 0 0       0 if ($self->debug) {
730 0         0 say "[DEBUG]: $json";
731             }
732 0         0 $self->http_request()->content($json);
733 0         0 my $response = $self->user_agent()->request( $self->http_request );
734 0         0 return $self->_check_and_return_response($response)->{result}->{body};
735             }
736              
737             sub _gen_cmd {
738 0     0   0 my $self = shift;
739 0         0 my $command = shift;
740              
741 0         0 my $json_ref = [{
742             jsonrpc => "2.0",
743             method => "cli",
744             params => {
745             cmd => "",
746             version => 1,
747             },
748             id => "1",
749             }];
750              
751 0         0 $json_ref->[0]->{params}->{cmd} = $command;
752 0         0 return encode_json($json_ref);
753             }
754              
755             sub _check_and_return_response {
756 0     0   0 my $self = shift;
757 0         0 my $response = shift;
758 0         0 my $json_content;
759             my $json_error_code;
760 0         0 my $json_error_msg;
761            
762 0         0 $json_content = eval { decode_json($response->content) };
  0         0  
763              
764 0 0       0 if ($json_content->{error}) {
765 0   0     0 $json_error_code = $json_content->{error}->{code} // "<No Code>";
766 0   0     0 $json_error_msg = $json_content->{error}->{data}->{msg} // "";
767             }
768              
769 0   0     0 $json_error_msg //= "";
770              
771 0 0       0 croak "HTTP Error (".$response->code()."): ".$response->status_line()." ".$json_error_msg if $response->is_error();
772              
773 0 0       0 croak "NX-API Error($json_error_code}): $json_error_msg" if $json_content->{error};
774              
775 0         0 return $json_content;
776             }
777              
778             sub _fixup_returned_structure {
779 589     589   400 my $structure_ref = shift;
780              
781             # Find all of the keys which a prefixed with 'TABLE_'
782 589         386 my @table_keys = grep { m{TABLE_}sxm } keys %{ $structure_ref };
  6338         5625  
  589         1100  
783              
784 589 100       1314 return $structure_ref if (@table_keys == 0);
785              
786 231         219 for my $table_key (@table_keys) {
787             # Rename the TABLE_ key
788 231         515 my ($new_key) = $table_key =~ m{TABLE_(\w+)}sxm;
789              
790             # Generate the ROW_ key name
791 231         231 my $row_key = "ROW_".$new_key;
792              
793             # If the row is a HASHREF, it means there's only one element.
794             # We change this to an ARRAYREF of one HASHREF so that the table
795             # is always an ARRAYREF, even if it's only one element.
796 231 100       384 if (ref($structure_ref->{ $table_key }->{ $row_key }) eq 'HASH') {
797 65         112 $structure_ref->{ $new_key } = [ $structure_ref->{ $table_key }->{ $row_key } ];
798             } else {
799 166         192 $structure_ref->{ $new_key } = $structure_ref->{ $table_key }->{ $row_key };
800             }
801              
802 231         234 delete $structure_ref->{ $table_key };
803              
804             # Go through each hash item and recursively fix them up
805 231         142 for my $row (@{ $structure_ref->{ $new_key } }) {
  231         282  
806 555         567 _fixup_returned_structure($row);
807             }
808             }
809             }
810            
811              
812              
813             =head1 AUTHOR
814              
815             Greg Foletta, C<< <greg at foletta.org> >>
816              
817             =head1 BUGS
818              
819             Please report any bugs or feature requests to C<bug-switch-nxapi at rt.cpan.org>, or through
820             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Switch-NXAPI>. I will be notified, and then you'll
821             automatically be notified of progress on your bug as I make changes.
822              
823              
824              
825              
826             =head1 SUPPORT
827              
828             You can find documentation for this module with the perldoc command.
829              
830             perldoc Device::Cisco::NXAPI
831              
832              
833             You can also look for information at:
834              
835             =over 4
836              
837             =item * RT: CPAN's request tracker (report bugs here)
838              
839             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Switch-NXAPI>
840              
841             =item * AnnoCPAN: Annotated CPAN documentation
842              
843             L<http://annocpan.org/dist/Switch-NXAPI>
844              
845             =item * CPAN Ratings
846              
847             L<http://cpanratings.perl.org/d/Switch-NXAPI>
848              
849             =item * Search CPAN
850              
851             L<http://search.cpan.org/dist/Switch-NXAPI/>
852              
853             =back
854              
855              
856             =head1 ACKNOWLEDGEMENTS
857              
858              
859             =head1 LICENSE AND COPYRIGHT
860              
861             Copyright 2016 Greg Foletta.
862              
863             This program is free software; you can redistribute it and/or modify it
864             under the terms of the the Artistic License (2.0). You may obtain a
865             copy of the full license at:
866              
867             L<http://www.perlfoundation.org/artistic_license_2_0>
868              
869             Any use, modification, and distribution of the Standard or Modified
870             Versions is governed by this Artistic License. By using, modifying or
871             distributing the Package, you accept this license. Do not use, modify,
872             or distribute the Package, if you do not accept this license.
873              
874             If your Modified Version has been derived from a Modified Version made
875             by someone other than you, you are nevertheless required to ensure that
876             your Modified Version complies with the requirements of this license.
877              
878             This license does not grant you the right to use any trademark, service
879             mark, tradename, or logo of the Copyright Holder.
880              
881             This license includes the non-exclusive, worldwide, free-of-charge
882             patent license to make, have made, use, offer to sell, sell, import and
883             otherwise transfer the Package with respect to any patent claims
884             licensable by the Copyright Holder that are necessarily infringed by the
885             Package. If you institute patent litigation (including a cross-claim or
886             counterclaim) against any party alleging that the Package constitutes
887             direct or contributory patent infringement, then this Artistic License
888             to you shall terminate on the date that such litigation is filed.
889              
890             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
891             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
892             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
893             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
894             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
895             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
896             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
897             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
898              
899              
900             =cut
901              
902             1; # End of Device::Cisco::NXAPI