patches/Google.pm

   1 ##########################################################
   2 # Google.pm
   3 # by Jim Smyser
   4 # Copyright (C) 1996-1999 by Jim Smyser & USC/ISI
   5 # $Id: Google.pm,v 2.20 2000/07/09 14:29:22 jims Exp $
   6 ##########################################################
   7
   8
   9 package WWW::Search::Google;
  10
  11
  12 =head1 NAME
  13
  14 WWW::Search::Google - class for searching Google
  15
  16
  17 =head1 SYNOPSIS
  18
  19 use WWW::Search;
  20 my $Search = new WWW::Search('Google'); # cAsE matters
  21 my $Query = WWW::Search::escape_query("Where is Jimbo");
  22 $Search->native_query($Query);
  23 while (my $Result = $Search->next_result()) {
  24 print $Result->url, "\n";
  25 }
  26
  27 =head1 DESCRIPTION
  28
  29 This class is a Google specialization of WWW::Search.
  30 It handles making and interpreting Google searches.
  31 F<http://www.google.com>.
  32
  33 This class exports no public interface; all interaction should
  34 be done through L<WWW::Search> objects.
  35
  36 =head1 LINUX SEARCH
  37
  38 For LINUX lovers like me, you can put Googles in a LINUX only search
  39 mode by changing search URL from:
  40
  41  'search_url' => 'http://www.google.com/search',
  42
  43 to:
  44
  45  'search_url' => 'http://www.google.com/linux',
  46
  47 =head1 SEE ALSO
  48
  49 To make new back-ends, see L<WWW::Search>.
  50
  51 =head1 HOW DOES IT WORK?
  52
  53 C<native_setup_search> is called (from C<WWW::Search::setup_search>)
  54 before we do anything.  It initializes our private variables (which
  55 all begin with underscore) and sets up a URL to the first results
  56 page in C<{_next_url}>.
  57
  58 C<native_retrieve_some> is called (from C<WWW::Search::retrieve_some>)
  59 whenever more hits are needed.  It calls C<WWW::Search::http_request>
  60 to fetch the page specified by C<{_next_url}>.
  61 It then parses this page, appending any search hits it finds to
  62 C<{cache}>.  If it finds a ``next'' button in the text,
  63 it sets C<{_next_url}> to point to the page for the next
  64 set of results, otherwise it sets it to undef to indicate we''re done.
  65
  66
  67 =head1 TESTING
  68
  69 This module adheres to the C<WWW::Search> test suite mechanism.
  70
  71 =head1 AUTHOR
  72
  73 This backend is written and maintained/supported by Jim Smyser.
  74 <jsmyser@bigfoot.com>
  75
  76 =head1 BUGS
  77
  78 Google is not an easy search engine to parse in that it is capable
  79 of altering it's output ever so slightly on different search terms.
  80 There may be new slight results output the author has not yet seen that
  81 will pop at any given time for certain searches. So, if you think you see
  82 a bug keep the above in mind and send me the search words you used so I
  83 may code for any new variations.
  84
  85 =head1 CHANGES
  86
  87 2.21.1
  88 Parsing update from Tim Riker <Tim@Rikers.org>
  89
  90 2.21
  91 Minor code correction for empty returned titles
  92
  93 2.20
  94 Forgot to add new next url regex in 2.19!
  95
  96 2.19
  97 Regex work on some search results url's that has changed. Number found
  98 return should be right now.
  99
 100 2.17
 101 Insert url as a title when no title is found.
 102
 103 2.13
 104 New regexp to parse newly found results format with certain search terms.
 105
 106 2.10
 107 removed warning on absence of description; new test case
 108
 109 2.09
 110 Google NOW returning url and title on one line.
 111
 112 2.07
 113 Added a new parsing routine for yet another found result line.
 114 Added a substitute for whacky url links some queries can produce.
 115 Added Kingpin's new hash_to_cgi_string() 10/12/99
 116
 117 2.06
 118 Fixed missing links / regexp crap.
 119
 120 2.05
 121 Matching overhaul to get the code parsing right due to multiple
 122 tags being used by google on the hit lines. 9/25/99
 123
 124 2.02
 125 Last Minute description changes  7/13/99
 126
 127 2.01
 128 New test mechanism  7/13/99
 129
 130 1.00
 131 First release  7/11/99
 132
 133 =head1 LEGALESE
 134
 135 THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
 136 WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
 137 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 138
 139
 140 =cut
 141 #'
 142
 143
 144 #####################################################################
 145
 146 require Exporter;
 147 @EXPORT = qw();
 148 @EXPORT_OK = qw();
 149 @ISA = qw(WWW::Search Exporter);
 150 $VERSION = '2.21.1';
 151
 152 $MAINTAINER = 'Jim Smyser <jsmyser@bigfoot.com>';
 153 $TEST_CASES = <<"ENDTESTCASES";
 154 # Google looks for partial words it can find results for so it will end up finding "Bogus" pages.
 155 &test('Google', '$MAINTAINER', 'zero', '4036e7757s5', \$TEST_EXACTLY);
 156 &test('Google', '$MAINTAINER', 'one_page', '+LS'.'AM +rep'.'lication', \$TEST_RANGE, 2,99);
 157 &test('Google', '$MAINTAINER', 'multi', 'dir'.'ty ha'.'rr'.'y bimbo', \$TEST_GREATER_THAN, 101);
 158 ENDTESTCASES
 159
 160 use Carp ();
 161 use WWW::Search(qw(generic_option strip_tags));
 162 require WWW::SearchResult;
 163
 164
 165 sub undef_to_emptystring {
 166 return defined($_[0]) ? $_[0] : "";
 167 }
 168 # private
 169 sub native_setup_search
 170     {
 171      my($self, $native_query, $native_options_ref) = @_;
 172      $self->user_agent('user');
 173      $self->{_next_to_retrieve} = 0;
 174      $self->{'_num_hits'} = 100;
 175          if (!defined($self->{_options})) {
 176          $self->{_options} = {
 177          'search_url' => 'http://www.google.com/search',
 178          'num' => $self->{'_num_hits'},
 179          };
 180          };
 181      my($options_ref) = $self->{_options};
 182      if (defined($native_options_ref)) {
 183      # Copy in new options.
 184      foreach (keys %$native_options_ref) {
 185      $options_ref->{$_} = $native_options_ref->{$_};
 186      };
 187      };
 188      # Process the options.
 189      my($options) = '';
 190      foreach (keys %$options_ref) {
 191      # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n";
 192      next if (generic_option($_));
 193      $options .= $_ . '=' . $options_ref->{$_} . '&';
 194      };
 195      $self->{_debug} = $options_ref->{'search_debug'};
 196      $self->{_debug} = 2 if ($options_ref->{'search_parse_debug'});
 197      $self->{_debug} = 0 if (!defined($self->{_debug}));
 198
 199      # Finally figure out the url.
 200      $self->{_base_url} =
 201      $self->{_next_url} =
 202      $self->{_options}{'search_url'} .
 203      "?" . $options .
 204      "q=" . $native_query;
 205      }
 206
 207 # private
 208 sub begin_new_hit {
 209      my($self) = shift;
 210      my($old_hit) = shift;
 211      my($old_raw) = shift;
 212      if (defined($old_hit)) {
 213      $old_hit->raw($old_raw) if (defined($old_raw));
 214      push(@{$self->{cache}}, $old_hit);
 215      };
 216      return (new WWW::SearchResult, '');
 217      }
 218 sub native_retrieve_some {
 219      my ($self) = @_;
 220      # fast exit if already done
 221      return undef if (!defined($self->{_next_url}));
 222      # get some
 223      print STDERR "Fetching " . $self->{_next_url} . "\n" if ($self->{_debug});
 224      my($response) = $self->http_request('GET', $self->{_next_url});
 225      $self->{response} = $response;
 226      if (!$response->is_success) {
 227      return undef;
 228      };
 229
 230      # parse the output
 231      my($HEADER, $HITS, $TRAILER, $POST_NEXT) = (1..10);
 232      my($hits_found) = 0;
 233      my($state) = ($HEADER);
 234      my($hit) = undef;
 235      my($raw) = '';
 236      foreach ($self->split_lines($response->content())) {
 237      next if m@^$@; # short circuit for blank lines
 238
 239   if ($state == $HEADER && m/about <b>([\d,]+)<\/b>/)
 240      {
 241      my($n) = $1;
 242      $self->approximate_result_count($n);
 243      print STDERR "Found Total: $n\n" ;
 244      $state = $HITS;
 245      }
 246   if ($state == $HITS &&
 247      m|<p><a href=([^\>]*)\>(.*?)</a\><br\>|i) {
 248      my ($url, $title) = ($1,$2);
 249      ($hit, $raw) = $self->begin_new_hit($hit, $raw);
 250      print STDERR "**Found HIT0 Line** $url - $title\n" if ($self->{_debug});
 251      $raw .= $_;
 252      $url =~ s/(>.*)//g;
 253      $hit->add_url(strip_tags($url));
 254      $hits_found++;
 255      $title = "No Title" if ($title =~ /^\s+/);
 256      $hit->title(strip_tags($title));
 257      $state = $HITS;
 258      }
 259   elsif ($state == $HITS &&
 260      m|<a href=(.*)\>(.*?)</a><font size=-1><br><font color=green><.*?>|i) {
 261      my ($url, $title) = ($1,$2);
 262      ($hit, $raw) = $self->begin_new_hit($hit, $raw);
 263      print STDERR "**Found HIT1 Line**\n" if ($self->{_debug});
 264      $raw .= $_;
 265      $url =~ s/(>.*)//g;
 266      $hit->add_url(strip_tags($url));
 267      $hits_found++;
 268      $title = "No Title" if ($title =~ /^\s+/);
 269      $hit->title(strip_tags($title));
 270      $state = $HITS;
 271      }
 272   elsif ($state == $HITS &&
 273      m@^<p><a href=/url\?sa=U&start=\d+&q=([^<]+)\&.*?>(.*)</a><font size=-1><br>(.*)@i ||
 274      m@^<p><a href=([^<]+)>(.*)</a>.*?<font size=-1><br>(.*)@i)
 275      {
 276      ($hit, $raw) = $self->begin_new_hit($hit, $raw);
 277      print STDERR "**Found HIT2 Line**\n" if ($self->{_debug});
 278      my ($url, $title) = ($1,$2);
 279      $mDesc = $3;
 280      $url =~ s/\/url\?sa=\w&start=\d+&q=//g;
 281      $url =~ s/&(.*)//g;
 282      $url =~ s/(>.*)//g;
 283      $raw .= $_;
 284      $hit->add_url(strip_tags($url));
 285      $hits_found++;
 286      $title = "No Title" if ($title =~ /^\s+/);
 287      $hit->title(strip_tags($title));
 288      $mDesc =~ s/<.*?>//g;
 289      $mDesc =  $mDesc . '<br>' if not $mDesc =~ m@<br>@;
 290      $hit->description($mDesc) if (defined($hit));
 291      $state = $HITS;
 292      }
 293   elsif ($state == $HITS && m@^(\.\.(.+))@i)
 294      {
 295      print STDERR "**Parsing Description Line**\n" if ($self->{_debug});
 296      $raw .= $_;
 297      $sDesc = $1;
 298      $sDesc ||= '';
 299      $sDesc =~ s/<.*?>//g;
 300      $sDesc = $mDesc . $sDesc;
 301      $hit->description($sDesc) if $sDesc =~ m@^\.@;
 302      $sDesc = '';
 303      $state = $HITS;
 304      }
 305   elsif ($state == $HITS && m@<div class=nav>@i)
 306      {
 307      ($hit, $raw) = $self->begin_new_hit($hit, $raw);
 308      print STDERR "**Found Last Line**\n" if ($self->{_debug});
 309      # end of hits
 310      $state = $TRAILER;
 311      }
 312   elsif ($state == $TRAILER &&
 313      m|<a href=([^<]+)><IMG SRC=/nav_next.gif.*?>.*?|i)
 314      {
 315      my($relative_url) = $1;
 316      print STDERR "**Fetching >>Next<< Page**\n" if ($self->{_debug});
 317      $self->{_next_url} = 'http://www.google.com' . $relative_url;
 318      $state = $POST_NEXT;
 319      } else {
 320      };
 321      };
 322   if ($state != $POST_NEXT) {
 323      # No "Next" Tag
 324      $self->{_next_url} = undef;
 325      if ($state == $HITS) {
 326      $self->begin_new_hit($hit, $raw);
 327      };
 328      $self->{_next_url} = undef;
 329      };
 330      # ZZZzzzzZZZZzzzzzzZZZZZZzzz
 331      $self->user_agent_delay if (defined($self->{_next_url}));
 332      return $hits_found;
 333      }
 334 1;
 335