Merge branch 'test-coverage'

.gitignore

@@ -9,3 +9,4 @@ Makefile*
 Build
 _build
 blib
+cover_db

Build.PL

@@ -27,6 +27,11 @@ Module::Build->new(
   test_requires => {
     'Test::More' => '0.88',
     'Test::Distribution' => '0',
+    'Test::Class::Most'  => '0',
+    'Test::MockObject::Extends' => '0',
+    'File::Find' => '0',
+    'Path::Class' => '0',
+    'File::Slurper' => '0', 
   },
   # script_files => [
   # ],

lib/SNMP/Info.pm

@@ -1277,7 +1277,7 @@ sub new {
     }
 
     # Connects to device unless open session is provided.
-    $sess = new SNMP::Session(
+    $sess = SNMP::Session->new(
         'UseEnums' => 1,
         %sess_args, 'RetryNoSuch' => $new_obj->{nosuch}
     ) unless defined $sess;
@@ -1339,7 +1339,7 @@ sub update {
     delete $sess_args{BigInt};
     delete $sess_args{MibDirs};
 
-    my $sess = new SNMP::Session(
+    my $sess = SNMP::Session->new(
         'UseEnums' => 1,
         %sess_args, 'RetryNoSuch' => $obj->{nosuch}
     );
@@ -2721,7 +2721,7 @@ sub _get_topo_data {
     my $self     = shift;
     my $partial  = shift;
     my $topo_cap = shift;
-    my $method   = shift;
+    my $method   = shift || '';
 
     return unless $method =~ /(ip|if|port|id|platform|cap)/;
 
@@ -3056,7 +3056,9 @@ the SNMP::Info methods.
     'name'         => 'sysName',
     'location'     => 'sysLocation',
     'layers'       => 'sysServices',
+    # IF-MIB
     'ports'        => 'ifNumber',
+    # IP-MIB
     'ipforwarding' => 'ipForwarding',
 );
 
@@ -3074,7 +3076,9 @@ ALTEON-TS-PHYSICAL-MIB::agPortCurCfgPortName.
 =cut
 
 %FUNCS = (
+    # IF-MIB::IfEntry
     'interfaces' => 'ifIndex',
+    # IF-MIB::IfEntry
     'i_name'     => 'ifName',
 
     # IF-MIB::IfEntry
@@ -3104,13 +3108,13 @@ ALTEON-TS-PHYSICAL-MIB::agPortCurCfgPortName.
     # IF-MIB::IfStackTable
     'i_stack_status'    => 'ifStackStatus',
 
-    # IP Address Table
+    # IP::MIB::ipAddrTable (deprecated IPv4 address table)
     'ip_index'     => 'ipAdEntIfIndex',
     'ip_table'     => 'ipAdEntAddr',
     'ip_netmask'   => 'ipAdEntNetMask',
     'ip_broadcast' => 'ipAdEntBcastAddr',
 
-    # ifXTable - Extension Table
+    # IF-MIB::ifXTable - Extension Table
     'i_speed_high'       => 'ifHighSpeed',
     'i_pkts_multi_in'    => 'ifInMulticastPkts',
     'i_pkts_multi_out'   => 'ifOutMulticastPkts',
@@ -3126,7 +3130,7 @@ ALTEON-TS-PHYSICAL-MIB::agPortCurCfgPortName.
     'i_pkts_bcast_out64' => 'ifHCOutBroadcastPkts',
     'i_alias'            => 'ifAlias',
 
-    # IP Routing Table
+    # RFC-1213::ipRoute (deprecated Table IP Routing Table)
     'ipr_route' => 'ipRouteDest',
     'ipr_if'    => 'ipRouteIfIndex',
     'ipr_1'     => 'ipRouteMetric1',
@@ -3157,7 +3161,13 @@ $info->init() will throw an exception if a MIB does not load.
 
 %MIBS = (
 
-    # The "main" MIBs are automagically loaded in Net-SNMP now.
+    # Include these here for cases where the Net-SNMP default MIB list has
+    # been overridden during the compliation of the local Net-SNMP library.
+    # These cover the globals and funcs defined in this file.
+    'SNMPv2-MIB'  => 'sysObjectID',
+    'RFC1213-MIB' => 'ipRouteIfIndex',
+    'IP-MIB'      => 'ipAdEntAddr',
+    'IF-MIB'      => 'ifIndex',
 );
 
 =item %MUNGE
@@ -4237,7 +4247,7 @@ sub _load_attr {
         # partial fetch may strip the Module portion upon return.  We need
         # the match to make sure we didn't leave the table during getnext
         # requests
-        
+
         my ($leaf) = $qual_leaf =~ /::(\w+)$/;
 
         $self->debug()
@@ -4245,7 +4255,7 @@ sub _load_attr {
             defined $partial ? "($partial)" : '', " : $oid" ,
             defined $partial ? ".$partial" : '', "\n";
 
-        my $var = new SNMP::Varbind( [$qual_leaf, $partial] );
+        my $var = SNMP::Varbind->new( [$qual_leaf, $partial] );
 
         # So devices speaking SNMP v.1 are not supposed to give out
         # data from SNMP2, but most do.  Net-SNMP, being very precise
@@ -4438,7 +4448,7 @@ sub snmp_connect_ip {
     return if ( $ip eq '0.0.0.0' ) or ( $ip =~ /^127\./ );
 
     # Create session object
-    my $snmp_test = new SNMP::Session(
+    my $snmp_test = SNMP::Session->new(
         'DestHost'  => $ip,
         'Community' => $comm,
         'Version'   => $ver
@@ -4680,21 +4690,27 @@ sub can {
     my $funcs = $self->funcs();
 
     # We need to resolve funcs with a prefix or suffix
-    my $f_method = $method;
+    my $base_method = $method;
-    $f_method =~ s/^(load|orig)_//;
+    $base_method =~ s/^(load|orig)_//;
-    $f_method =~ s/_raw$//;
+    $base_method =~ s/_raw$//;
 
     no strict 'refs';    ## no critic (ProhibitNoStrict )
 
+    # We could add load_/orig_/_raw alternatives to symbol table here on
+    # first call of any type for a global or func since they all use the same
+    # destination code, but they aren't used heavily in main code base so
+    # we’ll just create if/when they are called rather than pollute the
+    # symbol table with entries that never get called.
+
     # Check for set_ ing.
     if ( $method =~ /^set_/ ) {
-        return *{$AUTOLOAD} = _make_setter( $method, $oid, @_ );
+        return *{$method} = _make_setter( $method, $oid, @_ );
     }
-    elsif ( defined $funcs->{$f_method} || $table ) {
+    elsif ( defined $funcs->{$base_method} || $table ) {
-        return *{$AUTOLOAD} = _load_attr( $method, $oid, @_ );
+        return *{$method} = _load_attr( $method, $oid, @_ );
     }
     else {
-        return *{$AUTOLOAD} = _global( $method, $oid );
+        return *{$method} = _global( $method, $oid );
     }
 }
 
@@ -4734,12 +4750,12 @@ subclass.
 
 =cut
 
+our $AUTOLOAD;
+
 sub AUTOLOAD {
     my $self = shift;
     my ($sub_name) = $AUTOLOAD =~ /::(\w+)$/;
 
-    return if $sub_name =~ /DESTROY$/;
-
     # Typos in function calls in SNMP::Info subclasses turn into
     # AUTOLOAD requests for non-methods.  While this is deprecated,
     # we'll still get called, so report a less confusing error.
@@ -4766,6 +4782,9 @@ sub AUTOLOAD {
 
 }
 
+# Skip AUTOLOAD()
+sub DESTROY {}
+
 1;
 
 =head1 COPYRIGHT AND LICENSE

xt/20_run.t

@@ -0,0 +1,6 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::Class::Load qw<xt/lib>;

xt/lib/My/Test/Class.pm

@@ -0,0 +1,271 @@
+# My::Test::Class
+#
+# Copyright (c) 2018 Eric Miller
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+#     * Redistributions of source code must retain the above copyright notice,
+#       this list of conditions and the following disclaimer.
+#     * Redistributions in binary form must reproduce the above copyright
+#       notice, this list of conditions and the following disclaimer in the
+#       documentation and/or other materials provided with the distribution.
+#     * Neither the name of the University of California, Santa Cruz nor the
+#       names of its contributors may be used to endorse or promote products
+#       derived from this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+package My::Test::Class;
+
+use Test::Class::Most attributes => [qw/class mock_session test_obj/];
+use Test::MockObject::Extends;
+use File::Find 'find';
+use Path::Class 'dir';
+use File::Slurper 'read_lines';
+
+use base qw<Test::Class Class::Data::Inheritable>;
+
+INIT { Test::Class->runtests }
+
+my $EMPTY = q{};
+
+sub startup : Tests( startup => 1 ) {
+  my $test = shift;
+  (my $class = ref $test) =~ s/::Test$//x;
+  return ok 1, "$class loaded" if $class eq __PACKAGE__;
+  use_ok $class or die;
+  $test->class($class);
+  $test->mock_session(create_mock_session());
+  return;
+}
+
+sub shutdown : Tests(shutdown) { }
+
+sub setup : Tests(setup) {
+  my $test  = shift;
+  my $class = $test->class;
+  my $sess  = $test->mock_session;
+
+  $test->{info}
+    = $class->new('AutoSpecify' => 0, 'BulkWalk' => 0, 'Session' => $sess,);
+}
+
+sub teardown : Tests(teardown) { my $test = shift; $test->{info} = undef; }
+
+sub create_mock_session {
+
+  my $home = dir($ENV{HOME}, 'netdisco-mibs');
+
+  local $ENV{'SNMPCONFPATH'}        = $EMPTY;
+  local $ENV{'MIBDIRS'}             = $EMPTY;
+  local $ENV{'MIBS'}                = $EMPTY;
+  local $ENV{'SNMP_PERSISTENT_DIR'} = $home;
+
+  SNMP::initMib();
+
+  my @mibdirs = _build_mibdirs();
+
+  foreach my $d (@mibdirs) {
+    next unless -d $d;
+    SNMP::addMibDirs($d);
+  }
+
+  my $session = SNMP::Session->new(
+    UseEnums    => 1,
+    RetryNoSuch => 1,
+    DestHost    => '127.0.0.1',
+    Community   => 'public',
+    Version     => 2,
+
+    # Hold simulated data for mock sessions
+    Data => {},
+  );
+
+  my $mock_session = Test::MockObject::Extends->new($session);
+
+  mock_get($mock_session);
+  mock_getnext($mock_session);
+  mock_set($mock_session);
+
+  return $mock_session;
+}
+
+sub _build_mibdirs {
+  my $home = dir($ENV{HOME}, 'netdisco-mibs');
+  return map { dir($home, $_)->stringify } @{_get_mibdirs_content($home)};
+}
+
+sub _get_mibdirs_content {
+  my $home = shift;
+  my @list
+    = map { s|$home/||; $_ } grep {m/[a-z0-9]/} grep {-d} glob("$home/*");
+  return \@list;
+}
+
+sub mock_get {
+  my $mock_session = shift;
+
+  $mock_session->mock(
+    'get',
+    sub {
+      my $self = shift;
+      my $vars = shift;
+      my ($leaf, $iid, $oid, $oid_name);
+      my $c_data = $self->{Data};
+
+      # From SNMP::Info get will only be passed either an OID or
+      # SNMP::Varbind with a fully qualified leaf and potentially
+      # a partial
+      if (ref($vars) =~ /SNMP::Varbind/x) {
+        ($leaf, $iid) = @{$vars};
+      }
+      else {
+        $oid = $vars;
+        $oid_name = SNMP::translateObj($oid, 0, 1) || $EMPTY;
+        ($leaf, $iid) = $oid_name =~ /^(\S+::\w+)[.]?(\S+)*$/x;
+      }
+
+      $iid ||= 0;
+      my $new_iid = $iid;
+      my $val     = $EMPTY;
+      my $data    = $c_data->{$leaf} || {};
+      my $count   = scalar keys %{$data} || 0;
+      if ($count > 1) {
+        my $found = 0;
+        foreach my $d_iid (sort keys %{$data}) {
+          if ($d_iid eq $iid) {
+            $val   = $data->{$d_iid};
+            $found = 1;
+            next;
+          }
+          elsif ($found == 1) {
+            $new_iid = $d_iid;
+            last;
+          }
+        }
+        if ($found && ($new_iid eq $iid)) {
+          $leaf = 'unknown';
+        }
+      }
+      else {
+        $val  = $data->{$iid};
+        $leaf = 'unknown';
+      }
+
+      if (ref $vars =~ /SNMP::Varbind/x) {
+        $vars->[0] = $leaf;
+        $vars->[1] = $new_iid;
+        $vars->[2] = $val;
+      }
+      return (wantarray() ? $vars : $val);
+    }
+  );
+  return;
+}
+
+sub mock_getnext {
+  my $mock_session = shift;
+
+  $mock_session->mock(
+    'getnext',
+    sub {
+      my $self = shift;
+      my $vars = shift;
+      my ($leaf, $iid, $oid, $oid_name);
+      my $c_data = $self->{Data};
+
+      # From SNMP::Info getnext will only be passed a SNMP::Varbind
+      # with a fully qualified leaf and potentially a partial
+      ($leaf, $iid) = @{$vars};
+
+      # If we captured data using OIDs printed numerically -On option,
+      # we need to convert the leaf to an OID for match
+      my $leaf_oid = SNMP::translateObj($leaf, 0, 1) || '';
+
+      unless (defined $iid) {
+        $iid = -1;
+      }
+      my $new_iid = $iid;
+      my $val     = $EMPTY;
+      my $data    = $c_data->{$leaf} || $c_data->{$leaf_oid};
+      my $count   = scalar keys %{$data} || 0;
+      if ($count) {
+        my $found = 0;
+        foreach my $d_iid (sort keys %{$data}) {
+          if ($d_iid gt $iid && !$found) {
+            $val     = $data->{$d_iid};
+            $new_iid = $d_iid;
+            $found   = 1;
+            next;
+          }
+          elsif ($found == 1) {
+            last;
+          }
+        }
+        if ($found && ($new_iid eq $iid)) {
+          $leaf = 'unknown';
+        }
+      }
+      else {
+        $val  = $data->{$iid};
+        $leaf = 'unknown';
+      }
+
+      $vars->[0] = $leaf;
+      $vars->[1] = $new_iid;
+      $vars->[2] = $val;
+      return (wantarray() ? $vars : $val);
+    }
+  );
+  return;
+}
+
+# For testing purposes assume sets worked
+sub mock_set {1}
+
+# Utility to load snmpwalk from a file to use for mock sessions
+sub load_snmpdata {
+  my $test      = shift;
+  my $data_file = shift;
+
+  my @lines = read_lines($data_file);
+
+  my $snmp_data = {};
+  foreach my $line (@lines) {
+    next if !$line;
+    next if ($line =~ /^#/);
+    if ($line =~ /^(\S+::\w+)[.]?(\S+)*\s=\s(.*)$/x) {
+      my ($leaf, $iid, $val) = ($1, $2, $3);
+      next if !$leaf;
+      $iid ||= 0;
+      $val =~ s/\"//g;
+      $snmp_data->{$leaf}->{$iid} = $val;
+    }
+  }
+  return $snmp_data;
+}
+
+# Grab the symbol table for verification that
+# dynamic methods via AUTOLOAD and can() have been inserted
+sub symbols {
+  my $test  = shift;
+  my $class = $test->class;
+  {
+    no strict 'refs';    ## no critic (ProhibitNoStrict)
+    return \%{$class . '::'};
+  }
+}
+
+1;

xt/lib/SNMP/Info/Test.pm

@@ -0,0 +1,678 @@
+# SNMP::Info::Test
+#
+# Copyright (c) 2018 Eric Miller
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+#     * Redistributions of source code must retain the above copyright notice,
+#       this list of conditions and the following disclaimer.
+#     * Redistributions in binary form must reproduce the above copyright
+#       notice, this list of conditions and the following disclaimer in the
+#       documentation and/or other materials provided with the distribution.
+#     * Neither the name of the University of California, Santa Cruz nor the
+#       names of its contributors may be used to endorse or promote products
+#       derived from this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+package SNMP::Info::Test;
+
+use Test::Class::Most parent => 'My::Test::Class';
+
+use SNMP::Info;
+
+sub _constructor : Tests(11) {
+  my $test  = shift;
+  my $class = $test->class;
+  my $sess  = $test->mock_session;
+
+  can_ok $class, 'new';
+  isa_ok $test->{info}, $class, '... and the object it returns';
+
+  is(defined $test->{info}{init}, 1, 'mibs initialized');
+  ok(
+    scalar keys %{$test->{info}{mibs}},
+    'mibs subclass data structure initialized'
+  );
+  ok(
+    scalar keys %{$test->{info}{globals}},
+    'globals subclass data structure initialized'
+  );
+  ok(
+    scalar keys %{$test->{info}{funcs}},
+    'funcs subclass data structure initialized'
+  );
+  ok(
+    scalar keys %{$test->{info}{munge}},
+    'munge subclass data structure initialized'
+  );
+  is_deeply($test->{info}{store}, {}, 'store initialized');
+
+  is($test->{info}{snmp_comm}, 'public',  'snmp comm arg saved');
+  is($test->{info}{snmp_ver},  2,         'snmp version arg saved');
+  is($test->{info}{snmp_user}, 'initial', 'snmp user arg saved');
+}
+
+sub globals : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'globals');
+
+  subtest 'Globals can() subtest' => sub {
+
+    my $test_globals = $test->{info}->globals;
+    foreach my $key (keys %$test_globals) {
+      can_ok($test->{info}, $key);
+    }
+  };
+}
+
+sub funcs : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'funcs');
+
+  subtest 'Funcs can() subtest' => sub {
+
+    my $test_funcs = $test->{info}->funcs;
+    foreach my $key (keys %$test_funcs) {
+      can_ok($test->{info}, $key);
+    }
+  };
+}
+
+# update() needs to be reworked to discard all args except community
+# or context as described in documentation
+sub update : Tests(4) {
+  my $test = shift;
+
+  # Starting community
+  is($test->{info}{sess}{Community}, 'public', 'original community');
+
+  # Change community
+  $test->{info}->update('Community' => 'new_community',);
+  is($test->{info}{sess}{Community}, 'new_community', 'community changed');
+
+  # Starting context
+  is($test->{info}{sess}{Context}, '', 'original context');
+
+  # Change context
+  $test->{info}->update('Context' => 'new_context',);
+  is($test->{info}->{sess}->{Context}, 'new_context', 'context changed');
+}
+
+sub cache_and_clear_cache : Tests(9) {
+  my $test = shift;
+
+  # Isolate tests to cache method. Populated structure of global 'name' and
+  # func 'i_description'
+  my $cache_data = {
+    '_name'          => 'Test-Name',
+    '_i_description' => 1,
+    'store'          => {
+      'i_description' =>
+        {10 => 'Test-Description-10', 20 => 'Test-Description-20'}
+    }
+  };
+
+  # The empty store hash exists upon initialization and remains when the cache
+  # is cleared.
+  my $empty_cache = {'store' => {}};
+
+  can_ok($test->{info}, 'cache');
+  cmp_deeply($empty_cache, $test->{info}->cache(), 'cache starts empty');
+  ok($test->{info}->cache($cache_data), 'insert test data into cache');
+  cmp_deeply(
+    $cache_data,
+    $test->{info}->cache(),
+    'cache method returns test data'
+  );
+  is($test->{info}->name(),
+    'Test-Name', 'global method call returned cached data');
+  cmp_deeply(
+    $test->{info}->i_description(),
+    $cache_data->{store}{i_description},
+    'funcs method call returned cached data'
+  );
+  can_ok($test->{info}, 'clear_cache');
+  ok($test->{info}->clear_cache(), 'cache cleared');
+  cmp_deeply(
+    $empty_cache,
+    $test->{info}->cache(),
+    'no cached data returned after clear_cache method call'
+  );
+}
+
+sub debug : Tests(4) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'debug');
+
+  ok(
+    defined $test->{info}{debug}
+      && $test->{info}{debug} == 0
+      && $test->{info}->debug() == 0,
+    'debug initialized off'
+  );
+  $test->{info}->debug(1);
+  ok($test->{info}{debug} && $test->{info}->debug(), 'debug on');
+  $test->{info}->debug(0);
+  ok($test->{info}{debug} == 0 && $test->{info}->debug() == 0, 'debug off');
+}
+
+sub offline : Tests(4) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'offline');
+
+  ok(!defined $test->{info}{Offline}, 'offline not initialized');
+  $test->{info}->offline(1);
+  ok($test->{info}{Offline} && $test->{info}->offline(), 'offline mode on');
+  $test->{info}->offline(0);
+  ok($test->{info}{Offline} == 0 && $test->{info}->offline() == 0,
+    'offline off');
+}
+
+sub bulkwalk : Tests(4) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'bulkwalk';
+
+  # Test harness initalizes BulkWalk off, if we didn't provide an arg
+  # it would not be defined.
+  ok(
+    !defined $test->{info}{BulkWalk}
+      || ($test->{info}{BulkWalk} == 0 && $test->{info}->bulkwalk() == 0),
+    'bulkwalk initialized off'
+  );
+  $test->{info}->bulkwalk(1);
+  ok($test->{info}{BulkWalk} && $test->{info}->bulkwalk(), 'bulkwalk on');
+  $test->{info}->bulkwalk(0);
+  ok($test->{info}{BulkWalk} == 0 && $test->{info}->bulkwalk() == 0,
+    'bulkwalk off');
+}
+
+sub loopdetect : Tests(4) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'loopdetect';
+
+  ok(!defined $test->{info}{LoopDetect}, 'loopdetect not initialized');
+  $test->{info}->loopdetect(1);
+  ok($test->{info}{LoopDetect} && $test->{info}->loopdetect(), 'loopdetect on');
+  $test->{info}->loopdetect(0);
+  ok($test->{info}{LoopDetect} == 0 && $test->{info}->loopdetect() == 0,
+    'loopdetect off');
+}
+
+sub device_type : Tests(8) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'device_type');
+
+  # Empty args and no SNMP data should result in undef
+  is($test->{info}->device_type(),
+    undef, 'No sysServices, no sysDescr results in undef');
+
+  # Populate cache for tests rather than mocking session to limit code hit
+  # on these tests
+  my $cache_data
+    = {'_layers' => '00000000', '_description' => 'My-Test-sysDescr',};
+  $test->{info}->cache($cache_data);
+
+  is($test->{info}->device_type(),
+    'SNMP::Info', 'No sysServices and unknown sysDescr results in SNMP::Info');
+
+  $test->{info}->debug(1);
+  warnings_like { $test->{info}->device_type() }
+  [{carped => qr/Might give unexpected results/i}],
+    'No sysServices and unknown sysDescr with debug on gives warning';
+  $test->{info}->debug(0);
+  $test->{info}->clear_cache();
+
+  # Test one oid per layer hash just to verify oid mapping, no need to test
+  # every hash key - chose an id that is unique per layer
+
+  # Layer 3
+  $cache_data = {
+    '_layers'      => 4,
+    '_description' => 'My-Test-sysDescr',
+    '_id'          => '.1.3.6.1.4.1.18'
+  };
+  $test->{info}->cache($cache_data);
+  is($test->{info}->device_type,
+    'SNMP::Info::Layer3::BayRS', 'Layer 3 device type by sysObjectID');
+  $test->{info}->clear_cache();
+
+  # Layer 2
+  $cache_data = {
+    '_layers'      => 2,
+    '_description' => 'My-Test-sysDescr',
+    '_id'          => '.1.3.6.1.4.1.11898'
+  };
+  $test->{info}->cache($cache_data);
+  is($test->{info}->device_type,
+    'SNMP::Info::Layer2::Orinoco', 'Layer 2 device type by sysObjectID');
+  $test->{info}->clear_cache();
+
+  # Layer 1
+  $cache_data = {
+    '_layers'      => 1,
+    '_description' => 'My-Test-sysDescr',
+    '_id'          => '.1.3.6.1.4.1.2925'
+  };
+  $test->{info}->cache($cache_data);
+  is(
+    $test->{info}->device_type,
+    'SNMP::Info::Layer1::Cyclades',
+    'Layer 1 device type by sysObjectID'
+  );
+  $test->{info}->clear_cache();
+
+  # Layer 7
+  $cache_data = {
+    '_layers'      => 64,
+    '_description' => 'My-Test-sysDescr',
+    '_id'          => '.1.3.6.1.4.1.318'
+  };
+  $test->{info}->cache($cache_data);
+  is($test->{info}->device_type,
+    'SNMP::Info::Layer7::APC', 'Layer 1 device type by sysObjectID');
+  $test->{info}->clear_cache();
+
+  # Add Regex tests if needed
+}
+
+sub error : Tests(7) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'error');
+  ok(!exists $test->{info}{error}, 'Error not present');
+  $test->{info}{error} = 'Test Error';
+  is($test->{info}->error(), 'Test Error', 'Test Error present');
+  is($test->{info}->error(), undef,        'Test Error cleared upon read');
+  $test->{info}{error} = 'Test Error 2';
+  is($test->{info}->error(1),
+    'Test Error 2', 'Test Error 2 present and no clear flag set');
+  is($test->{info}->error(0),
+    'Test Error 2', 'Test Error 2 still present on next read');
+  is($test->{info}->error(),
+    undef, 'Test Error 2 cleared upon read with flag set to false');
+}
+
+sub has_layer : Tests(6) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'has_layer';
+  $test->{info}->clear_cache();
+
+  # Populate cache, one key/value so don't bother going through the
+  # cache() method.
+  # Layers holds the unmunged value (decimal)
+  $test->{info}{'_layers'} = 1;
+  is($test->{info}->has_layer(1), 1, 'Has layer 1');
+
+  $test->{info}{'_layers'} = 2;
+  is($test->{info}->has_layer(2), 1, 'Has layer 2');
+
+  $test->{info}{'_layers'} = 4;
+  is($test->{info}->has_layer(3), 1, 'Has layer 3');
+
+  # We don't use layers 4-6 for classification, skip testing
+
+  $test->{info}{'_layers'} = 64;
+  is($test->{info}->has_layer(7), 1, 'Has layer 7');
+
+  # Check for undef layers
+  $test->{info}{'_layers'} = undef;
+  is($test->{info}->has_layer(7), undef, 'Undef layers returns undef');
+}
+
+sub snmp_comm : Tests(4) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'snmp_comm';
+
+  # Define before test to be sure instead of relying on initalization
+  $test->{info}{snmp_comm} = 'publicv1';
+  $test->{info}{snmp_ver}  = 1;
+  is($test->{info}->snmp_comm(), 'publicv1',
+    'Version 1 returns SNMP community');
+
+  $test->{info}{snmp_comm} = 'publicv2';
+  $test->{info}{snmp_ver}  = 2;
+  is($test->{info}->snmp_comm(), 'publicv2',
+    'Version 2 returns SNMP community');
+
+  $test->{info}{snmp_user} = 'initialv3';
+  $test->{info}{snmp_ver}  = 3;
+  is($test->{info}->snmp_comm(), 'initialv3', 'Version 3 returns SNMP user');
+}
+
+sub snmp_ver : Tests(2) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'snmp_ver';
+
+  # Define before test to be sure instead of relying on initalization
+  $test->{info}{snmp_ver} = 1;
+  is($test->{info}->snmp_ver(), 1, 'SNMP version returned');
+}
+
+sub specify : Tests(4) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'specify';
+  $test->{info}->cache_clear();
+
+  # Specify uses device_type(), use same data as that test to setup
+  # test cases here since return values from device_type() with them
+  # have been tested
+
+  # device_type returns undef
+  $test->{info}->specify();
+  is(
+    $test->{info}->error(),
+    'SNMP::Info::specify() - Could not get info from device',
+    'Undef device type throws error'
+  );
+  $test->{info}->cache_clear();
+
+  # Populate cache for following tests
+  my $cache_data
+    = {'_layers' => '00000000', '_description' => 'My-Test-sysDescr',};
+  $test->{info}->cache($cache_data);
+
+  isa_ok($test->{info}->specify(),
+    'SNMP::Info', 'SNMP::Info device_type returns self');
+  $test->{info}->cache_clear();
+
+  # Layer 7 - SNMP::Info::Layer7::APC
+  $cache_data = {
+    '_layers'      => 64,
+    '_description' => 'My-Test-sysDescr',
+    '_id'          => '.1.3.6.1.4.1.318'
+  };
+  $test->{info}->cache($cache_data);
+  isa_ok($test->{info}->specify(),
+    'SNMP::Info::Layer7::APC',
+    'Layer 7 device type returns new object of same type');
+  $test->{info}->clear_cache();
+}
+
+sub cisco_comm_indexing : Tests(2) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'cisco_comm_indexing';
+  is($test->{info}->cisco_comm_indexing(), 0, 'Cisco community indexing off');
+}
+
+sub if_ignore : Tests(2) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'if_ignore';
+  is_deeply($test->{info}->if_ignore(),
+    {}, 'No ignored interfaces for this class');
+}
+
+sub bulkwalk_no : Tests(2) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'bulkwalk_no';
+  is($test->{info}->bulkwalk_no(), 0, 'Bulkwalk not turned off in this class');
+}
+
+sub i_speed : Tests(2) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'i_speed';
+
+  # Method uses partial fetches which ignores the cache and reloads data
+  # therefore we must use the mocked session. Populate the session data
+  # so that the mock_getnext() has data to fetch.
+  my $data = {
+
+    # Need to use OID for ifSpeed since it could resolve to a fully qualified
+    # name as either RFC1213-MIB::ifSpeed or IF-MIB::ifSpeed dependent upon
+    # which MIB got loaded last which is based upon random hash ordering. Using
+    # a fully qualified name with mock session we would need to know which MIB
+    # "owned" the OID since the MIB hash is indexed by OID. This is not an
+    # issue in live code since what is fed to getnext for a fully qualified
+    # name is what is returned.
+    '.1.3.6.1.2.1.2.2.1.5' => {38 => 0, 49 => 4294967295, 501 => 1000000000,},
+    'IF-MIB::ifHighSpeed'  => {38 => 0, 49 => 32000,      501 => 1000,},
+  };
+  my $expected = {38 => 0, 49 => '32 Gbps', 501 => '1.0 Gbps',};
+  $test->{info}{sess}{Data} = $data;
+  is_deeply($test->{info}->i_speed(),
+    $expected, 'High speed interface reported accurately');
+}
+
+sub i_speed_raw : Tests(3) {
+  my $test = shift;
+
+  can_ok $test->{info}, 'i_speed_raw';
+
+  # Method uses partial fetches which ignores the cache and reloads data
+  # therefore we must use the mocked session. Populate the session data
+  # so that the mock_getnext() has data to fetch.
+  my $data = {
+
+    # Need to use OID for ifSpeed since it could resolve to a fully qualified
+    # name as either RFC1213-MIB::ifSpeed or IF-MIB::ifSpeed dependent upon
+    # which MIB got loaded last which is based upon random hash ordering. Using
+    # a fully qualified name with mock session we would need to know which MIB
+    # "owned" the OID since the MIB hash is indexed by OID. This is not an
+    # issue in live code since what is fed to getnext for a fully qualified
+    # name is what is returned.
+    '.1.3.6.1.2.1.2.2.1.5' => {38 => 0, 49 => 4294967295, 501 => 1000000000,},
+    'IF-MIB::ifHighSpeed'  => {38 => 0, 49 => 32000,      501 => 1000,},
+  };
+  my $expected     = {38 => 0, 49 => '32 Gbps',   501 => '1.0 Gbps',};
+  my $expected_raw = {38 => 0, 49 => 32000000000, 501 => 1000000000,};
+  $test->{info}{sess}{Data} = $data;
+  is_deeply($test->{info}->i_speed_raw(),
+    $expected_raw, 'Raw high speed interface reported accurately');
+
+  # Note the cache is populated unmunged data now - not sure if that is
+  # expected behavior. Clear cache to get data to test that munges are restored.
+  $test->{info}->clear_cache();
+  is_deeply($test->{info}->i_speed(),
+    $expected, 'Munges restored after i_speed_raw() call');
+}
+
+# Topo routines will need to be tested in sub classes for conditionals
+sub has_topo : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'has_topo');
+  is($test->{info}->has_topo(), undef, 'Base class has no topo');
+}
+
+sub get_topo_data : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, '_get_topo_data');
+  is($test->{info}->_get_topo_data(), undef, 'Base class has no topo data');
+}
+
+sub c_ip : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'c_ip');
+  is($test->{info}->c_ip(), undef, 'Base class has no topo');
+}
+
+sub c_if : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'c_if');
+  is($test->{info}->c_if(), undef, 'Base class has no topo');
+}
+
+sub c_port : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'c_port');
+  is($test->{info}->c_port(), undef, 'Base class has no topo');
+}
+
+sub c_id : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'c_id');
+  is($test->{info}->c_id(), undef, 'Base class has no topo');
+}
+
+sub c_platform : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'c_platform');
+  is($test->{info}->c_platform(), undef, 'Base class has no topo');
+}
+
+sub c_cap : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'c_cap');
+  is($test->{info}->c_cap(), undef, 'Base class has no topo');
+}
+
+# Munges aren't methods, the are functions so calling convention is different
+sub munge_speed : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_speed');
+  is(SNMP::Info::munge_speed('2488000000'),
+    'OC-48', 'Speed munged according to map');
+}
+
+sub munge_highspeed : Tests(6) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_highspeed');
+  is(SNMP::Info::munge_highspeed('15000000'), '15 Tbps', 'Tbps munge');
+  is(SNMP::Info::munge_highspeed('1500000'),
+    '1.5 Tbps', 'Fractional Tbps munge');
+  is(SNMP::Info::munge_highspeed('15000'), '15 Gbps',  'Gbps munge');
+  is(SNMP::Info::munge_highspeed('1500'),  '1.5 Gbps', 'Fractional Gbps munge');
+  is(SNMP::Info::munge_highspeed('100'),   '100 Mbps', 'Mbps munge');
+}
+
+sub munge_ip : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_ip');
+  my $test_ip = pack("C4", split /\./, "123.4.5.6");
+  is(SNMP::Info::munge_ip($test_ip),
+    "123.4.5.6", 'Binary IP to dotted ASCII munge');
+}
+
+sub munge_mac : Tests(3) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_mac');
+
+  # The munge expects an octet string, pack a decimal string into
+  # representation munge is expecting
+  my $test_mac = pack("C*", split /\./, "01.35.69.103.137.171");
+  is(SNMP::Info::munge_mac($test_mac),
+    "01:23:45:67:89:ab", 'Octet string to colon separated ASCII hex string');
+  my $bogus_mac = pack("C*", split /\./, "01.35.69.103.137.171.02");
+  is(SNMP::Info::munge_mac($bogus_mac), undef,
+    'Bad octet string returns undef');
+}
+
+sub munge_prio_mac : Tests(3) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_prio_mac');
+
+  # The munge expects an octet string, pack a decimal string into
+  # representation munge is expecting
+  my $test_mac = pack("C*", split /\./, "01.35.69.103.137.171.205.239");
+  is(SNMP::Info::munge_prio_mac($test_mac),
+    "01:23:45:67:89:ab:cd:ef",
+    'Octet string to colon separated ASCII hex string');
+  my $bogus_mac = pack("C*", split /\./, "01.35.69.103.137.171.205.239.02");
+  is(SNMP::Info::munge_prio_mac($bogus_mac),
+    undef, 'Bad octet string returns undef');
+}
+
+sub munge_prio_port : Tests(3) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_prio_port');
+
+  # The munge expects an octet string, pack a decimal string into
+  # representation munge is expecting
+  my $test_mac = pack("C*", split /\./, "171.205");
+  is(SNMP::Info::munge_prio_port($test_mac),
+    "ab:cd", 'Octet string to colon separated ASCII hex string');
+  my $bogus_mac = pack("C*", split /\./, "171.205.02");
+  is(SNMP::Info::munge_prio_port($bogus_mac),
+    undef, 'Bad octet string returns undef');
+}
+
+# Can't see where this code is actually used, remove?
+sub munge_octet2hex : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_octet2hex');
+
+  # The munge expects an octet string, pack a decimal string into
+  # representation munge is expecting
+  my $test_mac = pack("C*", split /\./, "171.205");
+  is(SNMP::Info::munge_octet2hex($test_mac),
+    "abcd", 'Octet string to ASCII hex string');
+}
+
+sub munge_dec2bin : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_dec2bin');
+
+  # This is layers munge, use L3 test case
+  is(SNMP::Info::munge_dec2bin(4), '00000100', 'Binary char to ASCII binary');
+}
+
+sub munge_bits : Tests(2) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_bits');
+
+  my $bits = pack("B*", '00010110');
+
+  is(SNMP::Info::munge_bits($bits),
+    '00010110', 'SNMP2 BITS field to ASCII bit string');
+}
+
+# TODO
+#sub munge_counter64 : Tests() {
+#  my $test = shift;
+#
+#}
+
+sub munge_i_up : Tests(4) {
+  my $test = shift;
+
+  can_ok($test->{info}, 'munge_i_up');
+
+  is(SNMP::Info::munge_i_up(),  undef,            'No arg returns undef');
+  is(SNMP::Info::munge_i_up(4), 'unknown',        'Unknown status');
+  is(SNMP::Info::munge_i_up(7), 'lowerLayerDown', 'Lower layer down status');
+}
+
+1;