##########################################################
# Google.pm
# by Jim Smyser
# Copyright (C) 1996-1999 by Jim Smyser & USC/ISI
# $Id$
##########################################################


package WWW::Search::Google;


=head1 NAME

WWW::Search::Google - class for searching Google 


=head1 SYNOPSIS

use WWW::Search;
my $Search = new WWW::Search('Google'); # cAsE matters
my $Query = WWW::Search::escape_query("Where is Jimbo");
$Search->native_query($Query);
while (my $Result = $Search->next_result()) {
print $Result->url, "\n";
}

=head1 DESCRIPTION

This class is a Google specialization of WWW::Search.
It handles making and interpreting Google searches.
F<http://www.google.com>.

Googles returns 100 Hits per page. Custom Linux Only search capable.

This class exports no public interface; all interaction should
be done through L<WWW::Search> objects.

=head1 LINUX SEARCH

For LINUX lovers like me, you can put Googles in a LINUX only search
mode by changing search URL from:

 'search_url' => 'http://www.google.com/search',

to:

 'search_url' => 'http://www.google.com/linux',

=head1 SEE ALSO

To make new back-ends, see L<WWW::Search>.

=head1 HOW DOES IT WORK?

C<native_setup_search> is called (from C<WWW::Search::setup_search>)
before we do anything.  It initializes our private variables (which
all begin with underscore) and sets up a URL to the first results
page in C<{_next_url}>.

C<native_retrieve_some> is called (from C<WWW::Search::retrieve_some>)
whenever more hits are needed.  It calls C<WWW::Search::http_request>
to fetch the page specified by C<{_next_url}>.
It then parses this page, appending any search hits it finds to 
C<{cache}>.  If it finds a ``next'' button in the text,
it sets C<{_next_url}> to point to the page for the next
set of results, otherwise it sets it to undef to indicate we''re done.


=head1 TESTING

This module adheres to the C<WWW::Search> test suite mechanism. 

=head1 BUGS

2.07 now parses for most of what Google produces, but not all.
Because Google does not produce universial formatting for all
results it produces, there are undoublty a few line formats yet 
uncovered by the author. Different search terms creates various
differing format out puts for each line of results. Example,
searching for "visual basic" will create whacky url links,
whereas searching for "Visual C++" does not. It is a parsing
nitemare really! If you think you uncovered a BUG just remember
the above comments!  

With the above said, this back-end will produce proper formated
results for 96+% of what it is asked to produce. Your milage
will vary.

=head1 AUTHOR

This backend is maintained and supported by Jim Smyser.
<jsmyser@bigfoot.com>

=head1 BUGS

2.09 seems now to parse all hits with the new format change so there really shouldn't be
any like there were with 2.08. 

=head1 VERSION HISTORY

2.10
removed warning on absence of description; new test case

2.09
Google NOW returning url and title on one line.

2.07
Added a new parsing routine for yet another found result line.
Added a substitute for whacky url links some queries can produce.
Added Kingpin's new hash_to_cgi_string() 10/12/99

2.06
Fixed missing links / regexp crap.

2.05
Matching overhaul to get the code parsing right due to multiple 
tags being used by google on the hit lines. 9/25/99

2.02
Last Minute description changes  7/13/99

2.01
New test mechanism  7/13/99

1.00
First release  7/11/99

=head1 LEGALESE

THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.

=cut
#'

#####################################################################
require Exporter;
@EXPORT = qw();
@EXPORT_OK = qw();
@ISA = qw(WWW::Search Exporter);
$VERSION = '2.10';

$MAINTAINER = 'Jim Smyser <jsmyser@bigfoot.com>';
$TEST_CASES = <<"ENDTESTCASES";
# Google looks for partial words it can find results for so it will end up finding "Bogus" pages.
&test('Google', '$MAINTAINER', 'zero', '4036e7757s5', \$TEST_EXACTLY);
&test('Google', '$MAINTAINER', 'one_page', '+LS'.'AM +rep'.'lication', \$TEST_RANGE, 2,99);
&test('Google', '$MAINTAINER', 'multi', 'dir'.'ty ha'.'rr'.'y bimbo', \$TEST_GREATER_THAN, 101);
ENDTESTCASES

use Carp ();
use WWW::Search(generic_option);
require WWW::SearchResult;

sub native_setup_search {
   my($self, $native_query, $native_options_ref) = @_;
   $self->{_debug} = $native_options_ref->{'search_debug'};
   $self->{_debug} = 2 if ($native_options_ref->{'search_parse_debug'});
   $self->{_debug} = 0 if (!defined($self->{_debug}));
   $self->{agent_e_mail} = 'jsmyser@bigfoot.com';
   $self->user_agent('user');
   $self->{_next_to_retrieve} = 1;
   $self->{'_num_hits'} = 0;
   if (!defined($self->{_options})) {
     $self->{'search_base_url'} = 'http://www.google.com';
     $self->{_options} = {
         'search_url' => 'http://www.google.com/search',
         'num' => '100',
         'q' => $native_query,
         };
         }
   my $options_ref = $self->{_options};
   if (defined($native_options_ref)) 
     {
     # Copy in new options.
     foreach (keys %$native_options_ref) 
     {
     $options_ref->{$_} = $native_options_ref->{$_};
     } # foreach
     } # if
   # Process the options.
   my($options) = '';
   foreach (sort keys %$options_ref) 
     {
     # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n";
     next if (generic_option($_));
     $options .= $_ . '=' . $options_ref->{$_} . '&';
     }
   chop $options;
   # Finally figure out the url.
   $self->{_next_url} = $self->{_options}{'search_url'} .'?'. $self->hash_to_cgi_string($self->{_options});
   } # native_setup_search
 
# private
sub native_retrieve_some
   {
   my ($self) = @_;
   print STDERR "**Google::native_retrieve_some()**\n" if $self->{_debug};
   # Fast exit if already done:
   return undef if (!defined($self->{_next_url}));
   
   # If this is not the first page of results, sleep so as to not
   # overload the server:
   $self->user_agent_delay if 1 < $self->{'_next_to_retrieve'};
   
   # Get some if were not already scoring somewhere else:
   print STDERR "*Sending request (",$self->{_next_url},")\n" if $self->{_debug};
   my($response) = $self->http_request('GET', $self->{_next_url});
   $self->{response} = $response;
   if (!$response->is_success) 
     {
     return undef;
     }
   $self->{'_next_url'} = undef;
   print STDERR "**Response\n" if $self->{_debug};

   # parse the output
   my ($HEADER, $START, $HITS, $NEXT) = qw(HE HI ST NX);
   my $hits_found = 0;
   my $state = $HEADER;
   my $hit = ();
   foreach ($self->split_lines($response->content()))
      {
      next if m@^$@; # short circuit for blank lines
      print STDERR " $state ===$_=== " if 2 <= $self->{'_debug'};
  if (m|<b>(\d+)</b></font> matches|i) {
      print STDERR "**Found Header Count**\n" if ($self->{_debug});
      $self->approximate_result_count($1);
      $state = $START;
      # set-up attempting the tricky task of 
      # fetching the very first HIT line
      } 
  elsif ($state eq $START && m|Search took|i) 
      {
      print STDERR "**Found Start Line**\n" if ($self->{_debug});
      $state = $HITS;
      # Attempt to pull the very first hit line
      } 
  if ($state eq $HITS) {
      print "\n**state == HITS**\n" if 2 <= $self->{_debug};
  }
  if ($state eq $HITS && m@^<p><a href=([^<]+)>(.*)</a>@i)
      {
      print "**Found HIT**\n" if 2 <= $self->{_debug};
      my ($url, $title) = ($1,$2);
      if (defined($hit)) 
      {
      push(@{$self->{cache}}, $hit);
      };
      $hit = new WWW::SearchResult;
      # some queries *can* create internal junk in the url link
      # remove them! 
      $url =~ s/\/url\?sa=U&start=\d+&q=//g;
      $url =~ s/\&exp\=OneBoxNews //g;		# ~20000510.
      $url =~ s/\&e\=110 //g;			# -20000528.
      $hits_found++;
      $hit->add_url($url);
      $hit->title($title);
      $state = $HITS;
      } 
  if ($state eq $HITS && m@^<font size=-1><br>(.*)@i) 
      {
      print "**Found First Description**\n" if 2 <= $self->{_debug};
      $mDesc = $1; 
      if (not $mDesc =~ m@&nbsp;@)
      { 
      $mDesc =~ s/<.*?>//g; 
      $mDesc =  $mDesc . '<br>' if not $mDesc =~ m@<br>@;
      $hit->description($mDesc); 
      $state = $HITS;
      }
      } 
  elsif ($state eq $HITS && 
           m@^(\.(.+))@i ||
           m@^<br><font color=green>(.*)\s@i) { 
      print "**Found Second Description**\n" if 2 <= $self->{_debug};
      $sDesc = $1; 
      $sDesc ||= '';
      $sDesc = $mDesc . $sDesc if (defined $mDesc);
      $hit->description($sDesc) if (defined $hit and $sDesc ne '');
      $sDesc ='';
      $state = $HITS;
      } 
   elsif ($state eq $HITS && 
      m|<a href=([^<]+)><IMG SRC=/nav_next.gif.*?><br><.*?>.*?</A>|i) {
      my $nexturl = $self->{'_next_url'};
      if (defined $nexturl) {
	print STDERR "**Fetching Next URL-> ", $nexturl, "\n" if 2 <= $self->{_debug};
      } else {
	print STDERR "**Fetching Next URL-> UNDEF\n" if 2 <= $self->{_debug};
      }
	
      my $iURL = $1;
      $self->{'_next_url'} = $self->{'search_base_url'} . $iURL;
      } 
    else 
      {
      print STDERR "**Nothing matched.**\n" if 2 <= $self->{_debug};
      }
      } 
    if (defined($hit)) 
      {
      push(@{$self->{cache}}, $hit);
      } 
      return $hits_found;
      } # native_retrieve_some
1;  
