view release on metacpan or  search on metacpan

xt/175-discover-neighbor-columns.t  view on Meta::CPAN

use App::Netdisco::Backend::Job;
use App::Netdisco::Transport::SNMP ();
use App::Netdisco::Worker::Plugin::Discover::Neighbors ();
use DBIx::Class::SQLMaker;

use Try::Tiny;
use Dancer qw/:moose :script !pass/;

# The Neighbors worker runs for real with SNMP stubbed. Each DevicePort
# search-and-update is rendered to SQL by DBIx::Class::SQLMaker and recorded,
# so the WHERE that decides which rows are written is checked without a
# database. Ports no longer lose remote_* and is_uplink to a delete and
# reinsert each discover, so Neighbors clears them itself.

my $CONFIG = config();
$CONFIG->{logger} = 'console';
$CONFIG->{log} = ($ENV{'DANCER_DEBUG'} ? 'debug' : 'error');
Dancer::Logger->init('console', $CONFIG);

{
  package MyWorker;
  use Moo;
  with 'App::Netdisco::Worker::Runner';
}

config->{'device_auth'} = [{driver => 'snmp'}];
config->{'enable_incomplete_walk_protection'} = 1;
config->{'queue_neighbors'} = 1;
config->{'discover_neighbors'} = 1;

package FakeSNMP;
our $AUTOLOAD;
sub new { my ($class, %vals) = @_; return bless { walk_failures => [], %vals }, $class; }
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { $_[0]{walk_status}{$_[1]} }
sub AUTOLOAD {
  my $self = shift;
  (my $method = $AUTOLOAD) =~ s/.*:://;
  return if $method eq 'DESTROY';
  if (my $failure = delete $self->{fail_on_read}{$method}) {
    push @{ $self->{walk_failures} }, $failure;
    $self->{walk_status}{$method} = $failure;
  }
  # SNMP::Info returns an empty list, not undef, for a method the device does
  # not support, so a caller in list context sees no value at all
  return unless exists $self->{$method};
  return $self->{$method};
}

package FakePortRow;
sub new { my ($class, %cols) = @_; return bless { manual_topo => 0, %cols }, $class; }
sub port { $_[0]{port} }
sub manual_topo { $_[0]{manual_topo} }
sub slave_of { $_[0]{slave_of} }
sub is_master { $_[0]{is_master} }
sub remote_port { $_[0]{remote_port} }
sub remote_ip { $_[0]{remote_ip} }
sub is_uplink { $_[0]{is_uplink} }
sub discard_changes { $_[0] }
sub store_column { my ($self, $col, $value) = @_; $self->{$col} = $value }
sub update {
  my ($self, $values) = @_;
  push @main::row_updates,
    [ $self->{owner}, $self->{port}, $values, $self, { map {($_ => $self->{$_})} keys %$values } ];
  push @main::update_depths, [ $self->{port}, $main::txn_depth ]
    if ref $values->{manual_topo} and ${ $values->{manual_topo} } eq 'true';
  foreach my $col (keys %$values) {
    my $value = $values->{$col};
    $self->{$col} = ref $value ? (${$value} eq 'true' ? 1 : 0) : $value;
  }
  return $self;
}

package FakePorts;
sub new { my ($class, @rows) = @_; return bless { rows => [@rows] }, $class; }
sub all { @{ $_[0]{rows} } }
sub reset { $_[0] }
sub single { my ($self, $cond) = @_; return (grep { $_->port eq $cond->{port} } $self->all)[0] }
sub get_column { $_[0] }
sub as_query { \['(SELECT port FROM device_port WHERE ip = ?)'] }

package FakeDevicePortRS;
sub search { my ($self, $where) = @_; return bless { where => $where }, ref $self }
sub single {
  my ($self, $cond) = @_;
  return (grep { $_->{owner} eq $cond->{ip} and $_->port eq $cond->{port} } @main::port_rows)[0];
}
sub update {
  my ($self, $set) = @_;
  my ($sql, @bind) = DBIx::Class::SQLMaker->new->update('device_port', $set, $self->{where});
  push @main::port_updates, { sql => $sql, bind => [@bind], set => $set, depth => $main::txn_depth };
  return 0;
}

package FakeTopologyRS;
sub search { $_[0] }
sub delete { push @main::topology_delete_depths, $main::txn_depth; 0 }
sub next { shift @{ $_[0]{links} } }

package FakeLink;
sub dev1 { $_[0]{dev1} } sub port1 { $_[0]{port1} }
sub dev2 { $_[0]{dev2} } sub port2 { $_[0]{port2} }

package FakePeer;
sub ip { $_[0]{ip} }
sub in_storage { 1 }
sub ports { $_[0]{ports} }

package FakeSchema;
# rolls back the row updates made inside a block that dies, as Netdisco's
# auto_savepoint makes a nested txn_do do, and counts the nesting so a test
# can tell a top-level transaction from a savepoint
sub txn_do {
  my ($self, $code, @args) = @_;
  local $main::txn_depth = $main::txn_depth + 1;
  my $mark = scalar @main::row_updates;
  my @result = eval { $code->(@args) };
  if (my $error = $@) {
    foreach my $undo (reverse splice @main::row_updates, $mark) {
      my ($row, $old) = @{$undo}[3, 4];
      $row->{$_} = $old->{$_} for keys %$old;
    }
    die $error;
  }
  return @result;
}
sub resultset {
  my ($self, $name) = @_;
  return bless({}, 'FakeDevicePortRS') if $name eq 'DevicePort';
  return bless({ links => [ map { bless {%$_}, 'FakeLink' } @main::links ] }, 'FakeTopologyRS')
    if $name eq 'Topology';
  die "unexpected resultset $name";
}

package main;

our (@row_updates, @port_updates, @links, @warnings, @port_rows,
  @update_depths, @topology_delete_depths);
our $txn_depth = 0;

my %device_cols = (
  ip => '192.0.2.1', name => 'switch1', snmp_class => 'SNMP::Info::Layer2',
  custom_fields => '{}', snmp_ver => 2,
);

my %base_snmp = (
  has_topo   => 1,
  interfaces => { 1 => 'Gi1/1', 2 => 'Gi1/2', 3 => 'Gi1/3' },