[Rt-commit] rtir branch, 5.0/revert-to-old-net-whois-ripe, created. 5.0.0beta1-7-g9670aaeb

? sunnavy sunnavy at bestpractical.com
Wed Jul 8 14:11:04 EDT 2020


The branch, 5.0/revert-to-old-net-whois-ripe has been created
        at  9670aaebe375e17a8b0e8a20724d9ceda383d798 (commit)

- Log -----------------------------------------------------------------
commit 722e5a96005ebdc422d469d23444db12c547afe6
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Thu Jul 9 01:38:49 2020 +0800

    Revert "Catch parse failures from Net::Whois::Object"
    
    This reverts commit bb0c93a06100d64adfed331eb2b8898ed2327451.
    
    We are going to revert back to Net::Whois::Ripe 1.x because 2.x doesn't
    support general whois parsing.

diff --git a/html/RTIR/Tools/Elements/GetEmailFromIP b/html/RTIR/Tools/Elements/GetEmailFromIP
index 257f0746..a1e7d2f3 100644
--- a/html/RTIR/Tools/Elements/GetEmailFromIP
+++ b/html/RTIR/Tools/Elements/GetEmailFromIP
@@ -62,30 +62,17 @@ unless ( $iterator ) {
 
 $field ||= 'notify';
 
-# Trap possible failures when parsing results
-# Net::Whois currently dies in some cases, so we need to eval
-my @objects;
-eval {
-    @objects = Net::Whois::Object->new($iterator);
-};
-
+my @objects = Net::Whois::Object->new($iterator);
 my @res;
-if ( $@ ) {
-    RT->Logger->warn('Unable to parse WHOIS results for query ' . $q);
-    RT->Logger->debug($@);
-    $$error = loc('Unable to parse results from WHOIS lookup');
-}
-else {
-    foreach my $obj (@objects) {
-        foreach my $attr ( grep lc $_ eq lc $field, $obj->attributes ) {
-            push @res, $obj->$attr();
-        }
-    }
-    unless ( @res ) {
-        $$error = loc("Whois server response did not include field '[_1]'", $field);
-        return;
+foreach my $obj (@objects) {
+    foreach my $attr ( grep lc $_ eq lc $field, $obj->attributes ) {
+        push @res, $obj->$attr();
     }
 }
+unless ( @res ) {
+    $$error = loc("Whois server response did not include field '[_1]'", $field);
+    return;
+}
 
 ($$address) = grep defined && length, @res;
 </%INIT>

commit 9670aaebe375e17a8b0e8a20724d9ceda383d798
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Thu Jul 9 01:42:53 2020 +0800

    Revert "Updated Net::Whois::RIPE to 2.x"
    
    This reverts commit 1ffa0fb951f094b09b4944738cb633a5e5fc4c35.
    
    Sadly that Net::Whois::RIPE 2.x doesn't support general whois parsing,
    which we need on scripted action(By IP address) page.

diff --git a/Makefile.PL b/Makefile.PL
index 5ae905fd..fd381ba0 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -25,7 +25,6 @@ if ($^O ne 'VMS') {
 
 # RTIR needs this version of SB because of cud-from-select
 requires('DBIx::SearchBuilder', 1.61);
-requires('Net::Whois::RIPE', 2.006001);
 
 # IP searching
 requires('Regexp::Common');
diff --git a/html/RTIR/Tools/Elements/GetEmailFromIP b/html/RTIR/Tools/Elements/GetEmailFromIP
index a1e7d2f3..6b8e0a49 100644
--- a/html/RTIR/Tools/Elements/GetEmailFromIP
+++ b/html/RTIR/Tools/Elements/GetEmailFromIP
@@ -62,11 +62,10 @@ unless ( $iterator ) {
 
 $field ||= 'notify';
 
-my @objects = Net::Whois::Object->new($iterator);
 my @res;
-foreach my $obj (@objects) {
-    foreach my $attr ( grep lc $_ eq lc $field, $obj->attributes ) {
-        push @res, $obj->$attr();
+while ( my $query = $iterator->next ) {
+    foreach my $attr ( grep lc $_ eq lc $field, $query->attributes ) {
+        push @res, $query->$attr();
     }
 }
 unless ( @res ) {
diff --git a/html/RTIR/Tools/Elements/ToolResultsWhois b/html/RTIR/Tools/Elements/ToolResultsWhois
index df664bcf..30d9bae9 100644
--- a/html/RTIR/Tools/Elements/ToolResultsWhois
+++ b/html/RTIR/Tools/Elements/ToolResultsWhois
@@ -59,12 +59,11 @@
 <%PERL>
 my $DoInvestigate = 0;
 if ($WhoisIterator) {
-    while ( $WhoisIterator->isnt_exhausted) {
-        my $block = $WhoisIterator->value;
-        $SavedContent .= $block . "\n";
-        my @lines_starting_with_space = grep /^(\s+)(\w+)/, $block;
+    while (my $obj = $WhoisIterator->next) {
+        $SavedContent .= $obj->content . "\n";
+        my @lines_starting_with_space = grep /^(\s+)(\w+)/, $obj->content;
         if ($handparse || $#lines_starting_with_space >= 4) {    #we couldn't parse that. suck
-            my $content = join "", $block;
+            my $content = join "", $obj->content;
             $m->comp('/Elements/MakeClicky',
                      object        => $TicketObj,
                      lookup_params => "ticket=" . ($TicketObj ? $TicketObj->id : 0) . "&server=$WhoisServer",
@@ -75,20 +74,12 @@ if ($WhoisIterator) {
 %       } else {
 Structured RIPE whois data returned.
 Click <a href="Lookup.html?q=<% $q |u %>&server=<% $WhoisServer |u %>&handparse=1">here</a> to manually parse this data.
+<br />Warnings <% $obj->warnings %>
+<br />errors <% $obj->errors %>
+<hr />
 <%perl>
-my @objects = Net::Whois::Object->new($WhoisIterator);
-foreach my $object ( @objects ) {
-   my %seen;
-   foreach my $attribute ($object->attributes()) {
-       next if ($seen{$attribute});
-       $seen{$attribute} = 1;
-       my @values;
-       foreach my $value ( $object->$attribute() ) {
-         next unless ($value);
-         push (@values, (ref($value) eq 'ARRAY' ) ? @$value : $value);
-       }
-       next unless (scalar @values);
-       my $value = join("\n", ' ', @values);
+foreach my $attribute ( $obj->attributes ) {
+   foreach my $value ( $obj->$attribute() ) {
 </%perl>
      <b><%$attribute%></b>: 
 <& /Elements/MakeClicky, 
diff --git a/lib/Net/Whois/RIPE.pm b/lib/Net/Whois/RIPE.pm
new file mode 100644
index 00000000..d01155a8
--- /dev/null
+++ b/lib/Net/Whois/RIPE.pm
@@ -0,0 +1,528 @@
+###############################################################################
+# Net::Whois::RIPE - implementation of RIPE Whois.
+# Copyright (C) 2009 Luis Motta Campos
+# Copyright (C) 2005-2006 Paul Gampe, Kevin Baker
+# vim:tw=78:ts=4
+###############################################################################
+
+package Net::Whois::RIPE;
+
+use strict;
+use Carp;
+use IO::Socket;
+use Net::Whois::RIPE::Object;
+use Net::Whois::RIPE::Object::Template;
+use Net::Whois::RIPE::Iterator;
+
+use constant MAX_RETRY_ATTEMPTS => 3;  # number of times to attempt connection
+use constant SLEEP_INTERVAL     => 1;  # time interval between attempts
+
+our $VERSION = '1.30';
+
+# class wide debug flag 0=off,1=on,2=on for IO::Socket
+my $DEBUG = 0;
+
+# couple of regexs that may need attention
+my $RE_WHOIS = '(?:whois\.apnic\.net)$';
+my $RE_RIPE  = '(?:ripe|ra|apnic|afrinic|rr\.arin|6bone)\.net$';
+
+# version string to let whois know which client version it is talking to
+my $VER_FLAG = '-VNWR' . $VERSION;
+
+sub new {
+    my $proto = shift;
+    my ( $host, %arg ) = @_;
+    my $class = ref($proto) || $proto;
+
+    my $debug = exists $arg{Debug} ? $arg{Debug} : 0;
+    unless ($host) {
+        carp "new: no hostname found." if $DEBUG || $debug;
+        return undef;
+    }
+
+    my $self = bless {
+
+        # object fields
+        SOCKET        => undef,                  # unconnected
+        TIMEOUT       => $arg{Timeout} || 30,    # default timeout
+        MAX_READ_SIZE => 0,                      # no read size limit
+        DEBUG         => $debug,                 # object debug
+
+        # whois flags
+        FLAG_a => 0,   # search all databases
+        FLAG_B => 0,   # disable filtering of "notify:", "changed:",  "e-mail:
+        FLAG_F => 0,   # fast raw output
+        FLAG_g =>
+            0,    # used to sync databases. shouldn't be used for general use
+        FLAG_G => 0,        # Disables the grouping of objects by relevance
+        FLAG_h => $host,    # host to connect to
+        FLAG_i => '',       # do an inverse lookup for specified attributes
+        FLAG_k => 0,        # for persistant socket connection
+        FLAG_K => 0,        # return only primary keys
+        FLAG_L => 0,        # find all Less specific matches
+        FLAG_m => 0,        # find first level more specific matches
+        FLAG_M => 0,        # find all More specific matches
+        FLAG_p => $arg{Port} || 'whois',   # port, usually 43 for whois
+        FLAG_r => 0,                       # turn off recursive lookups
+        FLAG_R => 0,                       # do not trigger referral mechanism
+        FLAG_s => '',    # search databases with source 'source'
+        FLAG_S => 0,     # tell server to leave out 'syntactic sugar'
+        FLAG_t => '',    # requests template for object of type 'type'
+        FLAG_T => '',    # only look for objects of type 'type'
+        FLAG_v => '',    # request verbose template for object of type 'type'
+        FLAG_V => $VER_FLAG,    # client Version
+    }, $class;
+
+    # if host matches a server that accepts a
+    # referral IP then add the remote addr to version
+    $self->{FLAG_V} = $VER_FLAG . "," . $ENV{"REMOTE_ADDR"}
+        if $self->{FLAG_h} =~ /$RE_WHOIS/oi
+            and $ENV{"REMOTE_ADDR"};
+
+    # connect to server
+    #unless ($self->_connect) {
+    #    carp "new: whois connection failure." if $DEBUG || $debug;
+    #    return undef;
+    #    }
+    return $self;
+}
+
+sub connect {
+    my $self = shift;
+    $self->_connect();
+}
+
+sub query_iterator {
+    my $self      = shift;
+    my $query_key = shift;
+
+    unless ($query_key) {
+        carp "query: no QUERY_KEY found" if $self->debug;
+        return undef;
+    }
+
+    # TODO - close the connection pseudo gracefully if the timeout value
+    # expires. allow user to set timeouts?
+
+    my $sock;
+    unless ( $sock = $self->_connect ) {
+        carp "query: unable to obtain socket" if $self->debug;
+        return undef;
+    }
+
+    my $string;
+    unless ( $string = $self->_options($query_key) ) {
+        carp "query: unable to parse options" if $self->debug;
+        return undef;
+    }
+
+    return Net::Whois::RIPE::Iterator->new( $self, $string . "\n\n" );
+}
+
+sub template {
+    my $self     = shift;
+    my $template = shift;
+    unless ($template) {
+        carp "template: no WHOIS OBJECT NAME found" if $self->debug;
+        return wantarray ? () : undef;
+    }
+    $self->{FLAG_t} = 1;
+
+    my $string;
+    unless ( $string = $self->_options($template) ) {
+        carp "template: unable to parse options" if $self->debug;
+        return undef;
+    }
+
+    return $self->_query( $string . "\n\n",
+        "Net::Whois::RIPE::Object::Template" );
+}
+
+sub verbose_template {
+    my $self     = shift;
+    my $template = shift;
+    unless ($template) {
+        carp "verbose_template: no WHOIS OBJECT NAME found" if $self->debug;
+        return wantarray ? () : undef;
+    }
+    $self->{FLAG_v} = 1;
+
+    my $string;
+    unless ( $string = $self->_options($template) ) {
+        carp "verbose_template: unable to parse options" if $self->debug;
+        return undef;
+    }
+
+    return $self->_query( $string . "\n\n",
+        "Net::Whois::RIPE::Object::Template" );
+}
+
+sub query {
+    my $self      = shift;
+    my $query_key = shift;
+
+    unless ($query_key) {
+        carp "query: no QUERY_KEY found" if $self->debug;
+        return undef;
+    }
+
+    my $string;
+    unless ( $string = $self->_options($query_key) ) {
+        carp "query: unable to parse options" if $self->debug;
+        return undef;
+    }
+
+    if ( $self->{cache} ) {
+        my $object = $self->{cache}->get($string);
+        return wantarray ? @$object : $object->[0] if $object;
+    }
+
+    # TODO - close the connection pseudo gracefully if the timeout value
+    # expires. allow user to set timeouts?
+
+    my $sock;
+    unless ( $sock = $self->_connect ) {
+        carp "query: unable to obtain socket" if $self->debug;
+        return undef;
+    }
+
+    my @object = $self->_query( $string . "\n", "Net::Whois::RIPE::Object" );
+
+    $self->{cache}->set( $string, \@object ) if $self->{cache} and @object;
+
+    return wantarray ? @object : $object[0];
+}
+
+sub update {
+    my $self    = shift;
+    my $message = shift;
+
+    unless ($message) {
+        carp 'update: no TEXT message found' if $self->debug;
+        return undef;
+    }
+
+    # pull out login and domain from the changed: line
+    my ( $login, $domain ) = ( $message =~ /changed:\s+(.+)@(.+)\n/ );
+    unless ( $login and $domain ) {
+        carp "update: cannot find 'changed' attribute" if $self->debug;
+        return undef;
+    }
+
+    my $string = $self->{FLAG_V} . " -U $login $domain\n" . $message;
+    return $self->_query( $string, "Net::Whois::RIPE::Object" );
+}
+
+sub _query {
+    my $self      = shift;
+    my $string    = shift;
+    my $ripe_type = shift;
+
+    my $sock;
+    my @objects;
+    my $connection_attempts = 0;
+
+    while ( $connection_attempts < MAX_RETRY_ATTEMPTS ) {
+
+        unless ( $sock = $self->_connect ) {
+            carp "_query: unable to obtain socket" if $self->debug;
+            return undef;
+        }
+
+        unless ( print $sock $string ) {
+            carp "_query: unable to print to socket:\n$string"
+                if $self->debug;
+            return undef;
+        }
+
+        $sock->flush;
+
+        my $bytes = 0;
+        my $max   = $self->max_read_size;
+
+        while ( my $t = $ripe_type->new( $sock, $self->{FLAG_k} ) ) {
+
+            # discards pseudo-records containing only comments
+            next if $self->{FLAG_k} and not $t->attributes and $t->success;
+            if ( $t->size <= 2 ) {
+                return wantarray ? @objects : $objects[0];
+            }
+            push @objects, $t;
+            $bytes += $t->size;
+            if ( $max and $bytes > $max ) {
+                my $msg
+                    = "exceeded maximum read size of " 
+                    . $max
+                    . " bytes."
+                    . " results may have been truncated.";
+                $t->push_warn($msg);
+                carp "_query: " . $msg if $self->debug;
+                last;
+            }
+            last if $sock->eof or not wantarray;
+        }
+
+        # exit the retry loop unless the client has been disconnected
+        last unless not @objects and $sock->eof;
+
+        carp "_query: disconnected by server "
+            . $self->{FLAG_h}
+            . ", trying again..."
+            if $self->debug;
+        $self->_disconnect;
+        sleep SLEEP_INTERVAL;
+        $connection_attempts++;
+        next;
+    }
+
+    if ( $sock and $self->{FLAG_k} ) {
+        $sock->flush;
+        $self->{SOCKET}->flush;
+    }
+    else {
+        $self->_disconnect;
+    }
+
+    return wantarray ? @objects : $objects[0];
+}
+
+sub max_read_size {
+    my $self = shift;
+    @_ ? $self->{MAX_READ_SIZE} = 0 + shift : $self->{MAX_READ_SIZE};
+}
+
+sub disconnect {
+    $_[0]->_disconnect;
+}
+
+sub cache {
+    return $_[0]->{cache} if not defined $_[1];
+    $_[0]->{cache} = $_[1];
+}
+
+sub search_all      { $_[0]->{FLAG_a} = 1 }
+sub fast_raw        { $_[0]->{FLAG_F} = 1 }
+sub set_persistance { $_[0]->{FLAG_a} = 1 }
+sub find_less       { $_[0]->{FLAG_L} = 1 }
+sub find_more       { $_[0]->{FLAG_m} = 1 }
+sub find_all_more   { $_[0]->{FLAG_M} = 1 }
+sub no_recursive    { $_[0]->{FLAG_r} = 1 }
+sub no_referral     { $_[0]->{FLAG_R} = 1 }
+sub no_sugar        { $_[0]->{FLAG_S} = 1 }
+sub persistant      { $_[0]->{FLAG_k} = 1 }
+sub no_filtering    { $_[0]->{FLAG_B} = 1 }
+sub no_grouping     { $_[0]->{FLAG_G} = 1 }
+
+# sync is special and is here for completeness. it
+# is not expected that it wil be used
+sub sync           { my $self = shift; $self->{FLAG_g} = shift; }
+sub inverse_lookup { my $self = shift; $self->{FLAG_i} = shift; }
+sub primary_only   { my $self = shift; $self->{FLAG_K} = shift; }
+sub source         { my $self = shift; $self->{FLAG_s} = shift; }
+sub type           { my $self = shift; $self->{FLAG_T} = shift; }
+
+sub port {
+    my $self = shift;
+
+    unless ( $self->{FLAG_p} ) {
+        carp 'port: no port defined!' if $self->debug;
+        return undef;
+    }
+
+    # trying to change port? not allowed
+    if (@_) {
+        carp "port: cannot switch port." if $self->debug;
+    }
+    return $self->{FLAG_p};
+}
+
+sub server {
+    my $self = shift;
+
+    unless ( $self->{FLAG_h} ) {
+        carp 'server: no hostname found' if $self->debug;
+        return undef;
+    }
+
+    # trying to change servers? not allowed
+    if (@_) {
+        carp "server: cannot switch server." if $self->debug;
+    }
+    return $self->{FLAG_h};
+}
+
+sub debug {
+    my $self = shift;
+    if (@_) {
+        ref($self) ? $self->{DEBUG} = shift : $DEBUG = shift;
+    }
+    return ref($self) ? ( $DEBUG || $self->{DEBUG} ) : $DEBUG;
+}
+
+sub DESTROY {
+    my $self = shift;
+
+    carp "Destroying ", ref($self) if $self->debug;
+    if ( $self->{SOCKET} and $self->{FLAG_k} ) {    # $sock->flush;
+        $self->{SOCKET}->flush;
+    }
+    else {
+        $self->_disconnect;
+    }
+}
+
+END {
+    carp "All Net::Whois::RIPE objects are going away now." if $DEBUG;
+}
+
+###############################################################################
+##            P R I V A T E   M E T H O D S
+###############################################################################
+
+sub _connect {
+    my $self = shift;
+    if ( $self->{SOCKET} and $self->{SOCKET}->connected ) {
+
+        #carp 'already connected to '.$self->{SOCKET}->peerhost;
+        return $self->{SOCKET};
+    }
+
+    my $sock;
+    my $attempt   = 0;
+    my $connected = 0;
+    while ( !$connected and $attempt < MAX_RETRY_ATTEMPTS ) {
+        if ($attempt) {
+            carp "_connect: to server "
+                . $self->{FLAG_h}
+                . " failed, trying again..."
+                if $self->debug;
+            sleep SLEEP_INTERVAL;
+        }
+        $attempt++;
+        $connected = 1
+            if $sock = IO::Socket::INET->new(
+            PeerAddr => $self->server,
+            PeerPort => $self->port,
+            Proto    => 'tcp',
+            Timeout  => $self->{TIMEOUT}
+            );
+        carp $@ if $@ and $self->debug > 1;
+    }
+    if ( not $connected ) {
+        carp "Failed to connect to host [" . $self->server . "]"
+            if $self->debug;
+        return undef;
+    }
+    $sock->autoflush;    # on by default since IO 1.18, but anyhow
+    return $self->{SOCKET} = $sock;
+}
+
+sub _disconnect {
+    my $self = shift;
+    my $sock = $self->{SOCKET};
+    return unless $sock and $sock->connected;
+    $sock->flush;        # probably not necessary
+    carp "disconnecting from " . $self->{FLAG_h} if $self->debug;
+    $sock->close;
+    $self->{SOCKET} = undef;
+}
+
+sub _options {
+    my $self = shift;
+    my $key  = shift;
+
+    if (   ( !$key )
+        && ( !$self->{FLAG_t} )
+        && ( !$self->{FLAG_g} )
+        && ( !$self->{FLAG_v} )
+        && ( !( ( $self->{FLAG_g} ) && ( $self->{FLAG_t} ) ) ) )
+    {
+        carp '_options: no search key or valid option found' if $self->debug;
+        return undef;
+    }
+
+    if ( !$self->{FLAG_h} ) {
+        carp "_options: no hostname found" if $self->debug;
+        return undef;
+    }
+
+    if ( $self->{FLAG_L} ) {
+        if ( $self->debug ) {
+            carp "_options: warning -L overrides -m\n" if $self->{FLAG_m};
+            carp "_options: warning -L overrides -M\n" if $self->{FLAG_M};
+        }
+        $self->{FLAG_m} = 0;
+        $self->{FLAG_M} = 0;
+    }
+
+    if ( $self->{FLAG_m} ) {
+        if ( $self->debug ) {
+            carp "_options: warning -m overrides -M\n" if $self->{FLAG_M};
+        }
+        $self->{FLAG_M} = 0;
+    }
+
+    my $query = "";
+
+    # tell the server what version of RIPE whois we are running,
+    # but only if we are sure that we are talking to an
+    # RIPE whois server
+
+    if (   ( $self->{FLAG_h} =~ /$RE_RIPE/oi )
+        || $self->{FLAG_a}
+        || $self->{FLAG_B}
+        || $self->{FLAG_g}
+        || $self->{FLAG_G}
+        || $self->{FLAG_F}
+        || $self->{FLAG_i}
+        || $self->{FLAG_k}
+        || $self->{FLAG_K}
+        || $self->{FLAG_m}
+        || $self->{FLAG_M}
+        || $self->{FLAG_R}
+        || $self->{FLAG_L}
+        || $self->{FLAG_r}
+        || $self->{FLAG_s}
+        || $self->{FLAG_S}
+        || $self->{FLAG_t}
+        || $self->{FLAG_v}
+        || $self->{FLAG_T} )
+    {
+
+        $query .= $self->{FLAG_V} . " ";
+    }
+
+    # XXX -g is an undocumented option: get specified updates:
+    #       -g Source:First-Last
+    # get updates with 'Source'
+    # from serial 'First' till 'Last' (you may use 'LAST')
+
+    $query .= "-a "                         if ( $self->{FLAG_a} );
+    $query .= "-B "                         if ( $self->{FLAG_B} );
+    $query .= "-F "                         if ( $self->{FLAG_F} );
+    $query .= "-g " . $self->{FLAG_g} . " " if ( $self->{FLAG_g} );
+    $query .= "-G "                         if ( $self->{FLAG_G} );
+    $query .= "-i " . $self->{FLAG_i} . " " if ( $self->{FLAG_i} );
+    $query .= "-k "                         if ( $self->{FLAG_k} );
+    $query .= "-K "                         if ( $self->{FLAG_K} );
+    $query .= "-L "                         if ( $self->{FLAG_L} );
+    $query .= "-m "                         if ( $self->{FLAG_m} );
+    $query .= "-M "                         if ( $self->{FLAG_M} );
+    $query .= "-r "                         if ( $self->{FLAG_r} );
+    $query .= "-R "                         if ( $self->{FLAG_R} );
+    $query .= "-S "                         if ( $self->{FLAG_S} );
+    $query .= "-s " . $self->{FLAG_s} . " " if ( $self->{FLAG_s} );
+    $query .= "-T " . $self->{FLAG_T} . " " if ( $self->{FLAG_T} );
+    $query .= "-t "                         if ( $self->{FLAG_t} );
+    $query .= "-v "                         if ( $self->{FLAG_v} );
+
+    $query .= $key;
+
+    carp "_options: parsed query string: $query" if $self->debug;
+
+    return $query;
+}
+
+1;
+__END__
+
diff --git a/lib/Net/Whois/RIPE.pod b/lib/Net/Whois/RIPE.pod
new file mode 100644
index 00000000..62b34a45
--- /dev/null
+++ b/lib/Net/Whois/RIPE.pod
@@ -0,0 +1,254 @@
+=head1 NAME
+
+Net::Whois::RIPE - implementation of RIPE Whois.
+
+=head1 SYNOPSIS
+
+ use Net::Whois::RIPE;
+
+ $whois = Net::Whois::RIPE->new($host);
+ $whois = Net::Whois::RIPE->new($host,Timeout=>10);
+ $whois = Net::Whois::RIPE->new($host,Timeout=>10,Port=>43);
+
+
+ $whois->no_recursive;
+ $whois->source('APNIC');
+ $whois->type('inetnum');
+
+ foreach $inet ($whois->query('203.203.203.203')) {
+     print $inet->inetnum, "\n";
+ }
+
+ $whois->query('202.12.28.0');
+ $whois->update($text);
+
+ # to minimise memory requirements on large lookups...
+ $iterator = $whois->query_iterator('DNS3-AP');
+ while ($obj = $iterator->next) {
+     ...
+ }
+
+ $whois->template('inetnum');
+ $whois->verbose_template('inetnum');
+
+ $whois->debug(1);
+ $whois->max_read_size(1024);
+
+ $whois->search_all;     # -a
+ $whois->fast_raw;       # -F
+ $whois->find_less;      # -L
+ $whois->find_more;      # -m
+ $whois->find_all_more;  # -M
+ $whois->no_recursive;   # -r
+ $whois->no_referral;    # -R
+ $whois->no_sugar;       # -S
+ $whois->no_filtering;   # -B
+ $whois->no_grouping;    # -G
+
+ $whois->inverse_lookup($attribute); # -i $attribute
+ $whois->source('APNIC');            # -s APNIC
+ $whois->type('person');             # -T person
+
+ # query only
+
+ $whois->port();
+ $whois->server();
+
+
+=head1 DESCRIPTION
+
+Net::Whois::RIPE class implementing a RIPE whois client.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item B<new (HOST [,OPTIONS])>
+
+This is the constructor for a new Net::Whois::RIPE object. C<HOST> is the
+name of the remote host to which a whois connection is required.
+
+C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
+Possible options are:
+
+ Port - The port number to connect to on the remote machine
+ Timeout - Set a timeout value in seconds (defaults to 30)
+ Debug - See debug methog.
+
+The constructor returns undef on failure. If B<debug> is on then a message
+is carped about the failure.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item B<template(WHOIS_OBJECT_NAME)>
+
+Sends a template request to whois host for a template of WHOIS_OBJECT_NAME.
+Results are returned in a I<Net::Whois::RIPE::Object> object. The template is
+retrieved via the I<content> method on the I<Net::Whois::RIPE::Object> object.
+
+ $t = $whois->template('all');
+ $t = $whois->template('inetnum');
+ $t = $whois->template('person');
+ $text = $t->content;
+
+If WHOIS_OBJECT_NAME is undefined then the method will carp (under debug)
+and return undef.
+
+=item B<verbose_template(WHOIS_OBJECT_NAME)>
+
+Like B<template>, but sends a verbose template request to the whois host for
+WHOIS_OBJECT_NAME. Results are returned in a I<Net::Whois::RIPE::Object> object.
+The verbose template is retrieved via the I<content> method on the
+I<Net::Whois::RIPE::Object> object.
+
+ $vt = $whois->verbose_template('person');
+ $text = $vt->content;
+
+If WHOIS_OBJECT_NAME is undefined then the method will carp and return undef.
+
+=item B<query(QUERY_TEXT)>
+
+Formats query flag options (see below) and sends them and QUERY_TEXT to the
+server. If called in a scalar context then the first object returned from
+the server is passed back as a single I<Net::Whois::RIPE::Object> object.
+In an array context, all returned objects returned from the server are
+parsed into in a list and returned (potentially quite large).
+
+ $q = $whois->query('key')  # a single Query
+ @q = $whois->query('key')  # an array of Queries
+
+If QUERY_KEY is undefined, undef is returned. Any failure will carp and
+return undef.
+
+If B<max_read_size> is greater than zero then the server response will be
+abandoned when greater than max_read_size bytes have been read. The last
+object read will have warning messages set to indicate that
+the response was cut.
+
+=item B<query_iterator(QUERY_TEXT)>
+
+Similar to I<query> except that a Net::Whois::RIPE::Iterator object is
+returned. This object is used to iterate over the results of the query.
+
+This was created in response to huge results returned by whois queries where
+over 1000 objects may be returned. Query iterator returns an object at a time
+via the I<next> method as opposed to I<query> which returns an array of
+objects.
+
+ $iterator = $whois->query_iterator
+   or die "unable to create iterator";
+ while ($obj = $iterator->next) {
+     ...
+ }
+
+=item B<update(UPDATE_TEXT)>
+
+Sends UPDATE_TEXT directly to server. Query flag options (below) are not used
+by update. Server response is returned via I<Net::Whois::RIPE::Object>. Use the
+B<content> method on the Query object to via server response.
+
+ my $q = $whois->update($message)
+ print $q->content
+
+If UPDATE_TEXT is undefined, undef is returned.
+Any failure will carp and return undef.
+
+If no I<changed> field can be found to determine a login and domain the method
+will carp and return undef.
+
+If B<max_read_size> is greater than zero then the server response will be
+abandoned when greater than max_read_size bytes have been read.
+
+=item B<debug(LEVEL)>
+
+Sets/gets debugging level on the class or an object.
+
+ 0 - no debugging
+ 1 - debugging on
+ 2 - carp on IO::Socket::INET
+
+=item B<max_read_size([INTEGER])>
+
+Sets/reads the maximum number of bytes that I<Net::Whois::RIPE> will
+read before returning. This is to limit huge responses from the server
+overloading scripts.
+
+a I<max_read_size> of zero indicates B<no> limit.
+
+=item B<flag options>
+
+The following flags may be set by calling the method. Their meaning is
+identical to the ripe whois client. These flags require no arguments, they
+simply set the flag on.
+
+       Method                       Equivalent whois flag
+
+       search_all                   -a
+       fast_raw                     -F
+       find_less                    -L
+       find_more                    -m
+       find_all_more                -M
+       no_recursive                 -r
+       no_referral                  -R
+       no_sugar                     -S
+       no_filtering                 -B
+       no_grouping                  -G
+
+=item B<flag options taking values>
+
+The following flags may be set by calling the method with a value.
+There meaning is identical to the ripe whois client.
+
+       Method                       Equivalent whois flag
+
+       inverse_lookup(ATTRIBUTE)    -i ATTRIBUTE
+       port(PORT)                   -p PORT
+       source(SOURCE)               -s SOURCE
+       type(TYPE)                   -T TYPE
+
+=back
+
+=head1 AUTHOR
+
+ Paul Gampe, <pgampe at users.sourceforge.net>
+ Kevin Baker, <shagol at users.sourceforge.net>
+ Bruce Campbell, <bxc at users.sourceforge.net>
+ Luis Motta Campos E<lt>lmc at cpan.orgE<gt>
+
+=head1 TODO
+
+Update could be made clever enough to determine if it was been passed
+a string to update or a Net::Whois::RIPE::Object and adapt its behaviour.
+
+=head1 SEE ALSO
+
+ Net::Whois::RIPE::Iterator
+ Net::Whois::RIPE::Object
+ Net::Whois::RIPE::Object::Template
+ http://www.ripe.net/db/about.html
+
+=head1 COPYRIGHT
+
+ Copyright (C) 1998 Paul Gampe and APNIC Pty. Ltd.
+ Copyright (C) 2000 Kevin Baker and APNIC Pty. Ltd.
+ Copyright (C) 2004-2005 Paul Gampe
+ Copyright (C) 2009 Luis Motta Campos
+
+ This program is free software; you can redistribute it
+ and/or modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation;
+ either version 1, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public
+ License along with this program; if not, write to the
+ Free Software Foundation, Inc.,
+ 675 Mass Ave, Cambridge, MA 02139, USA.
diff --git a/lib/Net/Whois/RIPE/Iterator.pm b/lib/Net/Whois/RIPE/Iterator.pm
new file mode 100644
index 00000000..65253c8c
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Iterator.pm
@@ -0,0 +1,90 @@
+###############################################################################
+# Net::Whois::RIPE - implementation of RIPE Whois.
+# Copyright (C) 2009 Luis Motta Campos
+# Copyright (C) 2005 Paul Gampe, Kevin Baker
+# vim:tw=78:ts=4
+###############################################################################
+package Net::Whois::RIPE::Iterator;
+
+use strict;
+use Carp;
+use Net::Whois::RIPE::Object;
+use Net::Whois::RIPE::Object::Template;
+
+our $VERSION = '1.30';
+
+# class wide debug flag 0=off,1=on,2=on for IO::Socket
+my $DEBUG = 0;
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    unless ( @_ == 2 ) {
+        carp "new: expecting Net::Whois::RIPE object and a query string"
+            if $DEBUG;
+        return undef;
+    }
+    my $self = bless {
+        WHOIS => shift,
+        QUERY => shift,
+        DEBUG => 0,
+    }, $class;
+
+    unless ( ref( $self->{WHOIS} ) =~ /^Net::Whois::RIPE$/ ) {
+        carp "new: first parameter must be a Net::Whois::RIPE object"
+            if $DEBUG;
+        return undef;
+    }
+
+    if ( $self->{QUERY} =~ /^\s*$/ ) {
+        carp "new: second parameter must be a whois query string" if $DEBUG;
+        return undef;
+    }
+
+    my $sock = $self->{SOCKET} = $self->{WHOIS}->_connect;
+    unless ( print $sock $self->{QUERY} ) {
+        carp "new: unable to print to socket:\n" . $self->{QUERY} if $DEBUG;
+        return undef;
+    }
+
+    return $self;
+}
+
+sub next {
+    my $self = shift;
+
+    my $sock = $self->{SOCKET};
+    unless ( $sock and $sock->connected ) {
+        carp 'no socket connection' if $DEBUG || $self->debug;
+        return undef;
+    }
+
+    my $obj = Net::Whois::RIPE::Object->new($sock);
+    return $obj if $obj;
+    $self->{WHOIS}->_disconnect();
+    return undef;
+}
+
+sub debug {
+    my $self = shift;
+    if (@_) {
+        ref($self) ? $self->{DEBUG} = shift : $DEBUG = shift;
+    }
+    return ref($self) ? ( $DEBUG || $self->{DEBUG} ) : $DEBUG;
+}
+
+sub DESTROY {
+    my $self = shift;
+    carp "Destroying ", ref($self) if $self->debug;
+}
+
+END {
+    carp "All Net::Whois::RIPE::Iterator objects are going away now."
+        if $DEBUG;
+}
+
+###############################################################################
+##            P R I V A T E   M E T H O D S
+###############################################################################
+1;
+
diff --git a/lib/Net/Whois/RIPE/Iterator.pod b/lib/Net/Whois/RIPE/Iterator.pod
new file mode 100644
index 00000000..588d4898
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Iterator.pod
@@ -0,0 +1,83 @@
+
+=head1 NAME
+
+Net::Whois::RIPE::Iterator - iterator for RIPE object's.
+
+=head1 SYNOPSIS
+
+ use Net::Whois::RIPE;
+ use Net::Whois::RIPE::Iterator;
+
+ $whois = Net::Whois::RIPE->new($host);
+
+ $iterator = Net::Whois::RIPE::Iterator->new($whois,$query);
+ while ($obj = $iterator->next) {
+     ...
+ }
+
+=head1 DESCRIPTION
+
+Implements an iterator for Net::Whois::RIPE::Objects.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item B<new (WHOIS, QUERY)>
+
+The constructor returns undef on failure. If B<debug> is on then a message
+is carped about the failure.
+
+I<WHOIS> is an object of class I<Net::Whois::RIPE>
+
+I<QUERY> is a query string to be sent to the I<WHOIS> object to
+retrieve the whois objects.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item B<next()>
+
+Returns the next I<Net::Whois::RIPE::Object> from the query.
+
+Returns undef if no more objects.
+
+=item B<debug(LEVEL)>
+
+Sets/gets debugging level on the class or an object.
+
+ 0 - no debugging
+ 1 - debugging on
+
+=back
+
+=head1 AUTHOR
+
+ Kevin Baker, <shagol at users.sourceforge.net>
+
+=head1 SEE ALSO
+
+ Net::Whois::RIPE
+ Net::Whois::RIPE::Object
+
+=head1 COPYRIGHT
+
+ Copyright (C) 2000 Kevin Baker and APNIC Pty. Ltd.
+
+ This program is free software; you can redistribute it
+ and/or modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation;
+ either version 1, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public
+ License along with this program; if not, write to the
+ Free Software Foundation, Inc.,
+ 675 Mass Ave, Cambridge, MA 02139, USA.
diff --git a/lib/Net/Whois/RIPE/Object.pm b/lib/Net/Whois/RIPE/Object.pm
new file mode 100644
index 00000000..cccd4de5
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Object.pm
@@ -0,0 +1,259 @@
+###############################################################################
+# Net::Whois::RIPE - implementation of RIPE Whois.
+# Copyright (C) 2009 Luis Motta Campos
+# Copyright (C) 2005 Paul Gampe, Kevin Baker
+# vim:tw=78:ts=4
+###############################################################################
+package Net::Whois::RIPE::Object;
+use strict;
+use Carp;
+
+our $VERSION = '1.31';
+
+my $errstr = '';
+sub errstr { $errstr }
+
+# XXX: remove declaration of AUTOLOAD from here
+use vars qw($AUTOLOAD);
+
+# values not permitted to be added
+my @NO_ADD = qw(
+  content methods attributes warning error success debug parse
+  size _ok _err _wrn
+);
+my %NO_ADD = map { $_ => 1 } @NO_ADD;
+
+my @Free_Form = qw(descr remarks person address role trouble);
+my %Free_Form = map { $_ => 1 } @Free_Form;
+
+sub new {
+    my $proto       = shift;
+    my $class       = ref($proto) || $proto;
+    my $handle      = shift;
+    my $persistance = shift || 0;
+
+    unless ( $handle and ref($handle) ) {
+        $errstr = 'expected handle not found';
+        carp "expecting a handle";
+        return undef;
+    }
+    $errstr = '';
+
+    my $self = bless {
+        _methods => {}
+        ,    # storage for parsed attributes values, lookup by attribute
+        _order   => [],    # order attributes are saved in
+        _content => [],    # untampered text from whois server
+        _debug   => 0,     # off by default
+        _warn    => [],
+        _error   => [],
+    }, $class;
+
+    return $self->parse( $handle, $persistance ) ? $self : undef;
+}
+
+sub parse {
+    my $self        = shift;
+    my $handle      = shift;
+    my $persistance = shift;
+
+    my $found_record = 0;
+    my $precedent_attribute;
+    local $/ = "\n";
+    local $_;
+
+    my $line_cnt = 0;
+    while ( $_ = <$handle> ) {    # walk through the response
+        $line_cnt++;
+        push @{ $self->{_content} }, $_;    # save the entire response
+
+        if ( $self->debug ) {
+            my $received = $_;
+            chomp $received;
+            carp "received ->", $received;
+        }
+
+        /^The object shown below is NOT in the/ and $self->_err($_);
+        /^\%\s+No entries found/ and $self->_err('No entries found');
+        /^\%ERROR:(.*)/ and $self->_err($1), next;
+        /^%/   and next;                     # skip server comments
+        /^\n$/ and $found_record and last;
+        /^\n$/ and $persistance and last;
+        /^\n$/ and next;
+
+        chomp;
+
+        # search for errors, failures and warnings
+        /^(?:New|Delete|Update) FAILED/ and next;    # followed by ERROR
+        /^(?:New|Update|Delete) OK:(.*)/ and $self->_ok($1), next;
+        /^\*ERROR\*:\s+(.*)/ and $self->_err($1), next;
+        /^WARNING:\s+(.*)/   and $self->_wrn($1), next;
+
+        # ok, now try to match attribute value pairs
+        if ( my ($value) = /^(\+\s*.*|\s+.+)$/ and $precedent_attribute ) {
+            $value =~ s/^\+/ /;
+            $self->clean_and_add( $precedent_attribute, $value );
+        }
+        elsif ( my ( $attribute, $v ) = /^([\w\-]+|\*\w\w):\s*(.*)$/ ) {
+            $self->clean_and_add( $attribute, $v );
+            $precedent_attribute = $attribute;
+            $found_record        = 1;
+        }
+        else {
+            $self->_err("unparseable line: '$_'");
+        }
+    }
+
+    if ( $line_cnt == 0 ) {
+        carp "parse: no lines read from handle" if $self->debug;
+        $errstr = "no lines read from handle";
+        return 0;
+    }
+
+    if ( @{ $self->{_content} } == 0 ) {    # this should be caught by $line_cnt
+        carp "parse: no content read from handle" if $self->debug;
+        $errstr = "no content read from handle";
+        return 0;
+    }
+
+    if ( scalar $self->content =~ /^\s*$/ ) {
+        carp "parse: content is all whitespace" if $self->debug;
+        $errstr = "content is all whitespace";
+        return 0;
+    }
+
+    return 1;
+}
+
+sub size {    # will only work in the ascii world
+    my $self = shift;
+    return length scalar $self->content;
+}
+
+sub clean_and_add {
+    my ( $self, $attr, $value ) = @_;
+
+    # strip end of line comments and leading and trailing white space
+    $value =~ s/#.*$// unless exists $Free_Form{$attr};
+    $value =~ s/^\s+//;
+    $value =~ s/\s+$//;
+
+    return $self->add( $attr, $value );
+}
+
+sub add {
+    my ( $self, $attr, $value ) = @_;
+
+    unless ( ref($self) and $attr and defined $value ) {
+        carp "add: expecting an ATTRIBUTE and a VALUE" if $self->debug;
+        return undef;
+    }
+
+    # don't clobber our method names
+    if ( defined $NO_ADD{$attr} ) {
+        carp "attribute [$attr] is a reserved attribute" if $self->debug;
+        return undef;
+    }
+
+    carp "adding attribute [$attr] with value [$value]" if $self->debug;
+
+    # preserve order in which the attributes are registered.
+    # if this ATTRIBUTE has been saved before then do not
+    # place it on the order list again.
+    push @{ $self->{_order} }, $attr
+      unless exists $self->{_methods}->{$attr};
+
+    # save the VALUE on the list for that ATTRIBUTE
+    push @{ $self->{_methods}->{$attr} }, $value;
+}
+
+sub content {
+    my $self = shift;
+    return wantarray
+      ? @{ $self->{_content} }
+      : join( '', @{ $self->{_content} } );
+}
+
+sub methods { return $_[0]->attributes }
+
+sub attributes {
+    my $self = shift;
+    return @{ $self->{_order} };
+}
+
+sub warning {
+    my $self = shift;
+
+    #    local $^W=0;
+    return wantarray ? @{ $self->{_warn} } : join( "\n", @{ $self->{_warn} } );
+}
+
+sub error {
+    my $self = shift;
+
+    #    local $^W=0;
+    return
+      wantarray ? @{ $self->{_error} } : join( "\n", @{ $self->{_error} } );
+}
+
+sub success {
+    my $self = shift;
+    return @{ $self->{_error} } ? 0 : 1;
+}
+
+sub debug {
+    my $self = shift;
+    return @_ ? $self->{_debug} = shift : $self->{_debug};
+}
+
+sub AUTOLOAD {
+    my $self = shift;
+    my $type = ref($self) or croak "$self is not an object";
+
+    my $name = $AUTOLOAD;
+    $name =~ s/^.*://;    # strip fully-qualified portion
+    $name =~ s/_/-/g;     # change _ to - in method name: same as 'add'
+
+    unless ( exists $self->{_methods}->{$name} ) {
+        carp "I don't know about method `$name' in class $type"
+          if $self->debug;
+        return undef;
+    }
+
+    # all the attribute values are stored in arrays
+    return wantarray
+      ? @{ $self->{_methods}->{$name} }
+      : $self->{_methods}->{$name}->[0];
+}
+
+sub DESTROY { }
+
+###############################################################################
+##            P R I V A T E   M E T H O D S
+###############################################################################
+
+sub _err { my $self = shift; (@_) and push @{ $self->{_error} }, shift }
+sub push_warn { shift->_wrn(@_) }
+sub _wrn { my $self = shift; (@_) and push @{ $self->{_warn} }, shift }
+
+sub _ok {
+    my ( $self, $text ) = @_;
+    unless ($text) {
+        carp "_ok: can't find TEXT" if $self->debug;
+        return undef;
+    }
+
+    # New and Update return the nic hdl of the created/updated object
+    # tear out the nic-hdl from the text. example text below.
+    #New OK: [person] KB1-TEST (Kevin Baker)
+    #Update OK: [person] KB1-TEST (Kevin Baker)
+    # I made this a separate routine in case there turn out to be other
+    # cases to match. For instance, a route object.
+    if ( $text =~ /\[person\]\s+([^\s]+)\s+\((.+)\)/ ) {
+        $self->add( 'nic-hdl', $1 );
+        $self->add( 'person',  $2 );
+    }
+}
+
+1;
+__END__
diff --git a/lib/Net/Whois/RIPE/Object.pod b/lib/Net/Whois/RIPE/Object.pod
new file mode 100644
index 00000000..ed77b920
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Object.pod
@@ -0,0 +1,172 @@
+=head1 NAME
+
+Net::Whois::RIPE::Object - RIPE Query Results
+
+=head1 SYNOPSIS
+
+ use Net::Whois::RIPE::Object;
+
+
+ $object = new Net::Whois::RIPE::Object;
+ $object->debug(1);
+
+
+ while ($line = $whois_socket->get()) {
+     ($attribute,$value) = ($line =~ /^(.+?):\s+(.+)$/);
+     next unless $attribute;
+     $object->add($attribute,$value);
+ }
+
+ $object->success || die;
+
+ foreach $attribute ($object->attributes()) {
+     foreach $value ($object->$attribute()) {
+         printf "%s:    %-s\n", $attribute, $value;
+     }
+ }
+
+ print $object->content; # raw content from whois server
+
+ for $error ($object->error) {...}
+ for $warn ($object->warning) {...}
+
+=head1 DESCRIPTION
+
+Encapsulates the results of a whois query. The attribute/value pairs
+of the response may then by accessed using the attribute as a method
+name.
+
+These objects are created by I<Net::Whois::RIPE> to be
+returned as I<query> results.
+
+Short background...a B<whois> server would return the following for a person
+query.
+
+   person:      Paul Gampe
+   address:     Level 1 - 33 Park Road
+   address:     Milton, QLD, 4064
+   country:     AU
+   phone:       +61-7-3367-0490
+   fax-no:      +61-7-3367-0482
+   e-mail:      paulg at apnic.net
+   nic-hdl:     PG6-AP
+   remarks:     APNIC Technical Operations Team
+   mnt-by:      MAINT-AP-APNIC-TECH
+   changed:     paulg at apnic.net 19990909
+   source:      APNIC
+
+I<Net::Whois::RIPE::Object> parses the attribute's and values and B<add>'s
+them to itself. The RIPE object can then be used to access the attribute
+values using the attribute names as methods. A call to B<attributes> returns
+an ordered list of all attributes parsed.
+
+All values are stored as lists since some attributes are multiline
+(e.g. address). If there has been a problem with the query then the B<content>
+method may provide output from the server that can be used to diagnose why.
+
+ $whois = Net::Whois::RIPE->new($host);
+ $query = $whois->query('Paul Gampe');
+
+ unless ($query->success) {
+     print "There's been a problem...server response is...\n";
+     print $query->content;
+     exit
+ }
+
+ print "Paul's nic-hdl is ", $query->nic_hdl, "\n";
+
+Attributes that had a dash '-' are converted to underscore '_' for method names.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item B<new(HANDLE)>
+
+Creates a new RIPE object. Attempts to parse lines from I<HANDLE>. Any
+parsing failure causes the constructor to return undef. Error messages are
+available via B<errstr>. I<HANDLE> may be a file handle or a socket.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item B<content()>
+
+Returns the raw output from the whois server. In a list context it
+returns the lines from whois as a list. In a scalar context it returns
+the entire list in a scalar.
+
+In the case where no ATTRIBUTE's are available via the B<attributes> method,
+then the content may hold information from I<whois> as to why.
+
+=item B<attributes()>
+
+Returns the list of ATTRIBUTE's that were added by B<add>.
+The order of the list is the order the ATTRIBUTE's were added in.
+
+If no ATTRIBUTE's were added then an empty list is returned. Try calling
+B<content> to obtain output from the I<whois> server as to why.
+
+Call I<attributes> to find out if the object was successfully parsed.
+I<success> reports errors from the whois server. It is possible that
+I<success> can report true but the object has no attributes.
+
+=item B<warning()>
+
+In a list context it returns an array of warning lines. In a scalar
+context it returns a \n separated string of warning lines.
+
+These are the warnings from the whois server about the object.
+
+=item B<error()>
+
+In a list context it returns an array of error lines. In a scalar
+context it returns a \n separated string of error lines.
+
+These are the errors from the whois server about the object.
+
+=item B<success>
+
+Returns 1 if no errors defined, 0 otherwise
+
+=item B<debug(LEVEL)>
+
+Sets/gets the debug level.
+
+=back
+
+=head1 CAVEATS
+
+=head1 AUTHOR
+
+ Kevin Baker, <shagol at users.sourceforge.net>
+ Paul Gampe, <pgampe at users.sourceforge.net>
+ Bruce Campbell, <bxc at users.sourceforge.net>
+ Luis Motta Campos, E<lt>lmc at cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+ Net::Whois::RIPE
+
+=head1 COPYRIGHT
+
+ Copyright (C) 1999 Paul Gampe and APNIC Pty. Ltd.
+ Copyright (C) 2000 Kevin Baker and APNIC Pty. Ltd.
+ Copyright (C) 2009 Luis Motta Campos
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
diff --git a/lib/Net/Whois/RIPE/Object/Template.pm b/lib/Net/Whois/RIPE/Object/Template.pm
new file mode 100644
index 00000000..cf55d3ce
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Object/Template.pm
@@ -0,0 +1,83 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
+#                                          <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package Net::Whois::RIPE::Object::Template;
+use strict;
+use Carp;
+
+our $VERSION = '1.30';
+
+our @ISA = qw(Net::Whois::RIPE::Object);
+
+sub parse {
+    my $self   = shift;
+    my $handle = shift;
+
+    local $/ = "\n";    # record separator
+
+    my $not_a_template = 0;
+    while ( $_ = <$handle> ) {    # walk through the response
+        push @{ $self->{_content} }, $_;    # save the entire response
+        next if $not_a_template;
+
+        if (/^% (No (?:verbose )?template available for object .+$)/) {
+            $not_a_template = 1;
+            $self->__error($1);
+            next;
+        }
+
+        chomp;
+        my ( $attr, $value );
+        next unless ( ( $attr, $value ) = /^([\w\-]+|\*\w\w):\s+(.*)$/ );
+        $self->add( $attr, $value ) if $attr;
+    }
+
+    return ( scalar $self->content ) !~ /^\s*$/;
+}
+1;
+__END__
diff --git a/lib/RT/IR.pm b/lib/RT/IR.pm
index 01f813d6..1d4c03f4 100644
--- a/lib/RT/IR.pm
+++ b/lib/RT/IR.pm
@@ -686,10 +686,9 @@ sub WhoisLookup {
             last;
         }
     }
-
-    my $whois = Net::Whois::RIPE->new( hostname => $host, port => $port, recursive => 1 );
+    my $whois = Net::Whois::RIPE->new( $host, Port => $port, Debug => $debug || 0 );
     my $iterator;
-    $iterator = $whois->query( $args{'Query'} )
+    $iterator = $whois->query_iterator( $args{'Query'} )
         if $whois;
     return (undef, $args{'CurrentUser'}->loc("Unable to connect to WHOIS server '[_1]'", $server) )
         unless $iterator;

-----------------------------------------------------------------------


More information about the rt-commit mailing list