Files
netdisco/Netdisco/lib/App/Netdisco/Util/Device.pm
Oliver Gorwits 05928e8cf6 Refactor Util namespace
Squashed commit of the following:

commit 789c528fcf
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Mon Apr 1 19:31:07 2013 +0100

    update manifest and fix typo

commit b95d0951f2
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Mon Apr 1 19:22:41 2013 +0100

    refactor ::Util namespace

commit a8dde50343
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sun Mar 31 13:45:27 2013 +0100

    no need to search for device - IP should already be exact
2013-04-01 19:31:39 +01:00

90 lines
2.0 KiB
Perl

package App::Netdisco::Util::Device;
use Dancer qw/:syntax :script/;
use Dancer::Plugin::DBIC 'schema';
use NetAddr::IP::Lite ':lower';
use base 'Exporter';
our @EXPORT = ();
our @EXPORT_OK = qw/
get_device
is_discoverable
/;
our %EXPORT_TAGS = (all => \@EXPORT_OK);
=head1 NAME
App::Netdisco::Util::Device
=head1 DESCRIPTION
A set of helper subroutines to support parts of the Netdisco application.
There are no default exports, however the C<:all> tag will export all
subroutines.
=head1 FUNCTIONS
=head2 get_device( $ip )
Given an IP address, returns a L<DBIx::Class::Row> object for the Device in
the Netdisco database. The IP can be for any interface on the device.
Returns C<undef> if the device or interface IP is not known to Netdisco.
=cut
sub get_device {
my $ip = shift;
my $alias = schema('netdisco')->resultset('DeviceIp')
->search({alias => $ip})->first;
return if not eval { $alias->ip };
return schema('netdisco')->resultset('Device')
->find({ip => $alias->ip});
}
=head2 is_discoverable( $ip )
Given an IP address, returns C<true> if Netdisco on this host is permitted by
the local configuration to discover the device.
The configuration items C<discover_no> and C<discover_only> are checked
against the given IP.
Returns false if the host is not permitted to discover the target device.
=cut
sub is_discoverable {
my $q = shift;
my $device = get_device($q) or return 0;
my $addr = NetAddr::IP::Lite->new($device->ip);
my $discover_no = setting('discover_no') || [];
my $discover_only = setting('discover_only') || [];
if (scalar @$discover_no) {
foreach my $item (@$discover_no) {
my $ip = NetAddr::IP::Lite->new($item) or return 0;
return 0 if $ip->contains($addr);
}
}
if (scalar @$discover_only) {
my $okay = 0;
foreach my $item (@$discover_only) {
my $ip = NetAddr::IP::Lite->new($item) or return 0;
++$okay if $ip->contains($addr);
}
return 0 if not $okay;
}
return 1;
}
1;