File Coverage

blib/lib/Net/IRR.pm

Criterion	Covered	Total	%
statement	97	128	75.7
branch	24	70	34.2
condition	6	19	31.5
subroutine	22	26	84.6
pod	14	14	100.0
total	163	257	63.4

package Net::IRR;

use strict;
use warnings;

use Carp;
use IO::Socket::INET;

use vars qw/ @ISA %EXPORT_TAGS @EXPORT_OK $VERSION /;

$VERSION = '0.08';

#  used for route searches
use constant EXACT_MATCH   => 'o';
use constant ONE_LEVEL     => 'l';
use constant LESS_SPECIFIC => 'L';
use constant MORE_SPECIFIC => 'M';

require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK   = qw( EXACT_MATCH ONE_LEVEL LESS_SPECIFIC MORE_SPECIFIC );
%EXPORT_TAGS = (
    'all'   => \@EXPORT_OK,
    'route' => \@EXPORT_OK,
);

#  constructor
sub connect {
    my ($class, %args) = @_;
    my $self = bless {}, ref($class) || $class;
    $self->{host} = $args{host} || '127.0.0.1';
    $self->{port} = $args{port} || 43;
    $self->{tcp} = IO::Socket::INET->new(
                       PeerAddr => $self->{host},
                       PeerPort => $self->{port},
                       Proto    => 'tcp'
                   );

    unless ($self->{tcp}) {
        $self->{errstr} = "cannot create socket: $@";
        return;
    }

    return undef if $self->error();
    $self->_multi_mode();
    $self->_identify();
    return $self;
}

sub get_routes_by_origin {
    my ($self, $as) = @_;
    croak 'usage: $whois->get_routes_by_origin( $as_number )'
        unless @_ == 2;
    $as = 'as'.$as unless $as =~ /^as/i;
    $self->{tcp}->send("!g${as}\n");
    if (my $data = $self->_response()) {
        return wantarray ? split(" ", $data) : $data;
    }
    return ();
}

# RIPE-181 Only
sub get_routes_by_community {
    my ($self, $community) = @_;
    croak 'usage: $whois->get_routes_by_community( $community )'
        unless @_ == 2;
    $self->{tcp}->send("!h${community}\n");
    if (my $data = $self->_response()) {
        return wantarray ? split(" ", $data) : $data;
    }
    return ();
}

sub get_ipv6_routes_by_origin {
    my ($self, $as) = @_;
    croak 'usage: $whois->get_ipv6_routes_by_origin( $as_number )'
        unless @_ == 2;
    $as = 'as'.$as unless $as =~ /^as/i;
    $self->{tcp}->send("!6${as}\n");
    if (my $data = $self->_response()) {
        return wantarray ? split(" ", $data) : $data;
    }
    return ();
}

sub get_sync_info {
    my ($self, @dbs) = @_;
    my $dbs = (@dbs) ? join(",",@dbs) : '-*';
    $self->{tcp}->send("!j${dbs}\n");
    return $self->_response();
}

sub get_as_set {
    my ($self, $as_set, $expand) = @_;
    croak 'usage: $whois->get_as_set( $as_set )'
        unless @_ >= 2 && @_ <= 3;
    $expand = ($expand) ? ',1' : '';
    $self->{tcp}->send("!i${as_set}${expand}\n");
    if (my $data = $self->_response()) {
        return wantarray ? split(" ", $data) : $data;
    }
    return ();
}

sub get_route_set {    my ($self, $route_set, $expand) = @_;
    croak 'usage: $whois->get_route_set( $route_set )'
        unless @_ >= 2 && @_ <= 3;
    $expand = ($expand) ? ',1' : '';
    $self->{tcp}->send("!i${route_set}${expand}\n");
    if (my $data = $self->_response()) {
        return wantarray ? split(" ", $data) : $data;
    }
    return ();
}

sub match {
    my ($self, $type, $key) = @_;
    croak 'usage: $whois->match( $object_type, $key )'
        unless @_ == 3;
    $self->{tcp}->send("!m${type},${key}\n");
    return $self->_response();
}

*disconnect = \&quit;
sub quit {
    my $self = shift;
    $self->{tcp}->send("!q\n");
}

sub _identify {
    my ($self) = @_;
    $self->{tcp}->send("!nNet::IRR\n");
    return $self->_response();
}

sub _multi_mode {
    my ($self) = @_;
    $self->{tcp}->send("!!\n");
    return 1;
}

sub get_irrd_version {
    my ($self) = @_;
    $self->{tcp}->send("!v\n");
    return $self->_response();
}

sub route_search {
    my ($self, $route, $specific) = @_;
    croak 'usage: $whois->route_search( $route )'
        unless @_ >= 2 && @_ <= 3;
    $specific = ($specific) ? ",$specific" : '';
    $self->{tcp}->send("!r${route}${specific}\n");
    my $response = $self->_response();
    chomp($response) if $response;
    $response =~ s/\s*$// if $response;
    return $response;
}

sub sources {
    my ($self, @sources) = @_;
    my $source = (@sources) ? join(",", @sources) : '-lc';
    $self->{tcp}->send("!s${source}\n");
    my $response = $self->_response();
    chomp($response) if $response;
    return wantarray ? split(',', $response) : $response;
}

sub update {
    my ($self, $db, $action, $object) = @_;
    croak 'usage: $whois->update( $db, "ADD|DEL", $object )'
        unless @_ == 4;
    croak 'second argument to $whois->update() must be either ADD or DEL'
        unless $action eq 'ADD' || $action eq 'DEL';
    $self->{tcp}->send( sprintf("!us%s\n%s\n\n%s\n\n!ue\n", $db, $action, $object) );
    return $self->_response();
}

sub _response {
    my $self = shift;
    my $t = $self->{tcp};
    my $header = $t->getline();
    my $error_prefix = 'Net::IRR read error';
    if (not defined $header) {
        $self->{errstr} = sprintf("%s: no data read from %s:%d\n", $error_prefix, $self->{host}, $self->{port});
        return ();
    }
    return () if ($header =~ /^[CDEF].*$/);
    my($data_length) = $header =~ /^A(.*)$/;
    my $data = '';
    while($data_length != length($data)) {
        $data .= $t->getline();
    }
    carp sprintf("%s: only received %d out of %d bytes from %s:%d\n", $error_prefix, length($data), $data_length, $self->{host}, $self->{port})
        if $data_length != length($data);
    my $footer = $t->getline();
    return $data;
}

sub error {
    my $self = shift;
    return $self->{errstr};
}

1;
__END__