File Coverage

blib/lib/Metabrik/Network/Netbios.pm
Criterion Covered Total %
statement 9 34 26.4
branch 0 14 0.0
condition 0 9 0.0
subroutine 3 5 60.0
pod 1 2 50.0
total 13 64 20.3


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::netbios Brik
5             #
6             package Metabrik::Network::Netbios;
7 1     1   686 use strict;
  1         2  
  1         30  
8 1     1   6 use warnings;
  1         2  
  1         28  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         441  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             commands => {
19             probe => [ qw(ipv4_address) ],
20             },
21             require_modules => {
22             'Net::NBName' => [ ],
23             },
24             };
25             }
26              
27             sub probe {
28 0     0 0   my $self = shift;
29 0           my ($ip) = @_;
30              
31 0 0         $self->brik_help_run_undef_arg('probe', $ip) or return;
32              
33 0           my $nb = Net::NBName->new;
34 0 0         if (! $nb) {
35 0           return $self->log->error("probe: Net::NBName new failed");
36             }
37              
38 0           my %result = ();
39              
40 0           my $ns = $nb->node_status($ip);
41 0 0         if ($ns) {
42 0           my ($domain, $user, $machine);
43 0           for my $rr ($ns->names) {
44 0 0 0       if ($rr->suffix == 0 && $rr->G eq "GROUP") {
45 0           $domain = $rr->name;
46             }
47 0 0 0       if ($rr->suffix == 3 && $rr->G eq "UNIQUE") {
48 0           $user = $rr->name;
49             }
50 0 0 0       if ($rr->suffix == 0 && $rr->G eq "UNIQUE") {
51 0 0         $machine = $rr->name unless $rr->name =~ /^IS~/;
52             }
53             }
54              
55 0           $result{mac} = $ns->mac_address;
56 0           $result{domain} = $domain;
57 0           $result{user} = $user;
58 0           $result{machine} = $machine;
59              
60 0           my $raw = $ns->as_string;
61 0           $result{raw} = [ split(/\n/, $raw) ];
62             }
63              
64 0           return \%result;
65             }
66              
67             1;
68              
69             __END__