view release on metacpan or  search on metacpan

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

	$query = $self->adapt_query($query);
	my $iterator = $self->__query($query);

	my @objects = Net::Whois::Object->new($iterator);

	($response) = grep { ref($_) =~ /response/i } @objects;

	if ($response) {
		$self->_process_response($response);

	}

	if ($type) {
		@objects = grep { ref($_) =~ /$type/i } @objects;
	}

	if ($attribute) {
		return grep {defined} map {
			my $r;
			eval { $r = $_->$attribute };
			$@ ? undef : ref($r) eq 'ARRAY' ? @$r : $r
		} @objects;
	}
	else {
		return grep {defined} @objects;
	}
}

# Allows me to pass in queries without having all the automatic options added
# up to it.
sub __query
{
	my ($self, $query) = @_;

	$self->connect;

	# die "Not connected" unless $self->is_connected;

	if ($self->ios->can_write(SOON + $self->timeout)) {
		$self->socket->print($query, EOL);

		return Iterator->new(
			sub {
				local $/ = END_OF_OBJECT_MARK;
				if ($self->ios->can_read(SOON + $self->timeout)) {
					my $block = $self->socket->getline;
					return $block if defined $block;
				}
				Iterator::is_done;
			}
		);
	}
}

=head2 B<object_types()>

Return a list of known object types from the RIPE Database.

RIPE currently returns 21 types (Limerik have been removed):
as-block as-set aut-num domain filter-set inet6num inetnum inet-rtr irt
key-cert mntner organisation peering-set person poem poetic-form role route
route6 route-set rtr-set

Due to some strange mis-behaviour in the protocol (or documentation?) the RIPE
Database server won't allow a keep-alive token with this query, meaning the
connection will be terminated after this query.

=cut

sub object_types
{
	my $self     = shift;
	my $iterator = $self->__query(QUERY_LIST_OBJECTS);
	while (!$iterator->is_exhausted) {
		my $value = $iterator->value;
		return split /\s+/, $value if $value !~ /^%\s/;
	}
	return;
}

=head2 B<_process_response( $response )>

Process a response (error code, error message...)

=cut

sub _process_response
{
	my $self     = shift;
	my $response = shift;
	my $code;
	my $msg;

	eval { $response->comment };
	die "Dump : " . Dumper $response if $@;

	if ($response->response =~ /ERROR.*:.*?(\d+)/) {
		$code = $1;
		$msg = join '', $response->comment();
	}
}

=head1 AUTHOR

Arnaud "Arhuman" Assad, C<< <arhuman at gmail.com> >>

=head1 CAVEATS

=over 4

=item B<Update>

Update of objects from database other than RIPE is not currently implemented...

=item B<Sources>

Currently the only sources implemented are RIPE, AFRINIC, and APNIC.

=item B<Maturity>