#!/usr/bin/perl -w

use strict;
use warnings;
use Net::Whois::Raw;
use Getopt::Long;
use Encode;

my $help;
my $do_strip;
my $do_strip_more;
my $do_checkfail;
my $do_checkfail_more;
my $debug = 0;
my $timeout = 10;
my $enable_caching;
my @source_addresses;
my $return_first;
my $return_last;
my $return_all;

Getopt::Long::Configure( 'bundling', 'no_ignore_case' );

GetOptions(
    'help|h'           => \$help,
    'strip|s'          => \$do_strip,
    'checkfail|c'      => \$do_checkfail,
    'debug|d+'         => \$debug,
    'timeout|T=i'      => \$timeout,
    'enable_caching|t' => \$enable_caching,
    'src_addr|a=s@'    => \@source_addresses,
    'return_first|F'   => \$return_first,
    'return_last|L'    => \$return_last,
    'return_all|A'     => \$return_all,
) or die;

if ($help || !@ARGV) {
    print <<EOM;
Usage:	$0 [ -s ] [ -c ] [ -d ] [ -T <timeout> ] [ -a <src_ip> ] [ -t ] [ -F | -L | -A ] <domain> [ <server> ]

Switches:
-s	attempt to strip the copyright message or disclaimer.
-c	attempts to return an empty answer for failed searches.
-T	set timeout for connection attempts
-t	enables caching.
-a	specify an ip address that should be used as source address
-d	enables debugging messages.
-F	returns results of the first query of recursive whois requests
-L	returns results of the last query of recursive whois requests (the default)
-A	returns results of the all queries of recursive whois requests
EOM
    exit; 
}

$Net::Whois::Raw::DEBUG      = $debug;
$Net::Whois::Raw::OMIT_MSG   = $do_strip     ? 1 : 0;
$Net::Whois::Raw::CHECK_FAIL = $do_checkfail ? 1 : 0;
$Net::Whois::Raw::TIMEOUT    = $timeout;
@Net::Whois::Raw::SRC_IPS    = @source_addresses if @source_addresses;

if ($enable_caching) {
    $Net::Whois::Raw::CACHE_DIR = $ENV{TEMP} || ($^O =~ /Win/ ? "C:\\temp" : '/tmp' );
}
else {
    $Net::Whois::Raw::CACHE_DIR = undef;
}

my $dom = $ARGV[0];
my $server = $ARGV[1];

eval {
    my ($result, $server);
    my $which_whois = 
        $return_first ? 'QRY_FIRST' :
        $return_all   ? 'QRY_ALL'   : 'QRY_LAST';
                        
    ($result, $server) = 
        Net::Whois::Raw::get_whois( $dom, $server, $which_whois );

    if ($result and ref $result eq 'ARRAY') {
        make_output($_->{text}, $_->{srv}) for @{$result};
    }
    elsif ($result) {
        make_output($result, $server);
    }
    else {
        print STDERR "Failed.\n";
    }
};

if ($@) {
    my $err = $@;

    $err =~ s/\s+at \S+ line \d+\.$//;
    print "\nWhois information could not be fetched:\n$err\n";
    exit -1;
}	

# Prepare and print output
sub make_output {
    my ($result, $server) = @_;

    (my $cp = $ENV{LANG}) =~ s/^[a-z]{2}_[A-Z]{2}\.//;
    $cp = lc $cp;

    if ( $cp =~ /utf\-?8/ ) {
        $result = encode_utf8( $result );
    }
    else {
        $result = encode( $cp, $result );
    }
    
    print "[$server]\n";
    print $result, "\n";
}

__END__

=head1 NAME

pwhois   - Perl written whois client

=head1 SYNOPSIS

	pwhois perl.com
	pwhois gnu.org
	pwhois -s police.co.il
	pwhois -c there.is.no.tld.called.foobar
	pwhois yahoo.com whois.networksolutions.com
	pwhois -T 10 funet.fi

etc etc.....

=head1 DESCRIPTION

Just invoke with a domain name, optionally with a whois server name.
Switches:
    B<-s> attempt to strip the copyright message or disclaimer.
    B<-c> attempts to return an empty answer for failed searches.
    B<-e> forces die if connection rate to server have been exceeded.
    B<-T> set timeout for connection attempts
    B<-t> enables caching.
    B<-a> specify an ip address that should be used as source address
    B<-d> enables debugging messages.
    B<-F> returns results of the first query of recursive whois requests
    B<-L> returns results of the last query of recursive whois requests (the default)
    B<-A> returns results of the all queries of recursive whois requests
 
=head1 AUTHORS

Ariel Brosh B<schop@cpan.org>

Current Maintainer: Walery Studennikov B<despair@cpan.org>

=head1 SEE ALSO

L<Net::Whois::Raw>.
