The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package WWW::DomainTools;
use strict;
use warnings;
use Carp;
use LWP::UserAgent;
use XML::Simple ();
use URI::Escape;
use WWW::DomainTools::SearchEngine;
use WWW::DomainTools::NameSpinner;

BEGIN {
    use Exporter ();
    use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION     = "0.11";
    @ISA         = qw (Exporter);
    @EXPORT      = qw ();
    @EXPORT_OK   = qw (search_engine name_spinner);
    %EXPORT_TAGS = ();
}

use constant DEFAULT_URL    => "http://engine.whoisapi.com/api.xml";
use constant DEFAULT_FORMAT => "hash";

our @VALID_TLDS = qw/ com net org info biz us /;

=head1 NAME

WWW::DomainTools - DomainTools.com XML API interface 

=head1 SYNOPSIS

 use WWW::DomainTools qw(search_engine name_spinner);

 my $repsonse = search_engine(
 	q => 'example.com',
	ext => 'COM|NET|ORG|INFO'
        key => '12345',
        partner => 'yourname',
        customer_ip => '1.2.3.4'
 );

 # OO
 my $obj = WWW::DomainTools::SearchEngine->new(
        key => '12345',
        partner => 'yourname',
        customer_ip => '1.2.3.4'
 );
 my $response = $obj->request(
 	q => 'example.com',
	ext => 'COM|NET|ORG|INFO'
 );


 # Custom LWP user agent
 my $ua = LWP::UserAgent->new;
 $ua->env_proxy(true);

 my $obj = WWW::DomainTools::SearchEngine->new(
        key => '12345',
        partner => 'yourname',
        customer_ip => '1.2.3.4',
        lwp_ua => $ua
 );
 my $response = $obj->request(
 	q => 'example.com',
	ext => 'COM|NET|ORG|INFO'
 );

 

=head1 DESCRIPTION

This module allows you to use the name spinner and whois search available
on domaintools.com.

These methods are available as both class and object methods.  Nothing is 
exported by default.

=head1 EXPORTS

None by default.

Allowed:

 - search_engine
 - name_spinner

=head1 METHODS

=cut

sub new {
    my ( $class, %parameters ) = @_;

    croak "new() can't be invoked on an object"
        if ref($class);

    my $self = bless( {}, $class );

    $self->{_ua}         = $parameters{lwp_ua} || LWP::UserAgent->new;
    $self->{_xml}        = XML::Simple->new;
    $self->{_format}     = $parameters{format} || DEFAULT_FORMAT;
    $self->{_ua_timeout} = $parameters{timeout} || 10;
    $self->{_url}        = $parameters{url} || DEFAULT_URL;

    %{ $self->{default_params} } = ();

    # sub clases should implement this. Usually to set default_params fields
    $self->_init();

    ## the universally recognized parameters can be passed in without using the
    # 'params' hash as a convenience
    foreach my $field (qw{ appname version partner key customer_ip }) {
        if ( defined $parameters{$field} ) {
            ${ $self->{default_params} }{$field} = $parameters{$field};
        }
    }

    return $self;

}

=over 4

=item search_engine ( url parameters hash )

The keys and values expected are documented on the Domain Tools website. In 
addition the "search engine" specific parameters, you need to pass the
required parameters as documented in the L<WWW::DomainTools::SearchEngine> new()
method.

If the request is successful, the return value is either a hash reference or 
a string depending on the value of the 'format' parameter to the constructor.

See the documentation for the new() method for more detailed information
about 'format' and other standard parameters.

If the HTTP request fails, this method will die.

=back

=cut

sub search_engine {
	my $api = WWW::DomainTools::SearchEngine->new(@_);
	return $api->request();
}

=over 4

=item name_spinner ( url parameters hash )

The keys and values expected are documented on the Domain Tools website. In 
addition the "name spinner" specific parameters, you need to pass the
required parameters as documented in the L<WWW::DomainTools::NameSpinner> new()
method.

If the request is successful, the return value is either a hash reference or 
a string depending on the value of the 'format' parameter to the constructor.

See the documentation for the new() method for more detailed information
about 'format' and other standard parameters.

If the HTTP request fails, this method will die.

=back

=cut

sub name_spinner {
	my $api = WWW::DomainTools::NameSpinner->new(@_);
	return $api->request();
}

sub request {
    my ( $self, %params ) = @_;

    if ( $self->{_ua_timeout} > 0 ) {
        $self->{_ua}->timeout( $self->{_ua_timeout} );
    }

    my %parameters = ( %{ $self->{default_params} }, %params );

    my $req = HTTP::Request->new(
        GET => sprintf( "%s?%s",
            $self->{_url}, $self->_generate_query_string( \%parameters ) )
    );
    my $res = $self->{_ua}->request($req);
    if ( $res->is_success ) {
        if ( $self->{_format} eq 'hash' ) {
            return $self->_xml_string_to_hash( \$res->content );
        }
        elsif ( $self->{_format} eq 'xml' ) {
            return $res->content;
        }
    }
    else {
        die $res->status_line;
    }

    return;

}

sub _generate_query_string {
    my ( $self, $parameters ) = @_;

    return join "&",
        map { sprintf( "%s=%s", $_, uri_escape( $parameters->{$_} ) ) }
        keys %$parameters;

}

sub _init {
    my ($self) = @_;

    #this should be implemented in the subclasses

    return;
}

sub _xml_string_to_hash {
    my ( $self, $xml_string_ref ) = @_;

    return $self->{_xml}->XMLin($$xml_string_ref);
}

sub _tld_list_to_ext_param {
    my ( $self, @tlds ) = @_;

    return join( '|', ( map { uc($_) } @tlds ) );
}

sub _res_status_lookup {
    my ( $self, $status_line, $extensions ) = @_;

    my @status_items = split //, $status_line;
    my @extensions = map { lc($_) } split /\|/, $extensions;

    my %mapping;
    @mapping{@extensions} = @status_items;

    return \%mapping;
}

1;
__END__

=head1 SEE ALSO

L<WWW::DomainTools::SearchEngine>
L<WWW::DomainTools::NameSpinner>

=head1 BUGS

Please report bugs using the CPAN Request Tracker at L<http://rt.cpan.org/>

=head1 AUTHOR

David Bartle <captindave@gmail.com>

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

I am not affiliated with Domain Tools or Name Intelligence.  The use of
their API's are governed by their own terms of service:

http://www.domaintools.com/members/tos.html

The full text of the license can be found in the
LICENSE file included with this module.

=cut