#!/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 App::Netdisco; use Dancer ':script'; use Dancer::Plugin::DBIC 'schema'; use App::Netdisco::Util::Device 'get_device'; use NetAddr::IP::Lite ':lower'; use Try::Tiny; =head1 NAME nd-import-topology - Import a Nedisco 1.x Manual Topology File =head1 USAGE ~/bin/localenv nd-import-topology /path/to/netdisco-topology.txt =head1 DESCRIPTION This helper script will read and import the content of a Netdisco 1.x format Manual Topology file into the Netdisco 2.x database's C table. It's safe to run the script multiple times on the same file - any new data will be imported. The file syntax must be like so: left-device link:left-port,right-device,right-port The devices can be either host names or IPs. Data will be imported even if the devices are currently unknown to Netdisco. =cut my $file = $ARGV[0]; die "missing topology file name on command line\n" unless $file; chomp $file; my $dev = undef; # current device print "Loading topology information from $file\n"; open (DEVS,'<', $file) or die "topo_load_file($file): $!\n"; while (my $line = ) { chomp $line; $line =~ s/(?txn_do(sub { schema('netdisco')->resultset('Topology')->create({ dev1 => $dev, port1 => $from_port, dev2 => get_device($to)->ip, port2 => $to_port, }); }); }; } elsif ($line =~ /^alias:(.*)/) { # ignore aliases } else { my $ip = NetAddr::IP::Lite->new($line) or next; next if $ip->addr eq '0.0.0.0'; $dev = get_device($ip->addr)->ip; print " Set device: $dev\n"; } } close (DEVS);