view release on metacpan or  search on metacpan

bin/netdisco-rancid-export  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;

our $home;

BEGIN {
  use FindBin;
  FindBin::again();

  $home = ($ENV{NETDISCO_HOME} || $ENV{HOME});

  # try to find a localenv if one isn't already in place.
  if (!exists $ENV{PERL_LOCAL_LIB_ROOT}) {
      use File::Spec;
      my $localenv = File::Spec->catfile($FindBin::RealBin, 'localenv');
      exec($localenv, $0, @ARGV) if -f $localenv;
      $localenv = File::Spec->catfile($home, 'perl5', 'bin', 'localenv');
      exec($localenv, $0, @ARGV) if -f $localenv;

      die "Sorry, can't find libs required for App::Netdisco.\n"
        if !exists $ENV{PERLBREW_PERL};
  }
}

BEGIN {
  use Path::Class;

  # stuff useful locations into @INC and $PATH
  unshift @INC,
    dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
    dir($FindBin::RealBin, 'lib')->stringify;

  use Config;
  $ENV{PATH} = $FindBin::RealBin . $Config{path_sep} . $ENV{PATH};
}

use App::Netdisco;
use Dancer ':script';
use Dancer::Plugin::DBIC 'schema';

use App::Netdisco::Util::Permission 'acl_matches';

# silent exit unless explicitly requested
exit(0) unless setting('use_legacy_rancidexport');

my $settings = setting( 'rancid' );
my $domain_suffix = setting( 'domain_suffix' );
my $delimiter = $settings->{ 'delimiter' } || ':';
my $down_age = $settings->{ 'down_age' } || '1 day';
my $rancidhome = $settings->{ 'rancid_home' } || '/var/lib/rancid';
my $config_vendormap = $settings->{ 'vendormap' } || {};

my $by_ip = {};
foreach my $g (@{$settings->{ 'by_ip' }}) {
  $by_ip->{$g} = 1;
}

my $by_hostname = {};
foreach my $g (@{$settings->{ 'by_hostname' }}) {
  $by_hostname->{$g} = 1;
}

my @devices = schema('netdisco')->resultset('Device')->search({},
  {
    '+columns' => {
      old => \"age(LOCALTIMESTAMP, last_discover) > interval '$down_age'"
    }
  })->all;

my $groups = $settings->{ 'groups' };
my $list = {};

foreach my $d (@devices) {
  my $old = $d->get_column( 'old' );
  my $devgroup = 'other';
  foreach my $g (keys %$groups) {
    if (acl_matches( $d, $groups->{$g} )) {
      $devgroup = $g;