Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge remote-tracking branch 'origin/develop' into moritz-dev

Conflicts:
	lib/Net/Whois/Object.pm
	t/105-AsBlock.t
  • Loading branch information...
commit 6ae402752c57d650cbc7bfbddbcd64730ae6bc3c 2 parents 533a357 + 8032bb9
Moritz Lenz authored
View
23 Changes
@@ -1,5 +1,28 @@
Revision history for net-whois-ripe
+2.00019 12 Oct 2012
+ - **** API CHANGES ****
+ Now pass the credentials through option hashref
+ ('password' handled the same way as 'pgpkey')
+ - Add 'align' parameter to the dump() method
+ (code mainly from Moritz Lenz)
+ - Fix dump( {align => xxx }) issue on comments
+ - Tests now handle better network issues
+ - Add query() class method to Net::Whois::Object
+ - Also fix some typos, and perltidy the code
+
+
+
+2.00018 27 Sep 2012
+ Another big contribution from Moritz Lenz :
+ - drop dependency on Iterator::Util
+ - Add abuse_mailbox to Role
+ - Autogenerated accessor
+ - Reduce memory load by storing met information per class
+ - Move calls to attributes out of the constructors
+ - Improve error detection in syncupdates_create
+
+
2.00017 19 Sep 2012
A big thank you to Moritz Lenz from Noris Network AG
for all his patches :
View
358 lib/Net/Whois/Object.pm
@@ -4,16 +4,14 @@ use warnings;
use Carp;
use Net::Whois::RIPE;
-use Data::Dumper;
use IPC::Open2 qw/open2/;
use List::Util qw/max/;
our $LWP;
+
BEGIN {
- $LWP = do {
- eval {
- require LWP::UserAgent;
- };
+ $LWP = do {
+ eval { require LWP::UserAgent; };
($@) ? 0 : 1;
};
}
@@ -27,6 +25,11 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
use Net::Whois::RIPE;
use Net::Whois::Object;
+ my @objects = Net::Whois::Object->query('AS30781');
+
+
+ # Or you can use the previous way
+
my $whois = Net::Whois::RIPE->new( %options );
$iterator = $whois->query('AS30781');
@@ -37,6 +40,7 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
# Type of object is available via class() method
}
+
=head1 USAGE
=head2 Get the data
@@ -47,11 +51,22 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
=head2 Filter the objects
-Currently the only crude way to filter objects is to use the class() method.
+Before you had to filter objects using the class() method.
- # To only get the Person object (and ignore the Information objects)
+ # Then to only get the Person object (and ignore the Information objects)
my ($person) = grep {$_->class() eq 'Person'} Net::Whois::Object->new($iterator);
+But now the query() method allows you to filter more easily
+
+ my ($person) = Net::Whois::Object->query('POLK-RIPE', { type => 'person' });
+
+You can even use the query() filtering capabilities a little further
+
+ my @emails = Net::Whois::Object->query('POLK-RIPE', { type => 'person', attribute => 'e_mail' });
+
+Please note, that as soon as you use the attribute filter, the values returned
+are strings and no more Net::Whois::Objects.
+
=head2 Modify the data
# Add a phone number
@@ -61,12 +76,14 @@ Currently the only crude way to filter objects is to use the class() method.
The dump() method, permit to print the object under the classic
text form, made of 'attribute: value' lines.
-This may seem useless now, but will come handy to make update through
-email.
# Dump the modified data
my $to_be_mailed = $person->dump();
+dump() handle the 'align' parameter passed though a hash ref.
+
+ my $to_be_mailed = $person->dump( { align => 15 });
+
=head2 Update the RIPE database
The RIPE database update is currently under heavy development.
@@ -74,7 +91,7 @@ The RIPE database update is currently under heavy development.
We plan to offer several ways to update the RIPE database
-=head3 Update through the web interface.
+=head3 Update through the web interface
RIPE provides several web interfaces
@@ -89,14 +106,15 @@ B<CAUTION: SyncUpdates features require LWP::UserAgent to be installed.>
Once the object has been modified, locally, you can create it in the database
calling the syncupdates_create() method.
-The only parameter being the associated maintener's authentication
-as a password or pgp key:
+
+The parameters are passed through a hash ref, and can be the maintener
+authentication credentials ('password' or 'pgpkey') and the 'align' parameter
$object->person('John Doe');
...
- my $primary_key = $object->syncupdates_create({ password => $password });
+ my $primary_key = $object->syncupdates_create( { password => $password } );
# or
- my $primary_key = $object->syncupdates_create({ pgpkey => $pgpkey });
+ my $primary_key = $object->syncupdates_create( { pgpkey => $keyID, align => 8 } );
The pgp key must be an eight digit hexadecimal key ID known to the local
C<gpg> executable.
@@ -106,9 +124,6 @@ syncupdates_create, you can also pass in the C<pgpexec> key to chose a program
to execute for signing (C<gpg> by default), and C<pgpopts>, which must be an
array reference of additional options to pass to the signing binary.
-For backwards compatibility, the password can be passed directly without
-using a a hash reference, C<< $object->syncupdates_create($password) >>.
-
The primary key of the object created is returned.
The attribute used as primary key can be obtained through
$object->attribute('primary')
@@ -117,25 +132,28 @@ $object->attribute('primary')
An object existing in the RIPE database, can be retrived, modified locally
and the updated through the syncupdates_update() method.
-The only parameter being the associated maintener's authentication.
+
+The parameters are passed through a hash ref, and can be the maintener
+authentication credentials ('password' or 'pgpkey') and the 'align' parameter
See L</Create> for more information on the authentication methods.
$object->person('John Doe');
...
- $object->syncupdates_update($auth);
+ $object->syncupdates_update( { password => $password } );
=head4 Delete
An object existing in the RIPE database, can be retrived, and deleted in
the databased through the syncupdates_delete() method.
-The only required parameter being the associated maintener's authentication.
+The parameters are passed through a hash ref, and can be the maintener
+authentication credentials ('password' or 'pgpkey') and the 'reason' parameter
See L</Create> for more information on the authentication methods.
- $object->syncupdates_update($auth);
+ $object->syncupdates_update( { pgpkey => $keyID } );
An additional parameter can be used as a reason for the deletion.
- $object->syncupdates_update($auth,'Obsoleted by XXX');
+ $object->syncupdates_update( { pgpkey => $keyID, reason => 'Obsoleted by XXX' } );
If no reason is provided, a default one ('Not needed anymore') is used.
@@ -153,12 +171,11 @@ You can pass an array of lines or an iterator returned by Net::Whois::RIPE
as argument.
The two following ways of using the constructor are possible
-
+
my $whois = Net::Whois::RIPE->new( %options );
$iterator = $whois->query('AS30781');
# Using the iterator way
-
push @objects, Net::Whois::Object->new($iterator);
or
@@ -196,15 +213,13 @@ sub new {
$attribute = 'response';
$value = $1;
- }
- elsif ( $line =~ /^(\S+):\s+(.*)/ ) {
+ } elsif ( $line =~ /^(\S+):\s+(.*)/ ) {
# Attribute line
$attribute = $1;
$value = $2;
- }
- elsif ( $line =~ /^%\s+(.*)/ ) {
+ } elsif ( $line =~ /^%\s+(.*)/ ) {
$block = 'comment' unless $block;
@@ -212,14 +227,12 @@ sub new {
$attribute = "comment";
$value = $1;
- }
- elsif ( $line =~ /^[^%]\s*(.+)/ ) {
+ } elsif ( $line =~ /^[^%]\s*(.+)/ ) {
# Continuation line
$value = $1;
- }
- elsif ( $line =~ /^$/ ) {
+ } elsif ( $line =~ /^$/ ) {
# Blank line
push @results, $object;
@@ -238,14 +251,14 @@ sub new {
if ( !$object ) {
$object = _object_factory( $block, $value ) unless $object;
- }
- elsif ($attribute) {
+ } elsif ($attribute) {
$object->$attribute($value);
}
}
- return @results;
+ # TODO : fix the trailing undef
+ return grep {defined} @results;
}
=head2 B<attributes( [$type [, \@attributes]] )>
@@ -277,18 +290,16 @@ sub attributes {
$self->_TYPE()->{$type}{$a} = 1;
}
}
- if ($type eq 'single' || $type eq 'multiple') {
+ if ( $type eq 'single' || $type eq 'multiple' ) {
my $symbol_table = do {
no strict 'refs';
- \%{$self . '::'};
+ \%{ $self . '::' };
};
for my $a ( @{$ra_attributes} ) {
my $attr_name = $a;
- unless (exists $symbol_table->{$a}) {
- my $accessor = $type eq 'single'
- ? sub { _single_attribute_setget( $_[0], $a, $_[1]) }
- : sub { _multiple_attribute_setget($_[0], $a, $_[1]) };
+ unless ( exists $symbol_table->{$a} ) {
+ my $accessor = $type eq 'single' ? sub { _single_attribute_setget( $_[0], $a, $_[1] ) } : sub { _multiple_attribute_setget( $_[0], $a, $_[1] ) };
no strict 'refs';
*{"${self}::$a"} = $accessor;
}
@@ -319,11 +330,6 @@ sub attribute_is {
my ( $self, $attribute, $type ) = @_;
return defined $self->_TYPE()->{$type}{$attribute} ? 1 : 0;
-
- # for my $att ( $self->attributes( $type )) {
- # if ($att eq $attribute) { return 1; }
- # }
- # return 0 ;
}
=head2 B<hidden_attributes( $attribute )>
@@ -354,18 +360,35 @@ sub displayed_attributes {
return @{ $self->{displayed_attributes} };
}
-=head2 B<dump( )>
+=head2 B<dump( [\%options] )>
Simple naive way to display a text form of the class.
Try to be as close as possible as the submited text.
+Currently the only option available is 'align' which accept a $column number as
+parameter so that all C<< $self->dump >> produces values that are aligned
+vertically on column C<$column>.
+
=cut
sub dump {
- my ($self) = @_;
+ my ( $self, $options ) = @_;
my %current_index;
my $result;
+ my $align_to;
+
+ for my $opt ( keys %$options ) {
+ if ( $opt =~ /^align$/i ) {
+ $align_to = $options->{$opt};
+
+ } else {
+
+ croak "Unknown option $opt for dump()";
+ }
+ }
+
+ $align_to ||= 5 + max map length, $self->attributes('all');
for my $line ( @{ $self->{order} } ) {
my $attribute = $line;
@@ -381,10 +404,11 @@ sub dump {
$val = '' unless $val;
- my $output = "$attribute: $val\n";
+ my $alignment = ' ' x ( $align_to - length($attribute) - 1 );
+ my $output = "$attribute:$alignment$val\n";
# Process the comment
- $output =~ s/comment:\s+/\% /;
+ $output =~ s/comment:\s*/\% /;
$result .= $output;
}
@@ -392,68 +416,37 @@ sub dump {
return $result;
}
-=head2 B<align( $column )>
-
-Changes the object by adding or removing leading whitespace,
-so that all C<< $self->dump >> produces values that are aligned
-vertically on column C<$column>.
+=head2 B<syncupdates_update( $password, [\%options] )>
-If C<$column> is omitted, it is chosen large enough to make vertical
-alignment possible for all values.
+Update the RIPE database through the web syncupdates interface.
+Use the password passed as parameter to authenticate.
=cut
-sub align {
- my $self = shift;
- my $align_to = shift;
-
- # $self->dump adds one colon and five spaces,
- # so there's a padding of 5
- my $padding = 5;
- $align_to ||= $padding + max map length, $self->attributes('all');
+sub syncupdates_update {
+ my ( $self, $options ) = @_;
- for ($self->attributes('single')) {
- my $alignment = ' ' x ($align_to - $padding - length);
- if (exists $self->{$_}) {
- $self->{$_} =~ s/^\s*/$alignment/;
- }
- }
+ my $dump_options;
- for ($self->attributes('multiple')) {
- my $alignment = ' ' x ($align_to - $padding - length);
- if (exists $self->{$_}) {
- s/^\s*/$alignment/ for @{ $self->{$_} };
+ for my $opt ( keys %$options ) {
+ if ( $opt =~ /^align$/i ) {
+ $dump_options = { align => $options->{$opt} };
}
}
- return $self;
-}
-
-
-=head2 B<syncupdates_update( $password )>
-
-Update the RIPE database through the web syncupdates interface.
-Use the password passed as parameter to authenticate.
-
-=cut
-
-sub syncupdates_update {
- my ( $self, $auth ) = @_;
-
- my ($key) = $self->attributes('primary');
+ my ($key) = $self->attributes('primary');
my $value = $self->_single_attribute_setget($key);
- my $html = $self->_syncupdates_submit( $self->dump(), $auth );
-
+ my $html = $self->_syncupdates_submit( $self->dump($dump_options), $options );
+
if ( $html =~ /Modify SUCCEEDED:.*$value/m ) {
return $value;
- }
- else {
+ } else {
croak "Update not confirmed ($html)";
}
}
-=head2 B<syncupdates_delete( $password, [$reason] )>
+=head2 B<syncupdates_delete( \%options )>
Delete the object in the RIPE database through the web syncupdates interface.
Use the password passed as parameter to authenticate.
@@ -462,55 +455,118 @@ The optional parmeter reason is used to explain why the object is deleted.
=cut
sub syncupdates_delete {
- my ( $self, $auth, $reason) = @_;
+ my ( $self, $options ) = @_;
- my ($key) = $self->attributes('primary');
+ my ($key) = $self->attributes('primary');
my $value = $self->_single_attribute_setget($key);
my $text = $self->dump();
- $reason = 'Not needed anymore' unless $reason;
- $text .= "delete: $reason\n";
+ $options->{reason} = 'Not needed anymore' unless $options->{reason};
+ $text .= "delete: " . $options->{reason} . "\n";
- my $html = $self->_syncupdates_submit( $text, $auth );
+ my $html = $self->_syncupdates_submit( $text, $options );
- if ( $html =~ /Delete SUCCEEDED:.*\Q$value\E/m ) {
+ if ( $html =~ /Delete SUCCEEDED:.*$value/m ) {
return $value;
- }
- else {
+ } else {
croak "Deletion not confirmed ($html)";
}
}
-=head2 B<syncupdates_create( $auth )>
+=head2 B<syncupdates_create( \%options )>
Create an object in the the RIPE database through the web syncupdates interface.
-See L</Create> for possible values of C<$auth>.
+See L</Create> for more information on the authentication methods.
+
+The available options are 'pgpkey', 'password' and 'align'
Return the primary key of the object created.
=cut
sub syncupdates_create {
- my ( $self, $auth ) = @_;
+ my ( $self, $options ) = @_;
+
+ my $dump_options;
+
+ for my $opt ( keys %$options ) {
+ if ( $opt =~ /^align$/i ) {
+ $dump_options = { align => $options->{$opt} };
+ }
+ }
- my ($key) = $self->attributes('primary');
+ my ($key) = $self->attributes('primary');
- my $res = $self->_syncupdates_submit( $self->dump(), $auth );
+ my $res = $self->_syncupdates_submit( $self->dump($dump_options), $options );
- if (
- $res =~ /^Number of objects processed with errors:\s+(\d+)/m
- && $1 == 0
- && $res =~ /\*\*\*Info:\s+Authorisation for\s+\[[^\]]+]\s+(.+)\s*$/m
- ) {
+ if ( $res =~ /^Number of objects processed with errors:\s+(\d+)/m
+ && $1 == 0
+ && $res =~ /\*\*\*Info:\s+Authorisation for\s+\[[^\]]+]\s+(.+)\s*$/m )
+ {
my $value = $1;
$self->_single_attribute_setget( $key, $value );
return $value;
- }
- else {
+ } else {
croak "Error while creating object through syncupdates API: $res";
}
}
+=head2 B<query( $query, [\%options] )>
+
+ ******************************** EXPERIMENTAL ************************************
+ This method is a work in progress, the API and behaviour are subject to change
+ **********************************************************************************
+
+Query the RIPE database and return Net::Whois::Objects
+
+This method accepts 2 optional parameters
+
+'type' which is a regex used to filter the query result :
+Only the object whose type matches the 'type' parameter are returned
+
+'attribute' which is a regex used to filter the query result :
+Only the value of the attributes matching the 'attribute' parameter are
+returned
+
+Note that if 'attribute' is specified strings are returned, instead of
+Net::Whois::Objects
+
+=cut
+
+sub query {
+ my ( $class, $query, $options ) = @_;
+
+ my $attribute;
+ my $type;
+
+ for my $opt ( keys %$options ) {
+ if ( $opt =~ /^attribute$/i ) {
+ $attribute = $options->{$opt};
+ } elsif ( $opt =~ /^type$/i ) {
+ $type = $options->{$opt};
+ }
+ }
+
+ my $whois = Net::Whois::RIPE->new(%$options);
+ my $iterator = $whois->query($query);
+
+ my @objects = Net::Whois::Object->new($iterator);
+
+ if ($type) {
+ @objects = grep { ref($_) =~ /$type/i } @objects;
+ }
+
+ if ($attribute) {
+ return grep {defined} map {
+ my $r;
+ eval { $r = $_->$attribute };
+ $@ ? undef : ref($r) eq 'ARRAY' ? @$r : $r
+ } @objects;
+ } else {
+ return grep {defined} @objects;
+ }
+}
+
=begin UNDOCUMENTED
=head2 B<_object_factory( $type => $value )>
@@ -520,7 +576,6 @@ Private method. Shouldn't be used from other modules.
Simple factory, creating Net::Whois::Objet::XXXX from
the type passed as parameter.
-
=cut
sub _object_factory {
@@ -566,8 +621,7 @@ sub _object_factory {
# First attribute is always single valued, except for comments
if ( $type eq 'comment' ) {
$object->_multiple_attribute_setget( $type => $value );
- }
- else {
+ } else {
$object->_single_attribute_setget( $type => $value );
}
@@ -588,8 +642,7 @@ sub _single_attribute_setget {
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';
+ push @{ $self->{order} }, $attribute unless $self->{$attribute} or $attribute eq 'class';
$self->{$attribute} = $value;
}
@@ -608,7 +661,7 @@ sub _multiple_attribute_setget {
if ( defined $value ) {
# Store attribute order for dump
- push @{ $self->{order} }, $attribute;
+ push @{ $self->{order} }, $attribute;
push @{ $self->{$attribute} }, $value;
}
@@ -624,15 +677,14 @@ Initialize self with C<@options>
=cut
sub _init {
- my ($self, @options) = @_;
+ my ( $self, @options ) = @_;
- while (my ($key, $val ) = splice(@options, 0, 2)) {
- $self->$key( $val );
+ while ( my ( $key, $val ) = splice( @options, 0, 2 ) ) {
+ $self->$key($val);
}
}
-
-=head2 B<_syncupdates_submit( $text, $password )>
+=head2 B<_syncupdates_submit( $text, \%options )>
Interact with the RIPE database through the web syncupdates interface.
Submit the text passed as parameter.
@@ -645,39 +697,29 @@ Return the HTML code of the returned page.
=cut
sub _syncupdates_submit {
- my ( $self, $text, $auth ) = @_;
-
- if ( $auth && !ref $auth) {
- # preserve backwards compatiblity
- $auth = { password => $auth };
- }
- $auth ||= {};
+ my ( $self, $text, $options ) = @_;
- if ( exists $auth->{pgpkey} ) {
- $text = $self->_pgp_sign($text, $auth);
- }
- elsif ( exists $auth->{password} ) {
- my $password = $auth->{password};
+ if ( exists $options->{pgpkey} ) {
+ $text = $self->_pgp_sign( $text, { pgpkey => $options->{pgpkey} } );
+ } elsif ( exists $options->{password} ) {
+ my $password = $options->{password};
chomp $password;
- croak( "Passwords containing newlines are not supported" )
+ croak("Passwords containing newlines are not supported")
if $password =~ /\n/;
- $text .= "password: $password\n"
+ $text .= "password: $password\n";
}
- croak "LWP::UserAgent required for updates" unless $LWP;
-
- my $url = ($self->source || 'TEST') eq 'RIPE'
- ? 'http://syncupdates.db.ripe.net/'
- : 'http://syncupdates-test.db.ripe.net';
+ croak "LWP::UserAgent required for updates" unless $LWP;
+ my $url = $self->source eq 'RIPE' ? 'http://syncupdates.db.ripe.net/' : 'http://syncupdates-test.db.ripe.net';
my $ua = LWP::UserAgent->new;
- my $response = $ua->post($url, { DATA => $text });
+ my $response = $ua->post( $url, { DATA => $text } );
my $response_text = $response->decoded_content;
- unless ($response->is_success) {
- croak "Can't sync object with RIPE database: $response_text"
+ unless ( $response->is_success ) {
+ croak "Can't sync object with RIPE database: $response_text";
}
return $response_text;
@@ -692,13 +734,14 @@ Returns the signed text.
sub _pgp_sign {
my ( $self, $text, $auth ) = @_;
+
my $binary = $auth->{pgpexec} || 'gpg';
my $key_id = $auth->{pgpkey};
my @opts = @{ $auth->{pgpopts} || [] };
+
$key_id =~ s/^0x//;
- my $pid = open2(my $child_out, my $child_in,
- $binary, "--local-user=$key_id", '--clearsign', @opts);
- print { $child_in } $text;
+ my $pid = open2( my $child_out, my $child_in, $binary, "--local-user=$key_id", '--clearsign', @opts );
+ print {$child_in} $text;
close $child_in;
$text = do { local $/; <$child_out> };
@@ -706,9 +749,8 @@ sub _pgp_sign {
waitpid( $pid, 0 );
my $child_exit_status = $? >> 8;
- if ($child_exit_status != 0) {
- croak "Error while launching $binary for signing the message: "
- . "child prcoess exited with status $child_exit_status";
+ if ( $child_exit_status != 0 ) {
+ croak "Error while launching $binary for signing the message: child process exited with status $child_exit_status";
}
return $text;
@@ -724,15 +766,19 @@ of the object that the method was called on.
=cut
my %TYPES;
+
sub _TYPE {
- $TYPES{ref $_[0] || $_[0] } ||= {}
+ $TYPES{ ref $_[0] || $_[0] } ||= {};
}
-
=head1 TODO
The update part (in RIPE database) still needs a lot of work.
+Enhance testing without network
+
+Enhance test coverage
+
=head1 AUTHOR
Arnaud "Arhuman" Assad, C<< <arhuman at gmail.com> >>
View
18 lib/Net/Whois/RIPE.pm
@@ -28,11 +28,11 @@ Net::Whois::RIPE - a pure-Perl implementation of the RIPE Database client.
=head1 VERSION
-Version 2.00_017 - BETA
+Version 2.00_019 - BETA
=cut
-our $VERSION = 2.00_017;
+our $VERSION = 2.00_019;
=head1 SYNOPSIS
@@ -50,6 +50,12 @@ The usage should remain mostly the same:
my $whois = Net::Whois::RIPE->new( %options );
$iterator = $whois->query( 'AS333' );
+If you prefer to manipulate full-fledged objects you can now use
+
+ use Net::Whois::Object;
+
+ my @objects = Net::Whois::Object->query( 'AS333' );
+
Of course, comments are more than welcome. If you believe you can help, please
do not hesitate in contacting me.
@@ -91,6 +97,14 @@ believe).
Net::Whois::Object (from release 2.00_010) is the first attempt toward this
goal.
+ # You can now do
+ my @objects = Net::Whois::Object->query( 'AS333' );
+
+ # And manipulate the object the OO ways
+ for my $object (@objects) {
+ print $object->remarks();
+ }
+
=head1 METHODS
=head2 B<new( %options )>
View
8 t/02-methods.t
@@ -82,12 +82,16 @@ can_ok $class,
ok $c->unfiltered, '->new can set the unfiltered flag';
}
-{
my $c = $class->new( disconnected => 1 );
# connect()
# TODO: implement a test that doesn't requires internet connection
- lives_ok { $c->connect } 'The client connected without dying.';
+ eval { $c->connect };
+
+SKIP: {
+ skip "Network issue",14 if ( $@ =~ /IO::Socket::INET/ );
+
+ ok (!$@, "The client connected without dying. $@");
# is_connected()
ok $c->is_connected, 'The client is connected.';
View
22 t/03-objects.t
@@ -40,6 +40,28 @@ is_deeply( [ $o[0]->attributes('all') ], [ 'comment', 'opt1', 'opt2', 'opt3' ] )
is_deeply( [ $o[0]->attributes() ], [ 'comment', 'opt1', 'opt2', 'opt3' ] );
is( $o[2]->dump, "% Information related to 'AS30720 - AS30895'\n" );
+is( $o[2]->dump( { align => 8 } ), "% Information related to 'AS30720 - AS30895'\n" );
+
+my @objects;
+eval { @objects = Net::Whois::Object->query('AS30781', {attribute => 'remarks'}) };
+
+SKIP: {
+ skip "Network issue",14 if ( $@ =~ /IO::Socket::INET/ );
+
+ for my $object (@objects) {
+ ok(!ref($object), "query() : String returned for 'remarks' attribute filter")
+ }
+
+ @objects = Net::Whois::Object->query('AS30781');
+ for my $object (@objects) {
+ ok(ref($object) =~ /Net::Whois::Object/ , "query() : Object returned for 'remarks' attribute filter")
+ }
+
+ @objects = Net::Whois::Object->query('AS30781', {type => 'asblock', attribute => 'admin_c'});
+ for my $object (@objects) {
+ ok($object eq 'CREW-RIPE' , "query() : 'CREW-RIPE' returned for AsBlock and admin-c filter")
+ }
+}
__DATA__
% This is the RIPE Database query service.
View
6 t/105-AsBlock.t
@@ -112,12 +112,14 @@ my $align = Net::Whois::Object::AsBlock->new(
changed => 'arhuman@gmail.com 20120701',
source => 'RIPE # Filtered',
);
-$align->align(30);
-for (split /\n/, $align->dump) {
+for (split /\n/, $align->dump({align => 30})) {
ok $_ =~ /^.{29}\s\S/, "Line '$_' is aligned to column 30";
}
+# Test 'as_block' on aligned data
+is( $align->as_block(), 'AS30720 - AS30895', 'aligned as-block properly parsed' );
+
# Common tests
do 't/common.pl';
ok( $tested{common_loaded}, "t/common.pl properly loaded" );
View
12 t/215-SyncUpdates.t
@@ -4,14 +4,12 @@ use Test::More;
use Test::Exception;
use Net::Whois::RIPE;
use Net::Whois::Object;
-use Data::Dumper;
our $LWP;
+
BEGIN {
$LWP = do {
- eval {
- require LWP::UserAgent;
- };
+ eval { require LWP::UserAgent; };
($@) ? 0 : 1;
};
}
@@ -39,7 +37,7 @@ my $mntner = shift @o;
my $email_before = $person->e_mail()->[0];
-my $person_id = $person->syncupdates_create($PASSWD);
+my $person_id = $person->syncupdates_create( { password => $PASSWD, align => 8 } );
ok($person_id);
my $whois = Net::Whois::RIPE->new( hostname => 'whois-test.ripe.net' );
@@ -50,7 +48,7 @@ my $iterator = $whois->query($person_id);
is_deeply( $person->e_mail(), [$email_before], "Same name from previous" );
my $email_after = $person->e_mail('arhuman2@gmail.com');
-$person->syncupdates_update($PASSWD);
+$person->syncupdates_update( { password => $PASSWD, align => 10 } );
$iterator = $whois->query($person_id);
($person) = grep { ( $_->class() eq 'Person' ) and ( $_->nic_hdl eq $person_id ) } Net::Whois::Object->new($iterator);
@@ -59,7 +57,7 @@ is_deeply( $person->e_mail(), $email_after, "Same as set name" );
isa_ok( $person, 'Net::Whois::Object::Person', 'Found a Person' );
-$person->syncupdates_delete($PASSWD);
+$person->syncupdates_delete( { password => $PASSWD } );
$whois = Net::Whois::RIPE->new( hostname => 'whois-test.ripe.net' );
$iterator = $whois->query($person_id);
View
1  t/216-SyncUpdates-Signed.t
@@ -4,7 +4,6 @@ use Test::More;
use Test::Exception;
use Net::Whois::RIPE;
use Net::Whois::Object;
-use Data::Dumper;
our $LWP;
BEGIN {

0 comments on commit 6ae4027

Please sign in to comment.
Something went wrong with that request. Please try again.