asused 3.72-12 / usr / share / perl5 / ArinWhois.pm

# Copyright (c) 2000,2001					RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

#------------------------------------------------------------------------------
# Module Header
# Filename          : ArinWhois.pm
# Purpose           : Make whois queries to ARIN-style servers
# Author            : Timur Bakeyev <timur@ripe.net>
# Date              : 08082000
# Description       : General purpose, simple client to make whois queries
# Language Version  : Perl5
# OSs Tested        : BSD/OS 3.1
# Command Line      : None
# Input Files       : None
# Output Files      : None
# External Programs : None
# Problems          : None known
# To Do             : Make more consistent(?)
# Comments          :
# $Id: ArinWhois.pm,v 1.5 2001/04/22 21:34:20 timur Exp $
#------------------------------------------------------------------------------
package ArinWhois;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

require Exporter;

@ISA = qw(Exporter Whois); 

use Whois qw(:ERROR_CODES);
use Whois qw(%ERROR);

$VERSION = '1.05';

# This strings are perl regexp
my %WHOIS_ERROR = (
    $WHOIS_TIMEOUT	=> '%\s+Timeout',
    $WHOIS_NO_ENTRY	=> 'No\s+match\s+for',
    $WHOIS_UNKNOWN_QUERY=> '%\s+Request\s+for\+unknown',
    $CONNECTION_CLOSED	=> '(Timeout|Connection)\s+closed\s+by\s+foreign',
);

# Regexp for disclamer, returned by ARIN server
my $disclamer = '^\s+The\sARIN\sRegistration\sServices\sHost.*\Z';

# Default values for the class
my %default = (
    'Host'		=> 'whois.arin.net',
);

####################################################################
#  DESCRIPTION: Create new object
#        INPUT: Hash of parameters, can be:
#		Host, Port, Timeout, Retry.
#       OUTPUT: Object reference
# SIDE EFFECTS: None
#       SYNTAX:	None
####################################################################
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %param = (@_);

    # Set the host to default if nothing was passed
    unless($param{'Host'} && $param{'Host'} =~ /^\S+$/) {
        $param{'Host'} = $default{'Host'};
    }
    # Call the parent constructor
    my $self = $class->SUPER::new(%param);
    # Fail, if parent constructor failed
    return unless($self);

    bless $self, $class;
    
    return $self;
}

####################################################################
#  DESCRIPTION: Split raw query results into array of objects
#        INPUT: Scalar with the query result or uses internal one
#       OUTPUT: Error code on error, 0 on success.
# SIDE EFFECTS: None
#       SYNTAX:	None
####################################################################
sub SplitResult {
    my $self = shift;
    # We can obtain result from a parameter
    my $result = shift || $self->GetResult();
    
    return $self->error($NO_RESULT, $ERROR{$NO_RESULT})
	unless($result);

    foreach my $error (keys(%WHOIS_ERROR)) {
	# Respond contains one of the errors codes
	# from Whois server
	return $self->error($error, $ERROR{$error})
	    if($result =~ m/$WHOIS_ERROR{$error}/m);
    }
    
    # Get rid of all comment lines
    $result =~ s/^%.*$//mg;
    # Remove spaces from the begining
    # and end of the result
    $result =~ s/^\s*//s;
    $result =~ s/\s*$//s;
    
    $result =~ s/$disclamer//ms;
    
    # No results or failure
    return $self->error($NO_RESULT, $ERROR{$NO_RESULT})
	unless($result);

    # Split result into objects
    my @objects = split(/\n\n\n/, $result);
    # Return result
    $self->{'objects'} = \@objects;
    
    return 0;
}

####################################################################
#  DESCRIPTION: Return array of objects
#        INPUT: None
#       OUTPUT: Array or reference to array of objects
# SIDE EFFECTS: None
#       SYNTAX:	None
####################################################################
sub GetObjects {
    my $self = shift;
    
    return wantarray() ? @{ $self->{'objects'} } : $self->{'objects'};
}

####################################################################
#  DESCRIPTION: Query whois server and return array of objects
#        INPUT: Query, that should be send to the server
#       OUTPUT: Array of objects, or empty on error
# SIDE EFFECTS: None
#       SYNTAX:	None
####################################################################
sub QueryObjects {
    my $self = shift;
    my @query = @_;

    if(!$self->Query(@query) && !$self->SplitResult()) {
	return $self->GetObjects();
    }
    return;
}

1;
__END__
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

ArinWhois - Perl extension to retrieve information from ARIN Whois database.

=head1 SYNOPSIS

  use ArinWhois;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for ArinWhois was created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

=head1 AUTHOR

Timur Bakeyev <timur@ripe.net>

=head1 SEE ALSO

perl(1), Whois.pm(3).

=cut