Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Working SyncUpdate implementation

Allow to
- Create
- Update
- Delete
an Net::Whois::Object
(only with password yet)
  • Loading branch information...
commit 4db38214ac9a96b58bda697e89ae96cc741f9b97 1 parent 1f31cce
@arhuman authored
Showing with 1,506 additions and 1,290 deletions.
  1. +1 −0  Changes
  2. +4 −1 MANIFEST
  3. +3 −0  credentials.sh
  4. +215 −49 lib/Net/Whois/Object.pm
  5. +16 −16 lib/Net/Whois/Object/AsBlock.pm
  6. +16 −16 lib/Net/Whois/Object/AsSet.pm
  7. +24 −26 lib/Net/Whois/Object/AutNum.pm
  8. +21 −22 lib/Net/Whois/Object/Domain.pm
  9. +19 −19 lib/Net/Whois/Object/FilterSet.pm
  10. +21 −22 lib/Net/Whois/Object/Inet6Num.pm
  11. +21 −23 lib/Net/Whois/Object/InetNum.pm
  12. +21 −21 lib/Net/Whois/Object/InetRtr.pm
  13. +4 −4 lib/Net/Whois/Object/Information.pm
  14. +23 −24 lib/Net/Whois/Object/Irt.pm
  15. +16 −16 lib/Net/Whois/Object/KeyCert.pm
  16. +14 −14 lib/Net/Whois/Object/Limerick.pm
  17. +21 −21 lib/Net/Whois/Object/Mntner.pm
  18. +23 −24 lib/Net/Whois/Object/Organisation.pm
  19. +17 −18 lib/Net/Whois/Object/PeeringSet.pm
  20. +15 −15 lib/Net/Whois/Object/Person.pm
  21. +15 −15 lib/Net/Whois/Object/Poem.pm
  22. +13 −13 lib/Net/Whois/Object/PoeticForm.pm
  23. +18 −4 lib/Net/Whois/Object/Response.pm
  24. +18 −18 lib/Net/Whois/Object/Role.pm
  25. +22 −22 lib/Net/Whois/Object/Route.pm
  26. +23 −23 lib/Net/Whois/Object/Route6.pm
  27. +17 −17 lib/Net/Whois/Object/RouteSet.pm
  28. +17 −17 lib/Net/Whois/Object/RtrSet.pm
  29. +1 −3 t/03-objects.t
  30. +29 −39 t/105-AsBlock.t
  31. +42 −32 t/110-AutNum.t
  32. +28 −33 t/115-Person.t
  33. +32 −36 t/120-Role.t
  34. +28 −43 t/125-AsSet.t
  35. +40 −40 t/130-Domain.t
  36. +39 −39 t/135-InetNum.t
  37. +40 −39 t/140-Inet6Num.t
  38. +37 −34 t/145-InetRtr.t
  39. +30 −33 t/150-RtrSet.t
  40. +38 −36 t/155-Mntner.t
  41. +33 −32 t/160-KeyCert.t
  42. +47 −47 t/165-Route.t
  43. +46 −46 t/167-Route6.t
  44. +32 −32 t/170-RouteSet.t
  45. +30 −30 t/175-PeeringSet.t
  46. +27 −27 t/180-Limerick.t
  47. +28 −32 t/185-Poem.t
  48. +20 −24 t/187-PoeticForm.t
  49. +41 −40 t/190-Organisation.t
  50. +13 −7 t/195-Response.t
  51. +8 −9 t/200-Information.t
  52. +41 −47 t/205-Irt.t
  53. +31 −30 t/210-FilterSet.t
  54. +67 −0 t/215-SyncUpdates.t
View
1  Changes
@@ -1,6 +1,7 @@
Revision history for net-whois-ripe
+ - Add RIPE SyncUpdates prototype implementation (Create, Update, Delete)
- Add type on attributes to prepare future update, with the
following methods :
attributes()
View
5 MANIFEST
@@ -8,8 +8,8 @@ lib/Net/Whois/Object/FilterSet.pm
lib/Net/Whois/Object/Inet6Num.pm
lib/Net/Whois/Object/InetNum.pm
lib/Net/Whois/Object/InetRtr.pm
-lib/Net/Whois/Object/Irt.pm
lib/Net/Whois/Object/Information.pm
+lib/Net/Whois/Object/Irt.pm
lib/Net/Whois/Object/KeyCert.pm
lib/Net/Whois/Object/Limerick.pm
lib/Net/Whois/Object/Mntner.pm
@@ -57,6 +57,9 @@ t/190-Organisation.t
t/195-Response.t
t/200-Information.t
t/205-Irt.t
+t/210-FilterSet.t
+t/215-SyncUpdates.t
t/boilerplate.t
+t/common.pl
t/pod-coverage.t
t/pod.t
View
3  credentials.sh
@@ -0,0 +1,3 @@
+# source credentials.sh
+export TEST_MNTNER=MA86905-MNT
+export TEST_MNTNER_PASSWORD=totototo
View
264 lib/Net/Whois/Object.pm
@@ -4,6 +4,8 @@ use warnings;
use Carp;
use WWW::Mechanize;
+use Net::Whois::RIPE;
+use Data::Dumper;
=head1 NAME
@@ -56,12 +58,61 @@ email.
=head2 Update the RIPE database
-This part is still to be done
+The RIPE database update is currently under heavy development.
+*The update code is to be considered as experimental.*
+
+We plan to offer several ways to update the RIPE database
=head3 Update through the web interface.
-Not implemented yet.
+RIPE provides several web interfaces
+
+=head4 SyncUpdates (*Experimental*)
+
+Although not the latest one, this simple interface is the first to be wrapped
+by this module.
+
+=head4 Create
+
+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 password.
+(Certificates are planned to be used in a near future)
+
+ $object->person('John Doe');
+ ...
+ my $primary_key = $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')
+
+=head4 Update
+
+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 password.
+(Certificates are planned to be used in a near future)
+
+ $object->person('John Doe');
+ ...
+ $object->syncupdates_update($password);
+
+=head4 Update
+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 password.
+(Certificates are planned to be used in a near future)
+
+ $object->syncupdates_update($password);
+
+An additional parameter can be used as a reason for the deletion.
+
+ $object->syncupdates_update($password,'Obsoleted by XXX');
+
+If no reason is provided, a default one ('Not needed anymore') is used.
+
=head3 Update through email.
Not implemented yet.
@@ -107,26 +158,27 @@ sub new {
}
}
- my ( $object, $block, @results );
+ my ( $attribute, $block, $object, @results, $value );
- my ( $attribute, $value );
for my $line (@lines) {
- if ( $line =~ /^(\S+):\s+(.*)/ ) {
+ if ( $line =~ /^%(\S+)/ ) {
- # Attribute line
- $attribute = $1;
- $value = $2;
+ $block = 'response' unless $block;
+
+ # Response line
+ $attribute = 'response';
+ $value = $1;
}
- elsif ( $line =~ /^%(\S.*)/ ) {
+ elsif ( $line =~ /^(\S+):\s+(.*)/ ) {
- # Response line
- $block = 'response';
- $value = $1;
+ # Attribute line
+ $attribute = $1;
+ $value = $2;
}
- elsif ( $line =~ /^%\s(.*)/ ) {
+ elsif ( $line =~ /^%\s+(.*)/ ) {
$block = 'comment' unless $block;
@@ -188,14 +240,13 @@ Returns a list of attributes of the required type.
=cut
sub attributes {
- my ( $self, $type, $r_attributes ) = @_;
- if (not defined $type or $type =~ /all/i) {
- return ( $self->attributes('mandatory') , $self->attributes('optionnal'));
+ my ( $self, $type, $ra_attributes ) = @_;
+ if ( not defined $type or $type =~ /all/i ) {
+ return ( $self->attributes('mandatory'), $self->attributes('optionnal') );
}
- croak "Invalid attribute's type ($type)" unless $type =~
- m/(all|primary|mandatory|optionnal|single|multiple)/i;
- if ($r_attributes) {
- for my $a (@{$r_attributes}) {
+ croak "Invalid attribute's type ($type)" unless $type =~ m/(all|primary|mandatory|optionnal|single|multiple)/i;
+ if ($ra_attributes) {
+ for my $a ( @{$ra_attributes} ) {
$self->{TYPE}{$type}{$a} = 1;
}
}
@@ -211,7 +262,7 @@ This method return the RIPE class associated to the current object.
sub class {
my ( $self, $value ) = @_;
- return $self->_single_attribute_setget('class',$value);
+ return $self->_single_attribute_setget( 'class', $value );
}
=head2 B<attribute_is ( $attribute, $type )>
@@ -223,12 +274,12 @@ This method return true if $attribute is of type $type.
sub attribute_is {
my ( $self, $attribute, $type ) = @_;
- return defined $self->{TYPE}{$type}{$attribute}?1:0;
+ return defined $self->{TYPE}{$type}{$attribute} ? 1 : 0;
# for my $att ( $self->attributes( $type )) {
# if ($att eq $attribute) { return 1; }
# }
- # return 0 ;
+ # return 0 ;
}
=head2 B<hidden_attributes( $attribute )>
@@ -267,23 +318,26 @@ Try to be as close as possible as the submited text.
=cut
sub dump {
- my ( $self ) = @_;
+ my ($self) = @_;
my %current_index;
my $result;
- for my $line (@{ $self->{order} }) {
+ for my $line ( @{ $self->{order} } ) {
my $attribute = $line;
$attribute =~ s/_/-/g;
my $val = $self->$line();
- if (ref $val eq 'ARRAY') {
+ if ( ref $val eq 'ARRAY' ) {
+
# If multi value get the lines in order
- $val = $val->[$current_index{$line}++];
+ $val = $val->[ $current_index{$line}++ ];
}
- $output = "$attribute: $val\n";
+ $val = '' unless $val;
+
+ my $output = "$attribute: $val\n";
# Process the comment
$output =~ s/comment:\s+/\% /;
@@ -294,23 +348,81 @@ sub dump {
return $result;
}
-=head2 B<web_update( $password )>
+=head2 B<syncupdates_update( $password )>
-Update the RIPE database through the web update interface.
+Update the RIPE database through the web syncupdates interface.
Use the password passed as parameter to authenticate.
=cut
-sub web_update {
+sub syncupdates_update {
my ( $self, $password ) = @_;
- my $mech = WWW::Mechanize->new();
- $mech->get(https://apps.db.ripe.net/webupdates/search.html);
+ my ($key) = $self->attributes('primary');
+ my $value = $self->_single_attribute_setget($key);
+ my $html = $self->_syncupdates_submit( $self->dump(), $password );
+
+ if ( $html =~ /Modify SUCCEEDED:.*$value/m ) {
+ return $value;
+ }
+ else {
+ croak "Update not confirmed ($html)";
+ }
+}
+=head2 B<syncupdates_delete( $password, [$reason] )>
- push @{ $self->{web_update} }, $web_update if defined $web_update;
- return @{ $self->{web_update} };
+Delete the object in the RIPE database through the web syncupdates interface.
+Use the password passed as parameter to authenticate.
+The optionnal parmeter reason is used to explain why the object is deleted.
+
+=cut
+
+sub syncupdates_delete {
+ my ( $self, $password, $reason ) = @_;
+
+ 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";
+
+ my $html = $self->_syncupdates_submit( $text, $password );
+
+ if ( $html =~ /Delete SUCCEEDED:.*$value/m ) {
+ return $value;
+ }
+ else {
+ croak "Deletion not confirmed ($html)";
+ }
+}
+
+=head2 B<syncupdates_create( $password )>
+
+Create an object in the the RIPE database through the web syncupdates interface.
+Use the password passed as parameter to authenticate.
+
+Return the primary key of the object created.
+
+=cut
+
+sub syncupdates_create {
+ my ( $self, $password ) = @_;
+
+ my ($key) = $self->attributes('primary');
+
+ my $html = $self->_syncupdates_submit( $self->dump(), $password );
+
+ if ( $html =~ /\*\*\*Info:\s+Authorisation for\s+\[.+\]\s+(\S+)\s*$/m ) {
+ my $value = $1;
+ $self->_single_attribute_setget( $key, $value );
+ return $value;
+ }
+ else {
+ croak "No object KEY found ($html)";
+ }
}
=begin UNDOCUMENTED
@@ -356,19 +468,20 @@ sub _object_factory {
rtr_set => 'RtrSet',
);
- die "Unrecognized Object ($type first attribute)" unless $class{$type};
+ die "Unrecognized Object (first attribute: $type = $value)" unless $class{$type};
my $class = "Net::Whois::Object::" . $class{$type};
eval "require $class" or die "Can't require $class ($!)";
# my $object = $class->new( $type => $value );
- my $object = $class->new(class => $class{$type} );
-
+ my $object = $class->new( class => $class{$type} );
+
# 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 );
}
@@ -386,11 +499,12 @@ Generic setter/getter for singlevalue attribute.
sub _single_attribute_setget {
my ( $self, $attribute, $value ) = @_;
- if (defined $value) {
- # Store attribute order for dump, unless this attribute as already
- # been set
- push @{ $self->{order} }, $attribute unless $self->{$attribute};
-
+ 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';
+
$self->{$attribute} = $value;
}
return $self->{$attribute};
@@ -407,16 +521,68 @@ Generic setter/getter for multivalue attribute.
sub _multiple_attribute_setget {
my ( $self, $attribute, $value ) = @_;
- if (defined $value) {
- # Store attribute order for dump, unless this attribute as already
- # been set
- push @{ $self->{order} }, $attribute; # unless $update;
-
+ if ( defined $value ) {
+
+ # Store attribute order for dump
+ push @{ $self->{order} }, $attribute;
+
push @{ $self->{$attribute} }, $value;
}
+
+ croak "$attribute $self" unless ref $self;
return $self->{$attribute};
}
+=head2 B<_syncupdates_submit( $text, $password )>
+
+Interact with the RIPE database through the web syncupdates interface.
+Submit the text passed as parameter.
+Use the password passed as parameter to authenticate.
+The database used is chosen based on the 'source' attribute.
+
+Return the HTML code of the returned page.
+(This will change in a near future)
+
+
+=cut
+
+sub _syncupdates_submit {
+ my ( $self, $text, $password ) = @_;
+
+ $text .= "password: $password\n" if $password;
+
+ my $mech = WWW::Mechanize->new();
+
+ $mech->get('https://apps.db.ripe.net/syncupdates/simple-rpsl.html');
+
+ my $form = $mech->form_number(2);
+
+ if ( $self->source() eq 'RIPE' ) {
+
+ # TODO bogus value during tests to prevent "leaks"
+ $mech->set_fields( 'rpslBox:postRpsl:sourceRadioSelect' => 'AARIPE_NCC' );
+ }
+ else {
+ $mech->set_fields( 'rpslBox:postRpsl:sourceRadioSelect' => 'TEST' );
+ }
+
+ $mech->set_fields( 'rpslBox:postRpsl:sourceRadioSelect' => 'TEST' );
+ $mech->set_fields( 'rpslBox:postRpsl:rpslObject' => "$text\n" );
+
+ my $r = $mech->click_button( value => 'Update' );
+
+ croak "Can't submit to syncupdates : " . $mech->response()->status_linel unless $mech->success;
+
+ my $page = $mech->response()->content;
+
+ if ( $page !~ /Number of objects processed successfully: 1/s ) {
+
+ # carp "Syncupdate failed :\n$page\n";
+ }
+
+ return $page;
+}
+
=head1 TODO
The update part (RIPE database) is still missing, but I'm planning to offer a way
View
32 lib/Net/Whois/Object/AsBlock.pm
@@ -48,11 +48,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['as_block']);
- $self->attributes('mandatory',['as_block', 'admin_c', 'tech_c', 'mnt_by', 'changed', 'source']);
- $self->attributes('optionnal',['descr', 'remarks', 'org', 'notify', 'mnt_lower']);
- $self->attributes('single',['as_block', 'source']);
- $self->attributes('multiple',['descr', 'remarks', 'org', 'admin_c', 'tech_c', 'notify', 'mnt_lower', 'mnt_by', 'changed']);
+ $self->attributes( 'primary', ['as_block'] );
+ $self->attributes( 'mandatory', [ 'as_block', 'admin_c', 'tech_c', 'mnt_by', 'changed', 'source' ] );
+ $self->attributes( 'optionnal', [ 'descr', 'remarks', 'org', 'notify', 'mnt_lower' ] );
+ $self->attributes( 'single', [ 'as_block', 'source' ] );
+ $self->attributes( 'multiple', [ 'descr', 'remarks', 'org', 'admin_c', 'tech_c', 'notify', 'mnt_lower', 'mnt_by', 'changed' ] );
return $self;
}
@@ -75,7 +75,7 @@ stored in the appropriate Internet Registry's Whois Database.
sub as_block {
my ( $self, $as_block ) = @_;
- return $self->_single_attribute_setget('as_block',$as_block);
+ return $self->_single_attribute_setget( 'as_block', $as_block );
}
=head2 B<descr( [$descr] )>
@@ -91,7 +91,7 @@ in the as-block.
sub descr {
my ( $self, $descr ) = @_;
- return $self->_multiple_attribute_setget('descr',$descr);
+ return $self->_multiple_attribute_setget( 'descr', $descr );
}
=head2 B<remarks( [$remarks] )>
@@ -111,7 +111,7 @@ the AS numbers.
sub remarks {
my ( $self, $remarks ) = @_;
- return $self->_multiple_attribute_setget('remarks',$remarks);
+ return $self->_multiple_attribute_setget( 'remarks', $remarks );
}
=head2 B<tech_c( [$tech_c] )>
@@ -134,7 +134,7 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $tech_c ) = @_;
- return $self->_multiple_attribute_setget('tech_c',$tech_c);
+ return $self->_multiple_attribute_setget( 'tech_c', $tech_c );
}
=head2 B<admin_c( [$admin_c])>
@@ -154,7 +154,7 @@ located at the site of the network.
sub admin_c {
my ( $self, $admin_c ) = @_;
- return $self->_multiple_attribute_setget('admin_c',$admin_c);
+ return $self->_multiple_attribute_setget( 'admin_c', $admin_c );
}
=head2 B<notify( [$notify] )>
@@ -171,7 +171,7 @@ to the object should be sent.
sub notify {
my ( $self, $notify ) = @_;
- return $self->_multiple_attribute_setget('notify',$notify);
+ return $self->_multiple_attribute_setget( 'notify', $notify );
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -191,7 +191,7 @@ authorization.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
+ return $self->_multiple_attribute_setget( 'mnt_lower', $mnt_lower );
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -212,7 +212,7 @@ object will be able to change details.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
+ return $self->_multiple_attribute_setget( 'mnt_by', $mnt_by );
}
=head2 B<changed( [$changed] )>
@@ -235,7 +235,7 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- return $self->_multiple_attribute_setget('changed',$changed);
+ return $self->_multiple_attribute_setget( 'changed', $changed );
}
=head2 B<source( [$source] )>
@@ -250,7 +250,7 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- return $self->_single_attribute_setget('source',$source);
+ return $self->_single_attribute_setget( 'source', $source );
}
=head2 B<org( [$org] )>
@@ -265,7 +265,7 @@ The organisation entity this object is bound to.
sub org {
my ( $self, $org ) = @_;
- return $self->_single_attribute_setget('org',$org);
+ return $self->_single_attribute_setget( 'org', $org );
}
1;
View
32 lib/Net/Whois/Object/AsSet.pm
@@ -43,11 +43,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['as_set']);
- $self->attributes('mandatory',['as_set', 'descr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source']);
- $self->attributes('optionnal',['members', 'mbrs_by_ref', 'remarks', 'notify']);
- $self->attributes('single',['as_set', 'source']);
- $self->attributes('multiple',['descr', 'members', 'mbrs_by_ref', 'remarks', 'tech_c', 'admin_c', 'notify', 'mnt_by', 'changed']);
+ $self->attributes( 'primary', ['as_set'] );
+ $self->attributes( 'mandatory', [ 'as_set', 'descr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source' ] );
+ $self->attributes( 'optionnal', [ 'members', 'mbrs_by_ref', 'remarks', 'notify' ] );
+ $self->attributes( 'single', [ 'as_set', 'source' ] );
+ $self->attributes( 'multiple', [ 'descr', 'members', 'mbrs_by_ref', 'remarks', 'tech_c', 'admin_c', 'notify', 'mnt_by', 'changed' ] );
return $self;
}
@@ -68,7 +68,7 @@ with 'as-'.
sub as_set {
my ( $self, $as_set ) = @_;
- return $self->_single_attribute_setget('as_set',$as_set);
+ return $self->_single_attribute_setget( 'as_set', $as_set );
}
=head2 B<descr( [$descr] )>
@@ -84,7 +84,7 @@ A short description related to the object's purpose.
sub descr {
my ( $self, $descr ) = @_;
- return $self->_multiple_attribute_setget('descr',$descr);
+ return $self->_multiple_attribute_setget( 'descr', $descr );
}
=head2 B<members( [$member] )>
@@ -101,7 +101,7 @@ of AS Numbers, or other as-set names.
sub members {
my ( $self, $member ) = @_;
- return $self->_multiple_attribute_setget('member',$member);
+ return $self->_multiple_attribute_setget( 'member', $member );
}
=head2 B<mbrs_by_ref( [$mbr] )>
@@ -127,7 +127,7 @@ defined explicitly by the members attribute.
sub mbrs_by_ref {
my ( $self, $mbr ) = @_;
- return $self->_multiple_attribute_setget('mbr',$mbr);
+ return $self->_multiple_attribute_setget( 'mbr', $mbr );
}
=head2 B<remarks( [$remark] )>
@@ -144,7 +144,7 @@ May include a URL or email address.
sub remarks {
my ( $self, $remark ) = @_;
- return $self->_multiple_attribute_setget('remarks',$remark);
+ return $self->_multiple_attribute_setget( 'remarks', $remark );
}
=head2 B<tech_c( [$tech_c] )>
@@ -166,7 +166,7 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $tech_c ) = @_;
- return $self->_multiple_attribute_setget('tech_c',$tech_c);
+ return $self->_multiple_attribute_setget( 'tech_c', $tech_c );
}
=head2 B<admin_c( [$admin_c] )>
@@ -186,7 +186,7 @@ located at the site of the network.
sub admin_c {
my ( $self, $admin_c ) = @_;
- return $self->_multiple_attribute_setget('admin_c',$admin_c);
+ return $self->_multiple_attribute_setget( 'admin_c', $admin_c );
}
=head2 B<notify( [$notify] )>
@@ -203,7 +203,7 @@ sent.
sub notify {
my ( $self, $notify ) = @_;
- return $self->_multiple_attribute_setget('notify',$notify);
+ return $self->_multiple_attribute_setget( 'notify', $notify );
}
=head2 B<mnt_by( [$mnt] )>
@@ -224,7 +224,7 @@ object will be able to change details.
sub mnt_by {
my ( $self, $mnt ) = @_;
- return $self->_multiple_attribute_setget('mnt',$mnt);
+ return $self->_multiple_attribute_setget( 'mnt', $mnt );
}
=head2 B<changed( [$changed] )>
@@ -247,7 +247,7 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- return $self->_multiple_attribute_setget('changed',$changed);
+ return $self->_multiple_attribute_setget( 'changed', $changed );
}
=head2 B<source( [$source] )>
@@ -262,7 +262,7 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- return $self->_single_attribute_setget('source',$source);
+ return $self->_single_attribute_setget( 'source', $source );
}
1;
View
50 lib/Net/Whois/Object/AutNum.pm
@@ -25,7 +25,6 @@ use base qw/Net::Whois::Object/;
# changed: [mandatory] [multiple] [ ]
# source: [mandatory] [single] [ ]
-
=head1 NAME
Net::Whois::Object::AutNum - an object representation of a RPSL AutNum block
@@ -56,12 +55,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['aut_num']);
- $self->attributes('mandatory',['aut_num', 'as_name', 'descr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source']);
+ $self->attributes( 'primary', ['aut_num'] );
+ $self->attributes( 'mandatory', [ 'aut_num', 'as_name', 'descr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source' ] );
$self->attributes( 'optionnal', [ 'member_of', 'import', 'mp_import', 'export', 'mp_export', 'default', 'mp_default', 'remarks', 'notify', 'mnt_lower', 'mnt_routes' ] );
- $self->attributes('single',['aut_num', 'as_name', 'source']);
- $self->attributes('multiple',['descr', 'member_of', 'import', 'mp_import', 'export', 'mp_export', 'default', 'mp_default', 'remarks',
- 'admin_c', 'tech_c', 'notify', 'mnt_lower', 'mnt_routes', 'mnt_by', 'changed']);
+ $self->attributes( 'single', [ 'aut_num', 'as_name', 'source' ] );
+ $self->attributes( 'multiple', [ 'descr', 'member_of', 'import', 'mp_import', 'export', 'mp_export', 'default', 'mp_default', 'remarks', 'admin_c', 'tech_c', 'notify', 'mnt_lower', 'mnt_routes', 'mnt_by', 'changed' ] );
return $self;
}
@@ -87,7 +85,7 @@ sub aut_num {
warn "Illegal aut-num ($aut_num) : should be ASn, n being a 32 bit number with no leading 0";
}
- return $self->_single_attribute_setget('aut_num',$aut_num);
+ return $self->_single_attribute_setget( 'aut_num', $aut_num );
}
=head2 B<as_name( [$as_name] )>
@@ -102,7 +100,7 @@ The as-name attribute is a symbolic name of the AS.
sub as_name {
my ( $self, $as_name ) = @_;
- return $self->_single_attribute_setget('as_name',$as_name);
+ return $self->_single_attribute_setget( 'as_name', $as_name );
}
=head2 B<descr( [$descr] )>
@@ -115,7 +113,7 @@ Accepts an optional descr value to be added to the descr array, always return th
sub descr {
my ( $self, $descr ) = @_;
- return $self->_multiple_attribute_setget('descr',$descr);
+ return $self->_multiple_attribute_setget( 'descr', $descr );
}
=head2 B<member_of( [$mbr_of] )>
@@ -141,7 +139,7 @@ and/or list the AS number in the members attribute
sub member_of {
my ( $self, $member_of ) = @_;
- return $self->_multiple_attribute_setget('member_of',$member_of);
+ return $self->_multiple_attribute_setget( 'member_of', $member_of );
}
=head2 B<import( [$import] )>
@@ -157,7 +155,7 @@ The inbound IPv4 routing policy of the AS.
sub import {
my ( $self, $import ) = @_;
- return $self->_multiple_attribute_setget('import',$import);
+ return $self->_multiple_attribute_setget( 'import', $import );
}
=head2 B<mp_import( [$import] )>
@@ -173,7 +171,7 @@ The inbound IPv6 routing policy of the AS.
sub mp_import {
my ( $self, $mp_import ) = @_;
- return $self->_multiple_attribute_setget('mp_import',$mp_import);
+ return $self->_multiple_attribute_setget( 'mp_import', $mp_import );
}
=head2 B<export( [$export] )>
@@ -189,7 +187,7 @@ The outbound routing policy of the AS.
sub export {
my ( $self, $export ) = @_;
- return $self->_multiple_attribute_setget('export',$export);
+ return $self->_multiple_attribute_setget( 'export', $export );
}
=head2 B<mp_export( [$mp_export] )>
@@ -205,7 +203,7 @@ The outbound IPv6 routing policy of the AS.
sub mp_export {
my ( $self, $mp_export ) = @_;
- return $self->_multiple_attribute_setget('mp_export',$mp_export);
+ return $self->_multiple_attribute_setget( 'mp_export', $mp_export );
}
=head2 B<default( [$default] )>
@@ -222,7 +220,7 @@ more-specific information on where to send the traffic.
sub default {
my ( $self, $default ) = @_;
- return $self->_multiple_attribute_setget('default',$default);
+ return $self->_multiple_attribute_setget( 'default', $default );
}
=head2 B<mp_default( [$mp_default] )>
@@ -240,7 +238,7 @@ specified.
sub mp_default {
my ( $self, $mp_default ) = @_;
- return $self->_multiple_attribute_setget('mp_default',$mp_default);
+ return $self->_multiple_attribute_setget( 'mp_default', $mp_default );
}
=head2 B<remarks( [$remark] )>
@@ -257,7 +255,7 @@ include a URL or email address.
sub remarks {
my ( $self, $remark ) = @_;
- return $self->_multiple_attribute_setget('remark',$remark);
+ return $self->_multiple_attribute_setget( 'remark', $remark );
}
=head2 B<admin_c( [$contact] )>
@@ -277,7 +275,7 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('admin_c',$contact);
+ return $self->_multiple_attribute_setget( 'admin_c', $contact );
}
=head2 B<tech_c( [$contact] )>
@@ -299,7 +297,7 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('tech_c',$contact);
+ return $self->_multiple_attribute_setget( 'tech_c', $contact );
}
=head2 B<notify( [$notify] )>
@@ -313,7 +311,7 @@ always return the current notify array.
sub notify {
my ( $self, $notify ) = @_;
- return $self->_multiple_attribute_setget('notify',$notify);
+ return $self->_multiple_attribute_setget( 'notify', $notify );
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -327,7 +325,7 @@ always return the current mnt_lower array.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
+ return $self->_multiple_attribute_setget( 'mnt_lower', $mnt_lower );
}
=head2 B<mnt_routes( [$mnt_routes] )>
@@ -341,7 +339,7 @@ always return the current mnt_routes array.
sub mnt_routes {
my ( $self, $mnt_routes ) = @_;
- return $self->_multiple_attribute_setget('mnt_route',$mnt_route);
+ return $self->_multiple_attribute_setget( 'mnt_route', $mnt_route );
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -355,7 +353,7 @@ always return the current mnt_by array.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
+ return $self->_multiple_attribute_setget( 'mnt_by', $mnt_by );
}
=head2 B<changed( [$changed] )>
@@ -369,7 +367,7 @@ always return the current changed array.
sub changed {
my ( $self, $changed ) = @_;
- return $self->_multiple_attribute_setget('changed',$changed);
+ return $self->_multiple_attribute_setget( 'changed', $changed );
}
=head2 B<source( [$source] )>
@@ -384,7 +382,7 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- return $self->_single_attribute_setget('source',$source);
+ return $self->_single_attribute_setget( 'source', $source );
}
=head2 B<org( [$org] )>
@@ -400,7 +398,7 @@ This is to ensure only one organisation is responsible for this resource.
sub org {
my ( $self, $org ) = @_;
- return $self->_single_attribute_setget('org',$org);
+ return $self->_single_attribute_setget( 'org', $org );
}
1;
View
43 lib/Net/Whois/Object/Domain.pm
@@ -50,12 +50,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['domain']);
- $self->attributes('mandatory',['domain', 'descr', 'tech_c', 'admin_c', 'zone_c', 'changed', 'source']);
+ $self->attributes( 'primary', ['domain'] );
+ $self->attributes( 'mandatory', [ 'domain', 'descr', 'tech_c', 'admin_c', 'zone_c', 'changed', 'source' ] );
$self->attributes( 'optionnal', [ 'org', 'nserver', 'ds_rdata', 'sub_dom', 'dom_net', 'remarks', 'notify', 'mnt_by', 'mnt_lower', 'refer' ] );
- $self->attributes('single',['domain', 'refer', 'source']);
- $self->attributes('multiple',['descr', 'org', 'admin_c', 'tech_c', 'zone_c', 'nserver', 'ds_rdata', 'sub_dom', 'dom_net', 'remarks',
- 'notify', 'mnt_by', 'mnt_lower', 'changed']);
+ $self->attributes( 'single', [ 'domain', 'refer', 'source' ] );
+ $self->attributes( 'multiple', [ 'descr', 'org', 'admin_c', 'tech_c', 'zone_c', 'nserver', 'ds_rdata', 'sub_dom', 'dom_net', 'remarks', 'notify', 'mnt_by', 'mnt_lower', 'changed' ] );
return $self;
}
@@ -76,7 +75,7 @@ sub domain {
# Enforce the format
$domain =~ s/\.$// if $domain;
- return $self->_single_attribute_setget('domain',$domain);
+ return $self->_single_attribute_setget( 'domain', $domain );
}
=head2 B<descr( [$descr] )>
@@ -93,7 +92,7 @@ describe the use of the IP range described in the domain object.
sub descr {
my ( $self, $descr ) = @_;
- return $self->_multiple_attribute_setget('descr',$descr);
+ return $self->_multiple_attribute_setget( 'descr', $descr );
}
=head2 B<org( [$org] )>
@@ -109,7 +108,7 @@ The organisation responsible for this domain.
sub org {
my ( $self, $org ) = @_;
- return $self->_multiple_attribute_setget('org',$org);
+ return $self->_multiple_attribute_setget( 'org', $org );
}
=head2 B<admin_c( [$contact] )>
@@ -129,7 +128,7 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('admin_c',$contact);
+ return $self->_multiple_attribute_setget( 'admin_c', $contact );
}
=head2 B<tech_c( [$contact] )>
@@ -151,7 +150,7 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('tech_c',$contact);
+ return $self->_multiple_attribute_setget( 'tech_c', $contact );
}
=head2 B<zone_c( [$contact] )>
@@ -167,7 +166,7 @@ The NIC-handle of a 'person' or 'role' object with authority over a zone.
sub zone_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('zone_c',$contact);
+ return $self->_multiple_attribute_setget( 'zone_c', $contact );
}
=head2 B<nserver( [$server] )>
@@ -184,7 +183,7 @@ mandatory.
sub nserver {
my ( $self, $server ) = @_;
- return $self->_multiple_attribute_setget('nserver',$server);
+ return $self->_multiple_attribute_setget( 'nserver', $server );
}
=head2 B<ds_rdata( [$server] )>
@@ -201,7 +200,7 @@ for DNSSEC (short for DNS Security Extensions)
sub ds_rdata {
my ( $self, $server ) = @_;
- return $self->_multiple_attribute_setget('ds_data',$server);
+ return $self->_multiple_attribute_setget( 'ds_data', $server );
}
=head2 B<sub_dom( [$dom] )>
@@ -219,7 +218,7 @@ contains this attribute
sub sub_dom {
my ( $self, $dom ) = @_;
- return $self->_multiple_attribute_setget('sub_dom',$dom);
+ return $self->_multiple_attribute_setget( 'sub_dom', $dom );
}
=head2 B<dom_net( [$dom_net] )>
@@ -235,7 +234,7 @@ The dom_net attribute contains a list of IP networks in a domain.
sub dom_net {
my ( $self, $dom_net ) = @_;
- return $self->_multiple_attribute_setget('dom_net',$dom_net);
+ return $self->_multiple_attribute_setget( 'dom_net', $dom_net );
}
=head2 B<remarks( [$remark] )>
@@ -251,7 +250,7 @@ General remarks. May include a URL or email address.
sub remarks {
my ( $self, $remark ) = @_;
- return $self->_multiple_attribute_setget('remarks',$remark);
+ return $self->_multiple_attribute_setget( 'remarks', $remark );
}
=head2 B<notify( [$notify] )>
@@ -268,7 +267,7 @@ sent.
sub notify {
my ( $self, $notify ) = @_;
- return $self->_multiple_attribute_setget('notify',$notify);
+ return $self->_multiple_attribute_setget( 'notify', $notify );
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -285,7 +284,7 @@ this object.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
+ return $self->_multiple_attribute_setget( 'mnt_by', $mnt_by );
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -303,7 +302,7 @@ object.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
+ return $self->_multiple_attribute_setget( 'mnt_lower', $mnt_lower );
}
=head2 B<refer( [$refer] )>
@@ -321,7 +320,7 @@ removed and may be deprecated.
sub refer {
my ( $self, $refer ) = @_;
- return $self->_single_attribute_setget('refer',$refer);
+ return $self->_single_attribute_setget( 'refer', $refer );
}
=head2 B<changed( [$changed] )>
@@ -344,7 +343,7 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- return $self->_multiple_attribute_setget('changed',$changed);
+ return $self->_multiple_attribute_setget( 'changed', $changed );
}
=head2 B<source( [$source] )>
@@ -359,7 +358,7 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- return $self->_single_attribute_setget('source',$source);
+ return $self->_single_attribute_setget( 'source', $source );
}
1;
View
38 lib/Net/Whois/Object/FilterSet.pm
@@ -46,11 +46,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['filter_set']);
- $self->attributes('mandatory',['filter_set', 'filter', 'mp_filter', 'source']);
- $self->attributes( 'optionnal', [ 'remarks', 'org', 'notify', 'mnt_lower'] );
- $self->attributes('single',['filter_set', 'filter', 'mp_filter', 'source']);
- $self->attributes('multiple',['descr', 'remarks', 'org', 'tech_c', 'admin_c', 'notify', 'mnt_by', 'mnt_lower', 'changed']);
+ $self->attributes( 'primary', ['filter_set'] );
+ $self->attributes( 'mandatory', [ 'filter_set', 'filter', 'mp_filter', 'source' ] );
+ $self->attributes( 'optionnal', [ 'remarks', 'org', 'notify', 'mnt_lower' ] );
+ $self->attributes( 'single', [ 'filter_set', 'filter', 'mp_filter', 'source' ] );
+ $self->attributes( 'multiple', [ 'descr', 'remarks', 'org', 'tech_c', 'admin_c', 'notify', 'mnt_by', 'mnt_lower', 'changed' ] );
return $self;
}
@@ -74,11 +74,11 @@ components of a hierarchical filter-name have to be filter_set names.
sub filter_set {
my ( $self, $filter_set ) = @_;
- if ($filter_set and $filter_set !~/^fltr-/i) {
+ if ( $filter_set and $filter_set !~ /^fltr-/i ) {
warn "Incorrect FilterSet's name ($filter_set) : Should start with 'FLTR-'";
}
- return $self->_single_attribute_setget('filter_set',$filter_set);
+ return $self->_single_attribute_setget( 'filter_set', $filter_set );
}
=head2 B<descr( [$descr] )>
@@ -94,7 +94,7 @@ A short description related to the object's purpose.
sub descr {
my ( $self, $descr ) = @_;
- return $self->_multiple_attribute_setget('descr',$descr);
+ return $self->_multiple_attribute_setget( 'descr', $descr );
}
=head2 B<filter( [$filter] )>
@@ -113,7 +113,7 @@ you have said you want to see.
sub filter {
my ( $self, $filter ) = @_;
- return $self->_single_attribute_setget('filter',$filter);
+ return $self->_single_attribute_setget( 'filter', $filter );
}
=head2 B<mp_filter( [$mp_filter] )>
@@ -129,7 +129,7 @@ a subset of these routes.
sub mp_filter {
my ( $self, $mp_filter ) = @_;
- return $self->_single_attribute_setget('mp_filter',$mp_filter);
+ return $self->_single_attribute_setget( 'mp_filter', $mp_filter );
}
=head2 B<remarks( [$remark] )>
@@ -145,7 +145,7 @@ General remarks. May include a URL or email address.
sub remarks {
my ( $self, $remark ) = @_;
- return $self->_multiple_attribute_setget('remarks',$remark);
+ return $self->_multiple_attribute_setget( 'remarks', $remark );
}
=head2 B<tech_c( [$contact] )>
@@ -167,7 +167,7 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('tech_c',$contact);
+ return $self->_multiple_attribute_setget( 'tech_c', $contact );
}
=head2 B<admin_c( [$contact] )>
@@ -187,7 +187,7 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('admin_c',$contact);
+ return $self->_multiple_attribute_setget( 'admin_c', $contact );
}
=head2 B<org( [$org] )>
@@ -203,7 +203,7 @@ The organisation responsible for this FilterSet object.
sub org {
my ( $self, $org ) = @_;
- return $self->_multiple_attribute_setget('org',$org);
+ return $self->_multiple_attribute_setget( 'org', $org );
}
=head2 B<notify( [$notify] )>
@@ -226,7 +226,7 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub notify {
my ( $self, $notify ) = @_;
- return $self->_multiple_attribute_setget('notify',$notify);
+ return $self->_multiple_attribute_setget( 'notify', $notify );
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -247,7 +247,7 @@ object will be able to change details.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
+ return $self->_multiple_attribute_setget( 'mnt_by', $mnt_by );
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -264,7 +264,7 @@ used as well as mnt_by.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
+ return $self->_multiple_attribute_setget( 'mnt_lower', $mnt_lower );
}
=head2 B<changed( [$changed] )>
@@ -287,7 +287,7 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- return $self->_multiple_attribute_setget('changed',$changed);
+ return $self->_multiple_attribute_setget( 'changed', $changed );
}
=head2 B<source( [$source] )>
@@ -302,7 +302,7 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- return $self->_single_attribute_setget('source',$source);
+ return $self->_single_attribute_setget( 'source', $source );
}
1;
View
43 lib/Net/Whois/Object/Inet6Num.pm
@@ -53,12 +53,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['inet6num']);
- $self->attributes('mandatory',['inet6num', 'netname', 'org', 'status', 'source']);
+ $self->attributes( 'primary', ['inet6num'] );
+ $self->attributes( 'mandatory', [ 'inet6num', 'netname', 'status', 'source' ] );
$self->attributes( 'optionnal', [ 'org', 'remarks', 'notify', 'mnt_lower', 'mnt_routes', 'mnt_domains', 'mnt_irt' ] );
- $self->attributes('single',['inet6num', 'netname', 'org', 'status', 'source']);
- $self->attributes('multiple',['descr', 'country', 'tech_c', 'admin_c',
- 'remarks', 'notify', 'mnt_by', 'mnt_lower', 'mnt_routes', 'mnt_domains', 'mnt_irt', 'changed']);
+ $self->attributes( 'single', [ 'inet6num', 'netname', 'org', 'status', 'source' ] );
+ $self->attributes( 'multiple', [ 'descr', 'country', 'tech_c', 'admin_c', 'remarks', 'notify', 'mnt_by', 'mnt_lower', 'mnt_routes', 'mnt_domains', 'mnt_irt', 'changed' ] );
return $self;
}
@@ -78,7 +77,7 @@ Addresses can only be expressed in prefix notation
sub inet6num {
my ( $self, $inet6num ) = @_;
- return $self->_single_attribute_setget('inet6num',$inet6num);
+ return $self->_single_attribute_setget( 'inet6num', $inet6num );
}
=head2 B<netname( [$netname] )>
@@ -95,7 +94,7 @@ used for a common purpose.
sub netname {
my ( $self, $netname ) = @_;
- return $self->_single_attribute_setget('netname',$netname);
+ return $self->_single_attribute_setget( 'netname', $netname );
}
=head2 B<descr( [$descr] )>
@@ -112,7 +111,7 @@ in the inet6num.
sub descr {
my ( $self, $descr ) = @_;
- return $self->_multiple_attribute_setget('descr',$descr);
+ return $self->_multiple_attribute_setget( 'descr', $descr );
}
=head2 B<country( [$country] )>
@@ -132,7 +131,7 @@ map IP addresses to countries.
sub country {
my ( $self, $country ) = @_;
- return $self->_multiple_attribute_setget('country',$country);
+ return $self->_multiple_attribute_setget( 'country', $country );
}
=head2 B<org( [$org] )>
@@ -149,7 +148,7 @@ resource.
sub org {
my ( $self, $org ) = @_;
- return $self->_single_attribute_setget('org',$org);
+ return $self->_single_attribute_setget( 'org', $org );
}
=head2 B<admin_c( [$contact] )>
@@ -169,7 +168,7 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('admin_c',$contact);
+ return $self->_multiple_attribute_setget( 'admin_c', $contact );
}
=head2 B<tech_c( [$contact] )>
@@ -190,7 +189,7 @@ day-to-day operation of the network, but does not need to be
sub tech_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('tech_c',$contact);
+ return $self->_multiple_attribute_setget( 'tech_c', $contact );
}
=head2 B<status( [$status] )>
@@ -222,7 +221,7 @@ Status can have one of these values:
sub status {
my ( $self, $status ) = @_;
- return $self->_single_attribute_setget('status',$status);
+ return $self->_single_attribute_setget( 'status', $status );
}
=head2 B<remarks( [$remark] )>
@@ -239,7 +238,7 @@ complaints.
sub remarks {
my ( $self, $remark ) = @_;
- return $self->_multiple_attribute_setget('remarks',$remark);
+ return $self->_multiple_attribute_setget( 'remarks', $remark );
}
=head2 B<notify( [$notify] )>
@@ -256,7 +255,7 @@ sent.
sub notify {
my ( $self, $notify ) = @_;
- return $self->_multiple_attribute_setget('notify',$notify);
+ return $self->_multiple_attribute_setget( 'notify', $notify );
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -270,7 +269,7 @@ always return the current mnt_by array.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
+ return $self->_multiple_attribute_setget( 'mnt_by', $mnt_by );
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -287,7 +286,7 @@ used as well as 'mnt-by.'
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
+ return $self->_multiple_attribute_setget( 'mnt_lower', $mnt_lower );
}
=head2 B<mnt_routes( [$mnt_route] )>
@@ -305,7 +304,7 @@ object.
sub mnt_routes {
my ( $self, $mnt_route ) = @_;
- return $self->_multiple_attribute_setget('mnt_routes',$mnt_route);
+ return $self->_multiple_attribute_setget( 'mnt_routes', $mnt_route );
}
=head2 B<mnt_domains( [$mnt_route] )>
@@ -323,7 +322,7 @@ object.
sub mnt_domains {
my ( $self, $mnt_route ) = @_;
- return $self->_multiple_attribute_setget('mnt_domains',$mnt_route);
+ return $self->_multiple_attribute_setget( 'mnt_domains', $mnt_route );
}
=head2 B<mnt_irt( [$mnt_irt] )>
@@ -340,7 +339,7 @@ object to be able to add this reference.
sub mnt_irt {
my ( $self, $mnt_irt ) = @_;
- return $self->_multiple_attribute_setget('mnt_irt',$mnt_irt);
+ return $self->_multiple_attribute_setget( 'mnt_irt', $mnt_irt );
}
=head2 B<changed( [$changed] )>
@@ -363,7 +362,7 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- return $self->_multiple_attribute_setget('changed',$changed);
+ return $self->_multiple_attribute_setget( 'changed', $changed );
}
=head2 B<source( [$source] )>
@@ -378,7 +377,7 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- return $self->_single_attribute_setget('source',$source);
+ return $self->_single_attribute_setget( 'source', $source );
}
1;
View
44 lib/Net/Whois/Object/InetNum.pm
@@ -23,7 +23,6 @@ use base qw/Net::Whois::Object/;
# changed: [mandatory] [multiple] [ ]
# source: [mandatory] [single] [ ]
-
# From http://www.apnic.net/apnic-info/whois_search/using-whois/guide/inetnum?view=text-only
#
# mnt-irt: [mandatory] [multiple] [inverse key]
@@ -55,12 +54,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['inetnum']);
- $self->attributes('mandatory',['inetnum', 'netname', 'descr', 'country', 'tech_c', 'admin_c', 'status', 'mnt_by', 'changed', 'source']);
+ $self->attributes( 'primary', ['inetnum'] );
+ $self->attributes( 'mandatory', [ 'inetnum', 'netname', 'descr', 'country', 'tech_c', 'admin_c', 'status', 'mnt_by', 'changed', 'source' ] );
$self->attributes( 'optionnal', [ 'org', 'remarks', 'notify', 'mnt_lower', 'mnt_routes', 'mnt_domains', 'mnt_irt' ] );
- $self->attributes('single',['inetnum', 'netname', 'org', 'status', 'source']);
- $self->attributes('multiple',['descr', 'country', 'tech_c', 'admin_c',
- 'remarks', 'notify', 'mnt_by', 'mnt_lower', 'mnt_routes', 'mnt_domains', 'mnt_irt', 'changed']);
+ $self->attributes( 'single', [ 'inetnum', 'netname', 'org', 'status', 'source' ] );
+ $self->attributes( 'multiple', [ 'descr', 'country', 'tech_c', 'admin_c', 'remarks', 'notify', 'mnt_by', 'mnt_lower', 'mnt_routes', 'mnt_domains', 'mnt_irt', 'changed' ] );
return $self;
}
@@ -75,7 +73,7 @@ Accepts an optional inetnum value, always return the current inetnum value.
sub inetnum {
my ( $self, $inetnum ) = @_;
- return $self->_single_attribute_setget('inetnum',$inetnum);
+ return $self->_single_attribute_setget( 'inetnum', $inetnum );
}
=head2 B<netname( [$netname] )>
@@ -88,7 +86,7 @@ Accepts an optional netname, always return the current netname.
sub netname {
my ( $self, $netname ) = @_;
- return $self->_single_attribute_setget('netname',$netname);
+ return $self->_single_attribute_setget( 'netname', $netname );
}
=head2 B<descr( [$descr] )>
@@ -102,7 +100,7 @@ always return the current descr array.
sub descr {
my ( $self, $descr ) = @_;
- return $self->_multiple_attribute_setget('descr',$descr);
+ return $self->_multiple_attribute_setget( 'descr', $descr );
}
=head2 B<country( [$country] )>
@@ -116,7 +114,7 @@ always return the current country array.
sub country {
my ( $self, $country ) = @_;
- return $self->_multiple_attribute_setget('country',$country);
+ return $self->_multiple_attribute_setget( 'country', $country );
}
=head2 B<org( [$org] )>
@@ -132,7 +130,7 @@ This is to ensure only one organisation is responsible for this resource.
sub org {
my ( $self, $org ) = @_;
- return $self->_single_attribute_setget('org',$org);
+ return $self->_single_attribute_setget( 'org', $org );
}
=head2 B<admin_c( [$contact] )>
@@ -152,7 +150,7 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('admin_c',$contact);
+ return $self->_multiple_attribute_setget( 'admin_c', $contact );
}
=head2 B<tech_c( [$contact] )>
@@ -174,7 +172,7 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('tech_c',$contact);
+ return $self->_multiple_attribute_setget( 'tech_c', $contact );
}
=head2 B<status( [$status] )>
@@ -218,7 +216,7 @@ Status can have one of these values:
sub status {
my ( $self, $status ) = @_;
- return $self->_single_attribute_setget('status',$status);
+ return $self->_single_attribute_setget( 'status', $status );
}
=head2 B<remarks( [$remark] )>
@@ -235,7 +233,7 @@ complaints.
sub remarks {
my ( $self, $remark ) = @_;
- return $self->_multiple_attribute_setget('remarks',$remark);
+ return $self->_multiple_attribute_setget( 'remarks', $remark );
}
=head2 B<notify( [$notify] )>
@@ -252,7 +250,7 @@ sent.
sub notify {
my ( $self, $notify ) = @_;
- return $self->_multiple_attribute_setget('notify',$notify);
+ return $self->_multiple_attribute_setget( 'notify', $notify );
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -269,7 +267,7 @@ object.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
+ return $self->_multiple_attribute_setget( 'mnt_by', $mnt_by );
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -286,7 +284,7 @@ used as well as mnt_by.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
+ return $self->_multiple_attribute_setget( 'mnt_lower', $mnt_lower );
}
=head2 B<mnt_routes( [$mnt_route] )>
@@ -304,7 +302,7 @@ object.
sub mnt_routes {
my ( $self, $mnt_route ) = @_;
- return $self->_multiple_attribute_setget('mnt_route',$mnt_route);
+ return $self->_multiple_attribute_setget( 'mnt_route', $mnt_route );
}
=head2 B<mnt_domains( [$mnt_domain] )>
@@ -322,7 +320,7 @@ object.
sub mnt_domains {
my ( $self, $mnt_domain ) = @_;
- return $self->_multiple_attribute_setget('mnt_domain',$mnt_domain);
+ return $self->_multiple_attribute_setget( 'mnt_domain', $mnt_domain );
}
=head2 B<changed( [$changed] )>
@@ -345,7 +343,7 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- return $self->_multiple_attribute_setget('changed',$changed);
+ return $self->_multiple_attribute_setget( 'changed', $changed );
}
=head2 B<source( [$source] )>
@@ -360,7 +358,7 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- return $self->_single_attribute_setget('source',$source);
+ return $self->_single_attribute_setget( 'source', $source );
}
=head2 B<mnt_irt( [$mnt_irt] )>
@@ -377,7 +375,7 @@ about a Computer Security Incident Response Team (CSIRT).
sub mnt_irt {
my ( $self, $mnt_irt ) = @_;
- return $self->_multiple_attribute_setget('mnt_irt',$mnt_irt);
+ return $self->_multiple_attribute_setget( 'mnt_irt', $mnt_irt );
}
1;
View
42 lib/Net/Whois/Object/InetRtr.pm
@@ -48,11 +48,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['inet_rtr']);
- $self->attributes('mandatory',['inet_rtr', 'descr', 'local_as', 'ifaddr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source']);
+ $self->attributes( 'primary', ['inet_rtr'] );
+ $self->attributes( 'mandatory', [ 'inet_rtr', 'descr', 'local_as', 'ifaddr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source' ] );
$self->attributes( 'optionnal', [ 'alias', 'interface', 'peer', 'mp_peer', 'member_of', 'remarks', 'org', 'notify' ] );
- $self->attributes('single',['inet_rtr', 'local_as', 'source']);
- $self->attributes('multiple',['descr', 'remarks', 'alias', 'ifaddr', 'interface', 'peer', 'mp_peer', 'member_of', 'org', 'tech_c', 'admin_c', 'notify', 'mnt_by', 'changed']);
+ $self->attributes( 'single', [ 'inet_rtr', 'local_as', 'source' ] );
+ $self->attributes( 'multiple', [ 'descr', 'remarks', 'alias', 'ifaddr', 'interface', 'peer', 'mp_peer', 'member_of', 'org', 'tech_c', 'admin_c', 'notify', 'mnt_by', 'changed' ] );
return $self;
}
@@ -70,7 +70,7 @@ dot.
sub inet_rtr {
my ( $self, $inet_rtr ) = @_;
- return $self->_single_attribute_setget('inet_rtr',$inet_rtr);
+ return $self->_single_attribute_setget( 'inet_rtr', $inet_rtr );
}
=head2 B<descr( [$descr] )>
@@ -86,7 +86,7 @@ A short description related to the object's purpose.
sub descr {
my ( $self, $descr ) = @_;
- return $self->_multiple_attribute_setget('descr',$descr);
+ return $self->_multiple_attribute_setget( 'descr', $descr );
}
=head2 B<alias( [$alias] )>
@@ -103,7 +103,7 @@ specified router.
sub alias {
my ( $self, $alias ) = @_;
- return $self->_multiple_attribute_setget('alias',$alias);
+ return $self->_multiple_attribute_setget( 'alias', $alias );
}
=head2 B<local_as( [$local_as] )>
@@ -119,7 +119,7 @@ operates this router.
sub local_as {
my ( $self, $local_as ) = @_;
- return $self->_single_attribute_setget('local_as',$local_as);
+ return $self->_single_attribute_setget( 'local_as', $local_as );
}
=head2 B<ifaddr( [$ifaddr] )>
@@ -137,7 +137,7 @@ interface.
sub ifaddr {
my ( $self, $ifaddr ) = @_;
- return $self->_multiple_attribute_setget('ifaddr',$ifaddr);
+ return $self->_multiple_attribute_setget( 'ifaddr', $ifaddr );
}
=head2 B<peer( [$peer] )>
@@ -154,7 +154,7 @@ peering.
sub peer {
my ( $self, $peer ) = @_;
- return $self->_multiple_attribute_setget('peer',$peer);
+ return $self->_multiple_attribute_setget( 'peer', $peer );
}
=head2 B<member_of( [$member_of] )>
@@ -172,7 +172,7 @@ respective mbrs-by-ref attribute in the referenced object.
sub member_of {
my ( $self, $member_of ) = @_;
- return $self->_multiple_attribute_setget('member_of',$member_of);
+ return $self->_multiple_attribute_setget( 'member_of', $member_of );
}
=head2 B<remarks( [$remark] )>
@@ -189,7 +189,7 @@ complaints.
sub remarks {
my ( $self, $remark ) = @_;
- return $self->_multiple_attribute_setget('remarks',$remark);
+ return $self->_multiple_attribute_setget( 'remarks', $remark );
}
=head2 B<admin_c( [$contact] )>
@@ -209,7 +209,7 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('admin_c',$contact);
+ return $self->_multiple_attribute_setget( 'admin_c', $contact );
}
=head2 B<tech_c( [$contact] )>
@@ -231,7 +231,7 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- return $self->_multiple_attribute_setget('tech_c',$contact);
+ return $self->_multiple_attribute_setget( 'tech_c', $contact );
}
=head2 B<notify( [$notify] )>
@@ -248,7 +248,7 @@ be sent.
sub notify {
my ( $self, $notify ) = @_;
- return $self->_multiple_attribute_setget('notify',$notify);
+ return $self->_multiple_attribute_setget( 'notify', $notify );
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -265,7 +265,7 @@ object.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
+ return $self->_multiple_attribute_setget( 'mnt_by', $mnt_by );
}
=head2 B<changed( [$changed] )>
@@ -288,7 +288,7 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- return $self->_multiple_attribute_setget('changed',$changed);
+ return $self->_multiple_attribute_setget( 'changed', $changed );
}
=head2 B<source( [$source] )>
@@ -303,7 +303,7 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- return $self->_single_attribute_setget('source',$source);
+ return $self->_single_attribute_setget( 'source', $source );
}
=head2 B<mp_peer( [$peer] )>
@@ -323,7 +323,7 @@ The mp-peer attribute extends the peer attribute for IPv6 addresses.
sub mp_peer {
my ( $self, $mp_peer ) = @_;
- return $self->_multiple_attribute_setget('mp_peer',$mp_peer);
+ return $self->_multiple_attribute_setget( 'mp_peer', $mp_peer );
}
=head2 B<interface( [$interface] )>
@@ -340,7 +340,7 @@ an Internet router, optional action and tunnel definition.
sub interface {
my ( $self, $interface ) = @_;
- return $self->_multiple_attribute_setget('interface',$interface);
+ return $self->_multiple_attribute_setget( 'interface', $interface );
}
=head2 B<org( [$org] )>
@@ -356,7 +356,7 @@ The organisation entity this object is bound to.
sub org {
my ( $self, $org ) = @_;
- return $self->_multiple_attribute_setget('org',$org);
+ return $self->_multiple_attribute_setget( 'org', $org );
}
1;
View
8 lib/Net/Whois/Object/Information.pm
@@ -36,9 +36,9 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('mandatory',['comment']);
- $self->attributes( 'optionnal', [ ] );
- $self->attributes('multiple',['comment']);
+ $self->attributes( 'mandatory', ['comment'] );
+ $self->attributes( 'optionnal', [] );
+ $self->attributes( 'multiple', ['comment'] );
return $self;
}
@@ -54,7 +54,7 @@ always return the current comment array.
sub comment {
my ( $self, $comment ) = @_;
- return $self->_multiple_attribute_setget('comment',$comment);
+ return $self->_multiple_attribute_setget( 'comment', $comment );
}
1;
View
47 lib/Net/Whois/Object/Irt.pm
@@ -54,12 +54,11 @@ sub new {
$self->$key( $options{$key} );
}
- $self->attributes('primary',['irt']);
- $self->attributes('mandatory',['irt', 'address', 'e_mail', 'abuse_mailbox', 'tech_c', 'admin_c', 'auth', 'mnt_by', 'changed', 'source']);
- $self->attributes( 'optionnal', [ 'phone', 'fax_no', 'signature', 'encryption', 'org', 'remarks', 'irt_nfy', 'notify' ] );
- $self->attributes('single',['irt', 'source']);
- $self->attributes('multiple',['address', 'phone', 'fax_no', 'e_mail',
- 'abuse_mailbox', 'signature', 'encryption', 'org', 'auth', 'remarks', 'tech_c', 'admin_c', 'irt_nfy', 'notify', 'mnt_by', 'changed']);
+ $self->attributes( 'primary', ['irt'] );
+ $self->attributes( 'mandatory', [ 'irt', 'address', 'e_mail', 'abuse_mailbox', 'tech_c', 'admin_c', 'auth', 'mnt_by', 'changed', 'source' ] );
+ $self->attributes( 'optionnal', [ 'phone', 'fax_no', 'signature', 'encryption', 'org', 'remarks', 'irt_nfy', 'notify' ] );
+ $self->attributes( 'single', [ 'irt', 'source' ] );
+ $self->attributes( 'multiple', [ 'address', 'phone', 'fax_no', 'e_mail', 'abuse_mailbox', 'signature', 'encryption', 'org', 'auth', 'remarks', 'tech_c', 'admin_c', 'irt_nfy', 'notify', 'mnt_by', 'changed' ] );
return $self;
@@ -79,7 +78,7 @@ sub irt {
if ( $irt and $irt !~ /^IRT-/i ) {
warn "Irt name not valid ($irt) : Should start with 'IRT-'";
}
- return $self->_single_attribute_setget('irt',$irt);
+ return $self->_single_attribute_setget( 'irt', $irt );
}
=head2 B<address( [$address] )>
@@ -98,7 +97,7 @@ More than one line can be used.
sub address {
my ( $self, $address ) = @_;
- return $self->_multiple_attribute_setget('address'