From fcd9e808150bb7fa904efe2378a4b9b14c380855 Mon Sep 17 00:00:00 2001 From: "Arnaud \"Arhuman\" Assad" Date: Wed, 4 Jul 2012 05:53:32 +0200 Subject: [PATCH] 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 --- Changes | 14 ++ META.json | 22 ++- META.yml | 7 +- lib/Net/Whois/Object.pm | 253 ++++++++++++++++++++++++--- lib/Net/Whois/Object/AsBlock.pm | 49 +++--- lib/Net/Whois/Object/AsSet.pm | 48 ++--- lib/Net/Whois/Object/AutNum.pm | 88 +++++----- lib/Net/Whois/Object/Domain.pm | 73 ++++---- lib/Net/Whois/Object/FilterSet.pm | 60 ++++--- lib/Net/Whois/Object/Inet6Num.pm | 78 +++++---- lib/Net/Whois/Object/InetNum.pm | 74 ++++---- lib/Net/Whois/Object/InetRtr.pm | 85 +++++---- lib/Net/Whois/Object/Information.pm | 8 +- lib/Net/Whois/Object/Irt.pm | 80 +++++---- lib/Net/Whois/Object/KeyCert.pm | 69 ++++---- lib/Net/Whois/Object/Limerick.pm | 48 ++--- lib/Net/Whois/Object/Mntner.pm | 77 ++++---- lib/Net/Whois/Object/Organisation.pm | 79 +++++---- lib/Net/Whois/Object/PeeringSet.pm | 53 +++--- lib/Net/Whois/Object/Person.pm | 51 +++--- lib/Net/Whois/Object/Poem.pm | 53 +++--- lib/Net/Whois/Object/PoeticForm.pm | 50 ++++-- lib/Net/Whois/Object/Response.pm | 8 +- lib/Net/Whois/Object/Role.pm | 61 ++++--- lib/Net/Whois/Object/Route.pm | 85 ++++----- lib/Net/Whois/Object/Route6.pm | 81 +++++---- lib/Net/Whois/Object/RouteSet.pm | 57 +++--- lib/Net/Whois/Object/RtrSet.pm | 53 +++--- lib/Net/Whois/RIPE.pm | 4 +- t/03-objects.t | 57 +++--- t/105-AsBlock.t | 65 +++++-- t/110-AutNum.t | 105 ++++++++--- t/115-Person.t | 57 ++++-- t/120-Role.t | 72 ++++++-- t/125-AsSet.t | 47 +++-- t/130-Domain.t | 63 +++++-- t/135-InetNum.t | 64 +++++-- t/140-Inet6Num.t | 66 +++++-- t/145-InetRtr.t | 66 +++++-- t/150-RtrSet.t | 49 ++++-- t/155-Mntner.t | 67 +++++-- t/160-KeyCert.t | 63 +++++-- t/165-Route.t | 65 +++++-- t/167-Route6.t | 63 +++++-- t/170-RouteSet.t | 51 ++++-- t/175-PeeringSet.t | 49 ++++-- t/180-Limerick.t | 45 +++-- t/185-Poem.t | 62 +++++-- t/187-PoeticForm.t | 97 +++++----- t/190-Organisation.t | 73 ++++++-- t/195-Response.t | 26 +-- t/200-Information.t | 33 ++-- t/205-Irt.t | 74 ++++++-- t/210-FilterSet.t | 53 ++++-- t/common.pl | 40 +++++ 55 files changed, 2287 insertions(+), 1053 deletions(-) create mode 100644 t/common.pl diff --git a/Changes b/Changes index 864d450..ce225e8 100644 --- a/Changes +++ b/Changes @@ -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 diff --git a/META.json b/META.json index 62f72c9..8deae76 100644 --- a/META.json +++ b/META.json @@ -4,7 +4,7 @@ "Luis Motta Campos " ], "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" } diff --git a/META.yml b/META.yml index a04869c..01dd6c5 100644 --- a/META.yml +++ b/META.yml @@ -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 diff --git a/lib/Net/Whois/Object.pm b/lib/Net/Whois/Object.pm index 26e99ae..5dc24ee 100644 --- a/lib/Net/Whois/Object.pm +++ b/lib/Net/Whois/Object.pm @@ -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 +=head2 B -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 +=head2 B + +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 + +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 -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 @@ -139,6 +254,41 @@ sub displayed_attributes { return @{ $self->{displayed_attributes} }; } +=head2 B + +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<< >> diff --git a/lib/Net/Whois/Object/AsBlock.pm b/lib/Net/Whois/Object/AsBlock.pm index 9770732..33c0a81 100644 --- a/lib/Net/Whois/Object/AsBlock.pm +++ b/lib/Net/Whois/Object/AsBlock.pm @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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; diff --git a/lib/Net/Whois/Object/AsSet.pm b/lib/Net/Whois/Object/AsSet.pm index 8f26f81..ded8a46 100644 --- a/lib/Net/Whois/Object/AsSet.pm +++ b/lib/Net/Whois/Object/AsSet.pm @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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; diff --git a/lib/Net/Whois/Object/AutNum.pm b/lib/Net/Whois/Object/AutNum.pm index 8e88656..f351710 100644 --- a/lib/Net/Whois/Object/AutNum.pm +++ b/lib/Net/Whois/Object/AutNum.pm @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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; diff --git a/lib/Net/Whois/Object/Domain.pm b/lib/Net/Whois/Object/Domain.pm index b142dfb..17beeb3 100644 --- a/lib/Net/Whois/Object/Domain.pm +++ b/lib/Net/Whois/Object/Domain.pm @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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; diff --git a/lib/Net/Whois/Object/FilterSet.pm b/lib/Net/Whois/Object/FilterSet.pm index 57e315c..0fe1b07 100644 --- a/lib/Net/Whois/Object/FilterSet.pm +++ b/lib/Net/Whois/Object/FilterSet.pm @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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; diff --git a/lib/Net/Whois/Object/Inet6Num.pm b/lib/Net/Whois/Object/Inet6Num.pm index ae54c9f..03ab8a9 100644 --- a/lib/Net/Whois/Object/Inet6Num.pm +++ b/lib/Net/Whois/Object/Inet6Num.pm @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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; diff --git a/lib/Net/Whois/Object/InetNum.pm b/lib/Net/Whois/Object/InetNum.pm index 55016f6..8fcb229 100644 --- a/lib/Net/Whois/Object/InetNum.pm +++ b/lib/Net/Whois/Object/InetNum.pm @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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; diff --git a/lib/Net/Whois/Object/InetRtr.pm b/lib/Net/Whois/Object/InetRtr.pm index a29f025..3540cc9 100644 --- a/lib/Net/Whois/Object/InetRtr.pm +++ b/lib/Net/Whois/Object/InetRtr.pm @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 + +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; diff --git a/lib/Net/Whois/Object/Information.pm b/lib/Net/Whois/Object/Information.pm index 1ff9b2c..eb48a02 100644 --- a/lib/Net/Whois/Object/Information.pm +++ b/lib/Net/Whois/Object/Information.pm @@ -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; diff --git a/lib/Net/Whois/Object/Irt.pm b/lib/Net/Whois/Object/Irt.pm index b059ded..8197e29 100644 --- a/lib/Net/Whois/Object/Irt.pm +++ b/lib/Net/Whois/Object/Irt.pm @@ -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']); + return $self; + } =head2 B @@ -71,8 +78,7 @@ sub irt { if ( $irt and $irt !~ /^IRT-/i ) { warn "Irt name not valid ($irt) : Should start with 'IRT-'"; } - $self->{irt} = $irt if defined $irt; - return $self->{irt}; + return $self->_single_attribute_setget('irt',$irt); } =head2 B @@ -90,8 +96,8 @@ More than one line can be used. sub address { my ( $self, $address ) = @_; - push @{ $self->{address} }, $address if defined $address; - return \@{ $self->{address} }; + + return $self->_multiple_attribute_setget('address',$address); } =head2 B @@ -113,8 +119,8 @@ A contact telephone number. sub phone { my ( $self, $phone ) = @_; - push @{ $self->{phone} }, $phone if defined $phone; - return \@{ $self->{phone} }; + + return $self->_multiple_attribute_setget('phone',$phone); } =head2 B @@ -131,8 +137,8 @@ A contact fax number. sub fax_no { my ( $self, $fax_no ) = @_; - push @{ $self->{fax_no} }, $fax_no if defined $fax_no; - return \@{ $self->{fax_no} }; + + return $self->_multiple_attribute_setget('fax_no',$fax_no); } =head2 B @@ -147,8 +153,8 @@ A contact email address for non-abuse/technical incidents. sub e_mail { my ( $self, $e_mail ) = @_; - push @{ $self->{e_mail} }, $e_mail if defined $e_mail; - return \@{ $self->{e_mail} }; + + return $self->_multiple_attribute_setget('e_mail',$e_mail); } =head2 B @@ -163,8 +169,8 @@ Specifies the email address to which abuse complaints should be sent. sub abuse_mailbox { my ( $self, $abuse_mailbox ) = @_; - push @{ $self->{abuse_mailbox} }, $abuse_mailbox if defined $abuse_mailbox; - return \@{ $self->{abuse_mailbox} }; + + return $self->_multiple_attribute_setget('abuse_mailbox',$abuse_mailbox); } =head2 B @@ -180,8 +186,8 @@ team to sign their correspondence. sub signature { my ( $self, $signature ) = @_; - push @{ $self->{signature} }, $signature if defined $signature; - return \@{ $self->{signature} }; + + return $self->_multiple_attribute_setget('signature',$signature); } =head2 B @@ -197,8 +203,8 @@ correspondence sent to the CSIRT. sub encryption { my ( $self, $encryption ) = @_; - push @{ $self->{encryption} }, $encryption if defined $encryption; - return \@{ $self->{encryption} }; + + return $self->_multiple_attribute_setget('encryption',$encryption); } =head2 B @@ -213,8 +219,8 @@ The organisation responsible for this resource. sub org { my ( $self, $org ) = @_; - push @{ $self->{org} }, $org if defined $org; - return \@{ $self->{org} }; + + return $self->_multiple_attribute_setget('org',$org); } =head2 B @@ -230,8 +236,8 @@ authentication schemes used by the RIPE Database are allowed. sub auth { my ( $self, $auth ) = @_; - push @{ $self->{auth} }, $auth if defined $auth; - return \@{ $self->{auth} }; + + return $self->_multiple_attribute_setget('auth',$auth); } =head2 B @@ -250,8 +256,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 @@ -271,8 +277,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 @@ -286,9 +292,9 @@ Information about the object that cannot be stated in other attributes. =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 @@ -304,8 +310,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 @@ -321,8 +327,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 @@ -344,8 +350,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 @@ -359,8 +365,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 @@ -376,8 +382,8 @@ reference to the irt object is added or removed. sub irt_nfy { my ( $self, $irt_nfy ) = @_; - push @{ $self->{irt_nfy} }, $irt_nfy if defined $irt_nfy; - return \@{ $self->{irt_nfy} }; + + return $self->_multiple_attribute_setget('irt_nfy',$irt_nfy); } 1; diff --git a/lib/Net/Whois/Object/KeyCert.pm b/lib/Net/Whois/Object/KeyCert.pm index 983493c..32e6908 100644 --- a/lib/Net/Whois/Object/KeyCert.pm +++ b/lib/Net/Whois/Object/KeyCert.pm @@ -46,6 +46,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['key_cert', 'certif', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'org', 'remarks', 'notify', 'admin_c', 'tech_c' ] ); + $self->attributes('single',['key_cert', 'method', 'fingerpr', 'source']); + $self->attributes('multiple',['owner', 'certif', 'org', 'remarks', 'tech_c', 'admin_c', 'notify', 'mnt_by', 'changed']); + return $self; } @@ -67,8 +72,8 @@ recreate it with the same name. sub key_cert { my ( $self, $key_cert ) = @_; - $self->{key_cert} = $key_cert if defined $key_cert; - return $self->{key_cert}; + + return $self->_single_attribute_setget('key_cert',$key_cert); } =head2 B @@ -86,8 +91,8 @@ value. In this case a warning is returned to the user. sub method { my ( $self, $method ) = @_; - $self->{method} = $method if defined $method; - return $self->{method}; + + return $self->_single_attribute_setget('method',$method); } =head2 B @@ -106,8 +111,8 @@ value. In this case a warning is returned to the user. sub owner { my ( $self, $owner ) = @_; - push @{ $self->{owner} }, $owner if defined $owner; - return \@{ $self->{owner} }; + + return $self->_multiple_attribute_setget('owner',$owner); } =head2 B @@ -125,8 +130,8 @@ value. In this case a warning is returned to the user. sub fingerpr { my ( $self, $fingerpr ) = @_; - $self->{fingerpr} = $fingerpr if defined $fingerpr; - return $self->{fingerpr}; + + return $self->_single_attribute_setget('fingerpr',$fingerpr); } =head2 B @@ -149,8 +154,8 @@ from the key body. sub certif { my ( $self, $certif ) = @_; - push @{ $self->{certif} }, $certif if defined $certif; - return \@{ $self->{certif} }; + + return $self->_multiple_attribute_setget('certif',$certif); } =head2 B @@ -165,8 +170,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 @@ -181,8 +186,8 @@ The organisation entity this object is bound to. sub org { my ( $self, $org ) = @_; - push @{ $self->{org} }, $org if defined $org; - return \@{ $self->{org} }; + + return $self->_multiple_attribute_setget('org',$org); } =head2 B @@ -198,14 +203,14 @@ 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 +=head2 B Accessor to the admin_c attribute. -Accepts an optional admin_c value to be added to the admin_c array, +Accepts an optional contact to be added to the admin_c array, always return the current admin_c array. The NIC-handle of an on-site contact Person object. As more than one person @@ -217,15 +222,15 @@ located at the site of the network. =cut sub admin_c { - my ( $self, $admin_c ) = @_; - push @{ $self->{admin_c} }, $admin_c if defined $admin_c; - return \@{ $self->{admin_c} }; + my ( $self, $contact ) = @_; + + return $self->_multiple_attribute_setget('admin_c',$contact); } -=head2 B +=head2 B Accessor to the tech_c attribute. -Accepts an optional tech_c value to be added to the tech_c array, +Accepts an optional contact to be added to the tech_c array, always return the current tech_c array. The NIC-handle of a technical contact Person or Role object. As more than @@ -239,9 +244,9 @@ physically located at the site of the network. =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 @@ -257,8 +262,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 @@ -280,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 @@ -295,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; diff --git a/lib/Net/Whois/Object/Limerick.pm b/lib/Net/Whois/Object/Limerick.pm index 15b7e1c..840b78f 100644 --- a/lib/Net/Whois/Object/Limerick.pm +++ b/lib/Net/Whois/Object/Limerick.pm @@ -42,7 +42,13 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['limerick', 'text', 'admin_c', 'author', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'descr', 'remarks', 'notify' ] ); + $self->attributes('single',['limerick', 'source']); + $self->attributes('multiple',['text', 'admin_c', 'author', 'mnt_by', 'changed', 'descr', 'remarks', 'notify' ] ); + return $self; + } =head2 B @@ -54,8 +60,8 @@ Accepts an optional value, always return the current limerick value. sub limerick { my ( $self, $limerick ) = @_; - $self->{limerick} = $limerick if defined $limerick; - return $self->{limerick}; + + return $self->_single_attribute_setget('limerick', $limerick); } =head2 B @@ -68,8 +74,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 @@ -82,8 +88,8 @@ always return the current text array. sub text { my ( $self, $text ) = @_; - push @{ $self->{text} }, $text if defined $text; - return \@{ $self->{text} }; + + return $self->_multiple_attribute_setget('text', $text); } =head2 B @@ -96,8 +102,8 @@ always return the current admin_c array. 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 @@ -110,8 +116,8 @@ always return the current author array. sub author { my ( $self, $author ) = @_; - push @{ $self->{author} }, $author if defined $author; - return \@{ $self->{author} }; + + return $self->_multiple_attribute_setget('author', $author); } =head2 B @@ -123,9 +129,9 @@ always return the current remarks array. =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 @@ -138,8 +144,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 @@ -152,8 +158,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 @@ -166,8 +172,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 @@ -179,8 +185,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } 1; diff --git a/lib/Net/Whois/Object/Mntner.pm b/lib/Net/Whois/Object/Mntner.pm index c2edc6d..143051d 100644 --- a/lib/Net/Whois/Object/Mntner.pm +++ b/lib/Net/Whois/Object/Mntner.pm @@ -56,6 +56,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['mntner', 'descr', 'admin_c', 'auth', 'mnt_by', 'referral_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'org', 'tech_c', 'mnt_nfy', 'remarks', 'notify', 'abuse_mailbox', 'auth_override' ] ); + $self->attributes('single',['mntner', 'auth_override', 'auth', 'referral_by', 'source']); + $self->attributes('multiple',['descr', 'admin_c', 'mnt_by', 'changed', 'org', 'tech_c', 'mnt_nfy', 'remarks', 'notify', 'abuse_mailbox' ] ); + return $self; } @@ -78,8 +83,8 @@ Maintainer for resource registrations: sub mntner { my ( $self, $mntner ) = @_; - $self->{mntner} = $mntner if defined $mntner; - return $self->{mntner}; + + return $self->_single_attribute_setget('mntner', $mntner); } =head2 B @@ -95,8 +100,8 @@ associated with it. sub descr { my ( $self, $descr ) = @_; - push @{ $self->{descr} }, $descr if defined $descr; - return \@{ $self->{descr} }; + + return $self->_multiple_attribute_setget('descr', $descr); } =head2 B @@ -111,8 +116,8 @@ The organisation this object is bound to. sub org { my ( $self, $org ) = @_; - push @{ $self->{org} }, $org if defined $org; - return \@{ $self->{org} }; + + return $self->_multiple_attribute_setget('org', $org); } =head2 B @@ -132,8 +137,8 @@ physically 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 @@ -153,9 +158,9 @@ physically located at the site of the network. =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 @@ -171,8 +176,8 @@ attempt to update an object protected by this Mntner is unsuccessful. sub upd_to { my ( $self, $upd_to ) = @_; - push @{ $self->{upd_to} }, $upd_to if defined $upd_to; - return \@{ $self->{upd_to} }; + + return $self->_multiple_attribute_setget('upd_to', $upd_to); } =head2 B @@ -188,8 +193,8 @@ object protected by this Mntner is successfully updated. sub mnt_nfy { my ( $self, $mnt_nfy ) = @_; - push @{ $self->{mnt_nfy} }, $mnt_nfy if defined $mnt_nfy; - return \@{ $self->{mnt_nfy} }; + + return $self->_multiple_attribute_setget('mnt_nfy', $mnt_nfy); } =head2 B @@ -205,8 +210,8 @@ the current authentication schemes used by the RIPE Database are allowed. sub auth { my ( $self, $auth ) = @_; - push @{ $self->{auth} }, $auth if defined $auth; - return \@{ $self->{auth} }; + + return $self->_multiple_attribute_setget('auth', $auth); } =head2 B @@ -220,9 +225,9 @@ General remarks. May include a URL or email address. =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 @@ -238,8 +243,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 @@ -257,8 +262,8 @@ Most users set the mnt-by value in a Mntner to reference itself. 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 @@ -276,8 +281,8 @@ it has not been implemented in the current version of the database. sub auth_override { my ( $self, $auth_override ) = @_; - $self->{auth_override} = $auth_override if defined $auth_override; - return $self->{auth_override}; + + return $self->_single_attribute_setget('auth_override', $auth_override); } =head2 B @@ -295,8 +300,8 @@ it has not been implemented in the current version of the database. sub referral_by { my ( $self, $referral_by ) = @_; - $self->{referral_by} = $referral_by if defined $referral_by; - return $self->{referral_by}; + + return $self->_single_attribute_setget('referral_by', $referral_by); } =head2 B @@ -318,8 +323,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 @@ -333,8 +338,8 @@ The name of the database from which the data was obtained. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } =head2 B @@ -349,8 +354,8 @@ Please use UPPERCASE letters. sub country { my ( $self, $country ) = @_; - $self->{country} = $country if defined $country; - return $self->{country}; + + return $self->_single_attribute_setget('country', $country); } =head2 B @@ -363,8 +368,8 @@ always return the current abuse_mailbox array. sub abuse_mailbox { my ( $self, $abuse_mailbox ) = @_; - push @{ $self->{abuse_mailbox} }, $abuse_mailbox if defined $abuse_mailbox; - return \@{ $self->{abuse_mailbox} }; + + return $self->_multiple_attribute_setget('abuse_mailbox', $abuse_mailbox); } 1; diff --git a/lib/Net/Whois/Object/Organisation.pm b/lib/Net/Whois/Object/Organisation.pm index 8df6072..1d70c18 100644 --- a/lib/Net/Whois/Object/Organisation.pm +++ b/lib/Net/Whois/Object/Organisation.pm @@ -50,6 +50,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['organisation', 'org_name', 'org_type', 'address', 'e_mail', 'mnt_ref', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'descr', 'remarks', 'phone', 'fax_no', 'org', 'admin_c', 'tech_c', 'ref_nfy', 'notify' ] ); + $self->attributes('single',['organisation', 'org_name', 'org_type', 'source']); + $self->attributes('multiple',['descr', 'remarks', 'address', 'phone', 'fax_no', 'e_mail', 'org', 'admin_c', 'tech_c', 'ref_nfy', 'mnt_ref', 'notify', 'mnt_by', 'changed']); + return $self; } @@ -62,8 +67,8 @@ Accepts an optional organisation, always return the current organisation. sub organisation { my ( $self, $organisation ) = @_; - $self->{organisation} = $organisation if defined $organisation; - return $self->{organisation}; + + return $self->_single_attribute_setget('organisation', $organisation); } =head2 B @@ -75,8 +80,8 @@ Accepts an optional org_name, always return the current org_name. sub org_name { my ( $self, $org_name ) = @_; - $self->{org_name} = $org_name if defined $org_name; - return $self->{org_name}; + + return $self->_single_attribute_setget('org_name', $org_name); } =head2 B @@ -93,8 +98,8 @@ Registries, and OTHER for all other organisations. sub org_type { my ( $self, $org_type ) = @_; - $self->{org_type} = $org_type if defined $org_type; - return $self->{org_type}; + + return $self->_single_attribute_setget('org_type', $org_type); } =head2 B @@ -106,8 +111,8 @@ Accepts an optional org, always return the current org. sub org { my ( $self, $org ) = @_; - $self->{org} = $role if defined $role; - return $self->{org}; + + return $self->_single_attribute_setget('org', $org); } =head2 B @@ -120,8 +125,8 @@ always return the current address array. sub address { my ( $self, $address ) = @_; - push @{ $self->{address} }, $address if defined $address; - return \@{ $self->{address} }; + + return $self->_multiple_attribute_setget('address', $address); } =head2 B @@ -134,8 +139,8 @@ always return the current phone array. sub phone { my ( $self, $phone ) = @_; - push @{ $self->{phone} }, $phone if defined $phone; - return \@{ $self->{phone} }; + + return $self->_multiple_attribute_setget('phone', $phone); } =head2 B @@ -148,8 +153,8 @@ always return the current fax_no array. sub fax_no { my ( $self, $fax_no ) = @_; - push @{ $self->{fax_no} }, $fax_no if defined $fax_no; - return \@{ $self->{fax_no} }; + + return $self->_multiple_attribute_setget('fax_no', $fax_no); } =head2 B @@ -162,8 +167,8 @@ always return the current e_mail array. sub e_mail { my ( $self, $e_mail ) = @_; - push @{ $self->{e_mail} }, $e_mail if defined $e_mail; - return \@{ $self->{e_mail} }; + + return $self->_multiple_attribute_setget('e_mail', $e_mail); } =head2 B @@ -176,8 +181,8 @@ always return the current admin_c array. 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 @@ -190,8 +195,8 @@ always return the current tech_c array. 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 @@ -204,8 +209,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 @@ -217,9 +222,9 @@ always return the current remarks array. =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 @@ -232,8 +237,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 @@ -246,8 +251,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 @@ -260,8 +265,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 @@ -273,8 +278,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } =head2 B @@ -287,8 +292,8 @@ always return the current ref_nfy array. sub ref_nfy { my ( $self, $ref_nfy ) = @_; - push @{ $self->{ref_nfy} }, $ref_nfy if defined $ref_nfy; - return \@{ $self->{ref_nfy} }; + + return $self->_multiple_attribute_setget('ref_nfy', $ref_nfy); } @@ -302,8 +307,8 @@ always return the current mnt_ref array. sub mnt_ref { my ( $self, $mnt_ref ) = @_; - push @{ $self->{mnt_ref} }, $mnt_ref if defined $mnt_ref; - return \@{ $self->{mnt_ref} }; + + return $self->_multiple_attribute_setget('mnt_ref', $mnt_ref); } 1; diff --git a/lib/Net/Whois/Object/PeeringSet.pm b/lib/Net/Whois/Object/PeeringSet.pm index 3529664..cf00937 100644 --- a/lib/Net/Whois/Object/PeeringSet.pm +++ b/lib/Net/Whois/Object/PeeringSet.pm @@ -49,6 +49,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['peering_set', 'descr', 'peering', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'remarks', 'notify' ] ); + $self->attributes('single',['peering_set', 'source']); + $self->attributes('multiple',['descr', 'peering', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'remarks', 'notify' ] ); + return $self; } @@ -63,8 +68,8 @@ The peering_set must begin with 'PRNG-'. sub peering_set { my ( $self, $peering_set ) = @_; - $self->{peering_set} = $peering_set if defined $peering_set; - return $self->{peering_set}; + + return $self->_single_attribute_setget('peering_set', $peering_set); } =head2 B @@ -77,8 +82,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 @@ -91,8 +96,8 @@ always return the current peering array. sub peering { my ( $self, $peering ) = @_; - push @{ $self->{peering} }, $peering if defined $peering; - return \@{ $self->{peering} }; + + return $self->_multiple_attribute_setget('peering', $peering); } =head2 B @@ -105,8 +110,8 @@ always return the current remarks array. sub remarks { my ( $self, $remark ) = @_; - push @{ $self->{remarks} }, $remark if defined $remark; - return \@{ $self->{remarks} }; + + return $self->_multiple_attribute_setget('remarks', $remark); } =head2 B @@ -119,8 +124,8 @@ always return the current tech_c array. 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 @@ -133,8 +138,8 @@ always return the current admin_c array. 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 @@ -147,8 +152,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 @@ -161,8 +166,8 @@ Accepts an optional mnt_by value to be added to the 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 @@ -175,8 +180,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 @@ -188,8 +193,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } =head2 B @@ -202,8 +207,8 @@ always return the current mp_peering array. sub mp_peering { my ( $self, $mp_peering ) = @_; - push @{ $self->{mp_peering} }, $mp_peering if defined $mp_peering; - return \@{ $self->{mp_peering} }; + + return $self->_multiple_attribute_setget('mp_peering', $mp_peering); } =head2 B @@ -216,8 +221,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); } 1; diff --git a/lib/Net/Whois/Object/Person.pm b/lib/Net/Whois/Object/Person.pm index 94e589b..c6cb7de 100644 --- a/lib/Net/Whois/Object/Person.pm +++ b/lib/Net/Whois/Object/Person.pm @@ -45,6 +45,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['person', 'address', 'phone', 'nic_hdl', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'fax_no', 'e_mail', 'remarks', 'notify', 'mnt_by' ] ); + $self->attributes('single',['person', 'nic_hdl', 'source']); + $self->attributes('multiple',['address', 'phone', 'changed', 'fax_no', 'e_mail', 'remarks', 'notify', 'mnt_by' ] ); + return $self; } @@ -57,8 +62,8 @@ Accepts an optional person, always return the current person. sub person { my ( $self, $person ) = @_; - $self->{person} = $person if defined $person; - return $self->{person}; + + return $self->_single_attribute_setget('person', $person); } =head2 B @@ -71,8 +76,8 @@ always return the current address array. sub address { my ( $self, $address ) = @_; - push @{ $self->{address} }, $address if defined $address; - return \@{ $self->{address} }; + + return $self->_multiple_attribute_setget('address', $address); } =head2 B @@ -85,8 +90,8 @@ always return the current phone array. sub phone { my ( $self, $phone ) = @_; - push @{ $self->{phone} }, $phone if defined $phone; - return \@{ $self->{phone} }; + + return $self->_multiple_attribute_setget('phone', $phone); } =head2 B @@ -99,8 +104,8 @@ always return the current fax_no array. sub fax_no { my ( $self, $fax_no ) = @_; - push @{ $self->{fax_no} }, $fax_no if defined $fax_no; - return \@{ $self->{fax_no} }; + + return $self->_multiple_attribute_setget('fax_no', $fax_no); } =head2 B @@ -113,8 +118,8 @@ always return the current e_mail array. sub e_mail { my ( $self, $e_mail ) = @_; - push @{ $self->{e_mail} }, $e_mail if defined $e_mail; - return \@{ $self->{e_mail} }; + + return $self->_multiple_attribute_setget('e_mail', $e_mail); } =head2 B @@ -126,8 +131,8 @@ Accepts an optional nic_hdl, always return the current nic_hdl. sub nic_hdl { my ( $self, $nic_hdl ) = @_; - $self->{nic_hdl} = $nic_hdl if defined $nic_hdl; - return $self->{nic_hdl}; + + return $self->_single_attribute_setget('nic_hdl', $nic_hdl); } =head2 B @@ -139,9 +144,9 @@ always return the current remarks array. =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 @@ -154,8 +159,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 @@ -168,8 +173,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 @@ -182,8 +187,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 @@ -195,8 +200,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } 1; diff --git a/lib/Net/Whois/Object/Poem.pm b/lib/Net/Whois/Object/Poem.pm index 5cf4894..6b053ac 100644 --- a/lib/Net/Whois/Object/Poem.pm +++ b/lib/Net/Whois/Object/Poem.pm @@ -44,6 +44,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['poem', 'form', 'text', 'author', 'admin_c', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'descr', 'remarks', 'notify' ] ); + $self->attributes('single',['poem', 'form', 'source']); + $self->attributes('multiple',['descr', 'text', 'admin_c', 'author', 'remarks', 'notify', 'mnt_by', 'changed']); + return $self; } @@ -57,8 +62,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 @@ -71,8 +76,8 @@ always return the current text array. sub text { my ( $self, $text ) = @_; - push @{ $self->{text} }, $text if defined $text; - return \@{ $self->{text} }; + + return $self->_multiple_attribute_setget('text', $text); } =head2 B @@ -84,9 +89,9 @@ always return the current admin_c array. =cut sub admin_c { - my ( $self, $admin_c ) = @_; - push @{ $self->{admin_c} }, $admin_c if defined $admin_c; - return \@{ $self->{admin_c} }; + my ( $self, $contact ) = @_; + + return $self->_multiple_attribute_setget('admin_c', $contact); } =head2 B @@ -99,8 +104,8 @@ always return the current author array. sub author { my ( $self, $author ) = @_; - push @{ $self->{author} }, $author if defined $author; - return \@{ $self->{author} }; + + return $self->_multiple_attribute_setget('author', $author); } =head2 B @@ -112,9 +117,9 @@ always return the current remarks array. =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 @@ -127,8 +132,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 @@ -141,8 +146,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 @@ -155,8 +160,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 @@ -168,8 +173,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } =head2 B @@ -182,8 +187,8 @@ This attribute specifies the identifier of a registered poem type. sub form { my ( $self, $form ) = @_; - $self->{form} = $form if defined $form; - return $self->{form}; + + return $self->_single_attribute_setget('form', $form); } =head2 B @@ -195,8 +200,8 @@ Accepts an optional poem, always return the current poem. sub poem { my ( $self, $poem ) = @_; - $self->{poem} = $poem if defined $poem; - return $self->{poem}; + + return $self->_single_attribute_setget('poem', $poem); } 1; diff --git a/lib/Net/Whois/Object/PoeticForm.pm b/lib/Net/Whois/Object/PoeticForm.pm index 6538868..79c69c1 100644 --- a/lib/Net/Whois/Object/PoeticForm.pm +++ b/lib/Net/Whois/Object/PoeticForm.pm @@ -42,9 +42,27 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['poetic_form', 'admin_c', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'descr', 'remarks', 'notify' ] ); + $self->attributes('single',['poetic_form', 'source']); + $self->attributes('multiple',['descr', 'admin_c', 'remarks', 'notify', 'mnt_by', 'changed' ] ); + return $self; } +=head2 B + +Accessor to the poetic_form attribute. +Accepts an optional poetic_form, always return the current poetic_form. + +=cut + +sub poetic_form { + my ( $self, $poetic_form ) = @_; + + return $self->_single_attribute_setget('poetic_form', $poetic_form); +} + =head2 B Accessor to the descr attribute. @@ -55,8 +73,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 @@ -68,9 +86,9 @@ always return the current admin_c array. =cut sub admin_c { - my ( $self, $admin_c ) = @_; - push @{ $self->{admin_c} }, $admin_c if defined $admin_c; - return \@{ $self->{admin_c} }; + my ( $self, $contact ) = @_; + + return $self->_multiple_attribute_setget('admin_c', $contact); } =head2 B @@ -82,9 +100,9 @@ always return the current remarks array. =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 @@ -97,8 +115,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 @@ -111,8 +129,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 @@ -125,8 +143,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 @@ -138,8 +156,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } 1; diff --git a/lib/Net/Whois/Object/Response.pm b/lib/Net/Whois/Object/Response.pm index 8fa6b47..64ea173 100644 --- a/lib/Net/Whois/Object/Response.pm +++ b/lib/Net/Whois/Object/Response.pm @@ -35,6 +35,10 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['response' ]); + $self->attributes( 'optionnal', [ ] ); + $self->attributes('single',['response' ]); + return $self; } @@ -47,8 +51,8 @@ Accepts an optional response, always return the current response. sub response { my ( $self, $response ) = @_; - $self->{response} = $response if defined $response; - return $self->{response}; + + return $self->_single_attribute_setget('response', $response); } 1; diff --git a/lib/Net/Whois/Object/Role.pm b/lib/Net/Whois/Object/Role.pm index d139840..5fee37a 100644 --- a/lib/Net/Whois/Object/Role.pm +++ b/lib/Net/Whois/Object/Role.pm @@ -52,6 +52,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['role', 'address', 'e_mail', 'tech_c', 'admin_c', 'nic_hdl', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'phone', 'fax_no', 'trouble', 'remarks', 'notify', 'mnt_by' ] ); + $self->attributes('single',['role', 'nic_hdl', 'source']); + $self->attributes('multiple',['address', 'e_mail', 'tech_c', 'admin_c', 'changed', 'phone', 'fax_no', 'trouble', 'remarks', 'notify', 'mnt_by' ] ); + return $self; } @@ -64,8 +69,8 @@ Accepts an optional role, always return the current role. sub role { my ( $self, $role ) = @_; - $self->{role} = $role if defined $role; - return $self->{role}; + + return $self->_single_attribute_setget('role', $role); } =head2 B @@ -78,8 +83,8 @@ always return the current address array. sub address { my ( $self, $address ) = @_; - push @{ $self->{address} }, $address if defined $address; - return \@{ $self->{address} }; + + return $self->_multiple_attribute_setget('address', $address); } =head2 B @@ -92,8 +97,8 @@ always return the current phone array. sub phone { my ( $self, $phone ) = @_; - push @{ $self->{phone} }, $phone if defined $phone; - return \@{ $self->{phone} }; + + return $self->_multiple_attribute_setget('phone', $phone); } =head2 B @@ -106,8 +111,8 @@ always return the current fax_no array. sub fax_no { my ( $self, $fax_no ) = @_; - push @{ $self->{fax_no} }, $fax_no if defined $fax_no; - return \@{ $self->{fax_no} }; + + return $self->_multiple_attribute_setget('fax_no', $fax_no); } =head2 B @@ -120,8 +125,8 @@ always return the current e_mail array. sub e_mail { my ( $self, $e_mail ) = @_; - push @{ $self->{e_mail} }, $e_mail if defined $e_mail; - return \@{ $self->{e_mail} }; + + return $self->_multiple_attribute_setget('e_mail', $e_mail); } =head2 B @@ -134,8 +139,8 @@ always return the current trouble array. sub trouble { my ( $self, $trouble ) = @_; - push @{ $self->{trouble} }, $trouble if defined $trouble; - return \@{ $self->{trouble} }; + + return $self->_multiple_attribute_setget('trouble', $trouble); } =head2 B @@ -148,8 +153,8 @@ always return the current admin_c array. 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 @@ -162,8 +167,8 @@ always return the current tech_c array. 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 @@ -175,8 +180,8 @@ Accepts an optional nic_hdl, always return the current nic_hdl. sub nic_hdl { my ( $self, $nic_hdl ) = @_; - $self->{nic_hdl} = $nic_hdl if defined $nic_hdl; - return $self->{nic_hdl}; + + return $self->_single_attribute_setget('nic_hdl', $nic_hdl); } =head2 B @@ -189,8 +194,8 @@ always return the current remarks array. sub remarks { my ( $self, $remark ) = @_; - push @{ $self->{remarks} }, $remark if defined $remark; - return \@{ $self->{remarks} }; + + return $self->_multiple_attribute_setget('remarks', $remark); } =head2 B @@ -203,8 +208,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 @@ -217,8 +222,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 @@ -231,8 +236,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 @@ -244,8 +249,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } 1; diff --git a/lib/Net/Whois/Object/Route.pm b/lib/Net/Whois/Object/Route.pm index 4145a15..e5e13fc 100644 --- a/lib/Net/Whois/Object/Route.pm +++ b/lib/Net/Whois/Object/Route.pm @@ -59,6 +59,11 @@ sub new { for my $key ( keys %options ) { $self->$key( $options{$key} ); } + + $self->attributes( 'mandatory', [ 'route', 'origin', 'descr', 'mnt_by', 'changed', 'source' ] ); + $self->attributes( 'optionnal', [ 'holes', 'member_of', 'inject', 'aggr_mtd', 'aggr_bndry', 'export_comps', 'components', 'remarks', 'cross_mnt', 'cross_nfy', 'notify', 'mnt_lower', 'mnt_routes' ] ); + $self->attributes( 'single', [ 'route', 'origin', 'aggr_mtd', 'aggr_bndry', 'export_comps', 'components', 'source' ] ); + $self->attributes( 'multiple', [ 'descr', 'mnt_by', 'changed', 'holes', 'member_of', 'inject', 'remarks', 'cross_mnt', 'cross_nfy', 'notify', 'mnt_lower', 'mnt_routes' ] ); return $self; } @@ -72,8 +77,8 @@ Accepts an optional route, always return the current route. sub route { my ( $self, $route ) = @_; - $self->{route} = $route if defined $route; - return $self->{route}; + + return $self->_single_attribute_setget('route', $route); } =head2 B @@ -86,8 +91,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 @@ -99,8 +104,8 @@ Accepts an optional origin, always return the current origin. sub origin { my ( $self, $origin ) = @_; - $self->{origin} = $origin if defined $origin; - return $self->{origin}; + + return $self->_single_attribute_setget('origin', $origin); } =head2 B @@ -113,8 +118,8 @@ always return the current holes array. sub holes { my ( $self, $hole ) = @_; - push @{ $self->{holes} }, $hole if defined $hole; - return \@{ $self->{holes} }; + + return $self->_multiple_attribute_setget('holes', $hole); } =head2 B @@ -127,8 +132,8 @@ always return the current member_of array. 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 @@ -141,8 +146,8 @@ always return the current inject array. sub inject { my ( $self, $inject ) = @_; - push @{ $self->{inject} }, $inject if defined $inject; - return \@{ $self->{inject} }; + + return $self->_multiple_attribute_setget('inject', $inject); } =head2 B @@ -155,8 +160,8 @@ always return the current aggr_mtd. sub aggr_mtd { my ( $self, $aggr_mtd ) = @_; - $self->{aggr_mtd} = $aggr_mtd if defined $aggr_mtd; - return $self->{aggr_mtd}; + + return $self->_single_attribute_setget('aggr_mtd', $aggr_mtd); } =head2 B @@ -169,8 +174,8 @@ always return the current aggr_bndry. sub aggr_bndry { my ( $self, $aggr_bndry ) = @_; - $self->{aggr_bndry} = $aggr_bndry if defined $aggr_bndry; - return $self->{aggr_bndry}; + + return $self->_single_attribute_setget('aggr_bndry', $aggr_bndry); } =head2 B @@ -183,8 +188,8 @@ always return the current export_comps. sub export_comps { my ( $self, $export_comp ) = @_; - $self->{export_comps} = $export_comp if defined $export_comp; - return $self->{export_comps}; + + return $self->_single_attribute_setget('export_comps', $export_comp); } =head2 B @@ -197,8 +202,8 @@ always return the current components. sub components { my ( $self, $components ) = @_; - $self->{components} = $components if defined $components; - return $self->{components}; + + return $self->_single_attribute_setget('components', $components); } =head2 B @@ -211,8 +216,8 @@ always return the current 'remarks' array. sub remarks { my ( $self, $remark ) = @_; - push @{ $self->{remarks} }, $remark if defined $remark; - return \@{ $self->{remarks} }; + + return $self->_multiple_attribute_setget('remarks', $remark); } =head2 B @@ -225,8 +230,8 @@ always return the current cross_mnt array. sub cross_mnt { my ( $self, $cross_mnt ) = @_; - push @{ $self->{cross_mnt} }, $cross_mnt if defined $cross_mnt; - return \@{ $self->{cross_mnt} }; + + return $self->_multiple_attribute_setget('cross_mnt', $cross_mnt); } =head2 B @@ -239,8 +244,8 @@ always return the current cross_nfy array. sub cross_nfy { my ( $self, $cross_nfy ) = @_; - push @{ $self->{cross_nfy} }, $cross_nfy if defined $cross_nfy; - return \@{ $self->{cross_nfy} }; + + return $self->_multiple_attribute_setget('cross_nfy', $cross_nfy); } =head2 B @@ -253,8 +258,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 @@ -267,8 +272,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 @@ -281,8 +286,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_routes', $mnt_routes); } =head2 B @@ -295,8 +300,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 @@ -309,8 +314,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 @@ -322,8 +327,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } =head2 B @@ -338,8 +343,8 @@ Please use UPPERCASE letters. sub country { my ( $self, $country ) = @_; - $self->{country} = $country if defined $country; - return $self->{country}; + + return $self->_single_attribute_setget('country', $country); } 1; diff --git a/lib/Net/Whois/Object/Route6.pm b/lib/Net/Whois/Object/Route6.pm index dd66a56..825a6a5 100644 --- a/lib/Net/Whois/Object/Route6.pm +++ b/lib/Net/Whois/Object/Route6.pm @@ -57,6 +57,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['route6', 'origin', 'descr', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'holes', 'org', 'member_of', 'inject', 'aggr_mtd', 'aggr_bndry', 'export_comps', 'components', 'remarks', 'notify', 'mnt_lower', 'mnt_routes' ] ); + $self->attributes('single',['route6', 'origin', 'aggr_mtd', 'aggr_bndry', 'export_comps', 'components', 'source']); + $self->attributes('multiple',['descr', 'mnt_by', 'changed', 'holes', 'org', 'member_of', 'inject', 'remarks', 'notify', 'mnt_lower', 'mnt_routes' ] ); + return $self; } @@ -69,8 +74,8 @@ Accepts an optional route6, always return the current route. sub route6 { my ( $self, $route6 ) = @_; - $self->{route6} = $route6 if defined $route6; - return $self->{route6}; + + return $self->_single_attribute_setget('route6', $route6); } =head2 B @@ -83,8 +88,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 @@ -96,8 +101,8 @@ Accepts an optional origin, always return the current origin. sub origin { my ( $self, $origin ) = @_; - $self->{origin} = $origin if defined $origin; - return $self->{origin}; + + return $self->_single_attribute_setget('origin', $origin); } =head2 B @@ -110,8 +115,8 @@ always return the current org array. sub org { my ( $self, $org ) = @_; - push @{ $self->{org} }, $org if defined $org; - return \@{ $self->{org} }; + + return $self->_multiple_attribute_setget('org', $org); } =head2 B @@ -124,8 +129,8 @@ always return the current holes array. sub holes { my ( $self, $hole ) = @_; - push @{ $self->{holes} }, $hole if defined $hole; - return \@{ $self->{holes} }; + + return $self->_multiple_attribute_setget('holes', $hole); } =head2 B @@ -138,8 +143,8 @@ always return the current member_of array. 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 @@ -152,8 +157,8 @@ always return the current inject array. sub inject { my ( $self, $inject ) = @_; - push @{ $self->{inject} }, $inject if defined $inject; - return \@{ $self->{inject} }; + + return $self->_multiple_attribute_setget('inject', $inject); } =head2 B @@ -166,8 +171,8 @@ always return the current aggr_mtd. sub aggr_mtd { my ( $self, $aggr_mtd ) = @_; - $self->{aggr_mtd} = $aggr_mtd if defined $aggr_mtd; - return $self->{aggr_mtd}; + + return $self->_single_attribute_setget('aggr_mtd', $aggr_mtd); } =head2 B @@ -180,8 +185,8 @@ always return the current aggr_bndry. sub aggr_bndry { my ( $self, $aggr_bndry ) = @_; - $self->{aggr_bndry} = $aggr_bndry if defined $aggr_bndry; - return $self->{aggr_bndry}; + + return $self->_single_attribute_setget('aggr_bndry', $aggr_bndry); } =head2 B @@ -194,8 +199,8 @@ always return the current export_comps. sub export_comps { my ( $self, $export_comp ) = @_; - $self->{export_comps} = $export_comp if defined $export_comp; - return $self->{export_comps}; + + return $self->_single_attribute_setget('export_comps', $export_comp); } =head2 B @@ -208,8 +213,8 @@ always return the current components. sub components { my ( $self, $components ) = @_; - $self->{components} = $components if defined $components; - return $self->{components}; + + return $self->_single_attribute_setget('components', $components); } =head2 B @@ -222,8 +227,8 @@ always return the current 'remarks' array. sub remarks { my ( $self, $remark ) = @_; - push @{ $self->{remarks} }, $remark if defined $remark; - return \@{ $self->{remarks} }; + + return $self->_multiple_attribute_setget('remarks', $remark); } =head2 B @@ -236,8 +241,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 @@ -250,8 +255,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 @@ -264,8 +269,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_routes', $mnt_routes); } =head2 B @@ -278,8 +283,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 @@ -292,8 +297,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 @@ -305,8 +310,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } =head2 B @@ -321,8 +326,8 @@ Please use UPPERCASE letters. sub country { my ( $self, $country ) = @_; - $self->{country} = $country if defined $country; - return $self->{country}; + + return $self->_single_attribute_setget('country', $country); } 1; diff --git a/lib/Net/Whois/Object/RouteSet.pm b/lib/Net/Whois/Object/RouteSet.pm index cea15e5..6c45c5d 100644 --- a/lib/Net/Whois/Object/RouteSet.pm +++ b/lib/Net/Whois/Object/RouteSet.pm @@ -53,6 +53,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['route_set', 'descr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'members', 'mbrs_by_ref', 'remarks', 'notify' ] ); + $self->attributes('single',['route_set', 'source']); + $self->attributes('multiple',['descr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'members', 'mbrs_by_ref', 'remarks', 'notify' ] ); + return $self; } @@ -65,8 +70,8 @@ Accepts an optional route_set, always return the current route_set. sub route_set { my ( $self, $route_set ) = @_; - $self->{route_set} = $route_set if defined $route_set; - return $self->{route_set}; + + return $self->_single_attribute_setget('route_set', $route_set); } =head2 B @@ -79,8 +84,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 @@ -93,8 +98,8 @@ always return the current members array. sub members { my ( $self, $members ) = @_; - push @{ $self->{members} }, $members if defined $members; - return \@{ $self->{members} }; + + return $self->_multiple_attribute_setget('members', $members); } =head2 B @@ -107,8 +112,8 @@ Accepts an optional mbrs_by_ref to be added to the mbrs_by_ref array, sub mbrs_by_ref { my ( $self, $mbrs_by_ref ) = @_; - push @{ $self->{mbrs_by_ref} }, $mbrs_by_ref if defined $mbrs_by_ref; - return \@{ $self->{mbrs_by_ref} }; + + return $self->_multiple_attribute_setget('mbrs_by_ref', $mbrs_by_ref); } =head2 B @@ -121,8 +126,8 @@ always return the current remarks array. sub remarks { my ( $self, $remarks ) = @_; - push @{ $self->{remarks} }, $remarks if defined $remarks; - return \@{ $self->{remarks} }; + + return $self->_multiple_attribute_setget('remarks', $remarks); } =head2 B @@ -135,8 +140,8 @@ always return the current tech_c array. 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 @@ -149,8 +154,8 @@ always return the current admin_c array. 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 @@ -163,8 +168,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 @@ -177,8 +182,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 @@ -191,8 +196,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 @@ -204,8 +209,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } =head2 B @@ -218,8 +223,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 @@ -232,8 +237,8 @@ always return the current mp_members array. sub mp_members { my ( $self, $mp_members ) = @_; - push @{ $self->{mp_members} }, $mp_members if defined $mp_members; - return \@{ $self->{mp_members} }; + + return $self->_multiple_attribute_setget('mp_members', $mp_members); } 1; diff --git a/lib/Net/Whois/Object/RtrSet.pm b/lib/Net/Whois/Object/RtrSet.pm index 29df927..70262dc 100644 --- a/lib/Net/Whois/Object/RtrSet.pm +++ b/lib/Net/Whois/Object/RtrSet.pm @@ -49,6 +49,11 @@ sub new { $self->$key( $options{$key} ); } + $self->attributes('mandatory',['rtr_set', 'descr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'source']); + $self->attributes( 'optionnal', [ 'members', 'mbrs_by_ref', 'remarks', 'notify' ] ); + $self->attributes('single',['rtr_set', 'source']); + $self->attributes('multiple',[ 'descr', 'tech_c', 'admin_c', 'mnt_by', 'changed', 'members', 'mbrs_by_ref', 'remarks', 'notify' ] ); + return $self; } @@ -61,8 +66,8 @@ Accepts an optional rtr_set, always return the current rtr_set. sub rtr_set { my ( $self, $rtr_set ) = @_; - $self->{rtr_set} = $rtr_set if defined $rtr_set; - return $self->{rtr_set}; + + return $self->_single_attribute_setget('rtr_set', $rtr_set); } =head2 B @@ -75,8 +80,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 @@ -89,8 +94,8 @@ always return the current members array. sub members { my ( $self, $member ) = @_; - push @{ $self->{members} }, $member if defined $member; - return \@{ $self->{members} }; + + return $self->_multiple_attribute_setget('members', $member); } =head2 B @@ -103,8 +108,8 @@ always return the current mbrs_by_ref array. sub mbrs_by_ref { my ( $self, $mbrs_by_ref ) = @_; - push @{ $self->{mbrs_by_ref} }, $mbrs_by_ref if defined $mbrs_by_ref; - return \@{ $self->{mbrs_by_ref} }; + + return $self->_multiple_attribute_setget('mbrs_by_ref', $mbrs_by_ref); } =head2 B @@ -117,8 +122,8 @@ always return the current remarks array. sub remarks { my ( $self, $remark ) = @_; - push @{ $self->{remarks} }, $remark if defined $remark; - return \@{ $self->{remarks} }; + + return $self->_multiple_attribute_setget('remarks', $remark); } =head2 B @@ -131,8 +136,8 @@ always return the current tech_c array. 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 @@ -145,8 +150,8 @@ always return the current admin_c array. 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 @@ -159,8 +164,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 @@ -173,8 +178,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 @@ -187,8 +192,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 @@ -200,8 +205,8 @@ Accepts an optional source, always return the current source. sub source { my ( $self, $source ) = @_; - $self->{source} = $source if defined $source; - return $self->{source}; + + return $self->_single_attribute_setget('source', $source); } =head2 B @@ -225,8 +230,8 @@ Explicitly lists IPv4 or IPv6 'members' of the rtr-set can be: sub mp_members { my ( $self, $mp_member ) = @_; - push @{ $self->{mp_members} }, $mp_member if defined $mp_member; - return \@{ $self->{mp_members} }; + + return $self->_multiple_attribute_setget('mp_members', $mp_member); } 1; diff --git a/lib/Net/Whois/RIPE.pm b/lib/Net/Whois/RIPE.pm index ae63b64..af1628a 100644 --- a/lib/Net/Whois/RIPE.pm +++ b/lib/Net/Whois/RIPE.pm @@ -29,11 +29,11 @@ Net::Whois::RIPE - a pure-Perl implementation of the RIPE Database client. =head1 VERSION -Version 2.00_012 - BETA +Version 2.00_013 - BETA =cut -our $VERSION = 2.00_012; +our $VERSION = 2.00_013; =head1 SYNOPSIS diff --git a/t/03-objects.t b/t/03-objects.t index c085406..ff2d019 100644 --- a/t/03-objects.t +++ b/t/03-objects.t @@ -11,34 +11,37 @@ STDERR->autoflush(1); our $class; BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } -can_ok $class, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); - -{ - my @lines = ; - my @o = Net::Whois::Object->new(@lines); - for my $object (@o) { - isa_ok $object, $class; - } - isa_ok $o[0], $class . "::Information"; - can_ok $o[0], qw( comment ); - ok( !$o[0]->can('source'), "No AUTOLOAD interference with ${class}::Information tests" ); - - isa_ok $o[3], $class . "::AsBlock"; - can_ok $o[3], qw( as_block org source ), qw( descr remarks tech_c admin_c notify mnt_lower mnt_by changed); - ok( !$o[3]->can('bogusmethod'), "No AUTOLOAD interference with ${class}::AsBlock tests" ); - - isa_ok $o[5], $class . "::AutNum"; - can_ok $o[5], qw( aut_num as_name org source ), qw( descr member_of import mp_import export mp_export - default remarks tech_c admin_c notify - mnt_lower mnt_by mnt_routes changed); - ok( !$o[5]->can('bogusmethod'), "No AUTOLOAD interference with ${class}::AutNum tests" ); +my %tested; + +my @lines = ; +my @o = Net::Whois::Object->new(@lines); +for my $object (@o) { + isa_ok $object, $class; } +isa_ok $o[0], $class . "::Information"; +can_ok $o[0], qw( comment ); +ok( !$o[0]->can('source'), "No AUTOLOAD interference with ${class}::Information tests" ); + +isa_ok $o[3], $class . "::AsBlock"; +can_ok $o[3], qw( as_block org source ), qw( descr remarks tech_c admin_c notify mnt_lower mnt_by changed); +ok( !$o[3]->can('bogusmethod'), "No AUTOLOAD interference with ${class}::AsBlock tests" ); + +isa_ok $o[5], $class . "::AutNum"; +can_ok $o[5], qw( aut_num as_name org source ), qw( descr member_of import mp_import export mp_export + default remarks tech_c admin_c notify + mnt_lower mnt_by mnt_routes changed); +ok( !$o[5]->can('bogusmethod'), "No AUTOLOAD interference with ${class}::AutNum tests" ); + +is_deeply( [ $o[0]->attributes('mandatory') ], ['comment'] ); + +is_deeply( [ $o[0]->attributes('optionnal') ], [] ); +$o[0]->attributes( 'optionnal', [ 'opt1', 'opt2', 'opt3' ] ); +is_deeply( [ $o[0]->attributes('optionnal') ], [ 'opt1', 'opt2', 'opt3' ] ); + +is_deeply( [ $o[0]->attributes('all') ], [ 'comment', 'opt1', 'opt2', 'opt3' ] ); +is_deeply( [ $o[0]->attributes() ], [ 'comment', 'opt1', 'opt2', 'opt3' ] ); + +is( $o[2]->dump, "class: Information\n% Information related to 'AS30720 - AS30895'\n" ); __DATA__ % This is the RIPE Database query service. diff --git a/t/105-AsBlock.t b/t/105-AsBlock.t index dbbcdc5..5a41b8c 100644 --- a/t/105-AsBlock.t +++ b/t/105-AsBlock.t @@ -2,43 +2,44 @@ use strict; use warnings; use Test::More qw( no_plan ); use Test::Exception; -use Net::Whois::Object; +# use Net::Whois::Object; # synchronizes the {error,standard} output of this test. use IO::Handle; STDOUT->autoflush(1); STDERR->autoflush(1); -BEGIN { use_ok 'Net::Whois::Object::AsBlock'; } +our $class; +BEGIN { $class = 'Net::Whois::Object::AsBlock'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::AsBlock"; - -# Inherited method from Net::Whois::Object -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited method can_ok $object, qw( as_block descr remarks tech_c admin_c notify mnt_lower mnt_by changed source); - can_ok $object, qw( org ); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::AsBlock tests" ); +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'as_block' +$tested{'as_block'}++; is ($object->as_block(),'AS30720 - AS30895','as-block properly parsed'); $object->as_block('AS1 - AS2'); is ($object->as_block(),'AS1 - AS2','as_block properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'RIPE NCC ASN block' ],'descr properly parsed'); $object->descr('Added'); is_deeply ($object->descr(),[ 'RIPE NCC ASN block', 'Added' ],'descr properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(), [ 'These AS Numbers are further assigned to network', @@ -49,33 +50,67 @@ is_deeply ($object->remarks(), 'form available in the LIR Portal or at:', '' ],'remarks properly parsed'); + $object->remarks('Added remarks'); is ($object->remarks()->[7],'Added remarks','remarks properly added'); +# Test 'org' +$tested{'org'}++; is ($object->org(),'ORG-NCC1-RIPE','as-block properly parsed'); $object->org('ORG-MDFIED'); is ($object->org(),'ORG-MDFIED','as-block properly set'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),['CREW-RIPE'],'admin_c properly parsed'); $object->admin_c('Added admin_c'); is ($object->admin_c()->[1],'Added admin_c','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),['RD132-RIPE'],'tech_c properly parsed'); $object->tech_c('Added tech_c'); is ($object->tech_c()->[1],'Added tech_c','tech_c properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),['RIPE-DBM-MNT'],'mnt_by properly parsed'); $object->mnt_by('Added mnt_by'); is ($object->mnt_by()->[1],'Added mnt_by','mnt_by properly added'); +# Test 'mnt_lower' +$tested{'mnt_lower'}++; is_deeply ($object->mnt_lower(),['RIPE-NCC-HM-MNT'],'mnt_lower properly parsed'); $object->mnt_lower('Added mnt_lower'); is ($object->mnt_lower()->[1],'Added mnt_lower','mnt_lower properly added'); +# Test 'notify' +$tested{'notify'}++; +is_deeply ($object->notify(),['RIPE-DBM-MNT'],'notify properly parsed'); +$object->notify('Added notify'); +is ($object->notify()->[1],'Added notify','notify properly added'); + +# Test 'changed' +$tested{'changed'}++; +is_deeply ($object->changed(),['arhuman@gmail.com 20120701'],'changed properly parsed'); +$object->changed('Added changed'); +is ($object->changed()->[1],'Added changed','changed properly added'); + +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE # Filtered','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); __DATA__ as-block: AS30720 - AS30895 @@ -91,6 +126,8 @@ org: ORG-NCC1-RIPE admin-c: CREW-RIPE tech-c: RD132-RIPE mnt-by: RIPE-DBM-MNT +notify: RIPE-DBM-MNT mnt-lower: RIPE-NCC-HM-MNT +changed: arhuman@gmail.com 20120701 source: RIPE # Filtered diff --git a/t/110-AutNum.t b/t/110-AutNum.t index 4e57c3a..edd1c9a 100644 --- a/t/110-AutNum.t +++ b/t/110-AutNum.t @@ -2,6 +2,7 @@ use strict; use warnings; use Test::More qw( no_plan ); use Test::Exception; +# use Net::Whois::Object; # synchronizes the {error,standard} output of this test. use IO::Handle; @@ -9,53 +10,59 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::AutNum'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::AutNum"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); - -can_ok $object, qw( aut_num as_name 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 source); +isa_ok $object, $class; -can_ok $object, qw( mp_import mp_export ); - -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::AutNum tests" ); - -is ($object->aut_num(),'AS00007','aut_num properly parsed'); +# Test 'aut_num' +$tested{'aut_num'}++; +is ($object->aut_num(),'AS7','aut_num properly parsed'); $object->aut_num('AS1'); is ($object->aut_num(),'AS1','aut_num properly set'); +# Test 'remarks' +$tested{'remarks'}++; +is_deeply ($object->remarks(),['AS number 7'],'remarks properly parsed'); +$object->remarks('Added remarks'); +is ($object->remarks()->[1],'Added remarks','remarks properly added'); + +# Test 'as_name' +$tested{'as_name'}++; is ($object->as_name(),'FR-COMPANY','as_name properly parsed'); $object->as_name('FR-C'); is ($object->as_name(),'FR-C','as_name properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'French Company', 'FRANCE' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[2],'Added descr','descr properly added'); +# Test 'org' +$tested{'org'}++; is ($object->org(),'ORG-MISC01-RIPE','org properly parsed'); $object->org('ORG-MOD'); is ($object->org(),'ORG-MOD','org properly set'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'NC123-RIPE'],'admin_c properly parsed'); $object->admin_c('Added admin_c'); is ($object->admin_c()->[1],'Added admin_c','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'NC345-RIPE'],'tech_c properly parsed'); $object->tech_c('Added tech_c'); is ($object->tech_c()->[1],'Added tech_c','tech_c properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(), [ 'RIPE-NCC-END-MNT', @@ -64,12 +71,68 @@ is_deeply ($object->mnt_by(), $object->mnt_by('Added mnt_by'); is ($object->mnt_by()->[2],'Added mnt_by','mnt_by properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE # Filtered','source properly parsed'); $object->source('ANIC'); is ($object->source(),'ANIC','source properly set'); +# Test 'notify' +$tested{'notify'}++; +is_deeply ($object->notify(),[ 'MAIN-FR-MNT'],'notify properly parsed'); +$object->notify('Added notify'); +is ($object->notify()->[1],'Added notify','notify properly added'); + +# Test 'changed' +$tested{'changed'}++; +is_deeply ($object->changed(),[ 'arhuman@gmail.com 20120701' ],'changed properly parsed'); +$object->changed('Added changed'); +is ($object->changed()->[1],'Added changed','changed properly added'); + +# Test 'import' +$tested{'import'}++; +# TODO + +# Test 'mp_import' +$tested{'mp_import'}++; +# TODO + +# Test 'export' +$tested{'export'}++; +# TODO + +# Test 'mp_export' +$tested{'mp_export'}++; +# TODO + +# Test 'default' +$tested{'default'}++; +# TODO + +# Test 'mp_default' +$tested{'mp_default'}++; +# TODO + +# Test 'mnt_routes' +$tested{'mnt_routes'}++; +# TODO + +# Test 'member_of' +$tested{'member_of'}++; +# TODO + +# Test 'mnt_lower' +$tested{'mnt_lower'}++; +# TODO + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ -aut-num: AS00007 +aut-num: AS7 +remarks: AS number 7 as-name: FR-COMPANY descr: French Company descr: FRANCE @@ -78,6 +141,8 @@ admin-c: NC123-RIPE tech-c: NC345-RIPE mnt-by: RIPE-NCC-END-MNT mnt-by: MAIN-FR-MNT +notify: MAIN-FR-MNT mnt-routes: MAIN-FR-MNT +changed: arhuman@gmail.com 20120701 source: RIPE # Filtered diff --git a/t/115-Person.t b/t/115-Person.t index 51ac760..777bc9f 100644 --- a/t/115-Person.t +++ b/t/115-Person.t @@ -9,31 +9,31 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Person'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Person"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( person address phone fax_no e_mail nic_hdl remarks notify mnt_by changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Person tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'person' +$tested{'person'}++; is ($object->person(),'COMPANY Contact','person properly parsed'); $object->person('PERSON'); is ($object->person(),'PERSON','person properly set'); +# Test 'address' +$tested{'address'}++; is_deeply ($object->address(), [ 'The Company', @@ -43,36 +43,68 @@ is_deeply ($object->address(), $object->address('Added address'); is ($object->address()->[3],'Added address','address properly added'); +# Test 'phone' +$tested{'phone'}++; is_deeply ($object->phone(),[ '+33 1 72 44 01 00' ],'phone properly parsed'); $object->phone('Added phone'); is ($object->phone()->[1],'Added phone','phone properly added'); +# Test 'fax_no' +$tested{'fax_no'}++; is_deeply ($object->fax_no(),[ '+33 1 72 44 01 46' ],'fax_no properly parsed'); $object->fax_no('Added fax_no'); is ($object->fax_no()->[1],'Added fax_no','fax_no properly added'); +# Test 'e_mail' +$tested{'e_mail'}++; is_deeply ($object->e_mail(),['xxx@somewhere.com'],'e_mail properly parsed'); $object->e_mail('Added e_mail'); is ($object->e_mail()->[1],'Added e_mail','e_mail properly added'); +# Test 'nic_hdl' +$tested{'nic_hdl'}++; is ($object->nic_hdl(),'NC123-RIPE','nic_hdl properly parsed'); $object->nic_hdl('NIC-HDL'); is ($object->nic_hdl(),'NIC-HDL','nic_hdl properly set'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),['MAIN-FR-MNT'],'mnt_by properly parsed'); $object->mnt_by('Added mnt_by'); is ($object->mnt_by()->[1],'Added mnt_by','mnt_by properly added'); +# Test 'notify' +$tested{'notify'}++; +is_deeply ($object->notify(),['MAIN-FR-MNT'],'notify properly parsed'); +$object->notify('Added notify'); +is ($object->notify()->[1],'Added notify','notify properly added'); + +# Test 'remarks' +$tested{'remarks'}++; +is_deeply ($object->remarks(),['Simple person object'],'remarks properly parsed'); +$object->remarks('Added remarks'); +is ($object->remarks()->[1],'Added remarks','remarks properly added'); + +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'xxx@somewhere.com 20121016' ],'changed properly parsed'); $object->changed('Added changed'); is ($object->changed()->[1],'Added changed','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE # Filtered','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ person: COMPANY Contact +remarks: Simple person object address: The Company address: 2 Rue de la Gare address: 75001 PARIS @@ -81,6 +113,7 @@ fax-no: +33 1 72 44 01 46 e-mail: xxx@somewhere.com nic-hdl: NC123-RIPE mnt-by: MAIN-FR-MNT +notify: MAIN-FR-MNT changed: xxx@somewhere.com 20121016 source: RIPE # Filtered diff --git a/t/120-Role.t b/t/120-Role.t index b7f0f3f..4820ee1 100644 --- a/t/120-Role.t +++ b/t/120-Role.t @@ -9,30 +9,36 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Role'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Role"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( role address phone fax_no e_mail trouble admin_c tech_c nic_hdl remarks notify mnt_by changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Role tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'role' +$tested{'role'}++; is ($object->role(),'Company Admin','role properly parsed'); $object->role('Role'); is ($object->role(),'Role','role properly set'); +# Test 'remarks' +$tested{'remarks'}++; +is_deeply ($object->remarks(),["The Company's admin"],'remarks properly parsed'); +$object->remarks('Added remarks'); +is ($object->remarks()->[1],'Added remarks','remarks properly added'); + +# Test 'address' +$tested{'address'}++; is_deeply ($object->address(), [ 'The Company', @@ -43,36 +49,76 @@ is_deeply ($object->address(), $object->address('Added address'); is ($object->address()->[4],'Added address','address properly added'); +# Test 'phone' +$tested{'phone'}++; is_deeply ($object->phone(),[ '+33 1 44 01 01 00' ],'phone properly parsed'); $object->phone('Added phone'); is ($object->phone()->[1],'Added phone','phone properly added'); +# Test 'fax_no' +$tested{'fax_no'}++; is_deeply ($object->fax_no(),[ '+33 1 44 01 01 46' ],'fax_no properly parsed'); $object->fax_no('Added fax_no'); is ($object->fax_no()->[1],'Added fax_no','fax_no properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'CPY01-RIPE' ],'admin_c properly parsed'); $object->admin_c('Added admin_c'); is ($object->admin_c()->[1],'Added admin_c','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'CPY01-RIPE', 'C???-RIPE', 'C?????-RIPE' ],'tech_c properly parsed'); $object->tech_c('Added tech_c'); is ($object->tech_c()->[3],'Added tech_c','tech_c properly added'); +# Test 'nic_hdl' +$tested{'nic_hdl'}++; is ($object->nic_hdl(),'C??????-RIPE','nic_hdl properly parsed'); $object->nic_hdl('NICHDL'); is ($object->nic_hdl(),'NICHDL','nic_hdl properly set'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'E???-MNT' ],'mnt_by properly parsed'); $object->mnt_by('Added mnt_by'); is ($object->mnt_by()->[1],'Added mnt_by','mnt_by properly added'); +# Test 'notify' +$tested{'notify'}++; +is_deeply ($object->notify(),[ 'E???-MNT' ],'notify properly parsed'); +$object->notify('Added notify'); +is ($object->notify()->[1],'Added notify','notify properly added'); + +# Test 'changed' +$tested{'changed'}++; +is_deeply ($object->changed(),[ 'xxx@somewhere.com 20121016' ],'changed properly parsed'); +$object->changed('Added changed'); +is ($object->changed()->[1],'Added changed','changed properly added'); + +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE # Filtered','source properly parsed'); $object->source('RIPE'); is ($object->source(),'RIPE','source properly set'); +# Test 'e_mail' +$tested{'e_mail'}++; +# TODO + +# Test 'trouble' +$tested{'trouble'}++; +# TODO + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ role: Company Admin +remarks: The Company's admin address: The Company address: 2 avenue de la gare address: 75001 Paris @@ -85,5 +131,7 @@ tech-c: C???-RIPE tech-c: C?????-RIPE nic-hdl: C??????-RIPE mnt-by: E???-MNT +notify: E???-MNT +changed: xxx@somewhere.com 20121016 source: RIPE # Filtered diff --git a/t/125-AsSet.t b/t/125-AsSet.t index f739d64..df65238 100644 --- a/t/125-AsSet.t +++ b/t/125-AsSet.t @@ -9,35 +9,37 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::AsSet'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::AsSet"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( as_set descr members mbrs_by_ref remarks tech_c admin_c notify mnt_by changed source ); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::AsSet tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'as_set' +$tested{'as_set'}++; is ($object->as_set(),'AS-COM01','as-block properly parsed'); $object->as_set('AS1-AS2'); is ($object->as_set(),'AS1-AS2','as_set properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'A description' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(), [ '**********************', @@ -47,6 +49,8 @@ is_deeply ($object->remarks(), $object->remarks('Added remarks'); is ($object->remarks()->[3],'Added remarks','remarks properly added'); +# Test 'members' +$tested{'members'}++; is_deeply ($object->members(), [ 'AS1', @@ -57,6 +61,8 @@ is_deeply ($object->members(), $object->members('Added members'); is ($object->members()->[4],'Added members','members properly added'); +# Test 'mbrs_by_ref' +$tested{'mbrs_by_ref'}++; is_deeply ($object->mbrs_by_ref(), [ 'UNK-MNT', @@ -65,30 +71,47 @@ is_deeply ($object->mbrs_by_ref(), $object->mbrs_by_ref('Added mbrs_by_ref'); is ($object->mbrs_by_ref()->[2],'Added mbrs_by_ref','mbrs_by_ref properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'CPY01-RIPE' ],'admin_c properly parsed'); $object->admin_c('Added admin_c'); is ($object->admin_c()->[1],'Added admin_c','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'CPY01-RIPE', 'CXXX-RIPE', 'CXXXXX-RIPE' ],'tech_c properly parsed'); $object->tech_c('C007-RIPE'); is ($object->tech_c()->[3],'C007-RIPE','tech_c properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('Added notify'); is ($object->notify()->[1],'Added notify','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'THE-MNT' ],'mnt_by properly parsed'); $object->mnt_by('Added mnt_by'); is ($object->mnt_by()->[1],'Added mnt_by','mnt_by properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'someone@somewhere.net 20080422', 'someoneelese@somewere.net 20090429' ],'changed properly parsed'); $object->changed('Added changed'); is ($object->changed()->[2],'Added changed','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE # Filtered','source properly parsed'); $object->source('RIPE'); is ($object->source(),'RIPE','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ as-set: AS-COM01 descr: A description diff --git a/t/130-Domain.t b/t/130-Domain.t index 69952e8..ce60392 100644 --- a/t/130-Domain.t +++ b/t/130-Domain.t @@ -9,91 +9,130 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Domain'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Domain"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( domain descr org admin_c tech_c zone_c nserver ds_rdata sub_dom dom_net remarks notify mnt_by mnt_lower refer changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Domain tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'domain' +$tested{'domain'}++; is ($object->domain(),'somewhere.superdomain.com','domain properly parsed'); $object->domain('somewhereelse.superdomain.com'); is ($object->domain(),'somewhereelse.superdomain.com','domain properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Domain\'s description' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'org' +$tested{'org'}++; is_deeply ($object->org(),[ 'ORG-MISC01-RIPE' ],'org properly parsed'); $object->org('ORG-MISC02-RIPE'); is ($object->org()->[1],'ORG-MISC02-RIPE','org properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'CPNY-ADM01' ],'admin_c properly parsed'); $object->admin_c('Added admin_c'); is ($object->admin_c()->[1],'Added admin_c','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'CPNY-TECH01' ],'tech_c properly parsed'); $object->tech_c('Added tech_c'); is ($object->tech_c()->[1],'Added tech_c','tech_c properly added'); +# Test 'zone_c' +$tested{'zone_c'}++; is_deeply ($object->zone_c(),[ 'CPNY-ZONE' ],'zone_c properly parsed'); $object->zone_c('Added zone_c'); is ($object->zone_c()->[1],'Added zone_c','zone_c properly added'); +# Test 'nserver' +$tested{'nserver'}++; is_deeply ($object->nserver(),[ 'NS1.SUPERDOMAIN.COM', 'NS2.SUPERDOMAIN.COM' ],'nserver properly parsed'); $object->nserver('Added nserver'); is ($object->nserver()->[2],'Added nserver','nserver properly added'); +# Test 'ds_rdata' +$tested{'ds_rdata'}++; is_deeply ($object->ds_rdata(),[ '64431 5 1 278BF194C29A812B33935BB2517E17D1486210FA' ],'ds_rdata properly parsed'); $object->ds_rdata('Added ds_rdata'); is ($object->ds_rdata()->[1],'Added ds_rdata','ds_rdata properly added'); +# Test 'sub_dom' +$tested{'sub_dom'}++; is_deeply ($object->sub_dom(),[ 'SUBDOM1', 'SUBDOM2','PRIVATE.SUBDOM2' ],'sub_dom properly parsed'); $object->sub_dom('Added sub_dom'); is ($object->sub_dom()->[3],'Added sub_dom','sub_dom properly added'); +# Test 'dom_net' +$tested{'dom_net'}++; is_deeply ($object->dom_net(),[ '10.0.0.1' ],'dom_net properly parsed'); $object->dom_net('Added dom_net'); is ($object->dom_net()->[1],'Added dom_net','dom_net properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'Nothing to say' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'DOM-MAINT' ],'mnt_by properly parsed'); $object->mnt_by('Added mnt_by'); is ($object->mnt_by()->[1],'Added mnt_by','mnt_by properly added'); +# Test 'notify' +$tested{'notify'}++; +is_deeply ($object->notify(),[ 'watcher@somewhere.net' ],'notify properly parsed'); +$object->notify('Added notify'); +is ($object->notify()->[1],'Added notify','notify properly added'); + +# Test 'mnt_lower' +$tested{'mnt_lower'}++; is_deeply ($object->mnt_lower(),[ 'DOM-LMAINT' ],'mnt_lower properly parsed'); $object->mnt_lower('Added mnt_lower'); is ($object->mnt_lower()->[1],'Added mnt_lower','mnt_lower properly added'); +# Test 'refer' +$tested{'refer'}++; is ($object->refer(), 'CLIENTADDRESS whois.server.dom.com 43' ,'refer properly parsed'); $object->refer('CLIENTADDRESS whois.server.dom.com 45'); is ($object->refer(),'CLIENTADDRESS whois.server.dom.com 45','refer properly set'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'someoneelese@somewere.net 20090429' ],'changed properly parsed'); $object->changed('Added changed'); is ($object->changed()->[1],'Added changed','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE # Filtered','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ domain: somewhere.superdomain.com descr: Domain's description diff --git a/t/135-InetNum.t b/t/135-InetNum.t index a4bdec5..011c1be 100644 --- a/t/135-InetNum.t +++ b/t/135-InetNum.t @@ -9,90 +9,129 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::InetNum'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::InetNum"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( inetnum netname descr country org admin_c tech_c status remarks notify mnt_by mnt_lower mnt_routes mnt_domains mnt_irt changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::InetNum tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'inetnum' +$tested{'inetnum'}++; is ($object->inetnum(),'10.0.0.1 - 10.0.0.255','inetnum properly parsed'); $object->inetnum('192.168.0.1 - 192.168.0.255'); is ($object->inetnum(),'192.168.0.1 - 192.168.0.255','inetnum properly set'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remarks' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'netname' +$tested{'netname'}++; is ($object->netname(),'EXAMPLENET-AP','netname properly parsed'); $object->netname('EXAMPLENET-AP2'); is ($object->netname(),'EXAMPLENET-AP2','netname properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Example net Pty Ltd' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'country' +$tested{'country'}++; is_deeply ($object->country(),['FR'],'country properly parsed'); $object->country('Added country'); is ($object->country()->[1],'Added country','country properly added'); +# Test 'org' +$tested{'org'}++; is ($object->org(),'ORG-MISC01-RIPE','org properly parsed'); $object->org('ORG-MISC02-RIPE'); is ($object->org(),'ORG-MISC02-RIPE','org properly set'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'FR123-AP' ],'admin_c properly parsed'); $object->admin_c('Added admin_c'); is ($object->admin_c()->[1],'Added admin_c','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'FR123-AP' ],'tech_c properly parsed'); $object->tech_c('Added tech_c'); is ($object->tech_c()->[1],'Added tech_c','tech_c properly added'); +# Test 'status' +$tested{'status'}++; is ($object->status(),'ALLOCATED PA','status properly parsed'); $object->status('ALLOCATED PI'); is ($object->status(),'ALLOCATED PI','status properly set'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLENET-AP' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2'); is ($object->mnt_by()->[1],'MAINT2','mnt_by properly added'); +# Test 'mnt_lower' +$tested{'mnt_lower'}++; +is_deeply ($object->mnt_lower(),[ 'MAINL-EXAMPLENET-AP' ],'mnt_lower properly parsed'); +$object->mnt_lower('MAINT2'); +is ($object->mnt_lower()->[1],'MAINT2','mnt_lower properly added'); + +# Test 'mnt_domains' +$tested{'mnt_domains'}++; is_deeply ($object->mnt_domains(),[ 'DMNS-MNT' ],'mnt_domains properly parsed'); $object->mnt_domains('MAINT2'); is ($object->mnt_domains()->[1],'MAINT2','mnt_domains properly added'); +# Test 'mnt_irt' +$tested{'mnt_irt'}++; is_deeply ($object->mnt_irt(),[ 'IRT-EXAMPLENET-AP' ],'mnt_irt properly parsed'); $object->mnt_irt('IRT-EX2'); is ($object->mnt_irt()->[1],'IRT-EX2','mnt_irt properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@examplenet.com 20101231' ],'changed properly parsed'); $object->changed('Added changed'); is ($object->changed()->[1],'Added changed','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),['watcher@somewhere.net'],'notify properly parsed'); $object->notify('otherwatcher@somewhere.net'); is ($object->notify()->[1],'otherwatcher@somewhere.net','notify properly added'); +# Test 'mnt_routes' +$tested{'mnt_routes'}++; is_deeply ($object->mnt_routes(),['RTES-MNT'],'mnt_routes properly parsed'); $object->mnt_routes('RTES-MNT2'); is ($object->mnt_routes()->[1],'RTES-MNT2','mnt_routes properly added'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ inetnum: 10.0.0.1 - 10.0.0.255 remarks: No remarks @@ -104,6 +143,7 @@ admin-c: FR123-AP tech-c: FR123-AP status: ALLOCATED PA mnt-by: MAINT-EXAMPLENET-AP +mnt-lower: MAINL-EXAMPLENET-AP mnt-routes: RTES-MNT mnt-domains: DMNS-MNT mnt-irt: IRT-EXAMPLENET-AP diff --git a/t/140-Inet6Num.t b/t/140-Inet6Num.t index eac63d0..1714973 100644 --- a/t/140-Inet6Num.t +++ b/t/140-Inet6Num.t @@ -9,92 +9,132 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Inet6Num'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Inet6Num"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( inet6num netname descr country admin_c tech_c status remarks notify mnt_by mnt_lower mnt_routes mnt_domains mnt_irt changed source); - can_ok $object, qw( mnt_irt ); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Inet6Num tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'inet6num' +$tested{'inet6num'}++; is ($object->inet6num(),'2001:0DB8::/32','inet6num properly parsed'); $object->inet6num('2001:0DB9::/32'); is ($object->inet6num(),'2001:0DB9::/32','inet6num properly set'); +# Test 'netname' +$tested{'netname'}++; is ($object->netname(),'EXAMPLENET-AP','netname properly parsed'); $object->netname('EXAMPLE2'); is ($object->netname(),'EXAMPLE2','netname properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Example net Pty Ltd' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'country' +$tested{'country'}++; is_deeply ($object->country(),['AP'],'country properly parsed'); $object->country('FR'); is ($object->country()->[1],'FR','country properly added'); +# Test 'remarks' +$tested{'remarks'}++; +is_deeply ($object->remarks(),['Example subnet'],'remarks properly parsed'); +$object->remarks('Second remark'); +is ($object->remarks()->[1],'Second remark','remarks properly added'); + +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'FR123-AP' ],'admin_c properly parsed'); $object->admin_c('FR345-APF'); is ($object->admin_c()->[1],'FR345-APF','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'FR123-AP' ],'tech_c properly parsed'); $object->tech_c('FR345-AP'); is ($object->tech_c()->[1],'FR345-AP','tech_c properly added'); +# Test 'status' +$tested{'status'}++; is ($object->status(),'ALLOCATED PORTABLE','status properly parsed'); $object->status('ASSIGNED PORTABLE'); is ($object->status(),'ASSIGNED PORTABLE','status properly set'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'abc@examplenet.com' ],'notify properly parsed'); $object->notify('efg@examplenet.com'); is ($object->notify()->[1],'efg@examplenet.com','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLENET-AP' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLENET-AP'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLENET-AP','mnt_by properly added'); +# Test 'mnt_lower' +$tested{'mnt_lower'}++; is_deeply ($object->mnt_lower(),[ 'MAINT-EXAMPLENET-AP' ],'mnt_lower properly parsed'); $object->mnt_lower('MAINT2-EXAMPLENET-AP'); is ($object->mnt_lower()->[1],'MAINT2-EXAMPLENET-AP','mnt_lower properly added'); +# Test 'mnt_routes' +$tested{'mnt_routes'}++; is_deeply ($object->mnt_routes(),[ 'MAINT-EXAMPLENET-AP' ],'mnt_routes properly parsed'); $object->mnt_routes('MAINT2-EXAMPLENET-AP'); is ($object->mnt_routes()->[1],'MAINT2-EXAMPLENET-AP','mnt_routes properly added'); +# Test 'mnt_irt' +$tested{'mnt_irt'}++; is_deeply ($object->mnt_irt(),[ 'IRT-EXAMPLENET-AP' ],'mnt_irt properly parsed'); $object->mnt_irt('MAINT2-EXAMPLENET-AP'); is ($object->mnt_irt()->[1],'MAINT2-EXAMPLENET-AP','mnt_irt properly added'); +# Test 'mnt_domains' +$tested{'mnt_domains'}++; is_deeply ($object->mnt_domains(),[ 'MAINT-EXAMPLENET-AP' ],'mnt_domains properly parsed'); $object->mnt_domains('MAINT2-EXAMPLENET-AP'); is ($object->mnt_domains()->[1],'MAINT2-EXAMPLENET-AP','mnt_domains properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@examplenet.com 20101231' ],'changed properly parsed'); $object->changed('abc@examplenet.com 20121231'); is ($object->changed()->[1],'abc@examplenet.com 20121231','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'APNIC','source properly parsed'); $object->source('RIPE'); is ($object->source(),'RIPE','source properly set'); +# Test 'org' +$tested{'org'}++; +# TODO + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); __DATA__ inet6num: 2001:0DB8::/32 +remarks: Example subnet netname: EXAMPLENET-AP descr: Example net Pty Ltd country: AP diff --git a/t/145-InetRtr.t b/t/145-InetRtr.t index 60a8ca2..9e260d9 100644 --- a/t/145-InetRtr.t +++ b/t/145-InetRtr.t @@ -9,83 +9,123 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::InetRtr'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::InetRtr"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( inet_rtr descr alias local_as ifaddr interface peer mp_peer member_of remarks admin_c tech_c notify mnt_by changed source ); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::InetRtr tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'inet_rtr' +$tested{'inet_rtr'}++; is ($object->inet_rtr(),'RTR.EXAMPLE.COM','inet_rtr properly parsed'); $object->inet_rtr('RTR2.EXAMPLE.COM'); is ($object->inet_rtr(),'RTR2.EXAMPLE.COM','inet_rtr properly set'); +# Test 'alias' +$tested{'alias'}++; is_deeply ($object->alias(),[ 'EDGE01.EXAMPLE.COM' ],'alias properly parsed'); $object->alias('EDGE02.EXAMPLE.COM'); is ($object->alias()->[1],'EDGE02.EXAMPLE.COM','alias properly added'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Edge router for UniverseNet', 'Paris - France' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[2],'Added descr','descr properly added'); +# Test 'local_as' +$tested{'local_as'}++; is ($object->local_as(),'AS1','local_as properly parsed'); $object->local_as('AS2'); -is ($object->local_as(),'AS2','local properly set'); +is ($object->local_as(),'AS2','local_as properly set'); +# Test 'ifaddr' +$tested{'ifaddr'}++; is_deeply ($object->ifaddr(),[ '147.45.0.17 masklen 32'],'ifaddr properly parsed'); $object->ifaddr('147.45.0.18 masklen 32'); is ($object->ifaddr()->[1],'147.45.0.18 masklen 32','ifaddr properly added'); +# Test 'interface' +$tested{'interface'}++; is_deeply ($object->interface(),[ '147.45.0.17 masklen 32'],'interface properly parsed'); $object->interface('147.45.0.18 masklen 32'); is ($object->interface()->[1],'147.45.0.18 masklen 32','interface properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'FR123-AP'],'admin_c properly parsed'); $object->admin_c('FR456-AP'); is ($object->admin_c()->[1],'FR456-AP','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'FR123-AP'],'tech_c properly parsed'); $object->tech_c('FR456-AP'); is ($object->tech_c()->[1],'FR456-AP','tech_c properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLENET-AP'],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLENET-AP'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLENET-AP','mnt_by properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@example.com'],'notify properly parsed'); $object->notify('watcher2@example.com'); is ($object->notify()->[1],'watcher2@example.com','notify properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@examplenet.com 20101231'],'changed properly parsed'); $object->changed('abc@examplenet.com 20111231'); is ($object->changed()->[1],'abc@examplenet.com 20111231','changed properly added'); +# Test 'member_of' +$tested{'member_of'}++; is_deeply ($object->member_of(),['AS2'],'member_of properly parsed'); $object->member_of('AS3'); is ($object->member_of()->[1],'AS3','member_of properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remarks'],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Test 'org' +$tested{'org'}++; +# TODO + +# Test 'peer' +$tested{'peer'}++; +# TODO + +# Test 'mp_peer' +$tested{'mp_peer'}++; +# TODO + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); __DATA__ inet-rtr: RTR.EXAMPLE.COM diff --git a/t/150-RtrSet.t b/t/150-RtrSet.t index be6f495..f887078 100644 --- a/t/150-RtrSet.t +++ b/t/150-RtrSet.t @@ -9,39 +9,43 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::RtrSet'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::RtrSet"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw(rtr_set descr members mp_members mbrs_by_ref admin_c tech_c mnt_by notify changed remarks source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::RtrSet tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'rtr_set' +$tested{'rtr_set'}++; is ($object->rtr_set(),'RTRS-EXAMPLENET','rtr_set properly parsed'); $object->rtr_set('RTRS2-EXAMPLENET'); is ($object->rtr_set(),'RTRS2-EXAMPLENET','rtr_set properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Router set for', 'the company Example' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[2],'Added descr','descr properly added'); +# Test 'members' +$tested{'members'}++; is_deeply ($object->members(),[ 'INET-RTR1', 'RTRS-SET3' ],'members properly parsed'); $object->members('RTRS-SET4'); is ($object->members()->[2],'RTRS-SET4','members properly added'); +# Test 'mp_members' +$tested{'mp_members'}++; is_deeply ($object->mp_members(),[ '192.168.1.1', '2001:db8:85a3:8d3:1319:8a2e:370:7348', 'INET-RTRV6', @@ -49,38 +53,59 @@ is_deeply ($object->mp_members(),[ '192.168.1.1', $object->mp_members('RTRS-SET2'); is ($object->mp_members()->[4],'RTRS-SET2','mp_members properly added'); +# Test 'mbrs_by_ref' +$tested{'mbrs_by_ref'}++; is_deeply ($object->mbrs_by_ref(),[ 'CPNY-MNTNER'],'mbrs_by_ref properly parsed'); $object->mbrs_by_ref('CPY2-MNTNER'); is ($object->mbrs_by_ref()->[1],'CPY2-MNTNER','mbrs_by_ref properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'FR123-AP'],'admin_c properly parsed'); $object->admin_c('FR456-AP'); is ($object->admin_c()->[1],'FR456-AP','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'FR123-AP'],'tech_c properly parsed'); $object->tech_c('FR456-AP'); is ($object->tech_c()->[1],'FR456-AP','tech_c properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLENET-AP'],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLENET-AP'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLENET-AP','mnt_by properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@example.com'],'notify properly parsed'); $object->notify('watcher2@example.com'); is ($object->notify()->[1],'watcher2@example.com','notify properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@examplenet.com 20101231'],'changed properly parsed'); $object->changed('abc@examplenet.com 20121231'); is ($object->changed()->[1],'abc@examplenet.com 20121231','changed properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remarks'],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ rtr-set: RTRS-EXAMPLENET descr: Router set for diff --git a/t/155-Mntner.t b/t/155-Mntner.t index e96af6e..b26e2d6 100644 --- a/t/155-Mntner.t +++ b/t/155-Mntner.t @@ -9,85 +9,128 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Mntner'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Mntner"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( mntner descr country admin_c tech_c upd_to mnt_nfy auth auth_override remarks notify abuse_mailbox mnt_by referral_by changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Mntner tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'mntner' +$tested{'mntner'}++; is ($object->mntner(),'MAINT01-EXAMPLECOM','mntner properly parsed'); $object->mntner('MAINT02-EXAMPLECOM'); is ($object->mntner(),'MAINT02-EXAMPLECOM','mntner properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Maintainer for Example company' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +$tested{'remarks'}++; +is_deeply ($object->remarks(),[ 'Remark1' ],'remarks properly parsed'); +$object->remarks('Added remark'); +is ($object->remarks()->[1],'Added remark','remarks properly added'); + +# Test 'country' +$tested{'country'}++; is ($object->country(),'FR','country properly parsed'); $object->country('ZH'); is ($object->country(),'ZH','country properly set'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'FR123-AP' ],'admin_c properly parsed'); $object->admin_c('FR456-AP'); is ($object->admin_c()->[1],'FR456-AP','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'FR123-AP' ],'tech_c properly parsed'); $object->tech_c('FR456-AP'); is ($object->tech_c()->[1],'FR456-AP','tech_c properly added'); +# Test 'upd_to' +$tested{'upd_to'}++; is_deeply ($object->upd_to(),[ 'abc@somewhere.com' ],'upd_to properly parsed'); $object->upd_to('def@somewhere.com'); is ($object->upd_to()->[1],'def@somewhere.com','upd_to properly added'); +# Test 'mnt_nfy' +$tested{'mnt_nfy'}++; is_deeply ($object->mnt_nfy(),[ 'abc@somewhere.com' ],'mnt_nfy properly parsed'); $object->mnt_nfy('def@somewhere.com'); is ($object->mnt_nfy()->[1],'def@somewhere.com','mnt_nfy properly added'); +# Test 'auth' +$tested{'auth'}++; is_deeply ($object->auth(),['PGPKEY-78BBB10F'],'auth properly parsed'); $object->auth('PGPKEY-78BBB101'); is ($object->auth()->[1],'PGPKEY-78BBB101','auth properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('watcher2@somewhere.com'); is ($object->notify()->[1],'watcher2@somewhere.com','notify properly added'); +# Test 'abuse_mailbox' +$tested{'abuse_mailbox'}++; is_deeply ($object->abuse_mailbox(),[ 'abuse@somewhere.com' ],'abuse_mailbox properly parsed'); $object->abuse_mailbox('abuse2@somewhere.com'); is ($object->abuse_mailbox()->[1],'abuse2@somewhere.com','abuse_mailbox properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLENETCOM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLENETCOM'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLENETCOM','mnt_by properly added'); +# Test 'referral_by' +$tested{'referral_by'}++; is ($object->referral_by(), 'RIPE-HM' ,'referral_by properly parsed'); $object->referral_by('RIPE-HM2'); is ($object->referral_by(),'RIPE-HM2','reberral_by properly set'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@somewhere.com 20120131' ],'changeD properly parsed'); $object->changed('abc@somewhere.com 20110131'); is ($object->changed()->[1],'abc@somewhere.com 20110131','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Test 'auth_override' +$tested{'auth_override'}++; +# TODO + +# Test 'org' +$tested{'org'}++; +# TODO + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ mntner: MAINT01-EXAMPLECOM +remarks: Remark1 descr: Maintainer for Example company country: FR admin-c: FR123-AP diff --git a/t/160-KeyCert.t b/t/160-KeyCert.t index 712fcbb..e859d3a 100644 --- a/t/160-KeyCert.t +++ b/t/160-KeyCert.t @@ -9,69 +9,106 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::KeyCert'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::KeyCert"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( key_cert method owner fingerpr remarks org certif notify admin_c tech_c mnt_by changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::KeyCert tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'key_cert' +$tested{'key_cert'}++; is ($object->key_cert(),'PGPKEY-4E17C667','key_cert properly parsed'); $object->key_cert('PGPKEY-4E17C668'); is ($object->key_cert(),'PGPKEY-4E17C668','key_cert properly set'); +# Test 'method' +$tested{'method'}++; is ($object->method(),'PGP','method properly parsed'); $object->method('PGP2'); is ($object->method(),'PGP2','method properly set'); +# Test 'owner' +$tested{'owner'}++; is_deeply ($object->owner(),['KEY-OWNER Arhuman'],'owner properly parsed'); $object->owner('Added owner'); is ($object->owner()->[1],'Added owner','owner properly added'); +# Test 'fingerpr' +$tested{'fingerpr'}++; is ($object->fingerpr(),'8B33 C463 2555 F669 EEEB 105A 68BA 54F3 4E17 C667','fingerpr properly parsed'); $object->fingerpr('8B33 C463 2555 F669 EEEB 105A 68BA 54F3 4E17 FFFF'); is ($object->fingerpr(),'8B33 C463 2555 F669 EEEB 105A 68BA 54F3 4E17 FFFF','fingerpr properly set'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'Arhuman\'s key' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'certif' +$tested{'certif'}++; is ($object->certif()->[0],'-----BEGIN PGP PUBLIC KEY BLOCK-----','certif[0] properly parsed'); is ($object->certif()->[3],'mQGiBERfPw4RBACuTDkgkfCGFAgKeShm0FgozRsLkjccsV/Ua5Y0fs6Ay8agueTj','certif[3] properly parsed'); is ($object->certif()->[28],'=opxg','certif[28] properly parsed'); $object->certif('Added certif'); is ($object->certif()->[30],'Added certif','certif properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('watcher@elsewhere.com'); is ($object->notify()->[1],'watcher@elsewhere.com','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLECOM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLECOM'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLECOM','mnt_by properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; +is_deeply ($object->admin_c(),[ 'FR123-AP' ],'admin_c properly parsed'); +$object->admin_c('FR456-AP'); +is ($object->admin_c()->[1],'FR456-AP','admin_c properly added'); + +# Test 'tech_c' +$tested{'tech_c'}++; +is_deeply ($object->tech_c(),[ 'FR123-AP' ],'tech_c properly parsed'); +$object->tech_c('FR456-AP'); +is ($object->tech_c()->[1],'FR456-AP','tech_c properly added'); + +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@somewhere.com 20120131' ],'changed properly parsed'); $object->changed('def@somewhere.com 20120228'); is ($object->changed()->[1],'def@somewhere.com 20120228','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Test 'org' +$tested{'org'}++; +# TODO + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ key-cert: PGPKEY-4E17C667 method: PGP @@ -110,6 +147,8 @@ certif: =opxg certif: -----END PGP PUBLIC KEY BLOCK----- notify: watcher@somewhere.com mnt-by: MAINT-EXAMPLECOM +admin-c: FR123-AP +tech-c: FR123-AP changed: abc@somewhere.com 20120131 source: RIPE diff --git a/t/165-Route.t b/t/165-Route.t index 3972522..5cd8c62 100644 --- a/t/165-Route.t +++ b/t/165-Route.t @@ -9,108 +9,149 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Route'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Route"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( route descr country origin cross_mnt cross_nfy holes member_of inject aggr_mtd aggr_bndry export_comps components remarks notify mnt_lower mnt_routes mnt_by changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Route tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'route' +$tested{'route'}++; is ($object->route(),'192.168.1.0/24','route properly parsed'); $object->route('10.0.0.0/24'); is ($object->route(),'10.0.0.0/24','route properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'route object for 192.168.1.0/24' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'country' +$tested{'country'}++; is ($object->country(),'FR','country properly parsed'); $object->country('GB'); is ($object->country(),'GB','country properly set'); +# Test 'origin' +$tested{'origin'}++; is ($object->origin(),'AS1234','origin properly parsed'); $object->origin('AS12'); is ($object->origin(),'AS12','origin properly set'); +# Test 'cross_mnt' +$tested{'cross_mnt'}++; is_deeply ($object->cross_mnt(),[ 'CROSS-MAINT01' ],'cross_mnt properly parsed'); $object->cross_mnt('CROSS-MAINT02'); is ($object->cross_mnt()->[1],'CROSS-MAINT02','cross_mnt properly added'); +# Test 'cross_nfy' +$tested{'cross_nfy'}++; is_deeply ($object->cross_nfy(),[ 'watcher2@somewhere.com' ],'cross_nfy properly parsed'); $object->cross_nfy('watcher@somewhere.com'); is ($object->cross_nfy()->[1],'watcher@somewhere.com','cross_ntfy properly added'); +# Test 'holes' +$tested{'holes'}++; is_deeply ($object->holes(),[ '192.168.1.23' ],'holes properly parsed'); $object->holes('192.168.1.123'); is ($object->holes()->[1],'192.168.1.123','holes properly added'); +# Test 'member_of' +$tested{'member_of'}++; is_deeply ($object->member_of(),[ 'RTES-SET01' ],'member_of properly parsed'); $object->member_of('RTES-SET02'); is ($object->member_of()->[1],'RTES-SET02','member_of properly added'); +# Test 'inject' +$tested{'inject'}++; is_deeply ($object->inject(),[ 'RTR01' ],'inject properly parsed'); $object->inject('RTR02'); is ($object->inject()->[1],'RTR02','inject properly added'); +# Test 'aggr_mtd' +$tested{'aggr_mtd'}++; is ($object->aggr_mtd(),'AAAAAAA','aggr_mtd properly parsed'); $object->aggr_mtd('ABABABAB'); is ($object->aggr_mtd(),'ABABABAB','aggr_mtd properly set'); +# Test 'aggr_bndry' +$tested{'aggr_bndry'}++; is ($object->aggr_bndry(),'BBBBBBB','aggr_bndry properly parsed'); $object->aggr_bndry('BCBCBCBCBC'); is ($object->aggr_bndry(),'BCBCBCBCBC','aggr_bndry properly added'); +# Test 'export_comps' +$tested{'export_comps'}++; is ($object->export_comps(),'CCCCCCC','export_comps properly parsed'); $object->export_comps('CDCDCDCDCD'); is ($object->export_comps(),'CDCDCDCDCD','export_comps properly added'); +# Test 'components' +$tested{'components'}++; is ($object->components(),'DDDDDDD','components properly parsed'); $object->components('DEDEDEDEDE'); is ($object->components(),'DEDEDEDEDE','components properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remark' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('watcher2@somewhere.com'); is ($object->notify()->[1],'watcher2@somewhere.com','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLECOM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLECOM'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLECOM','mnt_by properly added'); +# Test 'mnt_lower' +$tested{'mnt_lower'}++; is_deeply ($object->mnt_lower(),[ 'MAINT-EXAMPLECOM' ],'mnt_lower properly parsed'); $object->mnt_lower('MAINT2-EXAMPLECOM'); is ($object->mnt_lower()->[1],'MAINT2-EXAMPLECOM','mnt_lower properly added'); +# Test 'mnt_routes' +$tested{'mnt_routes'}++; is_deeply ($object->mnt_routes(),[ 'MAINT-EXAMPLECOM' ],'mnt_routes properly parsed'); $object->mnt_routes('MAINT2-EXAMPLECOM'); is ($object->mnt_routes()->[1],'MAINT2-EXAMPLECOM','mnt_routes properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@somewhere.com 20120131' ],'changed properly parsed'); $object->changed('abc@somewhere.com 20120228'); is ($object->changed()->[1],'abc@somewhere.com 20120228','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ route: 192.168.1.0/24 descr: route object for 192.168.1.0/24 diff --git a/t/167-Route6.t b/t/167-Route6.t index 7508f1a..4b582f8 100644 --- a/t/167-Route6.t +++ b/t/167-Route6.t @@ -9,106 +9,145 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Route6'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Route6"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( route6 descr country origin org holes member_of inject aggr_mtd aggr_bndry export_comps components remarks notify mnt_lower mnt_routes mnt_by changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Route6 tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'route6' +$tested{'route6'}++; is ($object->route6(),'2001:0DB8::/32','route properly parsed'); $object->route6('2001:0DB8::0001/48'); is ($object->route6(),'2001:0DB8::0001/48','route properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'route object for 192.168.1.0/24' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'country' +$tested{'country'}++; is ($object->country(),'FR','country properly parsed'); $object->country('GB'); is ($object->country(),'GB','country properly set'); +# Test 'origin' +$tested{'origin'}++; is ($object->origin(),'AS1234','origin properly parsed'); $object->origin('AS12'); is ($object->origin(),'AS12','origin properly set'); +# Test 'org' +$tested{'org'}++; my $orgs = $object->org(); is ($orgs->[0],'ORG-MISC01-RIPE','org properly parsed'); $orgs = $object->org('ORG-MOD'); is ($orgs->[0],'ORG-MISC01-RIPE','org array preserved'); is ($orgs->[1],'ORG-MOD','org properly added'); +# Test 'holes' +$tested{'holes'}++; is_deeply ($object->holes(),[ '192.168.1.23' ],'holes properly parsed'); $object->holes('192.168.1.123'); is ($object->holes()->[1],'192.168.1.123','holes properly added'); +# Test 'member_of' +$tested{'member_of'}++; is_deeply ($object->member_of(),[ 'RTES-SET01' ],'member_of properly parsed'); $object->member_of('RTES-SET02'); is ($object->member_of()->[1],'RTES-SET02','member_of properly added'); +# Test 'inject' +$tested{'inject'}++; is_deeply ($object->inject(),[ 'RTR01' ],'inject properly parsed'); $object->inject('RTR02'); is ($object->inject()->[1],'RTR02','inject properly added'); +# Test 'aggr_mtd' +$tested{'aggr_mtd'}++; is ($object->aggr_mtd(),'AAAAAAA','aggr_mtd properly parsed'); $object->aggr_mtd('ABABABAB'); is ($object->aggr_mtd(),'ABABABAB','aggr_mtd properly set'); +# Test 'aggr_bndry' +$tested{'aggr_bndry'}++; is ($object->aggr_bndry(),'BBBBBBB','aggr_bndry properly parsed'); $object->aggr_bndry('BCBCBCBCBC'); is ($object->aggr_bndry(),'BCBCBCBCBC','aggr_bndry properly added'); +# Test 'export_comps' +$tested{'export_comps'}++; is ($object->export_comps(),'CCCCCCC','export_comps properly parsed'); $object->export_comps('CDCDCDCDCD'); is ($object->export_comps(),'CDCDCDCDCD','export_comps properly added'); +# Test 'components' +$tested{'components'}++; is ($object->components(),'DDDDDDD','components properly parsed'); $object->components('DEDEDEDEDE'); is ($object->components(),'DEDEDEDEDE','components properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remark' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('watcher2@somewhere.com'); is ($object->notify()->[1],'watcher2@somewhere.com','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLECOM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLECOM'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLECOM','mnt_by properly added'); +# Test 'mnt_lower' +$tested{'mnt_lower'}++; is_deeply ($object->mnt_lower(),[ 'MAINT-EXAMPLECOM' ],'mnt_lower properly parsed'); $object->mnt_lower('MAINT2-EXAMPLECOM'); is ($object->mnt_lower()->[1],'MAINT2-EXAMPLECOM','mnt_lower properly added'); +# Test 'mnt_routes' +$tested{'mnt_routes'}++; is_deeply ($object->mnt_routes(),[ 'MAINT-EXAMPLECOM' ],'mnt_routes properly parsed'); $object->mnt_routes('MAINT2-EXAMPLECOM'); is ($object->mnt_routes()->[1],'MAINT2-EXAMPLECOM','mnt_routes properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@somewhere.com 20120131' ],'changed properly parsed'); $object->changed('abc@somewhere.com 20120228'); is ($object->changed()->[1],'abc@somewhere.com 20120228','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ route6: 2001:0DB8::/32 descr: route object for 192.168.1.0/24 diff --git a/t/170-RouteSet.t b/t/170-RouteSet.t index ae53108..a3b86b2 100644 --- a/t/170-RouteSet.t +++ b/t/170-RouteSet.t @@ -9,79 +9,106 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::RouteSet'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::RouteSet"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( route_set descr members mp_members mbrs_by_ref remarks tech_c admin_c notify mnt_by mnt_lower changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::RouteSet tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'route_set' +$tested{'route_set'}++; is ($object->route_set(),'RS-DENIED-ROUTES','route_set properly parsed'); $object->route_set('RS-ALLOWED-ROUTES'); is ($object->route_set(),'RS-ALLOWED-ROUTES','route_set properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Set of denied routes' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'members' +$tested{'members'}++; is_deeply ($object->members(),[ 'RTE01', 'RTE02' ],'members properly parsed'); $object->members('RTE03'); is ($object->members()->[2],'RTE03','members properly added'); +# Test 'mp_members' +$tested{'mp_members'}++; is_deeply ($object->mp_members(),[ 'RTE-V6-01', 'RTE-V6-02' ],'mp_members properly parsed'); $object->mp_members('RTE-V6-03'); is ($object->mp_members()->[2],'RTE-V6-03','mp_members properly added'); +# Test 'mbrs_by_ref' +$tested{'mbrs_by_ref'}++; is_deeply ($object->mbrs_by_ref(),[ 'RTE-MAINT01' ],'mbrs_by_ref properly parsed'); $object->mbrs_by_ref('RTE-MAINT02'); is ($object->mbrs_by_ref()->[1],'RTE-MAINT02','mbrs_by_ref properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remarks' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'TECH-CTCT' ],'tech_c properly parsed'); $object->tech_c('TECH-CTCT2'); is ($object->tech_c()->[1],'TECH-CTCT2','tech_c properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'ADM-CTCT' ],'admin_c properly parsed'); $object->admin_c('ADM2-CTCT'); is ($object->admin_c()->[1],'ADM2-CTCT','admin_c properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('Added notify'); is ($object->notify()->[1],'Added notify','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLECOM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLECOM'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLECOM','mnt_by properly added'); +# Test 'mnt_lower' +$tested{'mnt_lower'}++; is_deeply ($object->mnt_lower(),[ 'MAINT-EXAMPLECOM' ],'mnt_lower properly parsed'); $object->mnt_lower('MAINT2-EXAMPLECOM'); is ($object->mnt_lower()->[1],'MAINT2-EXAMPLECOM','mnt_lower properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@somewhere.com 20120131' ],'changed properly parsed'); $object->changed('abc@somewhere.com 20120130'); is ($object->changed()->[1],'abc@somewhere.com 20120130','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ route-set: RS-DENIED-ROUTES descr: Set of denied routes diff --git a/t/175-PeeringSet.t b/t/175-PeeringSet.t index 06727c9..d602b16 100644 --- a/t/175-PeeringSet.t +++ b/t/175-PeeringSet.t @@ -9,75 +9,100 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::PeeringSet'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::PeeringSet"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( peering_set descr peering mp_peering remarks tech_c admin_c notify mnt_by mnt_lower changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::PeeringSet tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'peering_set' +$tested{'peering_set'}++; is ($object->peering_set(),'PRNG-EXAMPLE','peering_set properly parsed'); $object->peering_set('PRNG-EXAMPLE2'); is ($object->peering_set(),'PRNG-EXAMPLE2','peering_set properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Peering at EXAMPLE' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'peering' +$tested{'peering'}++; is_deeply ($object->peering(),[ 'PRNG-OTHER', 'AS1 at 9.9.9.1' ],'peering properly parsed'); $object->peering('PRNG-OTHER2'); is ($object->peering()->[2],'PRNG-OTHER2','peering properly added'); +# Test 'mp_peering' +$tested{'mp_peering'}++; is_deeply ($object->mp_peering(),[ 'PRNG-OTHERV6'],'mp_peering properly parsed'); $object->mp_peering('PRNG-ANjOTHERV6'); is ($object->mp_peering()->[1],'PRNG-ANjOTHERV6','mp_peering properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remarks' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'TECH-CTCT' ],'tech_c properly parsed'); $object->tech_c('TECH2-CTCT'); is ($object->tech_c()->[1],'TECH2-CTCT','tech_c properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'ADM-CTCT' ],'admin_c properly parsed'); $object->admin_c('ADM2-CTCT'); is ($object->admin_c()->[1],'ADM2-CTCT','admin_c properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('watcher@elsewhere.com'); is ($object->notify()->[1],'watcher@elsewhere.com','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLECOM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLECOM'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLECOM','mnt_by properly added'); +# Test 'mnt_lower' +$tested{'mnt_lower'}++; is_deeply ($object->mnt_lower(),[ 'MAINT-EXAMPLECOM' ],'mnt_lower properly parsed'); $object->mnt_lower('MAINT2-EXAMPLECOM'); is ($object->mnt_lower()->[1],'MAINT2-EXAMPLECOM','mnt_lower properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@somewhere.com 20120131' ],'changed properly parsed'); $object->changed('abc@somewhere.com 20120228'); is ($object->changed()->[1],'abc@somewhere.com 20120228','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ peering-set: PRNG-EXAMPLE descr: Peering at EXAMPLE diff --git a/t/180-Limerick.t b/t/180-Limerick.t index f9829aa..53dc06b 100644 --- a/t/180-Limerick.t +++ b/t/180-Limerick.t @@ -9,68 +9,89 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Limerick'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Limerick"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( limerick descr text admin_c author remarks notify mnt_by changed source ); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Limerick tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'limerick' +$tested{'limerick'}++; is ($object->limerick(),'LIMERICK-DEMO','limerick properly parsed'); $object->limerick('LIMERICK2-DEMO'); is ($object->limerick(),'LIMERICK2-DEMO','limerick properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Limerick example' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'text' +$tested{'text'}++; is ($object->text()->[0],'This won\'t be an ode','text[0] properly parsed'); is ($object->text()->[4],'I should have used POD','text[4] properly parsed'); $object->text('Added text'); is ($object->text()->[5],'Added text','text properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'ADM-CTCT' ],'admin_c properly parsed'); $object->admin_c('ADM2-CTCT'); is ($object->admin_c()->[1],'ADM2-CTCT','admin_c properly added'); +# Test 'author' +$tested{'author'}++; is_deeply ($object->author(),['GEEK-01'],'author properly parsed'); $object->author('GEEK-02'); is ($object->author()->[1],'GEEK-02','author properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remarks' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('watcher@elsewhere.com'); is ($object->notify()->[1],'watcher@elsewhere.com','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLECOM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLECOM'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLECOM','mnt_by properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@somewhere.com 20120131' ],'changed properly parsed'); $object->changed('abc@somewhere.com 20120228'); is ($object->changed()->[1],'abc@somewhere.com 20120228','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ limerick: LIMERICK-DEMO descr: Limerick example diff --git a/t/185-Poem.t b/t/185-Poem.t index b6c86dc..2e176b2 100644 --- a/t/185-Poem.t +++ b/t/185-Poem.t @@ -9,39 +9,43 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Poem'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Poem"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( poem descr form text admin_c author remarks notify mnt_by changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Poem tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'poem' +$tested{'poem'}++; is ($object->poem(),'POEM-EXAMPLE','poem properly parsed'); $object->poem('POEM-EXAMPLE2'); is ($object->poem(),'POEM-EXAMPLE2','poem properly set'); +# Test 'form' +$tested{'form'}++; is ($object->form(),'FORM-PROSE','form properly parsed'); $object->form('FORM-UNKNOWN'); is ($object->form(),'FORM-UNKNOWN','form properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'An example of poem' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'text' +$tested{'text'}++; is_deeply ($object->text(),[ 'line 1 is funny', 'line 2 is easy', 'line 3 is boring', @@ -50,25 +54,57 @@ is_deeply ($object->text(),[ 'line 1 is funny', $object->text('Added text'); is ($object->text()->[5],'Added text','text properly added'); +# Test 'author' +$tested{'author'}++; is_deeply ($object->author(),['GEEK-01'],'author properly parsed'); $object->author('GEEK-02'); is ($object->author()->[1],'GEEK-02','author properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'CPNY-ADM' ],'admin_c properly parsed'); $object->admin_c('CPNY-ADM2'); is ($object->admin_c()->[1],'CPNY-ADM2','admin_c properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'CPNY-MNT' ],'mnt_by properly parsed'); $object->mnt_by('CPNY-MNT2'); is ($object->mnt_by()->[1],'CPNY-MNT2','mnt_by properly added'); +# Test 'notify' +$tested{'notify'}++; +is_deeply ($object->notify(),[ 'CPNY-MNT' ],'notify properly parsed'); +$object->notify('CPNY-MNT2'); +is ($object->notify()->[1],'CPNY-MNT2','notify properly added'); + +# Test 'remarks' +$tested{'remarks'}++; +is_deeply ($object->remarks(),[ 'A remark' ],'remarks properly parsed'); +$object->remarks('Another one'); +is ($object->remarks()->[1],'Another one','remarks properly added'); + +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE #Filtered','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Test 'changed' +$tested{'changed'}++; +is_deeply ($object->changed(),['arhuman@gmail.com 20110214'],'changed properly parsed'); +$object->changed('arhuman@gmail.com 20110213'); +is ($object->changed()->[1],'arhuman@gmail.com 20110213','changed properly added'); + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ poem: POEM-EXAMPLE form: FORM-PROSE +remarks: A remark descr: An example of poem text: line 1 is funny text: line 2 is easy @@ -78,5 +114,7 @@ text: author: GEEK-01 admin-c: CPNY-ADM mnt-by: CPNY-MNT +notify: CPNY-MNT +changed: arhuman@gmail.com 20110214 source: RIPE #Filtered diff --git a/t/187-PoeticForm.t b/t/187-PoeticForm.t index b6c86dc..0a0e064 100644 --- a/t/187-PoeticForm.t +++ b/t/187-PoeticForm.t @@ -9,74 +9,87 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::PoeticForm'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Poem"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); - -can_ok $object, qw( poem descr form text admin_c author remarks notify mnt_by -changed source); - -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Poem tests" ); +isa_ok $object, $class; -is ($object->poem(),'POEM-EXAMPLE','poem properly parsed'); -$object->poem('POEM-EXAMPLE2'); -is ($object->poem(),'POEM-EXAMPLE2','poem properly set'); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); -is ($object->form(),'FORM-PROSE','form properly parsed'); -$object->form('FORM-UNKNOWN'); -is ($object->form(),'FORM-UNKNOWN','form properly set'); +# Test 'poetic_form' +$tested{'poetic_form'}++; +is ($object->poetic_form(),'POEM-EXAMPLE','poetic_form properly parsed'); +$object->poetic_form('POEM-EXAMPLE2'); +is ($object->poetic_form(),'POEM-EXAMPLE2','poetic_form properly set'); -is_deeply ($object->descr(),[ 'An example of poem' ],'descr properly parsed'); -$object->descr('Added descr'); -is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'remarks' +$tested{'remarks'}++; +is_deeply ($object->remarks(),[ 'I hope nobody ever read this text' ],'remarks properly parsed'); +$object->remarks('Added remark'); +is ($object->remarks()->[1],'Added remark','remarks properly added'); -is_deeply ($object->text(),[ 'line 1 is funny', +# Test 'descr' +$tested{'descr'}++; +is_deeply ($object->descr(),[ 'line 1 is funny', 'line 2 is easy', 'line 3 is boring', 'I\'d stick with coding', - ''],'text properly parsed'); -$object->text('Added text'); -is ($object->text()->[5],'Added text','text properly added'); - -is_deeply ($object->author(),['GEEK-01'],'author properly parsed'); -$object->author('GEEK-02'); -is ($object->author()->[1],'GEEK-02','author properly added'); + ''],'descr properly parsed'); +$object->descr('Added descr'); +is ($object->descr()->[5],'Added descr','descr properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'CPNY-ADM' ],'admin_c properly parsed'); $object->admin_c('CPNY-ADM2'); is ($object->admin_c()->[1],'CPNY-ADM2','admin_c properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'CPNY-MNT' ],'mnt_by properly parsed'); $object->mnt_by('CPNY-MNT2'); is ($object->mnt_by()->[1],'CPNY-MNT2','mnt_by properly added'); +# Test 'notify' +$tested{'notify'}++; +is_deeply ($object->notify(),[ 'CPNY-MNT' ],'notify properly parsed'); +$object->notify('CPNY-MNT2'); +is ($object->notify()->[1],'CPNY-MNT2','notify properly added'); + +# Test 'changed' +$tested{'changed'}++; +is_deeply ($object->changed(),[ 'arhuman@gmail.com 20120623' ],'changed properly parsed'); +$object->changed('arhuman@gmail.com 20120624'); +is ($object->changed()->[1],'arhuman@gmail.com 20120624','changed properly added'); + +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE #Filtered','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ -poem: POEM-EXAMPLE -form: FORM-PROSE -descr: An example of poem -text: line 1 is funny -text: line 2 is easy -text: line 3 is boring -text: I'd stick with coding -text: -author: GEEK-01 +poetic_form: POEM-EXAMPLE +remarks: I hope nobody ever read this text +descr: line 1 is funny +descr: line 2 is easy +descr: line 3 is boring +descr: I'd stick with coding +descr: admin-c: CPNY-ADM mnt-by: CPNY-MNT +notify: CPNY-MNT +changed: arhuman@gmail.com 20120623 source: RIPE #Filtered diff --git a/t/190-Organisation.t b/t/190-Organisation.t index 87cf4f7..4408d5b 100644 --- a/t/190-Organisation.t +++ b/t/190-Organisation.t @@ -9,90 +9,138 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Organisation'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Organisation"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( organisation org_name org_type descr remarks address phone e_mail fax_no org admin_c tech_c ref_nfy mnt_ref notify mnt_by changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Organisation tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'organisation' +$tested{'organisation'}++; is ($object->organisation(),'AUTO-1','organisation properly parsed'); $object->organisation('AUTO-2'); is ($object->organisation(),'AUTO-2','organisation properly set'); +# Test 'org_name' +$tested{'org_name'}++; is ($object->org_name(),'The name of the organisation','org_name properly parsed'); $object->org_name('Organisation\'s name'); is ($object->org_name(),'Organisation\'s name','name properly set'); +# Test 'org_type' +$tested{'org_type'}++; is ($object->org_type(),'OTHER','org_type properly parsed'); $object->org_type('IANA'); is ($object->org_type(),'IANA','org_type properly set'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'This is a dummy organisation object.', 'Used for testing' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[2],'Added remarks','remarks properly added'); +# Test 'address' +$tested{'address'}++; is_deeply ($object->address(),[ '2 Rue de la Gare', '75001 Paris', 'France' ],'address properly parsed'); $object->address('Added address'); is ($object->address()->[3],'Added address','address properly added'); +# Test 'phone' +$tested{'phone'}++; is_deeply ($object->phone(),[ '+33 1 75 75 75 01' ],'phone properly parsed'); $object->phone('+33 1 75 75 75 02'); is ($object->phone()->[1],'+33 1 75 75 75 02','phone properly added'); +# Test 'fax_no' +$tested{'fax_no'}++; is_deeply ($object->fax_no(),[ '+33 1 75 75 75 91' ],'fax_no properly parsed'); $object->fax_no('+33 1 75 75 75 92'); is ($object->fax_no()->[1],'+33 1 75 75 75 92','fax_no properly added'); +# Test 'e_mail' +$tested{'e_mail'}++; is_deeply ($object->e_mail(),[ 'someone@somewhere.com' ],'e_mail properly parsed'); $object->e_mail('someone@elsewhere.com'); is ($object->e_mail()->[1],'someone@elsewhere.com','e_mail properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'CPNY-ADM' ],'admin_c properly parsed'); $object->admin_c('CPNY-ADM2'); is ($object->admin_c()->[1],'CPNY-ADM2','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'CPNY-TCH' ],'tech_c properly parsed'); $object->tech_c('CPNY-TCH2'); is ($object->tech_c()->[1],'CPNY-TCH2','tech_c properly added'); +# Test 'ref_nfy' +$tested{'ref_nfy'}++; is_deeply ($object->ref_nfy(),[ 'someone@somewhere.com' ],'ref_nfy properly parsed'); $object->ref_nfy('someone@elsewhere.com'); is ($object->ref_nfy()->[1],'someone@elsewhere.com','ref_nfy properly added'); +# Test 'mnt_ref' +$tested{'mnt_ref'}++; is_deeply ($object->mnt_ref(),[ 'CPNY-MNT' ],'mnt_ref properly parsed'); $object->mnt_ref('CPNY-MNT2'); is ($object->mnt_ref()->[1],'CPNY-MNT2','mnt_ref properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'CPNY-MNT' ],'mnt_by properly parsed'); $object->mnt_by('CPNY-MNT2'); is ($object->mnt_by()->[1],'CPNY-MNT2','mnt_by properly added'); +# Test 'notify' +$tested{'notify'}++; +is_deeply ($object->notify(),[ 'CPNY-MNT' ],'notify properly parsed'); +$object->notify('CPNY-MNT2'); +is ($object->notify()->[1],'CPNY-MNT2','notify properly added'); + +# Test 'descr' +$tested{'descr'}++; +is_deeply ($object->descr(),[ 'Providing happiness from 7am to 7pm' ],'descr properly parsed'); +$object->descr('Idle'); +is ($object->descr()->[1],'Idle','descr properly added'); + +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'someone@somewhere.com 20120131' ],'changed properly parsed'); $object->changed('someone@somewhere.com 20120228'); is ($object->changed()->[1],'someone@somewhere.com 20120228','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Test 'org' +$tested{'org'}++; +# TODO + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ organisation: AUTO-1 org-name: The name of the organisation +descr: Providing happiness from 7am to 7pm org-type: OTHER remarks: This is a dummy organisation object. Used for testing @@ -107,6 +155,7 @@ tech-c: CPNY-TCH ref-nfy: someone@somewhere.com mnt-ref: CPNY-MNT mnt-by: CPNY-MNT +notify: CPNY-MNT changed: someone@somewhere.com 20120131 source: RIPE diff --git a/t/195-Response.t b/t/195-Response.t index 759d713..2bc2fef 100644 --- a/t/195-Response.t +++ b/t/195-Response.t @@ -9,28 +9,30 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Response'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Response"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( response ); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Response tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +# Test 'response' +$tested{'response'}++; is ($object->response(),'Response from server','response properly parsed'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ %Response from server diff --git a/t/200-Information.t b/t/200-Information.t index 54e593b..64bea51 100644 --- a/t/200-Information.t +++ b/t/200-Information.t @@ -9,30 +9,37 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Information'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Information"; +isa_ok $object, $class; + +# Non-inherited methods +can_ok $object, qw( comment ); -# Inherited method from Net::Whois::Object; -can_ok $object, +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); - # Constructor - qw( new ), +# Test 'comment' +$tested{'comment'}++; +is_deeply ($object->comment(),['This is the RIPE Database query service.', 'The objects are in RPSL format.'],'comment properly parsed'); - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); -can_ok $object, qw( comment ); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Information tests" ); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); __DATA__ % This is the RIPE Database query service. % The objects are in RPSL format. -% -% The RIPE Database is subject to Terms and Conditions. -% See http://www.ripe.net/db/support/db-terms-conditions.pdf diff --git a/t/205-Irt.t b/t/205-Irt.t index 3c2048f..a1d5420 100644 --- a/t/205-Irt.t +++ b/t/205-Irt.t @@ -9,91 +9,141 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::Irt'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::Irt"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( irt phone fax_no e_mail abuse_mailbox signature encryption admin_c tech_c auth remarks irt_nfy notify mnt_by changed); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::Irt tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'irt' +$tested{'irt'}++; is ($object->irt(),'IRT-DEMO','irt properly parsed'); $object->irt('IRT-DEMO-MOD'); is ($object->irt(),'IRT-DEMO-MOD','irt properly set'); +# Test 'address' +$tested{'address'}++; +is_deeply ($object->address(), + [ + '1 Rue de la Gare', + '75001 Paris', + 'France', + ],'address properly parsed'); +$object->address('Added address'); +is ($object->address()->[3],'Added address','address properly added'); + +# Test 'phone' +$tested{'phone'}++; is_deeply ($object->phone(),[ '+33 102030405' ],'phone properly parsed'); $object->phone('+33 102030406'); is ($object->phone()->[1],'+33 102030406','phone properly added'); +# Test 'fax_no' +$tested{'fax_no'}++; is_deeply ($object->fax_no(),[ '+33 102030405' ],'fax_no properly parsed'); $object->fax_no('+33 102030407'); is ($object->fax_no()->[1],'+33 102030407','fax_no properly added'); +# Test 'abuse_mailbox' +$tested{'abuse_mailbox'}++; is_deeply ($object->abuse_mailbox(),[ 'abuse@demo.com' ],'abuse_mailbox properly parsed'); $object->abuse_mailbox('otherabuse@demo.com'); is ($object->abuse_mailbox()->[1],'otherabuse@demo.com','abuse_mailbox properly added'); +# Test 'signature' +$tested{'signature'}++; is_deeply ($object->signature(),[ 'PGPKEY-F0F0F0F0' ],'signature properly parsed'); $object->signature('PGPKEY-F0F0F0FF'); is ($object->signature()->[1],'PGPKEY-F0F0F0FF','signature properly added'); +# Test 'encryption' +$tested{'encryption'}++; is_deeply ($object->encryption(),[ 'PGPKEY-0F0F0F0F' ],'encryption properly parsed'); $object->encryption('PGPKEY-0F0F0FFF'); is ($object->encryption()->[1],'PGPKEY-0F0F0FFF','encryption properly added'); +# Test 'org' +$tested{'org'}++; is_deeply ($object->org(),[ 'ORG-MISC01-RIPE' ],'org properly parsed'); $object->org('someone@elsewhere.com'); is ($object->org()->[1],'someone@elsewhere.com','org properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remarks', '24/24 7/7', 'https://www.demo.com' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[3],'Added remarks','remarks properly added'); +# Test 'e_mail' +$tested{'e_mail'}++; is_deeply ($object->e_mail(),[ 'someone@demo.com' ],'e_mail properly parsed'); $object->e_mail('someone@elsewhere.com'); is ($object->e_mail()->[1],'someone@elsewhere.com','e_mail properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'DC008-AP' ],'admin_c properly parsed'); $object->admin_c('DC008-AP2'); is ($object->admin_c()->[1],'DC008-AP2','admin_c properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'DC007-AP' ],'tech_c properly parsed'); $object->tech_c('DC007-AP2'); is ($object->tech_c()->[1],'DC007-AP2','tech_c properly added'); +# Test 'irt_nfy' +$tested{'irt_nfy'}++; is_deeply ($object->irt_nfy(),[ 'notify@demo.com' ],'irt_nfy properly parsed'); $object->irt_nfy('notify2@demo.com'); is ($object->irt_nfy()->[1],'notify2@demo.com','irt_nfy properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'someone@demo.com' ],'notify properly parsed'); $object->notify('someone@elsewhere.com'); is ($object->notify()->[1],'someone@elsewhere.com','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-DEMO-COM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT-DEMO-COM2'); is ($object->mnt_by()->[1],'MAINT-DEMO-COM2','mnt_by properly added'); +# Test 'auth' +$tested{'auth'}++; +is_deeply ($object->auth(),[ 'PGPKEY-F004BF15' ],'mnt_by properly parsed'); +$object->auth('PGPKEY-F004BF16'); +is ($object->auth()->[1],'PGPKEY-F004BF16','mnt_by properly added'); + +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'someone@demo.com 20120131' ],'changed properly parsed'); $object->changed('someone@demo.com 20120228'); is ($object->changed()->[1],'someone@demo.com 20120228','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'APNIC','source properly parsed'); $object->source('RIPE'); is ($object->source(),'RIPE','source properly set'); +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ irt: IRT-DEMO address: 1 Rue de la Gare diff --git a/t/210-FilterSet.t b/t/210-FilterSet.t index 68e8100..b1f01fc 100644 --- a/t/210-FilterSet.t +++ b/t/210-FilterSet.t @@ -9,75 +9,104 @@ STDOUT->autoflush(1); STDERR->autoflush(1); our $class; -BEGIN { $class = 'Net::Whois::Object'; use_ok $class; } +BEGIN { $class = 'Net::Whois::Object::FilterSet'; use_ok $class; } + +my %tested; my @lines = ; my $object = (Net::Whois::Object->new(@lines))[0]; -isa_ok $object, "Net::Whois::Object::FilterSet"; - -# Inherited method from Net::Whois::Object; -can_ok $object, - - # Constructor - qw( new ), - - # OO Support - qw( query_filter filtered_attributes displayed_attributes ); +isa_ok $object, $class; +# Non-inherited methods can_ok $object, qw( filter_set descr filter mp_filter remarks org tech_c admin_c notify mnt_by mnt_lower changed source); -ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with Net::Whois::Object::FilterSet tests" ); +# Check if typed attributes are correct +can_ok $object, $object->attributes('mandatory'); +can_ok $object, $object->attributes('optionnal'); +# Test 'filter_set' +$tested{'filter_set'}++; is ($object->filter_set(),'FLTR-EXAMPLE','filter_set properly parsed'); $object->filter_set('FLTR-EXAMPLE2'); is ($object->filter_set(),'FLTR-EXAMPLE2','filter_set properly set'); +# Test 'descr' +$tested{'descr'}++; is_deeply ($object->descr(),[ 'Filter local community routes' ],'descr properly parsed'); $object->descr('Added descr'); is ($object->descr()->[1],'Added descr','descr properly added'); +# Test 'filter' +$tested{'filter'}++; is ($object->filter(), '(AS1 or fltr-foo) and ','filter properly parsed'); $object->filter('other filter'); is ($object->filter(),'other filter','filter properly modified'); +# Test 'mp_filter' +$tested{'mp_filter'}++; is($object->mp_filter(), '{ 192.0.2.0/24, 2001:0DB8::/32 }','mp_filter properly parsed'); $object->mp_filter('other filter v6'); is ($object->mp_filter(), 'other filter v6','mp_filter properly added'); +# Test 'remarks' +$tested{'remarks'}++; is_deeply ($object->remarks(),[ 'No remarks' ],'remarks properly parsed'); $object->remarks('Added remarks'); is ($object->remarks()->[1],'Added remarks','remarks properly added'); +# Test 'tech_c' +$tested{'tech_c'}++; is_deeply ($object->tech_c(),[ 'TECH-CTCT' ],'tech_c properly parsed'); $object->tech_c('TECH2-CTCT'); is ($object->tech_c()->[1],'TECH2-CTCT','tech_c properly added'); +# Test 'admin_c' +$tested{'admin_c'}++; is_deeply ($object->admin_c(),[ 'ADM-CTCT' ],'admin_c properly parsed'); $object->admin_c('ADM2-CTCT'); is ($object->admin_c()->[1],'ADM2-CTCT','admin_c properly added'); +# Test 'notify' +$tested{'notify'}++; is_deeply ($object->notify(),[ 'watcher@somewhere.com' ],'notify properly parsed'); $object->notify('watcher@elsewhere.com'); is ($object->notify()->[1],'watcher@elsewhere.com','notify properly added'); +# Test 'mnt_by' +$tested{'mnt_by'}++; is_deeply ($object->mnt_by(),[ 'MAINT-EXAMPLECOM' ],'mnt_by properly parsed'); $object->mnt_by('MAINT2-EXAMPLECOM'); is ($object->mnt_by()->[1],'MAINT2-EXAMPLECOM','mnt_by properly added'); +# Test 'mnt_lower' +$tested{'mnt_lower'}++; is_deeply ($object->mnt_lower(),[ 'MAINT-EXAMPLECOM' ],'mnt_lower properly parsed'); $object->mnt_lower('MAINT2-EXAMPLECOM'); is ($object->mnt_lower()->[1],'MAINT2-EXAMPLECOM','mnt_lower properly added'); +# Test 'changed' +$tested{'changed'}++; is_deeply ($object->changed(),[ 'abc@somewhere.com 20120131' ],'changed properly parsed'); $object->changed('abc@somewhere.com 20120228'); is ($object->changed()->[1],'abc@somewhere.com 20120228','changed properly added'); +# Test 'source' +$tested{'source'}++; is ($object->source(),'RIPE','source properly parsed'); $object->source('APNIC'); is ($object->source(),'APNIC','source properly set'); +# Test 'org' +$tested{'org'}++; +# TODO + +# Do cause issue with lexicals +eval `cat t/common.pl`; +ok(!$!,"Can read t/common.pl ($!)"); +ok(!$@,"Can evaluate t/common.pl ($@)"); + __DATA__ filter-set: FLTR-EXAMPLE descr: Filter local community routes diff --git a/t/common.pl b/t/common.pl new file mode 100644 index 0000000..e6bcb47 --- /dev/null +++ b/t/common.pl @@ -0,0 +1,40 @@ +can_ok $class, + + # Constructor + qw( new ), + + # OO Support + qw( dump attributes attribute_is filtered_attributes displayed_attributes ); + +ok( !$object->can('bogusmethod'), "No AUTOLOAD interference with $class tests" ); + +for my $a ( $object->attributes('mandatory') ) { + ok( $object->attribute_is( $a, 'mandatory' ), "Attribute $a is mandatory" ); + ok( !$object->attribute_is( $a, 'optionnal' ), "Attribute $a is not optionnal"); +} + +for my $a ( $object->attributes('optionnal') ) { + ok( !$object->attribute_is( $a, 'mandatory' ), "Attribute $a is not mandatory" ); + ok( $object->attribute_is( $a, 'optionnal' ), "Attribute $a is optionnal"); +} + +for my $a ( $object->attributes('single') ) { + ok( $object->attribute_is( $a, 'single' ), "Attribute $a is single valued" ); + ok( !$object->attribute_is( $a, 'multiple', "Attribute $a is multi valued" ) ); +} + +for my $a ( $object->attributes('multiple') ) { + ok( !$object->attribute_is( $a, 'single' ), "Attribute $a is single valued" ); + ok( $object->attribute_is( $a, 'multiple', "Attribute $a is multi valued" ) ); +} + +# Check that all attributes have been tested + +for my $a ( $object->attributes('all') ) { + # Check that each attribute has been tested + ok ($tested{ $a }, "Attribute $a has been tested"); + + # Check that each attribute is set either to 'single' or 'multiple' + ok ($object->attribute_is($a, 'single') or $object->attribute_is($a, 'multiple'), "$a is either single or multiple"); + ok ($object->attribute_is($a, 'single') != $object->attribute_is($a, 'multiple'), "$a can't be both single".$object->attribute_is($a,'single')." and multi".$object->attribute_is($a,'multiple')); +}