Browse files

Merge branch 'release/Net-Whois-RIPE-2.001000'

  • Loading branch information...
2 parents 21cc634 + 01da63e commit 63cf22cd4f9b3e347ff7976241555df3da7b93dd @arhuman committed Nov 22, 2012
Showing with 183 additions and 26 deletions.
  1. +5 −0 Changes
  2. +2 −7 README
  3. +42 −0 README.md
  4. +111 −16 lib/Net/Whois/Object.pm
  5. +2 −2 lib/Net/Whois/RIPE.pm
  6. +20 −0 t/03-objects.t
  7. +1 −1 t/common.pl
View
5 Changes
@@ -1,5 +1,10 @@
Revision history for net-whois-ripe
+2.001000 2012-11-22
+ - Add the clone() method to Net::Whois::Object
+ - Enhance accessor for multiple value attributes
+ (enable multiple values in default append mode, add a replace mode)
+ - Add a README.md skeleton for github
2.00020 2012-11-14
- Changes date format in Changes file
View
9 README
@@ -31,14 +31,9 @@ perldoc command.
You can also look for information at:
- RT, CPAN's request tracker
- http://rt.cpan.org/NoAuth/Bugs.html?Dist=net-whois-ripe
+ GitHub
+ https://github.com/arhuman/Net-Whois-RIPE
- AnnoCPAN, Annotated CPAN documentation
- http://annocpan.org/dist/net-whois-ripe
-
- CPAN Ratings
- http://cpanratings.perl.org/d/net-whois-ripe
Search CPAN
http://search.cpan.org/dist/net-whois-ripe
View
42 README.md
@@ -0,0 +1,42 @@
+# Net::Whois::RIPE
+
+A pure-perl programming interface to the RIPE Database Whois service.
+
+This is a complete rewrite of the old version of the module Luis Motta Campos inherited from
+Paul Gampe.
+
+This repository (try to) follow the git-flow development model, so please use the 'develop' branch
+for your work/pull request.
+
+## INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+## SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc Net::Whois::RIPE
+
+You can also look for information at:
+
+ GitHub.
+ https://github.com/arhuman/Net-Whois-RIPE
+
+
+ Search CPAN
+ http://search.cpan.org/dist/net-whois-ripe
+
+## COPYRIGHT AND LICENCE
+
+Copyright (C) 2010 Luis Motta Campos
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
View
127 lib/Net/Whois/Object.pm
@@ -36,11 +36,10 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
push @objects, Net::Whois::Object->new($iterator);
for my $object (@objects) {
- # process the Net::Whois::Object::xxx objects...
+ # process Net::Whois::Object::xxx objects...
# Type of object is available via class() method
}
-
=head1 USAGE
=head2 Get the data
@@ -49,11 +48,11 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
my $whois = Net::Whois::RIPE->new( %options );
$iterator = $whois->query('POLK-RIPE');
-=head2 Filter the objects
+=head2 Filter objects
Before you had to filter objects using the class() method.
- # Then to only get the Person object (and ignore the Information objects)
+ # Then to only get the Person object (and ignore Information objects)
my ($person) = grep {$_->class() eq 'Person'} Net::Whois::Object->new($iterator);
But now the query() method allows you to filter more easily
@@ -70,11 +69,32 @@ are strings and no more Net::Whois::Objects.
=head2 Modify the data
# Add a phone number
- $person->phone(' +33 4 88 00 65 15')
+ $person->phone(' +33 4 88 00 65 15');
+
+Some attributes can have multiple value (remarks, mnt-by...) first implementation allowed only to
+add one value
+
+ # Add one maintener
+ $person->mnt_by('CPNY-MNT');
+
+New implementation (post 2.00020) allow to do:
+
+ $person->mnt_by({mode => 'append', value => 'CPNY-MNT'});
+
+Which is a verbose way to do exactly as the default mode above, but also
+
+ # Append multiple values at once
+ $person->mnt_by({mode => 'append', value => ['CPNY-MNT2','CPNY-MNT3']});
+
+Or even
+
+ # Replace CPNY-MNT2 by REPL-MNT
+ $person->mnt_by({mode => 'replace', value => {old => 'CPNY-MNT2', old => 'REPL-MNT'}});
+
=head2 Dump the current state of the data
-The dump() method, permit to print the object under the classic
+The dump() method, enable to print the object under the classic
text form, made of 'attribute: value' lines.
# Dump the modified data
@@ -130,10 +150,10 @@ $object->attribute('primary')
=head4 Update
-An object existing in the RIPE database, can be retrived, modified locally
-and the updated through the syncupdates_update() method.
+An object existing in the RIPE database, can be retrieved, modified locally
+and then updated through the syncupdates_update() method.
-The parameters are passed through a hash ref, and can be the maintener
+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.
@@ -143,9 +163,9 @@ See L</Create> for more information on the authentication methods.
=head4 Delete
-An object existing in the RIPE database, can be retrived, and deleted in
+An object existing in the RIPE database, can be retrieved, and deleted in
the databased through the syncupdates_delete() method.
-The parameters are passed through a hash ref, and can be the maintener
+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.
@@ -261,6 +281,48 @@ sub new {
return grep {defined} @results;
}
+=head2 B<clone( [\%options] )>
+
+Return a clone from a Net::Whois::RIPE object
+
+Current allowed option is remove => [attribute1, ..., attributen] where the specified
+attribute AREN'T copied to the clone object (for example to ignore the 'changed' values)
+
+=cut
+
+sub clone {
+ my ( $self, $rh_options ) = @_;
+
+ my $clone;
+ my %filtered;
+
+ for my $option ( keys %$rh_options ) {
+ if ( $option =~ /remove/i ) {
+ for my $att ( @{ $rh_options->{$option} } ) {
+ $filtered{ lc $att } = 1;
+ }
+ } else {
+ croak "Unknown option $option used while cloning a ", ref $self;
+ }
+ }
+
+ my @lines;
+ my @tofilter = split /\n/, $self->dump;
+
+ for my $line (@tofilter) {
+ if ( $line =~ /^(.+?):/ and $filtered{ lc $1 } ) {
+ next;
+ }
+ push @lines, $line;
+
+ }
+
+ eval { ($clone) = Net::Whois::Object->new( @lines, $/ ); };
+ croak $@ if $@;
+
+ return $clone;
+}
+
=head2 B<attributes( [$type [, \@attributes]] )>
Accessor to the attributes of the object.
@@ -297,7 +359,6 @@ sub attributes {
};
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] ) };
no strict 'refs';
@@ -657,13 +718,47 @@ Generic setter/getter for multivalue attribute.
sub _multiple_attribute_setget {
my ( $self, $attribute, $value ) = @_;
+ my $mode = 'append';
- if ( defined $value ) {
+ if ( ref $value eq 'HASH' ) {
+ my %options = %$value;
- # Store attribute order for dump
- push @{ $self->{order} }, $attribute;
+ if ( $options{mode} ) {
+ $mode = $options{mode};
+ }
- push @{ $self->{$attribute} }, $value;
+ if ( $options{value} ) {
+ $value = $options{value};
+ } else {
+ croak "Unable to determine attribute $attribute value";
+ }
+
+ }
+
+ if ( defined $value ) {
+
+ if ( $mode eq 'append' ) {
+ if ( ref $value eq 'ARRAY' ) {
+ push @{ $self->{$attribute} }, @$value;
+ push @{ $self->{order} }, map {$attribute} @$value;
+ } elsif ( !ref $value ) {
+ push @{ $self->{$attribute} }, $value;
+ push @{ $self->{order} }, $attribute;
+ } else {
+ croak "Trying to append weird data to $attribute: ", $value;
+ }
+ } elsif ( $mode eq 'replace' ) {
+ if ( ref $value ne 'HASH' or !$value->{old} or !$value->{new} ) {
+ croak " {old=>..., new=>} expected as value for $attribute update in replace mode";
+ } else {
+ my $old = $value->{old};
+ for ( @{ $self->{$attribute} } ) {
+ $_ = $value->{new} if $_ =~ /$old/;
+ }
+ }
+ } else {
+ croak "Unknown mode $mode for attribute $attribute";
+ }
}
croak "$attribute $self" unless ref $self;
View
4 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_020 - BETA
+Version 2.001000
=cut
-our $VERSION = 2.00_020;
+our $VERSION = 2.001000;
=head1 SYNOPSIS
View
20 t/03-objects.t
@@ -42,6 +42,26 @@ 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 $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']});
+is_deeply($clone, { class => 'AsBlock', order => ['as_block', 'descr'], as_block => 'AS30720 - AS30895', descr => ['RIPE NCC ASN block'] }, "Clone object similar with removed attribute");
+
+$clone->mnt_by({value =>['MNT1-ADD','MNT2-ADD']});
+is_deeply($clone->mnt_by,['MNT1-ADD','MNT2-ADD'],'Array properly added to empty multiple attribute');
+$clone->mnt_by({value =>['MNT3-ADD','MNT4-ADD']});
+is_deeply($clone->mnt_by,['MNT1-ADD','MNT2-ADD','MNT3-ADD','MNT4-ADD'],'Array properly added to multiple attribute');
+$clone->mnt_by({mode => 'replace', value => { old => 'MNT3-ADD', new => 'MNT3-RPL'}});
+is_deeply($clone->mnt_by,['MNT1-ADD','MNT2-ADD','MNT3-RPL','MNT4-ADD'],'Array properly added to multiple attribute');
+eval { $clone->mnt_by({mode => 'unknown', value => { old => 'MNT3-ADD', new => 'MNT3-RPL'}}); };
+like($@ ,qr/Unknown mode/, "Unknown mode detected in accessor");
+eval { $clone->mnt_by({mode => 'replace', value => { old => 'MNT3-ADD'}}); };
+like($@ ,qr/new.*replace mode/, "new=>... expected in replace mode");
+eval { $clone->mnt_by({mode => 'replace', value => { new => 'MNT3-ADD'}}); };
+like($@ ,qr/old.*replace mode/, "old=>... expected in replace mode");
+
my @objects;
eval { @objects = Net::Whois::Object->query('AS30781', {attribute => 'remarks'}) };
View
2 t/common.pl
@@ -6,7 +6,7 @@
qw( new ),
# OO Support
- qw( attributes attribute_is filtered_attributes displayed_attributes dump
+ qw( attributes attribute_is filtered_attributes clone displayed_attributes dump
syncupdates_update syncupdates_delete syncupdates_create _object_factory
_single_attribute_setget _multiple_attribute_setget _syncupdates_submit );

0 comments on commit 63cf22c

Please sign in to comment.