view release on metacpan or  search on metacpan

xt/204-arpnip-cli-subnets-vrf.t  view on Meta::CPAN

use strict; use warnings;
no warnings 'once'; # local *glob = sub {} overrides below are single-use by design

BEGIN { $ENV{DANCER_ENVDIR} = '/dev/null'; }

use Test::More 0.88;
use Test::File::ShareDir::Dist { 'App-Netdisco' => 'share/' };

use lib 'xt/lib';

use App::Netdisco;
use App::Netdisco::DB;
use App::Netdisco::Backend::Job;
use App::Netdisco::Transport::SSH ();
use App::Netdisco::Transport::SNMP ();
use App::Netdisco::Worker::Plugin::Arpnip::Subnets ();

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

# The CLI arpnip subnets worker with store_vrfs on, run through the Runner as
# xt/194 runs the SNMP one. session_for is faked to return a session over a
# stub platform, and the Subnet resultset records the upsert_subnet calls.

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';
}

package FlatPlatform;
sub new { my ($class, %args) = @_; return bless { calls => [], %args }, $class }
sub subnets {
  my $self = shift;
  push @{ $self->{calls} }, [ 'subnets', @_ ];
  return @{ $self->{flat} || [] };
}

package ReportingPlatform;
our @ISA = ('FlatPlatform');
sub subnets_by_vrf {
  my $self = shift;
  push @{ $self->{calls} }, [ 'subnets_by_vrf', @_ ];
  die $self->{die} if $self->{die};
  return $self->{by_vrf};
}

# the SNMP side, as xt/194 fakes it: each context answers only for its VRF
package FakeSNMP;
our $AUTOLOAD;
sub new { my ($class, %vals) = @_; return bless { walk_failures => [], context => '', %vals }, $class }
sub walk_failures { $_[0]{walk_failures} }
sub walk_status { undef }
sub snmp_ver { 2 }
sub snmp_comm { 'public' }
sub update {
  my ($self, %args) = @_;
  $self->{context} = exists $args{Context} ? $args{Context}
    : ($args{Community} =~ m/\@(.+)$/ ? $1 : '');
  return 1;
}
sub _context_of {
  my ($self, $name) = @_;
  my $ctx = $self->{instances}{$name}{contexts}[0];
  return '' if not $ctx or ($ctx->{kind} || '') eq 'none';
  return $ctx->{id};
}
sub vrf_instances { $_[0]{context} eq '' ? $_[0]{instances} : undef }
sub vrf_instances_complete { $_[0]{context} eq '' ? 1 : undef }
sub _vrf_answer {
  my ($self, $what, $name) = @_;
  return undef unless $self->{context} eq $self->_context_of($name);
  return $self->{vrf}{$name}{$what};
}
sub vrf_subnets { $_[0]->_vrf_answer('subnets', $_[1]) }
sub vrf_read_complete { $_[0]->_vrf_answer('complete', $_[1]) }
sub AUTOLOAD {
  my $self = shift;
  (my $method = $AUTOLOAD) =~ s/.*:://;
  return if $method eq 'DESTROY';
  return $self->{$method};
}

package FakeSubnetRs;
sub new { bless {}, shift }
sub upsert_subnet { my $self = shift; push @main::upserts, [ @_ ]; return 1 }
sub resultset { return $_[0] }

package main;

my %device_cols = (
  ip => '192.0.2.1', name => 'router1', layers => '00000100', snmp_ver => 2,
  snmp_class => 'SNMP::Info::Layer3',
);

our @upserts;

sub with_settings {
  my ($code, %settings) = @_;
  my %saved = map { $_ => setting($_) } keys %settings;
  set($_ => $settings{$_}) for keys %settings;
  my @result = eval { $code->() };
  my $error = $@;
  set($_ => $saved{$_}) for keys %saved;
  die $error if $error;
  return @result;
}

sub by_vrf {
  return {
    default => [ { prefix => '172.20.20.0', len => 24 } ],
    red  => [ { prefix => '10.100.1.0', len => 24 }, { prefix => '2001:db8:1::', len => 64 } ],
    blue => [ { prefix => '10.100.1.0', len => 24 } ],
    @_,
  };
}