Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add type on attribute to prepare update feature

- Add following methods for attribute handling
    attributes()
    attribute_is()
- Add the dump() method
- Add the class() method
- Remove query_filter(), filering is to be done through the
    new class() method
- Now accept Iterator as argument of Net::Whois::Object->new()
- More tests
- Complete the documentation, with some examples
  • Loading branch information...
commit fcd9e808150bb7fa904efe2378a4b9b14c380855 1 parent f1f7580
arhuman authored
Showing with 2,287 additions and 1,053 deletions.
  1. +14 −0 Changes
  2. +15 −7 META.json
  3. +5 −2 META.yml
  4. +229 −24 lib/Net/Whois/Object.pm
  5. +27 −22 lib/Net/Whois/Object/AsBlock.pm
  6. +26 −22 lib/Net/Whois/Object/AsSet.pm
  7. +46 −42 lib/Net/Whois/Object/AutNum.pm
  8. +39 −34 lib/Net/Whois/Object/Domain.pm
  9. +32 −28 lib/Net/Whois/Object/FilterSet.pm
  10. +42 −36 lib/Net/Whois/Object/Inet6Num.pm
  11. +40 −34 lib/Net/Whois/Object/InetNum.pm
  12. +53 −32 lib/Net/Whois/Object/InetRtr.pm
  13. +6 −2 lib/Net/Whois/Object/Information.pm
  14. +43 −37 lib/Net/Whois/Object/Irt.pm
  15. +37 −32 lib/Net/Whois/Object/KeyCert.pm
  16. +27 −21 lib/Net/Whois/Object/Limerick.pm
  17. +41 −36 lib/Net/Whois/Object/Mntner.pm
  18. +42 −37 lib/Net/Whois/Object/Organisation.pm
  19. +29 −24 lib/Net/Whois/Object/PeeringSet.pm
  20. +28 −23 lib/Net/Whois/Object/Person.pm
  21. +29 −24 lib/Net/Whois/Object/Poem.pm
  22. +34 −16 lib/Net/Whois/Object/PoeticForm.pm
  23. +6 −2 lib/Net/Whois/Object/Response.pm
  24. +33 −28 lib/Net/Whois/Object/Role.pm
  25. +45 −40 lib/Net/Whois/Object/Route.pm
  26. +43 −38 lib/Net/Whois/Object/Route6.pm
  27. +31 −26 lib/Net/Whois/Object/RouteSet.pm
  28. +29 −24 lib/Net/Whois/Object/RtrSet.pm
  29. +2 −2 lib/Net/Whois/RIPE.pm
  30. +30 −27 t/03-objects.t
  31. +51 −14 t/105-AsBlock.t
  32. +85 −20 t/110-AutNum.t
  33. +45 −12 t/115-Person.t
  34. +60 −12 t/120-Role.t
  35. +35 −12 t/125-AsSet.t
  36. +51 −12 t/130-Domain.t
  37. +52 −12 t/135-InetNum.t
  38. +53 −13 t/140-Inet6Num.t
  39. +53 −13 t/145-InetRtr.t
  40. +37 −12 t/150-RtrSet.t
  41. +55 −12 t/155-Mntner.t
  42. +51 −12 t/160-KeyCert.t
  43. +53 −12 t/165-Route.t
  44. +51 −12 t/167-Route6.t
  45. +39 −12 t/170-RouteSet.t
  46. +37 −12 t/175-PeeringSet.t
  47. +33 −12 t/180-Limerick.t
  48. +50 −12 t/185-Poem.t
  49. +55 −42 t/187-PoeticForm.t
  50. +61 −12 t/190-Organisation.t
  51. +14 −12 t/195-Response.t
  52. +20 −13 t/200-Information.t
  53. +62 −12 t/205-Irt.t
  54. +41 −12 t/210-FilterSet.t
  55. +40 −0 t/common.pl
14 Changes
View
@@ -1,5 +1,19 @@
Revision history for net-whois-ripe
+
+ - Add type on attributes to prepare future update, with the
+ following methods :
+ attributes()
+ attribute_is()
+ - Add the dump() method
+ - Add the class() method
+ - Remove query_filter(), filering is to be done through the
+ class() method
+ - Now accept Iterator as argument of Net::Whois::Object->new()
+ - More tests
+ - Complete the documentation, with some examples
+
+
2.00012 05 Jun 2012
Fix previous broken release (merge goof)
Fix some tests
22 META.json
View
@@ -4,7 +4,7 @@
"Luis Motta Campos <lmc@cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.59, CPAN::Meta::Converter version 2.112150",
+ "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921",
"license" : [
"unknown"
],
@@ -22,23 +22,31 @@
"prereqs" : {
"build" : {
"requires" : {
- "Test::Exception" : 0
+ "Test::Exception" : "0"
}
},
"configure" : {
"requires" : {
- "ExtUtils::MakeMaker" : 0
+ "ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
- "Iterator" : 0,
- "Iterator::Util" : 0,
- "Test::More" : 0,
+ "Iterator" : "0",
+ "Iterator::Util" : "0",
+ "Test::More" : "0",
"perl" : "5.006"
}
}
},
"release_status" : "stable",
- "version" : "2.00009"
+ "resources" : {
+ "bugtracker" : {
+ "web" : "https://github.com/arhuman/Net-Whois-RIPE/issues"
+ },
+ "repository" : {
+ "url" : "https://github.com/arhuman/Net-Whois-RIPE"
+ }
+ },
+ "version" : "2.00013"
}
7 META.yml
View
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.59, CPAN::Meta::Converter version 2.112150'
+generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -22,4 +22,7 @@ requires:
Iterator::Util: 0
Test::More: 0
perl: 5.006
-version: 2.00_010
+resources:
+ bugtracker: https://github.com/arhuman/Net-Whois-RIPE/issues
+ repository: https://github.com/arhuman/Net-Whois-RIPE
+version: 2.00013
253 lib/Net/Whois/Object.pm
View
@@ -1,4 +1,5 @@
package Net::Whois::Object;
+use Carp;
=head1 NAME
@@ -10,31 +11,97 @@ Net::Whois::Object - Object encapsulating RPSL data returned by Whois queries
use Net::Whois::Object;
my $whois = Net::Whois::RIPE->new( %options );
- $iterator = $whois->query( 'AS30781' );
+ $iterator = $whois->query('AS30781');
+
+ push @objects, Net::Whois::Object->new($iterator);
- while (my $value = $iterator->value()) {
- my @lines = split '\n', $value;
- push @projects, Net::Whois::Object(@lines);
- }
-
for my $object (@objects) {
# process the Net::Whois::Object::xxx objects...
+ # Type of object is available via class() method
}
- ...
+=head1 USAGE
+
+=head2 Get the data
+
+ # Get the Class we want to modify
+ my $whois = Net::Whois::RIPE->new( %options );
+ $iterator = $whois->query('POLK-RIPE');
+
+=head2 Filter the objects
+
+Currently the only crude way to filter objects is to use the class() method.
+
+ # To only get the Person object (and ignore the Information objects)
+ my ($person) = grep {$_->class() eq 'Person'} Net::Whois::Object->new($iterator);
+
+=head2 Modify the data
+
+ # Add a phone number
+ $person->phone(' +33 4 88 00 65 15')
+
+=head2 Dump the current state of the data
+
+The dump() method, permit to print the object under the classic
+text form, made of 'attribute: value' lines.
+This may seem useless now, but will come handy to make update through
+email.
+
+ # Dump the modified data
+ my $to_be_mailed = $person->dump();
+
+=head2 Update the RIPE database
+
+This part is still to be done
+
+=head3 Update through the web interface.
+
+Not implemented yet.
+
+=head3 Update through email.
+
+Not implemented yet.
=head1 SUBROUTINES/METHODS
-=head2 B<new( @lines )>
+=head2 B<new( @lines|$iterator )>
-The constructor is a factory returning the appropriate Net/Whois/Object
+The constructor is a factory returning the appropriate Net::Whois::Objects
based on the first attribute of the block.
+You can pass an array of lines or an iterator returned by Net::Whois::RIPE
+as argument.
+
+The two following ways of using the constructor are possible
+
+ my $whois = Net::Whois::RIPE->new( %options );
+ $iterator = $whois->query('AS30781');
+
+ # Using the iterator way
+
+ push @objects, Net::Whois::Object->new($iterator);
+
+or
+
+ # Using the previous (more circonvoluted) @lines way
+
+ while ( ! $iterator->is_exhausted() ) {
+ my @lines = map { "$_\n"} split '\n', $iterator->value();
+ push @objects, Net::Whois::Object->new(@lines,"\n");
+ }
=cut
sub new {
- my $class = shift;
- my @lines = @_;
+ my ( $class, @lines ) = @_;
+
+ # If an iterator is passed as argument convert it to lines.
+ if ( ref $lines[0] eq 'Iterator' ) {
+ my $iterator = shift @lines;
+ while ( !$iterator->is_exhausted() ) {
+ push @lines, map {"$_\n"} split '\n', $iterator->value();
+ push @lines, $/;
+ }
+ }
my ( $object, $block, @results );
@@ -87,28 +154,76 @@ sub new {
# First attribute determine the block
$block = $attribute unless $block;
- $object = _object_factory( $block, $value ) unless $object;
-
- if ($attribute) {
+ if ( !$object ) {
+ $object = _object_factory( $block, $value ) unless $object;
+ }
+ elsif ($attribute) {
$object->$attribute($value);
}
}
+
return @results;
}
-=head2 B<query_filter( $query_filter )>
+=head2 B<attributes( [$type [, \@attributes]] )>
+
+Accessor to the attributes of the object.
+$type can be
+ 'mandatory' Required for update creation
+ 'optionnal' Optionnal for update/creation
+ 'multiple' Can have multiple values
+ 'single' Have only one value
+ 'all' You can't specify attributes for this special type
+ which provides all the attributes which have a type
+
+If no $type is specified, 'all' is assumed.
+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'));
+ }
+ croak "Invalid attribute's type ($type)" unless $type =~
+ m/(all|mandatory|optionnal|single|multiple)/i;
+ if ($r_attributes) {
+ for my $a (@{$r_attributes}) {
+ $self->{TYPE}{$type}{$a} = 1;
+ }
+ }
+ return sort keys %{ $self->{TYPE}{$type} };
+}
+
+=head2 B<class ( )>
+
+This method return the RIPE class associated to the current object.
+
+=cut
+
+sub class {
+ my ( $self, $value ) = @_;
+
+ return $self->_single_attribute_setget('class',$value);
+}
+
+=head2 B<attribute_is ( $attribute, $type )>
-Accessor to the query_filter attribute used to query_filter out objects.
-Accepts an optional query_filter to be added to the query_filter array,
-always return the current query_filter array.
+This method return true if $attribute is of type $type.
=cut
-sub query_filter {
- my ( $self, $query_filter ) = @_;
- push @{ $self->{query_filter} }, $query_filter if defined $query_filter;
- return @{ $self->{query_filter} };
+sub attribute_is {
+ my ( $self, $attribute, $type ) = @_;
+
+ return defined $self->{TYPE}{$type}{$attribute}?1:0;
+
+ # for my $att ( $self->attributes( $type )) {
+ # if ($att eq $attribute) { return 1; }
+ # }
+ # return 0 ;
}
=head2 B<hidden_attributes( $attribute )>
@@ -139,6 +254,41 @@ sub displayed_attributes {
return @{ $self->{displayed_attributes} };
}
+=head2 B<dump( )>
+
+Simple naive way to display a text form of the class.
+Try to be as close as possible as the submited text.
+
+=cut
+
+sub dump {
+ my ( $self ) = @_;
+
+ my %current_index;
+ my $result;
+
+ for my $line (@{ $self->{order} }) {
+ my $attribute = $line;
+ $attribute =~ s/_/-/g;
+
+ my $val = $self->$line();
+
+ if (ref $val eq 'ARRAY') {
+ # If multi value get the lines in order
+ $val = $val->[$current_index{$line}++];
+ }
+
+ $output = "$attribute: $val\n";
+
+ # Process the comment
+ $output =~ s/comment:\s+/\% /;
+
+ $result .= $output;
+ }
+
+ return $result;
+}
+
=begin UNDOCUMENTED
=head2 B<_object_factory( $type => $value )>
@@ -148,7 +298,6 @@ Private method. Shouldn't be used from other modules.
Simple factory, creating Net::Whois::Objet::XXXX from
the type passed as parameter.
-=end UNDOCUMENTED
=cut
@@ -189,10 +338,66 @@ sub _object_factory {
eval "require $class" or die "Can't require $class ($!)";
- return $class->new( $type => $value );
+ # my $object = $class->new( $type => $value );
+ 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 {
+ $object->_single_attribute_setget( $type => $value );
+ }
+
+ # return $class->new( $type => $value );
+ return $object;
+
+}
+
+=head2 B<_single_attribute_setget( $attribute )>
+Generic setter/getter for singlevalue attribute.
+
+=cut
+
+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};
+
+ $self->{$attribute} = $value;
+ }
+ return $self->{$attribute};
}
+=head2 B<_multiple_attribute_setget( $attribute )>
+
+Generic setter/getter for multivalue attribute.
+
+=end UNDOCUMENTED
+
+=cut
+
+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;
+
+ push @{ $self->{$attribute} }, $value;
+ }
+ return $self->{$attribute};
+}
+
+=head1 TODO
+
+The update part (RIPE database) is still missing, but I'm planning to offer a way
+to do it in a near future (through email generation or webupdate)
+
=head1 AUTHOR
Arnaud "Arhuman" Assad, C<< <arhuman at gmail.com> >>
49 lib/Net/Whois/Object/AsBlock.pm
View
@@ -48,6 +48,11 @@ sub new {
$self->$key( $options{$key} );
}
+ $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;
}
@@ -68,8 +73,8 @@ stored in the appropriate Internet Registry's Whois Database.
sub as_block {
my ( $self, $as_block ) = @_;
- $self->{as_block} = $as_block if defined $as_block;
- return $self->{as_block};
+
+ return $self->_single_attribute_setget('as_block',$as_block);
}
=head2 B<descr( [$descr] )>
@@ -84,8 +89,8 @@ in the as-block.
sub descr {
my ( $self, $descr ) = @_;
- push @{ $self->{descr} }, $descr if defined $descr;
- return \@{ $self->{descr} };
+
+ return $self->_multiple_attribute_setget('descr',$descr);
}
=head2 B<remarks( [$remarks] )>
@@ -104,8 +109,8 @@ the AS numbers.
sub remarks {
my ( $self, $remarks ) = @_;
- push @{ $self->{remarks} }, $remarks if defined $remarks;
- return \@{ $self->{remarks} };
+
+ return $self->_multiple_attribute_setget('remarks',$remarks);
}
=head2 B<tech_c( [$tech_c] )>
@@ -127,8 +132,8 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $tech_c ) = @_;
- push @{ $self->{tech_c} }, $tech_c if defined $tech_c;
- return \@{ $self->{tech_c} };
+
+ return $self->_multiple_attribute_setget('tech_c',$tech_c);
}
=head2 B<admin_c( [$admin_c])>
@@ -147,8 +152,8 @@ located at the site of the network.
sub admin_c {
my ( $self, $admin_c ) = @_;
- push @{ $self->{admin_c} }, $admin_c if defined $admin_c;
- return \@{ $self->{admin_c} };
+
+ return $self->_multiple_attribute_setget('admin_c',$admin_c);
}
=head2 B<notify( [$notify] )>
@@ -164,8 +169,8 @@ to the object should be sent.
sub notify {
my ( $self, $notify ) = @_;
- push @{ $self->{notify} }, $notify if defined $notify;
- return \@{ $self->{notify} };
+
+ return $self->_multiple_attribute_setget('notify',$notify);
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -184,8 +189,8 @@ authorization.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- push @{ $self->{mnt_lower} }, $mnt_lower if defined $mnt_lower;
- return \@{ $self->{mnt_lower} };
+
+ return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -205,8 +210,8 @@ object will be able to change details.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- push @{ $self->{mnt_by} }, $mnt_by if defined $mnt_by;
- return \@{ $self->{mnt_by} };
+
+ return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
}
=head2 B<changed( [$changed] )>
@@ -228,8 +233,8 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- push @{ $self->{changed} }, $changed if defined $changed;
- return \@{ $self->{changed} };
+
+ return $self->_multiple_attribute_setget('changed',$changed);
}
=head2 B<source( [$source] )>
@@ -243,8 +248,8 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- $self->{source} = $source if defined $source;
- return $self->{source};
+
+ return $self->_single_attribute_setget('source',$source);
}
=head2 B<org( [$org] )>
@@ -258,8 +263,8 @@ The organisation entity this object is bound to.
sub org {
my ( $self, $org ) = @_;
- $self->{org} = $org if defined $org;
- return $self->{org};
+
+ return $self->_single_attribute_setget('org',$org);
}
1;
48 lib/Net/Whois/Object/AsSet.pm
View
@@ -43,6 +43,11 @@ sub new {
$self->$key( $options{$key} );
}
+ $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;
}
@@ -62,8 +67,7 @@ with 'as-'.
sub as_set {
my ( $self, $as_set ) = @_;
- $self->{as_set} = $as_set if defined $as_set;
- return $self->{as_set};
+ return $self->_single_attribute_setget('as_set',$as_set);
}
=head2 B<descr( [$descr] )>
@@ -78,8 +82,8 @@ A short description related to the object's purpose.
sub descr {
my ( $self, $descr ) = @_;
- push @{ $self->{descr} }, $descr if defined $descr;
- return \@{ $self->{descr} };
+
+ return $self->_multiple_attribute_setget('descr',$descr);
}
=head2 B<members( [$member] )>
@@ -95,8 +99,8 @@ of AS Numbers, or other as-set names.
sub members {
my ( $self, $member ) = @_;
- push @{ $self->{members} }, $member if defined $member;
- return \@{ $self->{members} };
+
+ return $self->_multiple_attribute_setget('member',$member);
}
=head2 B<mbrs_by_ref( [$mbr] )>
@@ -121,8 +125,8 @@ defined explicitly by the members attribute.
sub mbrs_by_ref {
my ( $self, $mbr ) = @_;
- push @{ $self->{mbrs_by_ref} }, $mbr if defined $mbr;
- return \@{ $self->{mbrs_by_ref} };
+
+ return $self->_multiple_attribute_setget('mbr',$mbr);
}
=head2 B<remarks( [$remark] )>
@@ -138,8 +142,8 @@ May include a URL or email address.
sub remarks {
my ( $self, $remark ) = @_;
- push @{ $self->{remarks} }, $remark if defined $remark;
- return \@{ $self->{remarks} };
+
+ return $self->_multiple_attribute_setget('remarks',$remark);
}
=head2 B<tech_c( [$tech_c] )>
@@ -160,8 +164,8 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $tech_c ) = @_;
- push @{ $self->{tech_c} }, $tech_c if defined $tech_c;
- return \@{ $self->{tech_c} };
+
+ return $self->_multiple_attribute_setget('tech_c',$tech_c);
}
=head2 B<admin_c( [$admin_c] )>
@@ -180,8 +184,8 @@ located at the site of the network.
sub admin_c {
my ( $self, $admin_c ) = @_;
- push @{ $self->{admin_c} }, $admin_c if defined $admin_c;
- return \@{ $self->{admin_c} };
+
+ return $self->_multiple_attribute_setget('admin_c',$admin_c);
}
=head2 B<notify( [$notify] )>
@@ -197,8 +201,8 @@ sent.
sub notify {
my ( $self, $notify ) = @_;
- push @{ $self->{notify} }, $notify if defined $notify;
- return \@{ $self->{notify} };
+
+ return $self->_multiple_attribute_setget('notify',$notify);
}
=head2 B<mnt_by( [$mnt] )>
@@ -218,8 +222,8 @@ object will be able to change details.
sub mnt_by {
my ( $self, $mnt ) = @_;
- push @{ $self->{mnt_by} }, $mnt if defined $mnt;
- return \@{ $self->{mnt_by} };
+
+ return $self->_multiple_attribute_setget('mnt',$mnt);
}
=head2 B<changed( [$changed] )>
@@ -241,8 +245,8 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- push @{ $self->{changed} }, $changed if defined $changed;
- return \@{ $self->{changed} };
+
+ return $self->_multiple_attribute_setget('changed',$changed);
}
=head2 B<source( [$source] )>
@@ -256,8 +260,8 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- $self->{source} = $source if defined $source;
- return $self->{source};
+
+ return $self->_single_attribute_setget('source',$source);
}
1;
88 lib/Net/Whois/Object/AutNum.pm
View
@@ -56,6 +56,12 @@ sub new {
$self->$key( $options{$key} );
}
+ $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']);
+
return $self;
}
@@ -77,12 +83,10 @@ sub aut_num {
my ( $self, $aut_num ) = @_;
if ( $aut_num and $aut_num !~ /^AS\d+/ ) {
- warn "Illegal aut-num ($aut_num) : should be ASn, n being a 32 bit
- number with no leading 0";
+ warn "Illegal aut-num ($aut_num) : should be ASn, n being a 32 bit number with no leading 0";
}
- $self->{aut_num} = $aut_num if defined $aut_num;
- return $self->{aut_num};
+ return $self->_single_attribute_setget('aut_num',$aut_num);
}
=head2 B<as_name( [$as_name] )>
@@ -96,8 +100,8 @@ The as-name attribute is a symbolic name of the AS.
sub as_name {
my ( $self, $as_name ) = @_;
- $self->{as_name} = $as_name if defined $as_name;
- return $self->{as_name};
+
+ return $self->_single_attribute_setget('as_name',$as_name);
}
=head2 B<descr( [$descr] )>
@@ -109,8 +113,8 @@ Accepts an optional descr value to be added to the descr array, always return th
sub descr {
my ( $self, $descr ) = @_;
- push @{ $self->{descr} }, $descr if defined $descr;
- return \@{ $self->{descr} };
+
+ return $self->_multiple_attribute_setget('descr',$descr);
}
=head2 B<member_of( [$mbr_of] )>
@@ -135,8 +139,8 @@ and/or list the AS number in the members attribute
sub member_of {
my ( $self, $member_of ) = @_;
- push @{ $self->{member_of} }, $member_of if defined $member_of;
- return \@{ $self->{member_of} };
+
+ return $self->_multiple_attribute_setget('member_of',$member_of);
}
=head2 B<import( [$import] )>
@@ -151,8 +155,8 @@ The inbound IPv4 routing policy of the AS.
sub import {
my ( $self, $import ) = @_;
- push @{ $self->{import} }, $import if defined $import;
- return \@{ $self->{import} };
+
+ return $self->_multiple_attribute_setget('import',$import);
}
=head2 B<mp_import( [$import] )>
@@ -167,8 +171,8 @@ The inbound IPv6 routing policy of the AS.
sub mp_import {
my ( $self, $mp_import ) = @_;
- push @{ $self->{mp_import} }, $import if defined $import;
- return \@{ $self->{mp_import} };
+
+ return $self->_multiple_attribute_setget('mp_import',$mp_import);
}
=head2 B<export( [$export] )>
@@ -183,8 +187,8 @@ The outbound routing policy of the AS.
sub export {
my ( $self, $export ) = @_;
- push @{ $self->{export} }, $export if defined $export;
- return \@{ $self->{export} };
+
+ return $self->_multiple_attribute_setget('export',$export);
}
=head2 B<mp_export( [$mp_export] )>
@@ -199,8 +203,8 @@ The outbound IPv6 routing policy of the AS.
sub mp_export {
my ( $self, $mp_export ) = @_;
- push @{ $self->{mp_export} }, $mp_export if defined $mp_export;
- return \@{ $self->{mp_export} };
+
+ return $self->_multiple_attribute_setget('mp_export',$mp_export);
}
=head2 B<default( [$default] )>
@@ -216,8 +220,8 @@ more-specific information on where to send the traffic.
sub default {
my ( $self, $default ) = @_;
- push @{ $self->{default} }, $default if defined $default;
- return \@{ $self->{default} };
+
+ return $self->_multiple_attribute_setget('default',$default);
}
=head2 B<mp_default( [$mp_default] )>
@@ -234,8 +238,8 @@ specified.
sub mp_default {
my ( $self, $mp_default ) = @_;
- push @{ $self->{mp_default} }, $mp_default if defined $mp_default;
- return \@{ $self->{mp_default} };
+
+ return $self->_multiple_attribute_setget('mp_default',$mp_default);
}
=head2 B<remarks( [$remark] )>
@@ -251,8 +255,8 @@ include a URL or email address.
sub remarks {
my ( $self, $remark ) = @_;
- push @{ $self->{remarks} }, $remark if defined $remark;
- return \@{ $self->{remarks} };
+
+ return $self->_multiple_attribute_setget('remark',$remark);
}
=head2 B<admin_c( [$contact] )>
@@ -271,8 +275,8 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- push @{ $self->{admin_c} }, $contact if defined $contact;
- return \@{ $self->{admin_c} };
+
+ return $self->_multiple_attribute_setget('admin_c',$contact);
}
=head2 B<tech_c( [$contact] )>
@@ -293,8 +297,8 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- push @{ $self->{tech_c} }, $contact if defined $contact;
- return \@{ $self->{tech_c} };
+
+ return $self->_multiple_attribute_setget('tech_c',$contact);
}
=head2 B<notify( [$notify] )>
@@ -307,8 +311,8 @@ always return the current notify array.
sub notify {
my ( $self, $notify ) = @_;
- push @{ $self->{notify} }, $notify if defined $notify;
- return \@{ $self->{notify} };
+
+ return $self->_multiple_attribute_setget('notify',$notify);
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -321,8 +325,8 @@ always return the current mnt_lower array.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- push @{ $self->{mnt_lower} }, $mnt_lower if defined $mnt_lower;
- return \@{ $self->{mnt_lower} };
+
+ return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
}
=head2 B<mnt_routes( [$mnt_routes] )>
@@ -335,8 +339,8 @@ always return the current mnt_routes array.
sub mnt_routes {
my ( $self, $mnt_routes ) = @_;
- push @{ $self->{mnt_routes} }, $mnt_routes if defined $mnt_routes;
- return \@{ $self->{mnt_routes} };
+
+ return $self->_multiple_attribute_setget('mnt_route',$mnt_route);
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -349,8 +353,8 @@ always return the current mnt_by array.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- push @{ $self->{mnt_by} }, $mnt_by if defined $mnt_by;
- return \@{ $self->{mnt_by} };
+
+ return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
}
=head2 B<changed( [$changed] )>
@@ -363,8 +367,8 @@ always return the current changed array.
sub changed {
my ( $self, $changed ) = @_;
- push @{ $self->{changed} }, $changed if defined $changed;
- return \@{ $self->{changed} };
+
+ return $self->_multiple_attribute_setget('changed',$changed);
}
=head2 B<source( [$source] )>
@@ -378,8 +382,8 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- $self->{source} = $source if defined $source;
- return $self->{source};
+
+ return $self->_single_attribute_setget('source',$source);
}
=head2 B<org( [$org] )>
@@ -394,8 +398,8 @@ This is to ensure only one organisation is responsible for this resource.
sub org {
my ( $self, $org ) = @_;
- $self->{org} = $org if defined $org;
- return $self->{org};
+
+ return $self->_single_attribute_setget('org',$org);
}
1;
73 lib/Net/Whois/Object/Domain.pm
View
@@ -50,6 +50,12 @@ sub new {
$self->$key( $options{$key} );
}
+ $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']);
+
return $self;
}
@@ -69,8 +75,7 @@ sub domain {
# Enforce the format
$domain =~ s/\.$// if $domain;
- $self->{domain} = $domain if defined $domain;
- return $self->{domain};
+ return $self->_single_attribute_setget('domain',$domain);
}
=head2 B<descr( [$descr] )>
@@ -86,8 +91,8 @@ describe the use of the IP range described in the domain object.
sub descr {
my ( $self, $descr ) = @_;
- push @{ $self->{descr} }, $descr if defined $descr;
- return \@{ $self->{descr} };
+
+ return $self->_multiple_attribute_setget('descr',$descr);
}
=head2 B<org( [$org] )>
@@ -102,8 +107,8 @@ The organisation responsible for this domain.
sub org {
my ( $self, $org ) = @_;
- push @{ $self->{org} }, $org if defined $org;
- return \@{ $self->{org} };
+
+ return $self->_multiple_attribute_setget('org',$org);
}
=head2 B<admin_c( [$contact] )>
@@ -122,8 +127,8 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- push @{ $self->{admin_c} }, $contact if defined $contact;
- return \@{ $self->{admin_c} };
+
+ return $self->_multiple_attribute_setget('admin_c',$contact);
}
=head2 B<tech_c( [$contact] )>
@@ -144,8 +149,8 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- push @{ $self->{tech_c} }, $contact if defined $contact;
- return \@{ $self->{tech_c} };
+
+ return $self->_multiple_attribute_setget('tech_c',$contact);
}
=head2 B<zone_c( [$contact] )>
@@ -160,8 +165,8 @@ The NIC-handle of a 'person' or 'role' object with authority over a zone.
sub zone_c {
my ( $self, $contact ) = @_;
- push @{ $self->{zone_c} }, $contact if defined $contact;
- return \@{ $self->{zone_c} };
+
+ return $self->_multiple_attribute_setget('zone_c',$contact);
}
=head2 B<nserver( [$server] )>
@@ -177,8 +182,8 @@ mandatory.
sub nserver {
my ( $self, $server ) = @_;
- push @{ $self->{nserver} }, $server if defined $server;
- return \@{ $self->{nserver} };
+
+ return $self->_multiple_attribute_setget('nserver',$server);
}
=head2 B<ds_rdata( [$server] )>
@@ -194,8 +199,8 @@ for DNSSEC (short for DNS Security Extensions)
sub ds_rdata {
my ( $self, $server ) = @_;
- push @{ $self->{ds_rdata} }, $server if defined $server;
- return \@{ $self->{ds_rdata} };
+
+ return $self->_multiple_attribute_setget('ds_data',$server);
}
=head2 B<sub_dom( [$dom] )>
@@ -212,8 +217,8 @@ contains this attribute
sub sub_dom {
my ( $self, $dom ) = @_;
- push @{ $self->{sub_dom} }, $dom if defined $dom;
- return \@{ $self->{sub_dom} };
+
+ return $self->_multiple_attribute_setget('sub_dom',$dom);
}
=head2 B<dom_net( [$dom_net] )>
@@ -228,8 +233,8 @@ The dom_net attribute contains a list of IP networks in a domain.
sub dom_net {
my ( $self, $dom_net ) = @_;
- push @{ $self->{dom_net} }, $dom_net if defined $dom_net;
- return \@{ $self->{dom_net} };
+
+ return $self->_multiple_attribute_setget('dom_net',$dom_net);
}
=head2 B<remarks( [$remark] )>
@@ -244,8 +249,8 @@ General remarks. May include a URL or email address.
sub remarks {
my ( $self, $remark ) = @_;
- push @{ $self->{remarks} }, $remark if defined $remark;
- return \@{ $self->{remarks} };
+
+ return $self->_multiple_attribute_setget('remarks',$remark);
}
=head2 B<notify( [$notify] )>
@@ -261,8 +266,8 @@ sent.
sub notify {
my ( $self, $notify ) = @_;
- push @{ $self->{notify} }, $notify if defined $notify;
- return \@{ $self->{notify} };
+
+ return $self->_multiple_attribute_setget('notify',$notify);
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -278,8 +283,8 @@ this object.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- push @{ $self->{mnt_by} }, $mnt_by if defined $mnt_by;
- return \@{ $self->{mnt_by} };
+
+ return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -296,8 +301,8 @@ object.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- push @{ $self->{mnt_lower} }, $mnt_lower if defined $mnt_lower;
- return \@{ $self->{mnt_lower} };
+
+ return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
}
=head2 B<refer( [$refer] )>
@@ -314,8 +319,8 @@ removed and may be deprecated.
sub refer {
my ( $self, $refer ) = @_;
- $self->{refer} = $refer if defined $refer;
- return $self->{refer};
+
+ return $self->_single_attribute_setget('refer',$refer);
}
=head2 B<changed( [$changed] )>
@@ -337,8 +342,8 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- push @{ $self->{changed} }, $changed if defined $changed;
- return \@{ $self->{changed} };
+
+ return $self->_multiple_attribute_setget('changed',$changed);
}
=head2 B<source( [$source] )>
@@ -352,8 +357,8 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- $self->{source} = $source if defined $source;
- return $self->{source};
+
+ return $self->_single_attribute_setget('source',$source);
}
1;
60 lib/Net/Whois/Object/FilterSet.pm
View
@@ -46,6 +46,11 @@ sub new {
$self->$key( $options{$key} );
}
+ $self->attributes('mandatory',['filter_set', 'descr', 'filter', 'mp_filter', 'tech_c', 'admin_c', 'mnt_by', 'changed', '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;
}
@@ -69,11 +74,10 @@ 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) {
- warn "Incorrect FilterSet's name ($filter_set) : Should start with
- 'FLTR-'";
+ warn "Incorrect FilterSet's name ($filter_set) : Should start with 'FLTR-'";
}
- $self->{filter_set} = $filter_set if defined $filter_set;
- return $self->{filter_set};
+
+ return $self->_single_attribute_setget('filter_set',$filter_set);
}
=head2 B<descr( [$descr] )>
@@ -88,8 +92,8 @@ A short description related to the object's purpose.
sub descr {
my ( $self, $descr ) = @_;
- push @{ $self->{descr} }, $descr if defined $descr;
- return \@{ $self->{descr} };
+
+ return $self->_multiple_attribute_setget('descr',$descr);
}
=head2 B<filter( [$filter] )>
@@ -107,8 +111,8 @@ you have said you want to see.
sub filter {
my ( $self, $filter ) = @_;
- $self->{filter} = $filter if defined $filter;
- return $self->{filter};
+
+ return $self->_single_attribute_setget('filter',$filter);
}
=head2 B<mp_filter( [$mp_filter] )>
@@ -123,8 +127,8 @@ a subset of these routes.
sub mp_filter {
my ( $self, $mp_filter ) = @_;
- $self->{mp_filter} = $mp_filter if defined $mp_filter;
- return $self->{mp_filter};
+
+ return $self->_single_attribute_setget('mp_filter',$mp_filter);
}
=head2 B<remarks( [$remark] )>
@@ -139,8 +143,8 @@ General remarks. May include a URL or email address.
sub remarks {
my ( $self, $remark ) = @_;
- push @{ $self->{remarks} }, $remark if defined $remark;
- return \@{ $self->{remarks} };
+
+ return $self->_multiple_attribute_setget('remarks',$remark);
}
=head2 B<tech_c( [$contact] )>
@@ -161,8 +165,8 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- push @{ $self->{tech_c} }, $contact if defined $contact;
- return \@{ $self->{tech_c} };
+
+ return $self->_multiple_attribute_setget('tech_c',$contact);
}
=head2 B<admin_c( [$contact] )>
@@ -181,8 +185,8 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- push @{ $self->{admin_c} }, $contact if defined $contact;
- return \@{ $self->{admin_c} };
+
+ return $self->_multiple_attribute_setget('admin_c',$contact);
}
=head2 B<org( [$org] )>
@@ -197,8 +201,8 @@ The organisation responsible for this FilterSet object.
sub org {
my ( $self, $org ) = @_;
- push @{ $self->{org} }, $org if defined $org;
- return \@{ $self->{org} };
+
+ return $self->_multiple_attribute_setget('org',$org);
}
=head2 B<notify( [$notify] )>
@@ -220,8 +224,8 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub notify {
my ( $self, $notify ) = @_;
- push @{ $self->{notify} }, $notify if defined $notify;
- return \@{ $self->{notify} };
+
+ return $self->_multiple_attribute_setget('notify',$notify);
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -241,8 +245,8 @@ object will be able to change details.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- push @{ $self->{mnt_by} }, $mnt_by if defined $mnt_by;
- return \@{ $self->{mnt_by} };
+
+ return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -258,8 +262,8 @@ used as well as mnt_by.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- push @{ $self->{mnt_lower} }, $mnt_lower if defined $mnt_lower;
- return \@{ $self->{mnt_lower} };
+
+ return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
}
=head2 B<changed( [$changed] )>
@@ -281,8 +285,8 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- push @{ $self->{changed} }, $changed if defined $changed;
- return \@{ $self->{changed} };
+
+ return $self->_multiple_attribute_setget('changed',$changed);
}
=head2 B<source( [$source] )>
@@ -296,8 +300,8 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- $self->{source} = $source if defined $source;
- return $self->{source};
+
+ return $self->_single_attribute_setget('source',$source);
}
1;
78 lib/Net/Whois/Object/Inet6Num.pm
View
@@ -53,6 +53,12 @@ sub new {
$self->$key( $options{$key} );
}
+ $self->attributes('mandatory',['inet6num', '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',['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;
}
@@ -70,8 +76,8 @@ Addresses can only be expressed in prefix notation
sub inet6num {
my ( $self, $inet6num ) = @_;
- $self->{inet6num} = $inet6num if defined $inet6num;
- return $self->{inet6num};
+
+ return $self->_single_attribute_setget('inet6num',$inet6num);
}
=head2 B<netname( [$netname] )>
@@ -87,8 +93,8 @@ used for a common purpose.
sub netname {
my ( $self, $netname ) = @_;
- $self->{netname} = $netname if defined $netname;
- return $self->{netname};
+
+ return $self->_single_attribute_setget('netname',$netname);
}
=head2 B<descr( [$descr] )>
@@ -104,8 +110,8 @@ in the inet6num.
sub descr {
my ( $self, $descr ) = @_;
- push @{ $self->{descr} }, $descr if defined $descr;
- return \@{ $self->{descr} };
+
+ return $self->_multiple_attribute_setget('descr',$descr);
}
=head2 B<country( [$country] )>
@@ -124,8 +130,8 @@ map IP addresses to countries.
sub country {
my ( $self, $country ) = @_;
- push @{ $self->{country} }, $country if defined $country;
- return \@{ $self->{country} };
+
+ return $self->_multiple_attribute_setget('country',$country);
}
=head2 B<org( [$org] )>
@@ -141,8 +147,8 @@ resource.
sub org {
my ( $self, $org ) = @_;
- $self->{org} = $org if defined $org;
- return $self->{org};
+
+ return $self->_single_attribute_setget('org',$org);
}
=head2 B<admin_c( [$contact] )>
@@ -161,8 +167,8 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- push @{ $self->{admin_c} }, $contact if defined $contact;
- return \@{ $self->{admin_c} };
+
+ return $self->_multiple_attribute_setget('admin_c',$contact);
}
=head2 B<tech_c( [$contact] )>
@@ -181,9 +187,9 @@ day-to-day operation of the network, but does not need to be
=cut
sub tech_c {
- my ( $self, $tech_c ) = @_;
- push @{ $self->{tech_c} }, $tech_c if defined $tech_c;
- return \@{ $self->{tech_c} };
+ my ( $self, $contact ) = @_;
+
+ return $self->_multiple_attribute_setget('tech_c',$contact);
}
=head2 B<status( [$status] )>
@@ -214,8 +220,8 @@ Status can have one of these values:
sub status {
my ( $self, $status ) = @_;
- $self->{status} = $status if defined $status;
- return $self->{status};
+
+ return $self->_single_attribute_setget('status',$status);
}
=head2 B<remarks( [$remark] )>
@@ -230,9 +236,9 @@ complaints.
=cut
sub remarks {
- my ( $self, $remarks ) = @_;
- push @{ $self->{remarks} }, $remarks if defined $remarks;
- return \@{ $self->{remarks} };
+ my ( $self, $remark ) = @_;
+
+ return $self->_multiple_attribute_setget('remarks',$remark);
}
=head2 B<notify( [$notify] )>
@@ -248,8 +254,8 @@ sent.
sub notify {
my ( $self, $notify ) = @_;
- push @{ $self->{notify} }, $notify if defined $notify;
- return \@{ $self->{notify} };
+
+ return $self->_multiple_attribute_setget('notify',$notify);
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -262,8 +268,8 @@ always return the current mnt_by array.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- push @{ $self->{mnt_by} }, $mnt_by if defined $mnt_by;
- return \@{ $self->{mnt_by} };
+
+ return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -279,8 +285,8 @@ used as well as 'mnt-by.'
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- push @{ $self->{mnt_lower} }, $mnt_lower if defined $mnt_lower;
- return \@{ $self->{mnt_lower} };
+
+ return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
}
=head2 B<mnt_routes( [$mnt_route] )>
@@ -297,8 +303,8 @@ object.
sub mnt_routes {
my ( $self, $mnt_route ) = @_;
- push @{ $self->{mnt_routes} }, $mnt_route if defined $mnt_route;
- return \@{ $self->{mnt_routes} };
+
+ return $self->_multiple_attribute_setget('mnt_routes',$mnt_route);
}
=head2 B<mnt_domains( [$mnt_route] )>
@@ -315,8 +321,8 @@ object.
sub mnt_domains {
my ( $self, $mnt_route ) = @_;
- push @{ $self->{mnt_domains} }, $mnt_route if defined $mnt_route;
- return \@{ $self->{mnt_domains} };
+
+ return $self->_multiple_attribute_setget('mnt_domains',$mnt_route);
}
=head2 B<mnt_irt( [$mnt_irt] )>
@@ -332,8 +338,8 @@ object to be able to add this reference.
sub mnt_irt {
my ( $self, $mnt_irt ) = @_;
- push @{ $self->{mnt_irt} }, $mnt_irt if defined $mnt_irt;
- return \@{ $self->{mnt_irt} };
+
+ return $self->_multiple_attribute_setget('mnt_irt',$mnt_irt);
}
=head2 B<changed( [$changed] )>
@@ -355,8 +361,8 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- push @{ $self->{changed} }, $changed if defined $changed;
- return \@{ $self->{changed} };
+
+ return $self->_multiple_attribute_setget('changed',$changed);
}
=head2 B<source( [$source] )>
@@ -370,8 +376,8 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- $self->{source} = $source if defined $source;
- return $self->{source};
+
+ return $self->_single_attribute_setget('source',$source);
}
1;
74 lib/Net/Whois/Object/InetNum.pm
View
@@ -55,6 +55,12 @@ sub new {
$self->$key( $options{$key} );
}
+ $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']);
+
return $self;
}
@@ -67,8 +73,8 @@ Accepts an optional inetnum value, always return the current inetnum value.
sub inetnum {
my ( $self, $inetnum ) = @_;
- $self->{inetnum} = $inetnum if defined $inetnum;
- return $self->{inetnum};
+
+ return $self->_single_attribute_setget('inetnum',$inetnum);
}
=head2 B<netname( [$netname] )>
@@ -80,8 +86,8 @@ Accepts an optional netname, always return the current netname.
sub netname {
my ( $self, $netname ) = @_;
- $self->{netname} = $netname if defined $netname;
- return $self->{netname};
+
+ return $self->_single_attribute_setget('netname',$netname);
}
=head2 B<descr( [$descr] )>
@@ -94,8 +100,8 @@ always return the current descr array.
sub descr {
my ( $self, $descr ) = @_;
- push @{ $self->{descr} }, $descr if defined $descr;
- return \@{ $self->{descr} };
+
+ return $self->_multiple_attribute_setget('descr',$descr);
}
=head2 B<country( [$country] )>
@@ -108,8 +114,8 @@ always return the current country array.
sub country {
my ( $self, $country ) = @_;
- push @{ $self->{country} }, $country if defined $country;
- return \@{ $self->{country} };
+
+ return $self->_multiple_attribute_setget('country',$country);
}
=head2 B<org( [$org] )>
@@ -124,8 +130,8 @@ This is to ensure only one organisation is responsible for this resource.
sub org {
my ( $self, $org ) = @_;
- $self->{org} = $org if defined $org;
- return $self->{org};
+
+ return $self->_single_attribute_setget('org',$org);
}
=head2 B<admin_c( [$contact] )>
@@ -144,8 +150,8 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- push @{ $self->{admin_c} }, $contact if defined $contact;
- return \@{ $self->{admin_c} };
+
+ return $self->_multiple_attribute_setget('admin_c',$contact);
}
=head2 B<tech_c( [$contact] )>
@@ -166,8 +172,8 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- push @{ $self->{tech_c} }, $contact if defined $contact;
- return \@{ $self->{tech_c} };
+
+ return $self->_multiple_attribute_setget('tech_c',$contact);
}
=head2 B<status( [$status] )>
@@ -210,8 +216,8 @@ Status can have one of these values:
sub status {
my ( $self, $status ) = @_;
- $self->{status} = $status if defined $status;
- return $self->{status};
+
+ return $self->_single_attribute_setget('status',$status);
}
=head2 B<remarks( [$remark] )>
@@ -227,8 +233,8 @@ complaints.
sub remarks {
my ( $self, $remark ) = @_;
- push @{ $self->{remarks} }, $remark if defined $remark;
- return \@{ $self->{remarks} };
+
+ return $self->_multiple_attribute_setget('remarks',$remark);
}
=head2 B<notify( [$notify] )>
@@ -244,8 +250,8 @@ sent.
sub notify {
my ( $self, $notify ) = @_;
- push @{ $self->{notify} }, $notify if defined $notify;
- return \@{ $self->{notify} };
+
+ return $self->_multiple_attribute_setget('notify',$notify);
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -261,8 +267,8 @@ object.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- push @{ $self->{mnt_by} }, $mnt_by if defined $mnt_by;
- return \@{ $self->{mnt_by} };
+
+ return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
}
=head2 B<mnt_lower( [$mnt_lower] )>
@@ -278,8 +284,8 @@ used as well as mnt_by.
sub mnt_lower {
my ( $self, $mnt_lower ) = @_;
- push @{ $self->{mnt_lower} }, $mnt_lower if defined $mnt_lower;
- return \@{ $self->{mnt_lower} };
+
+ return $self->_multiple_attribute_setget('mnt_lower',$mnt_lower);
}
=head2 B<mnt_routes( [$mnt_route] )>
@@ -296,8 +302,8 @@ object.
sub mnt_routes {
my ( $self, $mnt_route ) = @_;
- push @{ $self->{mnt_routes} }, $mnt_route if defined $mnt_route;
- return \@{ $self->{mnt_routes} };
+
+ return $self->_multiple_attribute_setget('mnt_route',$mnt_route);
}
=head2 B<mnt_domains( [$mnt_domain] )>
@@ -314,8 +320,8 @@ object.
sub mnt_domains {
my ( $self, $mnt_domain ) = @_;
- push @{ $self->{mnt_domains} }, $mnt_domain if defined $mnt_domain;
- return \@{ $self->{mnt_domains} };
+
+ return $self->_multiple_attribute_setget('mnt_domain',$mnt_domain);
}
=head2 B<changed( [$changed] )>
@@ -337,8 +343,8 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- push @{ $self->{changed} }, $changed if defined $changed;
- return \@{ $self->{changed} };
+
+ return $self->_multiple_attribute_setget('changed',$changed);
}
=head2 B<source( [$source] )>
@@ -352,8 +358,8 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- $self->{source} = $source if defined $source;
- return $self->{source};
+
+ return $self->_single_attribute_setget('source',$source);
}
=head2 B<mnt_irt( [$mnt_irt] )>
@@ -369,8 +375,8 @@ about a Computer Security Incident Response Team (CSIRT).
sub mnt_irt {
my ( $self, $mnt_irt ) = @_;
- push @{ $self->{mnt_irt} }, $mnt_irt if defined $mnt_irt;
- return \@{ $self->{mnt_irt} };
+
+ return $self->_multiple_attribute_setget('mnt_irt',$mnt_irt);
}
1;
85 lib/Net/Whois/Object/InetRtr.pm
View
@@ -48,6 +48,11 @@ sub new {
$self->$key( $options{$key} );
}
+ $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']);
+
return $self;
}
@@ -63,8 +68,8 @@ dot.
sub inet_rtr {
my ( $self, $inet_rtr ) = @_;
- $self->{inet_rtr} = $inet_rtr if defined $inet_rtr;
- return $self->{inet_rtr};
+
+ return $self->_single_attribute_setget('inet_rtr',$inet_rtr);
}
=head2 B<descr( [$descr] )>
@@ -79,8 +84,8 @@ A short description related to the object's purpose.
sub descr {
my ( $self, $descr ) = @_;
- push @{ $self->{descr} }, $descr if defined $descr;
- return \@{ $self->{descr} };
+
+ return $self->_multiple_attribute_setget('descr',$descr);
}
=head2 B<alias( [$alias] )>
@@ -96,8 +101,8 @@ specified router.
sub alias {
my ( $self, $alias ) = @_;
- push @{ $self->{alias} }, $alias if defined $alias;
- return \@{ $self->{alias} };
+
+ return $self->_multiple_attribute_setget('alias',$alias);
}
=head2 B<local_as( [$local_as] )>
@@ -112,8 +117,8 @@ operates this router.
sub local_as {
my ( $self, $local_as ) = @_;
- $self->{local_as} = $local_as if defined $local_as;
- return $self->{local_as};
+
+ return $self->_single_attribute_setget('local_as',$local_as);
}
=head2 B<ifaddr( [$ifaddr] )>
@@ -130,8 +135,8 @@ interface.
sub ifaddr {
my ( $self, $ifaddr ) = @_;
- push @{ $self->{ifaddr} }, $ifaddr if defined $ifaddr;
- return \@{ $self->{ifaddr} };
+
+ return $self->_multiple_attribute_setget('ifaddr',$ifaddr);
}
=head2 B<peer( [$peer] )>
@@ -147,8 +152,8 @@ peering.
sub peer {
my ( $self, $peer ) = @_;
- push @{ $self->{peer} }, $peer if defined $peer;
- return \@{ $self->{peer} };
+
+ return $self->_multiple_attribute_setget('peer',$peer);
}
=head2 B<member_of( [$member_of] )>
@@ -165,8 +170,8 @@ respective mbrs-by-ref attribute in the referenced object.
sub member_of {
my ( $self, $member_of ) = @_;
- push @{ $self->{member_of} }, $member_of if defined $member_of;
- return \@{ $self->{member_of} };
+
+ return $self->_multiple_attribute_setget('member_of',$member_of);
}
=head2 B<remarks( [$remark] )>
@@ -182,8 +187,8 @@ complaints.
sub remarks {
my ( $self, $remark ) = @_;
- push @{ $self->{remarks} }, $remark if defined $remark;
- return \@{ $self->{remarks} };
+
+ return $self->_multiple_attribute_setget('remarks',$remark);
}
=head2 B<admin_c( [$contact] )>
@@ -202,8 +207,8 @@ located at the site of the network.
sub admin_c {
my ( $self, $contact ) = @_;
- push @{ $self->{admin_c} }, $contact if defined $contact;
- return \@{ $self->{admin_c} };
+
+ return $self->_multiple_attribute_setget('admin_c',$contact);
}
=head2 B<tech_c( [$contact] )>
@@ -224,8 +229,8 @@ physically located at the site of the network.
sub tech_c {
my ( $self, $contact ) = @_;
- push @{ $self->{tech_c} }, $contact if defined $contact;
- return \@{ $self->{tech_c} };
+
+ return $self->_multiple_attribute_setget('tech_c',$contact);
}
=head2 B<notify( [$notify] )>
@@ -241,8 +246,8 @@ be sent.
sub notify {
my ( $self, $notify ) = @_;
- push @{ $self->{notify} }, $notify if defined $notify;
- return \@{ $self->{notify} };
+
+ return $self->_multiple_attribute_setget('notify',$notify);
}
=head2 B<mnt_by( [$mnt_by] )>
@@ -258,8 +263,8 @@ object.
sub mnt_by {
my ( $self, $mnt_by ) = @_;
- push @{ $self->{mnt_by} }, $mnt_by if defined $mnt_by;
- return \@{ $self->{mnt_by} };
+
+ return $self->_multiple_attribute_setget('mnt_by',$mnt_by);
}
=head2 B<changed( [$changed] )>
@@ -281,8 +286,8 @@ format using one of the following two formats: YYYYMMDD or YYMMDD.
sub changed {
my ( $self, $changed ) = @_;
- push @{ $self->{changed} }, $changed if defined $changed;
- return \@{ $self->{changed} };
+
+ return $self->_multiple_attribute_setget('changed',$changed);
}
=head2 B<source( [$source] )>
@@ -296,8 +301,8 @@ The database where the object is registered.
sub source {
my ( $self, $source ) = @_;
- $self->{source} = $source if defined $source;
- return $self->{source};
+
+ return $self->_single_attribute_setget('source',$source);
}
=head2 B<mp_peer( [$peer] )>
@@ -316,8 +321,8 @@ The mp-peer attribute extends the peer attribute for IPv6 addresses.
sub mp_peer {
my ( $self, $mp_peer ) = @_;
- push @{ $self->{mp_peer} }, $mp_peer if defined $mp_peer;
- return \@{ $self->{mp_peer} };
+
+ return $self->_multiple_attribute_setget('mp_peer',$mp_peer);
}
=head2 B<interface( [$interface] )>
@@ -333,8 +338,24 @@ an Internet router, optional action and tunnel definition.
sub interface {
my ( $self, $interface ) = @_;
- push @{ $self->{interface} }, $interface if defined $interface;
- return \@{ $self->{interface} };
+
+ return $self->_multiple_attribute_setget('interface',$interface);
+}
+
+=head2 B<org( [$org] )>
+
+Accessor to the org attribute.
+Accepts an optional org to be added to the org array,
+always return the current org array.
+
+The organisation entity this object is bound to.
+
+=cut
+
+sub org {
+ my ( $self, $org ) = @_;
+
+ return $self->_multiple_attribute_setget('org',$org);
}
1;
8 lib/Net/Whois/Object/Information.pm
View
@@ -36,6 +36,10 @@ sub new {
$self->$key( $options{$key} );
}
+ $self->attributes('mandatory',['comment']);
+ $self->attributes( 'optionnal', [ ] );
+ $self->attributes('multiple',['comment']);
+
return $self;
}
@@ -49,8 +53,8 @@ always return the current comment array.
sub comment {
my ( $self, $comment ) = @_;
- push @{ $self->{comment} }, $comment if defined $comment;
- return \@{ $self->{comment} };
+
+ return $self->_multiple_attribute_setget('comment',$comment);
}
1;
80 lib/Net/Whois/Object/Irt.pm
View
@@ -54,7 +54,14 @@ sub new {
$self->$key( $options{$key} );
}
+ $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']);
+