Permalink
Browse files

Merge branch 'release/Net-Whois-RIPE-2.004' into develop

  • Loading branch information...
2 parents dd5cac3 + e486328 commit c10abf01c4fc52323c2d28e3094f6ab01aa6b96d @arhuman committed May 30, 2013
Showing with 248 additions and 28 deletions.
  1. +4 −0 Changes
  2. +150 −0 bin/awhois.pl
  3. +81 −22 lib/Net/Whois/Object.pm
  4. +2 −2 lib/Net/Whois/RIPE.pm
  5. +11 −4 t/03-objects.t
View
@@ -1,5 +1,9 @@
Revision history for net-whois-ripe
+2.004000 2013-05-29
+ - Fix 'delete' mode on accessor
+ - Add awhois.pl skeleton script
+
2.003000 2013-04-17
Another contribution from Moritz Lenz :
- Add abuse_c field to Organisation
View
@@ -0,0 +1,150 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Net::Whois::Object;
+use Data::Dumper;
+
+####################################################################################
+#
+# Global variables
+
+my $DEBUG;
+my @EXCLUDES;
+my $HELP;
+my $KEY;
+my $ONLY;
+my $QUERY;
+my %QUERY_OPTIONS;
+my @TYPES;
+my $VERSION;
+
+####################################################################################
+#
+# Processing
+
+# Get options value from command line
+GetOptions( 'debug' => \$DEBUG,
+ 'excludes=s' => \@EXCLUDES,
+ 'help' => \$HELP,
+ 'key=s' => \$KEY,
+ 'only=s' => \$ONLY,
+ 'query=s' => \$QUERY,
+ 'type=s' => \@TYPES,
+ 'version' => \$VERSION,
+) or die usage();
+
+if ($HELP) {
+ print usage();
+ exit 0;
+}
+
+if ($VERSION) {
+ print "$0 - using Net::Whois::RIPE $Net::Whois::RIPE::VERSION\n";
+ exit 0;
+}
+
+# Query can be implicit or explicit
+$QUERY = $ARGV[0] unless $QUERY;
+
+# You can now do
+if (@TYPES) {
+ my $query_types = lc join '|', @TYPES;
+ $query_types =~ s/-//g;
+ $QUERY_OPTIONS{type} = $query_types;
+}
+
+if ($KEY) {
+ $QUERY = "-i $KEY " . $ARGV[0] unless $QUERY =~ /-i/;
+}
+
+if ($DEBUG) {
+ print "QUERY=($QUERY)";
+ print "OTIONS=", Dumper \%QUERY_OPTIONS;
+}
+
+my @objects = Net::Whois::Object->query( $QUERY, \%QUERY_OPTIONS );
+
+# And manipulate the object the OO ways
+for my $object (@objects) {
+ print $object->dump;
+ print $/;
+}
+
+exit 0;
+
+sub excluded {
+ my $tested = shift;
+
+ return 0 unless @EXCLUDES;
+
+ if ($ONLY) {
+ return 1 unless $tested =~ /$ONLY/msi;
+ }
+
+ for my $ex_pattern (@EXCLUDES) {
+ return 1 if $tested =~ /$ex_pattern/msi;
+ }
+
+ return 0;
+}
+
+sub usage {
+
+ return <<EOT;
+
+NAME
+
+ $0 - WHOIS client for RIPE database
+
+SYNOPSIS
+
+ $0 [options] [query ...]
+
+ # Get objects whose maintener is MNT-JAGN
+ $0 --key mnt-by MNT-JAGN
+
+ # Get objects about ASN 30781
+ $0 AS30781
+
+
+OPTIONS
+
+
+--help
+
+ Print a brief help message and exits.
+
+--debug
+
+ Display debugging information
+
+--exclude
+
+ Not yet implemented
+
+--key
+
+ The attribute to be used as the key for the search
+
+--only
+
+ Not yet implemented
+
+--type
+
+ The type of record to be returned (example: person, role, inetnum, route...)
+
+--version
+
+ Display version information
+
+
+DESCRIPTION
+
+This program is a WHOIS client requesting the RIPE database
+
+EOT
+}
+
@@ -279,11 +279,10 @@ sub new {
if ( !$object ) {
$object = _object_factory( $block, $value ) unless $object;
- } elsif ($object->can($attribute)) {
+ } elsif ( $object->can($attribute) ) {
$object->$attribute($value);
} else {
- warn "Objects of type " . ref($object)
- . " do not support attribute '$attribute', but it was supplied with value '$value'\n";
+ warn "Objects of type " . ref($object) . " do not support attribute '$attribute', but it was supplied with value '$value'\n";
}
}
@@ -571,31 +570,28 @@ sub syncupdates_create {
if ( $res =~ /^Number of objects processed with errors:\s+(\d+)/m
&& $1 == 0
- && (
- $res =~ /\*\*\*Info:\s+Authorisation for\s+\[[^\]]+]\s+(.+)\s*$/m
- || $res =~ /(?:Create SUCCEEDED|No operation): \[[^\]]+\]\s+(\S+)/m
- )
- )
+ && ( $res =~ /\*\*\*Info:\s+Authorisation for\s+\[[^\]]+]\s+(.+)\s*$/m
+ || $res =~ /(?:Create SUCCEEDED|No operation): \[[^\]]+\]\s+(\S+)/m )
+ )
{
my $value = $1;
- my ( $key ) = $self->attributes( 'primary' );
+ my ($key) = $self->attributes('primary');
+
# some primary keys can contain spaces, in which case $value
# is not correct. So only use it for objects where the primary
# key can be generated by the RIPE DB, and where it never contains
# spaces. According to
# http://www.ripe.net/ripe/mail/archives/db-help/2013-January/000411.html
# this is the case for person, organization, role and key-cert
- my %obj_types_with_autogen_key = (
- KeyCert => 1,
- Organisation => 1,
- Person => 1,
- Role => 1,
+ my %obj_types_with_autogen_key = ( KeyCert => 1,
+ Organisation => 1,
+ Person => 1,
+ Role => 1,
);
- if ($self->class && $obj_types_with_autogen_key{$self->class}) {
+ if ( $self->class && $obj_types_with_autogen_key{ $self->class } ) {
$self->_single_attribute_setget( $key, $value );
return $value;
- }
- else {
+ } else {
return $self->$key();
}
} else {
@@ -730,13 +726,37 @@ Generic setter/getter for singlevalue attribute.
sub _single_attribute_setget {
my ( $self, $attribute, $value ) = @_;
+ my $mode = 'replace';
+
+ if ( ref $value eq 'HASH' ) {
+ my %options = %$value;
+
+ if ( $options{mode} ) {
+ $mode = $options{mode};
+ }
+
+ if ( $options{value} ) {
+ $value = $options{value};
+ } else {
+ croak "Unable to determine attribute $attribute value";
+ }
+
+ }
if ( defined $value ) {
- # Store attribute order for dump, unless this attribute as already been set
- push @{ $self->{order} }, $attribute unless $self->{$attribute} or $attribute eq 'class';
+ if ( $mode eq 'replace' ) {
+ # Store attribute order for dump, unless this attribute as already been set
+ push @{ $self->{order} }, $attribute unless $self->{$attribute} or $attribute eq 'class';
- $self->{$attribute} = $value;
+ $self->{$attribute} = $value;
+ } elsif ( $mode eq 'delete' ) {
+ if ( ref $value ne 'HASH' or !$value->{old} ) {
+ croak " {old=>...} expected as value for $attribute update in delete mode";
+ } else {
+ $self->_delete_attribute($attribute,$value->{old});
+ }
+ }
}
return $self->{$attribute};
}
@@ -791,8 +811,8 @@ sub _multiple_attribute_setget {
if ( ref $value ne 'HASH' or !$value->{old} ) {
croak " {old=>...} expected as value for $attribute update in delete mode";
} else {
- my $old = $value->{old};
- $self->{$attribute} = [grep {!/$old/} @{$self->{$attribute}}];
+ # $self->{$attribute} = [grep {!/$old/} @{$self->{$attribute}}];
+ $self->_delete_attribute($attribute,$value->{old});
}
} else {
croak "Unknown mode $mode for attribute $attribute";
@@ -803,6 +823,45 @@ sub _multiple_attribute_setget {
return $self->{$attribute};
}
+=head2 B<_delete_attribute( $attribute, $pattern )>
+
+Delete an attribute if its value match the pattern value
+
+=cut
+
+sub _delete_attribute {
+ my ( $self, $attribute, $pattern ) = @_;
+
+ my @lines;
+
+ for my $a ( @{ $self->{order} } ) {
+ my $val = ref $self->{$a} ? shift @{ $self->{$a} } : $self->{$a};
+ push @lines, [ $a, $val ];
+ }
+
+ @lines = grep {$attribute ne $_->[0] or $_->[1] !~ /$pattern/} @lines;
+ delete $self->{$attribute} if $self->attribute_is($attribute, 'single') and $self->{$attribute} =~ /$pattern/;
+
+ $self->{order} = [];
+ for my $l (@lines) {
+ $self->{ $l->[0] } = [] if ref( $self->{ $l->[0] } ) ;
+ }
+
+ for my $i ( 0 .. $#lines ) {
+ push @{ $self->{order} }, $lines[$i]->[0];
+ if ( $self->attribute_is( $lines[$i]->[0], 'multiple' ) ) {
+ push @{ $self->{ $lines[$i]->[0] } }, $lines[$i]->[1];
+ } else {
+ $self->{ $lines[$i]->[0] } = $lines[$i]->[1];
+
+ }
+
+ }
+
+}
+
+
+
=head2 B<_init( @options )>
Initialize self with C<@options>
@@ -28,11 +28,11 @@ Net::Whois::RIPE - a pure-Perl implementation of the RIPE Database client.
=head1 VERSION
-Version 2.003000
+Version 2.004000
=cut
-our $VERSION = 2.003000;
+our $VERSION = 2.004000;
=head1 SYNOPSIS
View
@@ -51,10 +51,10 @@ is( $o[2]->dump( { align => 8 } ), "% Information related to 'AS30720 - AS30895'
#
# 'clone' method
#
-my $clone = $o[3]->clone;
-isa_ok($clone, ref $o[3], "Clone object has the same type of source");
-is_deeply($clone, $o[3], "Clone object deeply similar to source");
-$clone = $o[3]->clone({remove => ['source','remarks','org', 'admin-c', 'tech-c', 'mnt-by','mnt-lower']});
+my $full_clone = $o[3]->clone;
+isa_ok($full_clone, ref $o[3], "Clone object has the same type of source");
+is_deeply($full_clone, $o[3], "Clone object deeply similar to source");
+my $clone = $o[3]->clone({remove => ['source','remarks','org', 'admin-c', 'tech-c', 'mnt-by','mnt-lower']});
is_deeply($clone, { class => 'AsBlock', order => ['as_block', 'descr'], as_block => 'AS30720 - AS30895', descr => ['RIPE NCC ASN block'] }, "Clone object similar with removed attribute");
#
@@ -86,6 +86,13 @@ eval { $clone->mnt_by({mode => 'delete', value => { new => 'MNT3-ADD'}}); };
like($@ ,qr/old.*delete mode/, "old=>... expected in delete mode");
$clone->mnt_by({mode => 'delete', value => { old => '.'}});
is_deeply($clone->mnt_by,[],'Array properly emptyed through delete wildcard');
+like($clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\n/,"Dump of deleted attributes ok");
+my $delete_clone = $full_clone->clone({remove=>['remarks']});
+like($full_clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\nremarks:\s+These AS Numbers are further assigned to network\nremarks:\s+operators in the RIPE NCC service region. AS\nremarks:\s+assignment policy is documented in:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asn-assignment.html>\nremarks:\s+RIPE NCC members can request AS Numbers using the\nremarks:\s+form available in the LIR Portal or at:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asnrequestform.html>\norg:\s+ORG-NCC1-RIPE\nadmin-c:\s+CREW-RIPE\ntech-c:\s+RD132-RIPE\nmnt-by:\s+RIPE-DBM-MNT\nmnt-lower:\s+RIPE-NCC-HM-MNT\nsource:\s+RIPE # Filtered\n/,"org full clone stil ok");
+$full_clone->mnt_lower({mode=>'delete', value => {old => 'RIPE-NCC-HM-MNT'}});
+like($full_clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\nremarks:\s+These AS Numbers are further assigned to network\nremarks:\s+operators in the RIPE NCC service region. AS\nremarks:\s+assignment policy is documented in:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asn-assignment.html>\nremarks:\s+RIPE NCC members can request AS Numbers using the\nremarks:\s+form available in the LIR Portal or at:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asnrequestform.html>\norg:\s+ORG-NCC1-RIPE\nadmin-c:\s+CREW-RIPE\ntech-c:\s+RD132-RIPE\nmnt-by:\s+RIPE-DBM-MNT\nsource:\s+RIPE # Filtered\n$/,"non last attribute deletion ok");
+$full_clone->source({mode=>'delete', value => {old => 'RIPE'}});
+like($full_clone->dump,qr/as-block:\s+AS30720 - AS30895\ndescr:\s+RIPE NCC ASN block\nremarks:\s+These AS Numbers are further assigned to network\nremarks:\s+operators in the RIPE NCC service region. AS\nremarks:\s+assignment policy is documented in:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asn-assignment.html>\nremarks:\s+RIPE NCC members can request AS Numbers using the\nremarks:\s+form available in the LIR Portal or at:\nremarks:\s+<http:\/\/www.ripe.net\/ripe\/docs\/asnrequestform.html>\norg:\s+ORG-NCC1-RIPE\nadmin-c:\s+CREW-RIPE\ntech-c:\s+RD132-RIPE\nmnt-by:\s+RIPE-DBM-MNT\n$/,"last attribute deletion ok");
my @objects;
eval { @objects = Net::Whois::Object->query('AS30781', {attribute => 'remarks'}) };

0 comments on commit c10abf0

Please sign in to comment.