view release on metacpan or  search on metacpan

lib/Net/IP/Identifier/WhoisParser.pm  view on Meta::CPAN

#      PODNAME:  Net::IP::Identifier::WhoisParser
#     ABSTRACT:  parse WHOIS result, extracting particular information
#
#       AUTHOR:  Reid Augustin (REID)
#        EMAIL:  reid@hellosix.com
#      CREATED:  Sat May  2 15:51:45 PDT 2015
#===============================================================================

use 5.002;
use strict;
use warnings;

package Net::IP::Identifier::WhoisParser;
use Math::BigInt;
use Net::IP;   # for IP_IDENTICAL, OVERLAP, etc
use Net::IP::Identifier::Net;
use Net::IP::Identifier::Regex;
use Moo;
use namespace::clean;

our $VERSION = '0.111'; # VERSION

has verbose => (    # verbose mode
    is => 'rw',
);
has text => (
    is => 'rw',
);
has relevant_lines => (
    is => 'lazy',
    default => \&get_relevant_lines,
);
has entity => (     # if entity is found in the WHOIS result from entity strings
    is => 'lazy',
    default => \&get_entity,
);
has range => (      # a Net::IP::Identifier::Net object
    is => 'lazy',
    default => \&get_range,
);
has _entity => (    # if entity is found before ->entity call, stash it here
    is => 'rw',
);
has _range => (     # if range is found before ->range call, stash it here
    is => 'rw',
);

# some class variables

#my $Re = Net::IP::Identifier::Regex->new;
#my $re_any      = $Re->IP_any;
#my $re_netblock = $Re->netblock;

my @whois_stop_regexs = (   # lines beyond which we should not go
    qr[^parent:]i,
    qr[^route([s6])?:]i,
    qr[^mnt-routes:]i,
);

my @whois_range_regexs = (   # lines which might contain the range
    qr[^inet6?num:\s*(.+)]i,
    qr[^NetRange:\s*(.+)]i,
    qr[^CIDR:\s*(\S+)]i,
    qr[^Network:IP-Network(?:-Block)?:\s*(.+)]i,
    qr/^a\.\s*\[Network Number\]\s*(.*)/i,
);

my @whois_entity_regexs = (   # lines that might contain the entity
    qr[^Organization:\s*(.*)]i,
    qr[^org-name:\s*(.*)]i,
    qr[^descr:\s*(.*)]i,
    qr[^owner:\s*(.*)]i,
    qr[^Network:Org-Name:(.*)]i,
    qr/^g\.\s*\[Organization\]\s*(.*)/i,
);

sub get_relevant_lines {
    my ($self) = @_;

    my @lines;
    my $non_server_lines = 0;

    for my $line (split "\n", $self->text) {
        $line =~ s/\s*$//;
        next if (not $line =~ m/\S/);   # skip blank lines
        if ($line =~ m/^[#%]/) {    # comments
            if ($line =~ m/ Information related to / and
                $non_server_lines > 0) {   # if it's not the first thing
                last;       # skip everything else
            }
            next;   # skip comments
        }
        if ($line =~ m/^No match for "/ or
            $line =~ m/^descr:.* address block not managed by/) {
            return []; # no relevant lines
        }
        for my $re (@whois_stop_regexs) {
            last if ($line =~ m/$re/);
        }
        push @lines, $line;
        $non_server_lines++ if (not $line =~ m/^\[/);
        # check for ARIN style listing:
        if (my ($entity, $range) = $line =~ m/(.*?) \S+ \(NET6?[\da-fA-F-]+\) (.*)/) {
            $range = Net::IP::Identifier::Net->new($range);
            if (defined $self->_range and
                $self->_range->overlaps($range) == $IP_A_IN_B_OVERLAP) {
                # previous _range is inside new range.  we want
                #    the smallest, so swap
                $range = $self->_range;
                $entity = $self->_entity;
            }
            else {
            }
            $self->_range($range);
            $self->_entity($entity);
        }
    }
    return \@lines;
}

sub get_range {