view release on metacpan or  search on metacpan

lib/Net/Whois/Object.pm  view on Meta::CPAN

        # is not correct. So only use it for objects where the primary
        # key can be generated by the RIPE DB, and where it never contains
        # spaces. According to
        # http://www.ripe.net/ripe/mail/archives/db-help/2013-January/000411.html
        # this is the case for person, organization, role and key-cert
        my %obj_types_with_autogen_key = ( KeyCert      => 1,
                                           Organisation => 1,
                                           Person       => 1,
                                           Role         => 1,
        );
        if ( $self->class && $obj_types_with_autogen_key{ $self->class } ) {
            $self->_single_attribute_setget( $key, $value );
            return $value;
        } else {
            return $self->$key();
        }
    } else {
        croak "Error while creating object through syncupdates API: $res";
    }
}

=head2 B<query( $query, [\%options] )>

This method is deprecated since release 2.005 of Net::Whois::RIPE

Please use Net::Whois::Generic->query() instead.

=cut

sub query {

    croak "This method is deprecated since release 2.005 of Net::Whois::RIPE\nPlease use Net::Whois::Generic->query() instead\n";

}

=begin UNDOCUMENTED

=head2 B<_object_factory( $type => $value, $attributes_hashref )>

Private method. Shouldn't be used from other modules.

Simple factory, creating Net::Whois::Objet::XXXX from
the type passed as parameter.

=cut

sub _object_factory {
    my $type   = shift;
    my $value  = shift;
    my $object = shift;
    my $rir;

    my $object_returned;

    my %class = ( as_block     => 'AsBlock',
                  as_set       => 'AsSet',
                  aut_num      => 'AutNum',
                  comment      => 'Information',
                  domain       => 'Domain',
                  filter_set   => 'FilterSet',
                  inet6num     => 'Inet6Num',
                  inetnum      => 'InetNum',
                  inet_rtr     => 'InetRtr',
                  irt          => 'Irt',
                  key_cert     => 'KeyCert',
                  limerick     => 'Limerick',
                  mntner       => 'Mntner',
                  organisation => 'Organisation',
                  peering_set  => 'PeeringSet',
                  person       => 'Person',
                  poem         => 'Poem',
                  poetic_form  => 'PoeticForm',
                  response     => 'Response',
                  role         => 'Role',
                  route6       => 'Route6',
                  route        => 'Route',
                  route_set    => 'RouteSet',
                  rtr_set      => 'RtrSet',
    );

    die "Unrecognized Object (first attribute: $type = $value)\n" . Dumper($object) unless defined $type and $class{$type};

    my $class = "Net::Whois::Object::" . $class{$type};

    for my $a ( @{ $object->{attributes} } ) {
        if ( $a->[0] =~ /source/ ) {
            $rir = $a->[1];
            $rir =~ s/^(\S+)\s*#.*/$1/;
            $rir = uc $rir;
            $rir = undef if $rir =~ /^(RIPE|TEST)$/;    # For historical/compatibility reason RIPE objects aren't derived
        }
    }

    $class .= "::$rir" if $rir;

    eval "require $class" or die "Can't require $class ($!)";

    # my $object = $class->new( $type => $value );
    $object_returned = $class->new( class => $class{$type} );

    # First attribute is always single valued, except for comments
    if ( $type eq 'comment' ) {
        $object_returned->_multiple_attribute_setget( $type => $value );
    } else {
        $object_returned->_single_attribute_setget( $type => $value );
    }

    if ( $object->{attributes} ) {
        for my $a ( @{ $object->{attributes} } ) {
            my $method = $a->[0];
	    if( my $ref = eval { $object_returned->can( $method ) } ) {
		$object_returned->$ref( $a->[1] );
	    } else {
		carp "Unknown method '$method' for object $class (Did the Database schema changed ?)"
	    }
        }
    }

    # return $class->new( $type => $value );
    return $object_returned;