Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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
23 Changes
... ... @@ -1,5 +1,28 @@
1 1 Revision history for net-whois-ripe
2 2
  3 +2.00019 12 Oct 2012
  4 + - **** API CHANGES ****
  5 + Now pass the credentials through option hashref
  6 + ('password' handled the same way as 'pgpkey')
  7 + - Add 'align' parameter to the dump() method
  8 + (code mainly from Moritz Lenz)
  9 + - Fix dump( {align => xxx }) issue on comments
  10 + - Tests now handle better network issues
  11 + - Add query() class method to Net::Whois::Object
  12 + - Also fix some typos, and perltidy the code
  13 +
  14 +
  15 +
  16 +2.00018 27 Sep 2012
  17 + Another big contribution from Moritz Lenz :
  18 + - drop dependency on Iterator::Util
  19 + - Add abuse_mailbox to Role
  20 + - Autogenerated accessor
  21 + - Reduce memory load by storing met information per class
  22 + - Move calls to attributes out of the constructors
  23 + - Improve error detection in syncupdates_create
  24 +
  25 +
3 26 2.00017 19 Sep 2012
4 27 A big thank you to Moritz Lenz from Noris Network AG
5 28 for all his patches :
358 lib/Net/Whois/Object.pm
@@ -4,16 +4,14 @@ use warnings;
4 4
5 5 use Carp;
6 6 use Net::Whois::RIPE;
7   -use Data::Dumper;
8 7 use IPC::Open2 qw/open2/;
9 8 use List::Util qw/max/;
10 9
11 10 our $LWP;
  11 +
12 12 BEGIN {
13   - $LWP = do {
14   - eval {
15   - require LWP::UserAgent;
16   - };
  13 + $LWP = do {
  14 + eval { require LWP::UserAgent; };
17 15 ($@) ? 0 : 1;
18 16 };
19 17 }
@@ -27,6 +25,11 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
27 25 use Net::Whois::RIPE;
28 26 use Net::Whois::Object;
29 27
  28 + my @objects = Net::Whois::Object->query('AS30781');
  29 +
  30 +
  31 + # Or you can use the previous way
  32 +
30 33 my $whois = Net::Whois::RIPE->new( %options );
31 34 $iterator = $whois->query('AS30781');
32 35
@@ -37,6 +40,7 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
37 40 # Type of object is available via class() method
38 41 }
39 42
  43 +
40 44 =head1 USAGE
41 45
42 46 =head2 Get the data
@@ -47,11 +51,22 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
47 51
48 52 =head2 Filter the objects
49 53
50   -Currently the only crude way to filter objects is to use the class() method.
  54 +Before you had to filter objects using the class() method.
51 55
52   - # To only get the Person object (and ignore the Information objects)
  56 + # Then to only get the Person object (and ignore the Information objects)
53 57 my ($person) = grep {$_->class() eq 'Person'} Net::Whois::Object->new($iterator);
54 58
  59 +But now the query() method allows you to filter more easily
  60 +
  61 + my ($person) = Net::Whois::Object->query('POLK-RIPE', { type => 'person' });
  62 +
  63 +You can even use the query() filtering capabilities a little further
  64 +
  65 + my @emails = Net::Whois::Object->query('POLK-RIPE', { type => 'person', attribute => 'e_mail' });
  66 +
  67 +Please note, that as soon as you use the attribute filter, the values returned
  68 +are strings and no more Net::Whois::Objects.
  69 +
55 70 =head2 Modify the data
56 71
57 72 # Add a phone number
@@ -61,12 +76,14 @@ Currently the only crude way to filter objects is to use the class() method.
61 76
62 77 The dump() method, permit to print the object under the classic
63 78 text form, made of 'attribute: value' lines.
64   -This may seem useless now, but will come handy to make update through
65   -email.
66 79
67 80 # Dump the modified data
68 81 my $to_be_mailed = $person->dump();
69 82
  83 +dump() handle the 'align' parameter passed though a hash ref.
  84 +
  85 + my $to_be_mailed = $person->dump( { align => 15 });
  86 +
70 87 =head2 Update the RIPE database
71 88
72 89 The RIPE database update is currently under heavy development.
@@ -74,7 +91,7 @@ The RIPE database update is currently under heavy development.
74 91
75 92 We plan to offer several ways to update the RIPE database
76 93
77   -=head3 Update through the web interface.
  94 +=head3 Update through the web interface
78 95
79 96 RIPE provides several web interfaces
80 97
@@ -89,14 +106,15 @@ B<CAUTION: SyncUpdates features require LWP::UserAgent to be installed.>
89 106
90 107 Once the object has been modified, locally, you can create it in the database
91 108 calling the syncupdates_create() method.
92   -The only parameter being the associated maintener's authentication
93   -as a password or pgp key:
  109 +
  110 +The parameters are passed through a hash ref, and can be the maintener
  111 +authentication credentials ('password' or 'pgpkey') and the 'align' parameter
94 112
95 113 $object->person('John Doe');
96 114 ...
97   - my $primary_key = $object->syncupdates_create({ password => $password });
  115 + my $primary_key = $object->syncupdates_create( { password => $password } );
98 116 # or
99   - my $primary_key = $object->syncupdates_create({ pgpkey => $pgpkey });
  117 + my $primary_key = $object->syncupdates_create( { pgpkey => $keyID, align => 8 } );
100 118
101 119 The pgp key must be an eight digit hexadecimal key ID known to the local
102 120 C<gpg> executable.
@@ -106,9 +124,6 @@ syncupdates_create, you can also pass in the C<pgpexec> key to chose a program
106 124 to execute for signing (C<gpg> by default), and C<pgpopts>, which must be an
107 125 array reference of additional options to pass to the signing binary.
108 126
109   -For backwards compatibility, the password can be passed directly without
110   -using a a hash reference, C<< $object->syncupdates_create($password) >>.
111   -
112 127 The primary key of the object created is returned.
113 128 The attribute used as primary key can be obtained through
114 129 $object->attribute('primary')
@@ -117,25 +132,28 @@ $object->attribute('primary')
117 132
118 133 An object existing in the RIPE database, can be retrived, modified locally
119 134 and the updated through the syncupdates_update() method.
120   -The only parameter being the associated maintener's authentication.
  135 +
  136 +The parameters are passed through a hash ref, and can be the maintener
  137 +authentication credentials ('password' or 'pgpkey') and the 'align' parameter
121 138 See L</Create> for more information on the authentication methods.
122 139
123 140 $object->person('John Doe');
124 141 ...
125   - $object->syncupdates_update($auth);
  142 + $object->syncupdates_update( { password => $password } );
126 143
127 144 =head4 Delete
128 145
129 146 An object existing in the RIPE database, can be retrived, and deleted in
130 147 the databased through the syncupdates_delete() method.
131   -The only required parameter being the associated maintener's authentication.
  148 +The parameters are passed through a hash ref, and can be the maintener
  149 +authentication credentials ('password' or 'pgpkey') and the 'reason' parameter
132 150 See L</Create> for more information on the authentication methods.
133 151
134   - $object->syncupdates_update($auth);
  152 + $object->syncupdates_update( { pgpkey => $keyID } );
135 153
136 154 An additional parameter can be used as a reason for the deletion.
137 155
138   - $object->syncupdates_update($auth,'Obsoleted by XXX');
  156 + $object->syncupdates_update( { pgpkey => $keyID, reason => 'Obsoleted by XXX' } );
139 157
140 158 If no reason is provided, a default one ('Not needed anymore') is used.
141 159
@@ -153,12 +171,11 @@ You can pass an array of lines or an iterator returned by Net::Whois::RIPE
153 171 as argument.
154 172
155 173 The two following ways of using the constructor are possible
156   -
  174 +
157 175 my $whois = Net::Whois::RIPE->new( %options );
158 176 $iterator = $whois->query('AS30781');
159 177
160 178 # Using the iterator way
161   -
162 179 push @objects, Net::Whois::Object->new($iterator);
163 180
164 181 or
@@ -196,15 +213,13 @@ sub new {
196 213 $attribute = 'response';
197 214 $value = $1;
198 215
199   - }
200   - elsif ( $line =~ /^(\S+):\s+(.*)/ ) {
  216 + } elsif ( $line =~ /^(\S+):\s+(.*)/ ) {
201 217
202 218 # Attribute line
203 219 $attribute = $1;
204 220 $value = $2;
205 221
206   - }
207   - elsif ( $line =~ /^%\s+(.*)/ ) {
  222 + } elsif ( $line =~ /^%\s+(.*)/ ) {
208 223
209 224 $block = 'comment' unless $block;
210 225
@@ -212,14 +227,12 @@ sub new {
212 227 $attribute = "comment";
213 228 $value = $1;
214 229
215   - }
216   - elsif ( $line =~ /^[^%]\s*(.+)/ ) {
  230 + } elsif ( $line =~ /^[^%]\s*(.+)/ ) {
217 231
218 232 # Continuation line
219 233 $value = $1;
220 234
221   - }
222   - elsif ( $line =~ /^$/ ) {
  235 + } elsif ( $line =~ /^$/ ) {
223 236
224 237 # Blank line
225 238 push @results, $object;
@@ -238,14 +251,14 @@ sub new {
238 251
239 252 if ( !$object ) {
240 253 $object = _object_factory( $block, $value ) unless $object;
241   - }
242   - elsif ($attribute) {
  254 + } elsif ($attribute) {
243 255 $object->$attribute($value);
244 256 }
245 257
246 258 }
247 259
248   - return @results;
  260 + # TODO : fix the trailing undef
  261 + return grep {defined} @results;
249 262 }
250 263
251 264 =head2 B<attributes( [$type [, \@attributes]] )>
@@ -277,18 +290,16 @@ sub attributes {
277 290 $self->_TYPE()->{$type}{$a} = 1;
278 291 }
279 292 }
280   - if ($type eq 'single' || $type eq 'multiple') {
  293 + if ( $type eq 'single' || $type eq 'multiple' ) {
281 294 my $symbol_table = do {
282 295 no strict 'refs';
283   - \%{$self . '::'};
  296 + \%{ $self . '::' };
284 297 };
285 298
286 299 for my $a ( @{$ra_attributes} ) {
287 300 my $attr_name = $a;
288   - unless (exists $symbol_table->{$a}) {
289   - my $accessor = $type eq 'single'
290   - ? sub { _single_attribute_setget( $_[0], $a, $_[1]) }
291   - : sub { _multiple_attribute_setget($_[0], $a, $_[1]) };
  301 + unless ( exists $symbol_table->{$a} ) {
  302 + my $accessor = $type eq 'single' ? sub { _single_attribute_setget( $_[0], $a, $_[1] ) } : sub { _multiple_attribute_setget( $_[0], $a, $_[1] ) };
292 303 no strict 'refs';
293 304 *{"${self}::$a"} = $accessor;
294 305 }
@@ -319,11 +330,6 @@ sub attribute_is {
319 330 my ( $self, $attribute, $type ) = @_;
320 331
321 332 return defined $self->_TYPE()->{$type}{$attribute} ? 1 : 0;
322   -
323   - # for my $att ( $self->attributes( $type )) {
324   - # if ($att eq $attribute) { return 1; }
325   - # }
326   - # return 0 ;
327 333 }
328 334
329 335 =head2 B<hidden_attributes( $attribute )>
@@ -354,18 +360,35 @@ sub displayed_attributes {
354 360 return @{ $self->{displayed_attributes} };
355 361 }
356 362
357   -=head2 B<dump( )>
  363 +=head2 B<dump( [\%options] )>
358 364
359 365 Simple naive way to display a text form of the class.
360 366 Try to be as close as possible as the submited text.
361 367
  368 +Currently the only option available is 'align' which accept a $column number as
  369 +parameter so that all C<< $self->dump >> produces values that are aligned
  370 +vertically on column C<$column>.
  371 +
362 372 =cut
363 373
364 374 sub dump {
365   - my ($self) = @_;
  375 + my ( $self, $options ) = @_;
366 376
367 377 my %current_index;
368 378 my $result;
  379 + my $align_to;
  380 +
  381 + for my $opt ( keys %$options ) {
  382 + if ( $opt =~ /^align$/i ) {
  383 + $align_to = $options->{$opt};
  384 +
  385 + } else {
  386 +
  387 + croak "Unknown option $opt for dump()";
  388 + }
  389 + }
  390 +
  391 + $align_to ||= 5 + max map length, $self->attributes('all');
369 392
370 393 for my $line ( @{ $self->{order} } ) {
371 394 my $attribute = $line;
@@ -381,10 +404,11 @@ sub dump {
381 404
382 405 $val = '' unless $val;
383 406
384   - my $output = "$attribute: $val\n";
  407 + my $alignment = ' ' x ( $align_to - length($attribute) - 1 );
  408 + my $output = "$attribute:$alignment$val\n";
385 409
386 410 # Process the comment
387   - $output =~ s/comment:\s+/\% /;
  411 + $output =~ s/comment:\s*/\% /;
388 412
389 413 $result .= $output;
390 414 }
@@ -392,68 +416,37 @@ sub dump {
392 416 return $result;
393 417 }
394 418
395   -=head2 B<align( $column )>
396   -
397   -Changes the object by adding or removing leading whitespace,
398   -so that all C<< $self->dump >> produces values that are aligned
399   -vertically on column C<$column>.
  419 +=head2 B<syncupdates_update( $password, [\%options] )>
400 420
401   -If C<$column> is omitted, it is chosen large enough to make vertical
402   -alignment possible for all values.
  421 +Update the RIPE database through the web syncupdates interface.
  422 +Use the password passed as parameter to authenticate.
403 423
404 424 =cut
405 425
406   -sub align {
407   - my $self = shift;
408   - my $align_to = shift;
409   -
410   - # $self->dump adds one colon and five spaces,
411   - # so there's a padding of 5
412   - my $padding = 5;
413   - $align_to ||= $padding + max map length, $self->attributes('all');
  426 +sub syncupdates_update {
  427 + my ( $self, $options ) = @_;
414 428
415   - for ($self->attributes('single')) {
416   - my $alignment = ' ' x ($align_to - $padding - length);
417   - if (exists $self->{$_}) {
418   - $self->{$_} =~ s/^\s*/$alignment/;
419   - }
420   - }
  429 + my $dump_options;
421 430
422   - for ($self->attributes('multiple')) {
423   - my $alignment = ' ' x ($align_to - $padding - length);
424   - if (exists $self->{$_}) {
425   - s/^\s*/$alignment/ for @{ $self->{$_} };
  431 + for my $opt ( keys %$options ) {
  432 + if ( $opt =~ /^align$/i ) {
  433 + $dump_options = { align => $options->{$opt} };
426 434 }
427 435 }
428 436
429   - return $self;
430   -}
431   -
432   -
433   -=head2 B<syncupdates_update( $password )>
434   -
435   -Update the RIPE database through the web syncupdates interface.
436   -Use the password passed as parameter to authenticate.
437   -
438   -=cut
439   -
440   -sub syncupdates_update {
441   - my ( $self, $auth ) = @_;
442   -
443   - my ($key) = $self->attributes('primary');
  437 + my ($key) = $self->attributes('primary');
444 438 my $value = $self->_single_attribute_setget($key);
445 439
446   - my $html = $self->_syncupdates_submit( $self->dump(), $auth );
447   -
  440 + my $html = $self->_syncupdates_submit( $self->dump($dump_options), $options );
  441 +
448 442 if ( $html =~ /Modify SUCCEEDED:.*$value/m ) {
449 443 return $value;
450   - }
451   - else {
  444 + } else {
452 445 croak "Update not confirmed ($html)";
453 446 }
454 447 }
455 448
456   -=head2 B<syncupdates_delete( $password, [$reason] )>
  449 +=head2 B<syncupdates_delete( \%options )>
457 450
458 451 Delete the object in the RIPE database through the web syncupdates interface.
459 452 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.
462 455 =cut
463 456
464 457 sub syncupdates_delete {
465   - my ( $self, $auth, $reason) = @_;
  458 + my ( $self, $options ) = @_;
466 459
467   - my ($key) = $self->attributes('primary');
  460 + my ($key) = $self->attributes('primary');
468 461 my $value = $self->_single_attribute_setget($key);
469 462
470 463 my $text = $self->dump();
471   - $reason = 'Not needed anymore' unless $reason;
472   - $text .= "delete: $reason\n";
  464 + $options->{reason} = 'Not needed anymore' unless $options->{reason};
  465 + $text .= "delete: " . $options->{reason} . "\n";
473 466
474   - my $html = $self->_syncupdates_submit( $text, $auth );
  467 + my $html = $self->_syncupdates_submit( $text, $options );
475 468
476   - if ( $html =~ /Delete SUCCEEDED:.*\Q$value\E/m ) {
  469 + if ( $html =~ /Delete SUCCEEDED:.*$value/m ) {
477 470 return $value;
478   - }
479   - else {
  471 + } else {
480 472 croak "Deletion not confirmed ($html)";
481 473 }
482 474 }
483 475
484   -=head2 B<syncupdates_create( $auth )>
  476 +=head2 B<syncupdates_create( \%options )>
485 477
486 478 Create an object in the the RIPE database through the web syncupdates interface.
487   -See L</Create> for possible values of C<$auth>.
  479 +See L</Create> for more information on the authentication methods.
  480 +
  481 +The available options are 'pgpkey', 'password' and 'align'
488 482
489 483 Return the primary key of the object created.
490 484
491 485 =cut
492 486
493 487 sub syncupdates_create {
494   - my ( $self, $auth ) = @_;
  488 + my ( $self, $options ) = @_;
  489 +
  490 + my $dump_options;
  491 +
  492 + for my $opt ( keys %$options ) {
  493 + if ( $opt =~ /^align$/i ) {
  494 + $dump_options = { align => $options->{$opt} };
  495 + }
  496 + }
495 497
496   - my ($key) = $self->attributes('primary');
  498 + my ($key) = $self->attributes('primary');
497 499
498   - my $res = $self->_syncupdates_submit( $self->dump(), $auth );
  500 + my $res = $self->_syncupdates_submit( $self->dump($dump_options), $options );
499 501
500   - if (
501   - $res =~ /^Number of objects processed with errors:\s+(\d+)/m
502   - && $1 == 0
503   - && $res =~ /\*\*\*Info:\s+Authorisation for\s+\[[^\]]+]\s+(.+)\s*$/m
504   - ) {
  502 + if ( $res =~ /^Number of objects processed with errors:\s+(\d+)/m
  503 + && $1 == 0
  504 + && $res =~ /\*\*\*Info:\s+Authorisation for\s+\[[^\]]+]\s+(.+)\s*$/m )
  505 + {
505 506 my $value = $1;
506 507 $self->_single_attribute_setget( $key, $value );
507 508 return $value;
508   - }
509   - else {
  509 + } else {
510 510 croak "Error while creating object through syncupdates API: $res";
511 511 }
512 512 }
513 513
  514 +=head2 B<query( $query, [\%options] )>
  515 +
  516 + ******************************** EXPERIMENTAL ************************************
  517 + This method is a work in progress, the API and behaviour are subject to change
  518 + **********************************************************************************
  519 +
  520 +Query the RIPE database and return Net::Whois::Objects
  521 +
  522 +This method accepts 2 optional parameters
  523 +
  524 +'type' which is a regex used to filter the query result :
  525 +Only the object whose type matches the 'type' parameter are returned
  526 +
  527 +'attribute' which is a regex used to filter the query result :
  528 +Only the value of the attributes matching the 'attribute' parameter are
  529 +returned
  530 +
  531 +Note that if 'attribute' is specified strings are returned, instead of
  532 +Net::Whois::Objects
  533 +
  534 +=cut
  535 +
  536 +sub query {
  537 + my ( $class, $query, $options ) = @_;
  538 +
  539 + my $attribute;
  540 + my $type;
  541 +
  542 + for my $opt ( keys %$options ) {
  543 + if ( $opt =~ /^attribute$/i ) {
  544 + $attribute = $options->{$opt};
  545 + } elsif ( $opt =~ /^type$/i ) {
  546 + $type = $options->{$opt};
  547 + }
  548 + }
  549 +
  550 + my $whois = Net::Whois::RIPE->new(%$options);
  551 + my $iterator = $whois->query($query);
  552 +
  553 + my @objects = Net::Whois::Object->new($iterator);
  554 +
  555 + if ($type) {
  556 + @objects = grep { ref($_) =~ /$type/i } @objects;
  557 + }
  558 +
  559 + if ($attribute) {
  560 + return grep {defined} map {
  561 + my $r;
  562 + eval { $r = $_->$attribute };
  563 + $@ ? undef : ref($r) eq 'ARRAY' ? @$r : $r
  564 + } @objects;
  565 + } else {
  566 + return grep {defined} @objects;
  567 + }
  568 +}
  569 +
514 570 =begin UNDOCUMENTED
515 571
516 572 =head2 B<_object_factory( $type => $value )>
@@ -520,7 +576,6 @@ Private method. Shouldn't be used from other modules.
520 576 Simple factory, creating Net::Whois::Objet::XXXX from
521 577 the type passed as parameter.
522 578
523   -
524 579 =cut
525 580
526 581 sub _object_factory {
@@ -566,8 +621,7 @@ sub _object_factory {
566 621 # First attribute is always single valued, except for comments
567 622 if ( $type eq 'comment' ) {
568 623 $object->_multiple_attribute_setget( $type => $value );
569   - }
570   - else {
  624 + } else {
571 625 $object->_single_attribute_setget( $type => $value );
572 626 }
573 627
@@ -588,8 +642,7 @@ sub _single_attribute_setget {
588 642 if ( defined $value ) {
589 643
590 644 # Store attribute order for dump, unless this attribute as already been set
591   - #
592   - push @{ $self->{order} }, $attribute unless $self->{$attribute} or $attribute eq 'class';
  645 + push @{ $self->{order} }, $attribute unless $self->{$attribute} or $attribute eq 'class';
593 646
594 647 $self->{$attribute} = $value;
595 648 }
@@ -608,7 +661,7 @@ sub _multiple_attribute_setget {
608 661 if ( defined $value ) {
609 662
610 663 # Store attribute order for dump
611   - push @{ $self->{order} }, $attribute;
  664 + push @{ $self->{order} }, $attribute;
612 665
613 666 push @{ $self->{$attribute} }, $value;
614 667 }
@@ -624,15 +677,14 @@ Initialize self with C<@options>
624 677 =cut
625 678
626 679 sub _init {
627   - my ($self, @options) = @_;
  680 + my ( $self, @options ) = @_;
628 681
629   - while (my ($key, $val ) = splice(@options, 0, 2)) {
630   - $self->$key( $val );
  682 + while ( my ( $key, $val ) = splice( @options, 0, 2 ) ) {
  683 + $self->$key($val);
631 684 }
632 685 }
633 686
634   -
635   -=head2 B<_syncupdates_submit( $text, $password )>
  687 +=head2 B<_syncupdates_submit( $text, \%options )>
636 688
637 689 Interact with the RIPE database through the web syncupdates interface.
638 690 Submit the text passed as parameter.
@@ -645,39 +697,29 @@ Return the HTML code of the returned page.
645 697 =cut
646 698
647 699 sub _syncupdates_submit {
648   - my ( $self, $text, $auth ) = @_;
649   -
650   - if ( $auth && !ref $auth) {
651   - # preserve backwards compatiblity
652   - $auth = { password => $auth };
653   - }
654   - $auth ||= {};
  700 + my ( $self, $text, $options ) = @_;
655 701
656   - if ( exists $auth->{pgpkey} ) {
657   - $text = $self->_pgp_sign($text, $auth);
658   - }
659   - elsif ( exists $auth->{password} ) {
660   - my $password = $auth->{password};
  702 + if ( exists $options->{pgpkey} ) {
  703 + $text = $self->_pgp_sign( $text, { pgpkey => $options->{pgpkey} } );
  704 + } elsif ( exists $options->{password} ) {
  705 + my $password = $options->{password};
661 706 chomp $password;
662   - croak( "Passwords containing newlines are not supported" )
  707 + croak("Passwords containing newlines are not supported")
663 708 if $password =~ /\n/;
664   - $text .= "password: $password\n"
  709 + $text .= "password: $password\n";
665 710 }
666 711
667   - croak "LWP::UserAgent required for updates" unless $LWP;
668   -
669   - my $url = ($self->source || 'TEST') eq 'RIPE'
670   - ? 'http://syncupdates.db.ripe.net/'
671   - : 'http://syncupdates-test.db.ripe.net';
  712 + croak "LWP::UserAgent required for updates" unless $LWP;
672 713
  714 + my $url = $self->source eq 'RIPE' ? 'http://syncupdates.db.ripe.net/' : 'http://syncupdates-test.db.ripe.net';
673 715
674 716 my $ua = LWP::UserAgent->new;
675 717
676   - my $response = $ua->post($url, { DATA => $text });
  718 + my $response = $ua->post( $url, { DATA => $text } );
677 719 my $response_text = $response->decoded_content;
678 720
679   - unless ($response->is_success) {
680   - croak "Can't sync object with RIPE database: $response_text"
  721 + unless ( $response->is_success ) {
  722 + croak "Can't sync object with RIPE database: $response_text";
681 723 }
682 724
683 725 return $response_text;
@@ -692,13 +734,14 @@ Returns the signed text.
692 734
693 735 sub _pgp_sign {
694 736 my ( $self, $text, $auth ) = @_;
  737 +
695 738 my $binary = $auth->{pgpexec} || 'gpg';
696 739 my $key_id = $auth->{pgpkey};
697 740 my @opts = @{ $auth->{pgpopts} || [] };
  741 +
698 742 $key_id =~ s/^0x//;
699   - my $pid = open2(my $child_out, my $child_in,
700   - $binary, "--local-user=$key_id", '--clearsign', @opts);
701   - print { $child_in } $text;
  743 + my $pid = open2( my $child_out, my $child_in, $binary, "--local-user=$key_id", '--clearsign', @opts );
  744 + print {$child_in} $text;
702 745 close $child_in;
703 746
704 747 $text = do { local $/; <$child_out> };
@@ -706,9 +749,8 @@ sub _pgp_sign {
706 749
707 750 waitpid( $pid, 0 );
708 751 my $child_exit_status = $? >> 8;
709   - if ($child_exit_status != 0) {
710   - croak "Error while launching $binary for signing the message: "
711   - . "child prcoess exited with status $child_exit_status";
  752 + if ( $child_exit_status != 0 ) {
  753 + croak "Error while launching $binary for signing the message: child process exited with status $child_exit_status";
712 754 }
713 755
714 756 return $text;
@@ -724,15 +766,19 @@ of the object that the method was called on.
724 766 =cut
725 767
726 768 my %TYPES;
  769 +
727 770 sub _TYPE {
728   - $TYPES{ref $_[0] || $_[0] } ||= {}
  771 + $TYPES{ ref $_[0] || $_[0] } ||= {};
729 772 }
730 773
731   -
732 774 =head1 TODO
733 775
734 776 The update part (in RIPE database) still needs a lot of work.
735 777
  778 +Enhance testing without network
  779 +
  780 +Enhance test coverage
  781 +
736 782 =head1 AUTHOR
737 783
738 784 Arnaud "Arhuman" Assad, C<< <arhuman at gmail.com> >>
18 lib/Net/Whois/RIPE.pm
@@ -28,11 +28,11 @@ Net::Whois::RIPE - a pure-Perl implementation of the RIPE Database client.
28 28
29 29 =head1 VERSION
30 30
31   -Version 2.00_017 - BETA
  31 +Version 2.00_019 - BETA
32 32
33 33 =cut
34 34
35   -our $VERSION = 2.00_017;
  35 +our $VERSION = 2.00_019;
36 36
37 37 =head1 SYNOPSIS
38 38
@@ -50,6 +50,12 @@ The usage should remain mostly the same:
50 50 my $whois = Net::Whois::RIPE->new( %options );
51 51 $iterator = $whois->query( 'AS333' );
52 52
  53 +If you prefer to manipulate full-fledged objects you can now use
  54 +
  55 + use Net::Whois::Object;
  56 +
  57 + my @objects = Net::Whois::Object->query( 'AS333' );
  58 +
53 59 Of course, comments are more than welcome. If you believe you can help, please
54 60 do not hesitate in contacting me.
55 61
@@ -91,6 +97,14 @@ believe).
91 97 Net::Whois::Object (from release 2.00_010) is the first attempt toward this
92 98 goal.
93 99
  100 + # You can now do
  101 + my @objects = Net::Whois::Object->query( 'AS333' );
  102 +
  103 + # And manipulate the object the OO ways
  104 + for my $object (@objects) {
  105 + print $object->remarks();
  106 + }
  107 +
94 108 =head1 METHODS
95 109
96 110 =head2 B<new( %options )>
8 t/02-methods.t
@@ -82,12 +82,16 @@ can_ok $class,
82 82 ok $c->unfiltered, '->new can set the unfiltered flag';
83 83 }
84 84
85   -{
86 85 my $c = $class->new( disconnected => 1 );
87 86
88 87 # connect()
89 88 # TODO: implement a test that doesn't requires internet connection
90   - lives_ok { $c->connect } 'The client connected without dying.';
  89 + eval { $c->connect };
  90 +
  91 +SKIP: {
  92 + skip "Network issue",14 if ( $@ =~ /IO::Socket::INET/ );
  93 +
  94 + ok (!$@, "The client connected without dying. $@");
91 95
92 96 # is_connected()
93 97 ok $c->is_connected, 'The client is connected.';
22 t/03-objects.t
@@ -40,6 +40,28 @@ is_deeply( [ $o[0]->attributes('all') ], [ 'comment', 'opt1', 'opt2', 'opt3' ] )
40 40 is_deeply( [ $o[0]->attributes() ], [ 'comment', 'opt1', 'opt2', 'opt3' ] );
41 41
42 42 is( $o[2]->dump, "% Information related to 'AS30720 - AS30895'\n" );
  43 +is( $o[2]->dump( { align => 8 } ), "% Information related to 'AS30720 - AS30895'\n" );
  44 +
  45 +my @objects;
  46 +eval { @objects = Net::Whois::Object->query('AS30781', {attribute => 'remarks'}) };
  47 +
  48 +SKIP: {
  49 + skip "Network issue",14 if ( $@ =~ /IO::Socket::INET/ );
  50 +
  51 + for my $object (@objects) {
  52 + ok(!ref($object), "query() : String returned for 'remarks' attribute filter")
  53 + }
  54 +
  55 + @objects = Net::Whois::Object->query('AS30781');
  56 + for my $object (@objects) {
  57 + ok(ref($object) =~ /Net::Whois::Object/ , "query() : Object returned for 'remarks' attribute filter")
  58 + }
  59 +
  60 + @objects = Net::Whois::Object->query('AS30781', {type => 'asblock', attribute => 'admin_c'});
  61 + for my $object (@objects) {
  62 + ok($object eq 'CREW-RIPE' , "query() : 'CREW-RIPE' returned for AsBlock and admin-c filter")
  63 + }
  64 +}
43 65
44 66 __DATA__
45 67 % This is the RIPE Database query service.
6 t/105-AsBlock.t
@@ -112,12 +112,14 @@ my $align = Net::Whois::Object::AsBlock->new(
112 112 changed => 'arhuman@gmail.com 20120701',
113 113 source => 'RIPE # Filtered',
114 114 );
115   -$align->align(30);
116 115
117   -for (split /\n/, $align->dump) {
  116 +for (split /\n/, $align->dump({align => 30})) {
118 117 ok $_ =~ /^.{29}\s\S/, "Line '$_' is aligned to column 30";
119 118 }
120 119
  120 +# Test 'as_block' on aligned data
  121 +is( $align->as_block(), 'AS30720 - AS30895', 'aligned as-block properly parsed' );
  122 +
121 123 # Common tests
122 124 do 't/common.pl';
123 125 ok( $tested{common_loaded}, "t/common.pl properly loaded" );
12 t/215-SyncUpdates.t
@@ -4,14 +4,12 @@ use Test::More;
4 4 use Test::Exception;
5 5 use Net::Whois::RIPE;
6 6 use Net::Whois::Object;
7   -use Data::Dumper;
8 7
9 8 our $LWP;
  9 +
10 10 BEGIN {
11 11 $LWP = do {
12   - eval {
13   - require LWP::UserAgent;
14   - };
  12 + eval { require LWP::UserAgent; };
15 13 ($@) ? 0 : 1;
16 14 };
17 15 }
@@ -39,7 +37,7 @@ my $mntner = shift @o;
39 37
40 38 my $email_before = $person->e_mail()->[0];
41 39
42   -my $person_id = $person->syncupdates_create($PASSWD);
  40 +my $person_id = $person->syncupdates_create( { password => $PASSWD, align => 8 } );
43 41 ok($person_id);
44 42
45 43 my $whois = Net::Whois::RIPE->new( hostname => 'whois-test.ripe.net' );
@@ -50,7 +48,7 @@ my $iterator = $whois->query($person_id);
50 48 is_deeply( $person->e_mail(), [$email_before], "Same name from previous" );
51 49 my $email_after = $person->e_mail('arhuman2@gmail.com');
52 50
53   -$person->syncupdates_update($PASSWD);
  51 +$person->syncupdates_update( { password => $PASSWD, align => 10 } );
54 52
55 53 $iterator = $whois->query($person_id);
56 54 ($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" );
59 57
60 58 isa_ok( $person, 'Net::Whois::Object::Person', 'Found a Person' );
61 59
62   -$person->syncupdates_delete($PASSWD);
  60 +$person->syncupdates_delete( { password => $PASSWD } );
63 61
64 62 $whois = Net::Whois::RIPE->new( hostname => 'whois-test.ripe.net' );
65 63 $iterator = $whois->query($person_id);
1  t/216-SyncUpdates-Signed.t
@@ -4,7 +4,6 @@ use Test::More;
4 4 use Test::Exception;
5 5 use Net::Whois::RIPE;
6 6 use Net::Whois::Object;
7   -use Data::Dumper;
8 7
9 8 our $LWP;
10 9 BEGIN {

0 comments on commit 6ae4027

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