view release on metacpan or  search on metacpan

xt/195-arpnip-retire-unvouched.t  view on Meta::CPAN

Dancer::Logger->init('console', $CONFIG);

config->{'device_auth'} = [{driver => 'snmp'}];
config->{'dns'}->{'no'} = ['0.0.0.0/0'];

my (@ran, $txns, @stored_vrfs);

package FakeDbh;
sub new { return bless {}, $_[0] }
sub do  { my ($self, $sql, undef, @binds) = @_; push @ran, [$sql, @binds]; return 3 }
sub selectcol_arrayref {
  my ($self, $sql, undef, @binds) = @_;
  push @ran, [$sql, @binds];
  # as PostgreSQL would apply the named-only predicate
  return [ grep { $sql !~ m/vrf <> ''/ or $_ ne '' } @stored_vrfs ];
}

package FakeSchema;
sub new     { return bless { dbh => FakeDbh->new }, $_[0] }
sub txn_do  { ++$txns; return $_[1]->() }
sub storage { return $_[0] }
sub dbh_do  { my ($self, $code) = @_; return $code->($self, $self->{dbh}) }

package main;

{ no warnings 'redefine'; *App::Netdisco::Util::Node::schema = sub { FakeSchema->new }; }

my $router = '198.51.100.1';

# the unit tests below run with collection on unless they say otherwise
set store_vrfs => 1;
my $now = 'to_timestamp(1.5)::timestamp';

sub device {
  my $device = App::Netdisco::DB->resultset('Device')->new_result({
    ip => $router, name => 'router1', layers => '00000100', snmp_ver => 2,
    snmp_class => 'SNMP::Info::Layer3' });
  $device->in_storage(1);
  return $device;
}

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

# stored: the VRFs this router's active rows sit in
sub run_retire {
  my ($stored, @args) = @_;
  @ran = (); $txns = 0; @stored_vrfs = @$stored;
  my $count = retire_unvouched_arps(device(), @args);
  return ($count, @ran);
}

sub updates_of { return grep { $_->[0] =~ m/^\s*UPDATE node_ip/ } @_ }
sub update_of { return (updates_of(@_))[0] }

# the named VRFs' UPDATE binds its list; the default table's names it in the SQL
sub retired_vrfs {
  my @updates = updates_of(@_) or return undef;
  my @vrfs = map { ($_->[0] =~ m/ANY/ ? @{ $_->[-1] } : ($_->[0] =~ m/vrf = ''\s*$/ ? '' : ())) } @updates;
  return [ sort @vrfs ];
}

subtest 'retire__switch_on__complete_vrfs_and_uncovered_vrfs_retired' => sub {
  my ($count, @stmts) = run_retire(['', 'gone', 'red'], $now, { '' => 1, red => 1 }, 1);
  is_deeply retired_vrfs(@stmts), ['', 'gone', 'red'],
    'default and red read whole, gone no longer listed';
  is $count, 6, 'returns the rows deactivated by both UPDATEs';
};

subtest 'retire__switch_on__incomplete_vrf_excluded' => sub {
  my (undef, @stmts) = run_retire(['', 'red'], $now, { '' => 1, red => 0 }, 1);
  is_deeply retired_vrfs(@stmts), [''], 'red read short, so red kept';
  my (undef, @none) = run_retire(['', 'red'], $now, { '' => 0, red => 0 }, 1);
  ok !update_of(@none), 'no UPDATE when nothing qualifies, the default table included';
};

subtest 'retire__switch_on__short_vrf_list__uncovered_vrfs_kept' => sub {
  my (undef, @stmts) = run_retire(['', 'gone', 'red'], $now, { '' => 1, red => 1 }, 0);
  is_deeply retired_vrfs(@stmts), ['', 'red'], 'gone may only be missing from a short list';
  my (undef, @absent) = run_retire(['', 'gone'], $now, { '' => 1 });
  is_deeply retired_vrfs(@absent), [''], 'an absent list completeness reads as short';
};

subtest 'retire__switch_on__skipped_vrf__retired_even_with_short_list' => sub {
  my (undef, @by_name) = with_settings(sub {
    run_retire(['', 'blue', 'gone'], $now, { '' => 1 }, 0) }, vrf_no_devicevrfs => { 'group:__ANY__' => 'vrf:blue' });
  is_deeply retired_vrfs(@by_name), ['', 'blue'], 'vrf_no_devicevrfs for every device';
  my (undef, @by_device) = with_settings(sub {
    run_retire(['', 'blue', 'gone'], $now, { '' => 1 }, 0) }, vrf_no_devicevrfs => { $router => 'vrf:gone' });
  is_deeply retired_vrfs(@by_device), ['', 'gone'], 'vrf_no_devicevrfs';
};

sub check_named_only {
  my ($count, @stmts) = @_;
  is scalar @stmts, 2, 'lock and one UPDATE, no VRF query';
  my $update = update_of(@stmts);
  like $update->[0], qr/AND vrf <> ''\s*$/, 'never the default table';
  unlike $update->[0], qr/ANY/, 'no VRF list';
  is_deeply [@$update[1 .. $#$update]], [$router], 'router is the only bind';
  is $count, 3, 'returns the rows deactivated';
}

subtest 'retire__switch_off__named_vrfs_only' => sub {
  check_named_only(with_settings(sub { run_retire(['', 'red'], $now, undef, undef) }, store_vrfs => 0));
};

subtest 'retire__switch_on_device_in_skip_vrf_devices__named_vrfs_only' => sub {
  check_named_only(with_settings(sub { run_retire(['', 'red'], $now, undef, undef) },
    skip_vrf_devices => [$router]));
  my (undef, @stmts) = with_settings(sub { run_retire(['', 'red'], $now, { '' => 1 }, 1) },
    skip_vrf_devices => [$router]);
  like update_of(@stmts)->[0], qr/AND vrf <> ''\s*$/, 'a stale vrf_read does not override the device skip';
};