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

# Copyright (c) 2000						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          : RipeWhois.pm
# Purpose           : Make whois queries to RIPE-like 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: RipeWhois.pm,v 1.4 2001/04/18 17:01:20 timur Exp $
#------------------------------------------------------------------------------
package RipeWhois;

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.03';

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

# Default parameters for the class
my %default = (
    'Host'		=> 'whois.ripe.net',
    'FormatMode'	=> 0,
    'KeepAlive'		=> 0
);

####################################################################
#  DESCRIPTION: Create new object
#        INPUT: Hash of parameters, can be:
#		host, port, timeout, retry, KeepAlive.
#       OUTPUT: Object
# SIDE EFFECTS: None
#       SYNTAX:	None
####################################################################
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %param = (@_);
    my $param = '';
    my %extend = ();


    # Keepalive connection
    $param = delete $param{'KeepAlive'};
    $extend{'KeepAlive'} = ($param && $param =~ /^\d+$/) ? $param : $default{'KeepAlive'};
    # Extract the value of the mode
    my $mode = delete $param{'FormatMode'};
    if($mode && $mode =~ /^\d+$/) {
	# We need this module only if we use legacy conversion
	require RipeWhois::FormatMode;
	# Strip continuation and comments
	if($mode == 1) {
	    $extend{'FormatMode'} = 1;
	}
	# Sort the fields as well
	elsif($mode == 2) {
	    $extend{'FormatMode'} = 2;
	}
    }
    else {
	$extend{'FormatMode'} = $default{'FormatMode'};
    }

    # 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;
    
    # Fill additional parameters
    $self->{'KeepAlive'} = $extend{'KeepAlive'};
    $self->debug("KeepAlive: ", $self->{'KeepAlive'});

    $self->{'FormatMode'} = $extend{'FormatMode'};
    $self->debug("FormatMode: ", $self->{'FormatMode'});
    
    return $self;
}

####################################################################
#  DESCRIPTION: Query whois server
#        INPUT: Query, that should be send to the server
#       OUTPUT: Error code on error, 0 on success.
# SIDE EFFECTS: None
#       SYNTAX:	None
####################################################################
sub Query {
    my $self = shift;
    # Filter out empty paramters
    my @query = grep { /\S+/ } @_;

    # Fix for new whois query defaults (2 May 2005) ZS.
    unshift(@query, '-B', '-G');
    
    # Add keep-alive flag if necessary
    if($self->{'KeepAlive'}) {
	# Only for non-empty list
	unshift(@query, '-k') if(@query);
    }
    # Make the query
    my $error = $self->SUPER::Query(@query);
    # If query failed return the error code
    return $error if($error);
    # On success
    return 0;
}

####################################################################
#  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);

    # Did we get any errors from the server
    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;
    
    # No results or failure
    return $self->error($NO_RESULT, $ERROR{$NO_RESULT})
	unless($result);

    # Split result into objects
    my @objects = split(/\n\n/, $result);
    
    # If we need to do conversion to the legacy format
    if($self->{'FormatMode'}) {
	# Do inline modification of the objects, if required
	foreach my $object (@objects) {
	    # Stripping
	    if($self->{'FormatMode'} == 1) {
		$object = RipeWhois::FormatMode::Filter($object);
	    }
	    # ...or stripping and sorting
	    elsif($self->{'FormatMode'} == 2) {
		$object = RipeWhois::FormatMode::Filter($object, 'yes');
	    }
	}
    }
    # Save results
    $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;
}

####################################################################
#  DESCRIPTION: Close connection with the whois server
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
#       SYNTAX:	None
####################################################################
sub Close {
    my $self = shift;
    # Don't close keep-alive session    
    unless($self->{'KeepAlive'}) {
	# Call the parent method
	$self->SUPER::Close();
    }
}

####################################################################
#  DESCRIPTION: Destructor for the object.
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: None
#       SYNTAX:	None
####################################################################
sub DESTROY {
    my $self = shift;
    
    if(defined($self->{'Sock'}) && $self->{'Sock'}->opened()) {
	# Send notification to the server to close it's side of the 
	# connection if we were in keep-alive mode
	if($self->{'KeepAlive'}) {
	    #
	    $self->debug("Terminate keep alive connection");
	    # We don't care about possible connection 
	    # errors at this stage
	    $self->{'Sock'}->print("-k\x0d\x0a");
	}
    }

    $self->SUPER::Close();
    $self->debug(ref($self), " object was destroyed");
}

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

=head1 NAME

RipeWhois - Perl extension to retrieve information from RIPE Whois database.

=head1 SYNOPSIS

  use RipeWhois;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for RipeWhois 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).

=cut