File Coverage

blib/lib/Google/Search.pm

Criterion	Covered	Total	%
statement	103	211	48.8
branch	29	98	29.5
condition	13	39	33.3
subroutine	24	38	63.1
pod	8	15	53.3
total	177	401	44.1

package Google::Search;
{
  $Google::Search::VERSION = '0.028';
}
# ABSTRACT: Interface to the Google AJAX Search API and suggestion API (DEPRECATED)

use warnings;
use strict;


use Any::Moose;
use Google::Search::Carp;

use Google::Search::Response;
use Google::Search::Page;
use Google::Search::Result;
use Google::Search::Error;
use LWP::UserAgent;
require HTTP::Request::Common;
use JSON;

my $json = JSON->new;

BEGIN {
    use vars qw/ $Base %Service2URI /;
    $Base = 'http://ajax.googleapis.com/ajax/services/search';
    %Service2URI = (
        videos => "$Base/video",
        blog => "$Base/blogs",
        book => "$Base/books",
        image => "$Base/images",
        patents => "$Base/patent",
        map { $_ => "$Base/$_" } qw/ web local video blogs news books images patent /,
    );
}


sub _inflate_query (@) {
    my @query;
    for (@_) {
        if      ( ref eq 'HASH' )   { push @query, %$_ }
        elsif   ( ref eq 'ARRAY' )  { push @query, @$_ }
        elsif   ( ! ref )           { push @query, q => $_ }
        else                        { croak "Invalid query ($_)" }
    }
    return \@query;
}

{
    my $agent_;
    sub suggest {
        my $self = shift; # Could be class or object

        my $agent = blessed $self ? $self->agent : ( $agent_ ||= LWP::UserAgent->new );
        my ( $term, $query, $uri ) = ( undef, [], {} );

        for( @_ ) {
            next unless defined $_;
            if      ( ! ref )          { $term = $_ }
            elsif   ( ref eq 'ARRAY' ) { $query = $_ }
            elsif   ( ref eq 'HASH' )  { $uri = $_ }
            else                       { croak "Invalid parameter ($_)" }
        }

        croak "Missing term" unless defined $term;
        my @query = @$query;
        croak "Uneven query ($#query): ", @query if @query % 2;

        my %query = @query;
        unshift @query, q => $term unless exists $query{q};

        my @uri = ( map { $_ => $uri->{$_} } grep { exists $uri->{$_} }
            qw/ host port host_port scheme path userinfo authority agent / );
        unshift @uri, qw{ scheme http host clients1.google.com path complete/search };
        my %uri = @uri;
        my $user_agent = delete $uri{agent};

        $uri = URI->new;
        while ( my ($k, $v) = each %uri ) { $uri->$k( $v ) }
        $uri->query_form( @query );

        my @header;
        @header = ( 'User-Agent' => $user_agent ) if defined $user_agent;

        my $response = $agent->get( $uri, @header );
        croak "Failed response: ", $response->status_line unless $response->is_success;
        my $content = $response->decoded_content;
        croak "Malformed content: $content" unless $content =~ s/^.*?\(\[(.*)\]\)$/[$1]/g;
        my $data = $json->decode( $content );
        croak "Malformed content: $content" unless ref $data eq 'ARRAY' && $data->[1];
        return $data->[1];
    }
}

sub service2uri {
    my $class = shift;
    my $service = shift;
    croak "Missing service" unless $service;
    $service = lc $service;
    return unless my $uri = $Service2URI{$service};
    return $uri;
}

sub BUILDARGS {
    my $class = shift;

    my $given;
    if ( 1 == @_ && ref $_[0] eq 'HASH' ) {
        $given = $_[0];
    }
    elsif ( 3 == @_ && $_[0] eq 'service' && ! ref $_[2] && defined $_[2] ) {
        my $query = pop;
        $given = { @_, query => $query };
    }
    elsif ( 0 == @_ % 2 ) {
        $given = { @_ };
    }
    elsif ( @_ > 3 && $_[0] eq 'service' ) {
        my @given = splice @_, 0, 2;
        push @given, query => shift @_;
        $given = { @given, @_ };
    }
    else {
        croak "Odd number of arguments: @_";
    }

    my $query = delete $given->{q};
    $given->{query} = $query if defined $query && ! defined $given->{query};

    my $version = delete $given->{v};
    $given->{version} = $version if defined $version && ! defined $given->{version};

    my $referrer = delete $given->{referrer};
    $given->{referer} = $referrer if defined $referrer && ! defined $given->{referer};

    $query = $given->{query};
    my @query;

    while( my( $key, $value ) = each %$given ) {
        next if $key =~ m/^(?:agent|service|uri|query|version|hl|referer|
            key|start|rsz|rsz2number|current|error)$/x;
        carp "Including unknown parameter \"$key\" with query";
        push @query, $key => $value;
    }

    $given->{query} = _inflate_query \@query, $query if @query;
    return $given;
}

for my $service ( keys %Service2URI ) {
    no strict 'refs';
    my $umethod = ucfirst $service;
    my $lmethod = lc $service;
    *$umethod = *$lmethod = sub {
        my $class = shift;
        return $class->new( service => $service, @_ );
    };
}

has agent => qw/ is ro lazy_build 1 isa LWP::UserAgent /;
sub _build_agent {
    my $self = shift;
    my $agent = LWP::UserAgent->new;
    $agent->env_proxy;
    return $agent;
}

has service => qw/ is ro lazy_build 1 /;
sub _build_service { 'web' }

has uri => qw/ is ro lazy_build 1 isa URI /;
sub _build_uri {
    my $self = shift;
    my $service = $self->service;
    my $uri = $self->service2uri( $service );
    croak "Invalid service ($service)" unless $uri;
    return URI->new( $uri );
}

has query => qw/ is ro required 1 /;
sub q { return shift->query( @_ ) }

has version => qw/ is ro lazy_build 1 isa Str /;
sub _build_version { '1.0' }
sub v { return shift->version( @_ ) }

has hl => qw/ is rw predicate has_hl /;

has referer => qw/ is ro isa Str /;
sub referrer { return shift->referer( @_ ) }

has key => qw/ is ro isa Str /;

has start => qw/ is ro lazy_build 1 isa Int /;
sub _build_start { 0 }

has rsz => qw/ is ro lazy_build 1 isa Str /;
sub _build_rsz { 'large' }
has rsz2number => qw/ is ro lazy_build 1 isa Int /;
sub _build_rsz2number {
    my $self = shift;
    my $rsz = $self->rsz;
    return 4 if $rsz eq "small";
    return 8 if $rsz eq "large";
    croak "Don't understand rsz ($rsz)";
}

has _page => qw/ is ro required 1 /, default => sub { [] };
has _result => qw/ is ro required 1 /, default => sub { [] };
has current => qw/ is ro lazy_build 1 /;
sub _build_current {
    return shift->first;
}
has error => qw/ is rw /;

sub request {
    my $self = shift;
    my $http_request = $self->build( @_ );
    return unless my $http_response = $self->agent->request( $http_request );
    return Google::Search::Response->new( http_response => $http_response );
}

sub build {
    my $self = shift;

    my ( @query_form, @header_supplement );

    {
        my $referer = $self->referer;
        my $key = $self->key;

        push @header_supplement, Referer => $referer if $referer;
        push @query_form, key => $key if $key;
    }

    my $query = $self->query;
    # TODO Check for query instead of q?
    push @query_form, @{ _inflate_query $query };
    push @query_form, hl => $self->hl if $self->has_hl;

    my $uri = $self->uri->clone;
    $uri->query_form({ v => $self->version, rsz => $self->rsz, @query_form, @_ });

    if ( $ENV{GS_TRACE} ) {
        warn $uri->as_string, "\n";
    }

    my $request = HTTP::Request::Common::GET( $uri => @header_supplement );

    if ( $ENV{GS_TRACE} && $request ) {
        warn $request->as_string, "\n";
    }

    return $request;
}

sub page {
    my $self = shift;
    my $number = shift;

    $self->error( undef );

    my $page = $self->_page->[$number] ||=
            Google::Search::Page->new( search => $self, number => $number );

    $self->error( $page->error ) if $page->error;

    return $page;
}


sub first {
    my $self = shift;
    return $self->result( $self->start );
}


sub next {
    my $self = shift;
    return $self->current unless $self->{current};
    return $self->{current} = $self->current->next;
}


sub result {
    my $self = shift;
    my $number = shift;

    $self->error( undef );

    return $self->_result->[$number] if $self->_result->[$number];
    my $result = do {
        my $result_number = $number % $self->rsz2number;
        my $page_number = int( $number / $self->rsz2number );
        my $page = $self->page( $page_number );
        my $content = $page->result( $result_number );
        if ( $content ) {
            Google::Search::Result->parse( $content,
                page => $page, search => $self, number => $number);
        }
        else {
            undef;
        }
    };
    return undef unless $result;
    return $self->_result->[$number] = $result;
}


sub all {
    my $self = shift;

    my $result = $self->first;
    1 while $result && ( $result = $result->next ); # Fetch everything
    if ($self->error) {
        die $self->error->reason unless $self->error->message eq "out of range start";
    }

    my @results = @{ $self->_result };
    return wantarray ? @results : \@results;
}


sub match {
    my $self = shift;
    my $matcher = shift;

    my @matched;
    my $result = $self->first;
    while ($result) {
        push @matched, $result if $matcher->($result);
        $result = $result->next;
    }
    if ($self->error) {
        die $self->error->reason unless $self->error->message eq "out of range start";
    }
    return @matched;
}


sub first_match {
    my $self = shift;
    my $matcher = shift;

    my $result = $self->first;
    while ($result) {
        return $result if $matcher->($result);
        $result = $result->next;
    }
    if ($self->error) {
        die $self->error->reason unless $self->error->message eq "out of range start";
    }
    return undef;
}

$_->meta->make_immutable for qw/
    Google::Search
    Google::Search::Response
    Google::Search::Page
    Google::Search::Result
    Google::Search::Error
/;


1;

__END__