view release on metacpan or  search on metacpan

lib/App/Netdisco/AnyEvent/Nbtstat.pm  view on Meta::CPAN

        or $self->_store_result( $request, 'ERROR' );

    return;
}

sub _encode_name {
    my $name   = uc(shift);
    my $pad    = shift || "\x20";
    my $suffix = shift || 0x00;

    $name .= $pad x ( 16 - length($name) );
    substr( $name, 15, 1, chr( $suffix & 0xFF ) );

    my $encoded_name = "";
    for my $c ( unpack( "C16", $name ) ) {
        $encoded_name .= chr( ord('A') + ( ( $c & 0xF0 ) >> 4 ) );
        $encoded_name .= chr( ord('A') + ( $c & 0xF ) );
    }

    # Note that the _encode_name function doesn't add any scope,
    # nor does it calculate the length (32), it just prefixes it
    return "\x20" . $encoded_name . "\x00";
}

sub _decode_rr {
    my $rr_data = shift;

    my @nodetypes = qw/B-node P-node M-node H-node/;
    my ( $name, $suffix, $flags ) = unpack( "a15Cn", $rr_data );
    $name =~ tr/\x00-\x19/\./;    # replace ctrl chars with "."
    $name =~ s/\s+//g;

    my $rr = {};
    $rr->{'name'}   = $name;
    $rr->{'suffix'} = $suffix;
    $rr->{'G'}      = ( $flags & 2**15 ) ? "GROUP" : "UNIQUE";
    $rr->{'ONT'}    = $nodetypes[ ( $flags >> 13 ) & 3 ];
    $rr->{'DRG'}    = ( $flags & 2**12 ) ? "Deregistering" : "Registered";
    $rr->{'CNF'}    = ( $flags & 2**11 ) ? "Conflict" : "";
    $rr->{'ACT'}    = ( $flags & 2**10 ) ? "Active" : "Inactive";
    $rr->{'PRM'}    = ( $flags & 2**9 ) ? "Permanent" : "";

    return $rr;
}

1;
__END__

=head1 NAME

App::Netdisco::AnyEvent::Nbtstat - Request NetBIOS node status with AnyEvent

=head1 SYNOPSIS

    use App::Netdisco::AnyEvent::Nbtstat;;

    my $request = App::Netdisco::AnyEvent::Nbtstat->new();

    my $cv = AE::cv;

    $request->nbtstat(
        '127.0.0.1',
        sub {
            my $result = shift;
            print "MAC: ", $result->{'mac_address'} || '', " ";
            print "Status: ", $result->{'status'}, "\n";
            printf '%3s %-18s %4s %-18s', '', 'Name', '', 'Type'
                if ( $result->{'status'} eq 'OK' );
            print "\n";
            for my $rr ( @{ $result->{'names'} } ) {
                printf '%3s %-18s <%02s> %-18s', '', $rr->{'name'},
                    $rr->{'suffix'},
                    $rr->{'G'};
                print "\n";
            }
            $cv->send;
        }
    );

    $cv->recv;

=head1 DESCRIPTION

L<App::Netdisco::AnyEvent::Nbtstat> is an asynchronous AnyEvent NetBIOS node
status requester.

=head1 ATTRIBUTES

L<App::Netdisco::AnyEvent::Nbtstat> implements the following attributes.

=head2 C<interval>

    my $interval = $request->interval;
    $request->interval(1);

Interval between requests, defaults to 0.02 seconds.

=head2 C<timeout>

    my $timeout = $request->timeout;
    $request->timeout(2);

Maximum request response time, defaults to 0.5 seconds.

=head1 METHODS

L<App::Netdisco::AnyEvent::Nbtstat> implements the following methods.

=head2 C<nbtstat>

    $request->nbtstat($ip, sub {
        my $result = shift;
    });

Perform a NetBIOS node status request of $ip.

=head1 SEE ALSO

L<AnyEvent>

=cut