patches/WWW_Search.patch

   1 --- Google.pm.orig      Wed May 24 16:55:47 2000
   2 +++ Google.pm   Wed Jan 16 22:02:53 2002
   3 @@ -2,7 +2,7 @@
   4  # Google.pm
   5  # by Jim Smyser
   6  # Copyright (C) 1996-1999 by Jim Smyser & USC/ISI
   7 -# $Id$
   8 +# $Id$
   9  ##########################################################
  10
  11
  12 @@ -30,8 +30,6 @@
  13  It handles making and interpreting Google searches.
  14  F<http://www.google.com>.
  15
  16 -Googles returns 100 Hits per page. Custom Linux Only search capable.
  17 -
  18  This class exports no public interface; all interaction should
  19  be done through L<WWW::Search> objects.
  20
  21 @@ -70,33 +68,41 @@
  22
  23  This module adheres to the C<WWW::Search> test suite mechanism.
  24
  25 -=head1 BUGS
  26 -
  27 -2.07 now parses for most of what Google produces, but not all.
  28 -Because Google does not produce universial formatting for all
  29 -results it produces, there are undoublty a few line formats yet
  30 -uncovered by the author. Different search terms creates various
  31 -differing format out puts for each line of results. Example,
  32 -searching for "visual basic" will create whacky url links,
  33 -whereas searching for "Visual C++" does not. It is a parsing
  34 -nitemare really! If you think you uncovered a BUG just remember
  35 -the above comments!
  36 -
  37 -With the above said, this back-end will produce proper formated
  38 -results for 96+% of what it is asked to produce. Your milage
  39 -will vary.
  40 -
  41  =head1 AUTHOR
  42
  43 -This backend is maintained and supported by Jim Smyser.
  44 +This backend is written and maintained/supported by Jim Smyser.
  45  <jsmyser@bigfoot.com>
  46
  47  =head1 BUGS
  48
  49 -2.09 seems now to parse all hits with the new format change so there really shouldn't be
  50 -any like there were with 2.08.
  51 +Google is not an easy search engine to parse in that it is capable
  52 +of altering it's output ever so slightly on different search terms.
  53 +There may be new slight results output the author has not yet seen that
  54 +will pop at any given time for certain searches. So, if you think you see
  55 +a bug keep the above in mind and send me the search words you used so I
  56 +may code for any new variations.
  57 +
  58 +=head1 CHANGES
  59 +
  60 +2.22
  61 +Fixed up changed format from google
  62 +reformatted code
  63 +
  64 +2.21
  65 +Minor code correction for empty returned titles
  66 +
  67 +2.20
  68 +Forgot to add new next url regex in 2.19!
  69 +
  70 +2.19
  71 +Regex work on some search results url's that has changed. Number found
  72 +return should be right now.
  73 +
  74 +2.17
  75 +Insert url as a title when no title is found.
  76
  77 -=head1 VERSION HISTORY
  78 +2.13
  79 +New regexp to parse newly found results format with certain search terms.
  80
  81  2.10
  82  removed warning on absence of description; new test case
  83 @@ -131,15 +137,18 @@
  84  WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  85  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  86
  87 +
  88  =cut
  89  #'
  90 -
  91 +
  92 +
  93  #####################################################################
  94 +
  95  require Exporter;
  96  @EXPORT = qw();
  97  @EXPORT_OK = qw();
  98  @ISA = qw(WWW::Search Exporter);
  99 -$VERSION = '2.10';
 100 +$VERSION = '2.22';
 101
 102  $MAINTAINER = 'Jim Smyser <jsmyser@bigfoot.com>';
 103  $TEST_CASES = <<"ENDTESTCASES";
 104 @@ -148,160 +157,187 @@
 105  &test('Google', '$MAINTAINER', 'one_page', '+LS'.'AM +rep'.'lication', \$TEST_RANGE, 2,99);
 106  &test('Google', '$MAINTAINER', 'multi', 'dir'.'ty ha'.'rr'.'y bimbo', \$TEST_GREATER_THAN, 101);
 107  ENDTESTCASES
 108 -
 109 +
 110  use Carp ();
 111 -use WWW::Search(generic_option);
 112 +use WWW::Search(qw(generic_option strip_tags));
 113  require WWW::SearchResult;
 114 -
 115 +
 116 +
 117 +sub undef_to_emptystring {
 118 +return defined($_[0]) ? $_[0] : "";
 119 +}
 120 +# private
 121  sub native_setup_search {
 122 -   my($self, $native_query, $native_options_ref) = @_;
 123 -   $self->{_debug} = $native_options_ref->{'search_debug'};
 124 -   $self->{_debug} = 2 if ($native_options_ref->{'search_parse_debug'});
 125 -   $self->{_debug} = 0 if (!defined($self->{_debug}));
 126 -   $self->{agent_e_mail} = 'jsmyser@bigfoot.com';
 127 -   $self->user_agent('user');
 128 -   $self->{_next_to_retrieve} = 1;
 129 -   $self->{'_num_hits'} = 0;
 130 -   if (!defined($self->{_options})) {
 131 -     $self->{'search_base_url'} = 'http://www.google.com';
 132 -     $self->{_options} = {
 133 -         'search_url' => 'http://www.google.com/search',
 134 -         'num' => '100',
 135 -         'q' => $native_query,
 136 -         };
 137 -         }
 138 -   my $options_ref = $self->{_options};
 139 -   if (defined($native_options_ref))
 140 -     {
 141 -     # Copy in new options.
 142 -     foreach (keys %$native_options_ref)
 143 -     {
 144 -     $options_ref->{$_} = $native_options_ref->{$_};
 145 -     } # foreach
 146 -     } # if
 147 -   # Process the options.
 148 -   my($options) = '';
 149 -   foreach (sort keys %$options_ref)
 150 -     {
 151 -     # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n";
 152 -     next if (generic_option($_));
 153 -     $options .= $_ . '=' . $options_ref->{$_} . '&';
 154 -     }
 155 -   chop $options;
 156 -   # Finally figure out the url.
 157 -   $self->{_next_url} = $self->{_options}{'search_url'} .'?'. $self->hash_to_cgi_string($self->{_options});
 158 -   } # native_setup_search
 159 -
 160 +    my($self, $native_query, $native_options_ref) = @_;
 161 +    $self->user_agent('user');
 162 +    $self->{_next_to_retrieve}         = 0;
 163 +    $self->{'_num_hits'}               = 100;
 164 +
 165 +    if (!defined $self->{_options}) {
 166 +       $self->{_options} = {
 167 +               'search_url' => 'http://www.google.com/search',
 168 +               'num' => $self->{'_num_hits'},
 169 +       };
 170 +    }
 171 +
 172 +    my($options_ref) = $self->{_options};
 173 +
 174 +    if (defined $native_options_ref) {
 175 +       # Copy in new options.
 176 +       foreach (keys %$native_options_ref) {
 177 +           $options_ref->{$_} = $native_options_ref->{$_};
 178 +       }
 179 +    }
 180 +
 181 +    # Process the options.
 182 +    my($options) = '';
 183 +    foreach (keys %$options_ref) {
 184 +       # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n";
 185 +       next if (generic_option($_));
 186 +       $options .= $_ . '=' . $options_ref->{$_} . '&';
 187 +    }
 188 +
 189 +    $self->{_debug} = $options_ref->{'search_debug'};
 190 +    $self->{_debug} = 2 if ($options_ref->{'search_parse_debug'});
 191 +    $self->{_debug} = 0 if (!defined $self->{_debug});
 192 +
 193 +    # Finally figure out the url.
 194 +    $self->{_base_url} =
 195 +    $self->{_next_url} =
 196 +    $self->{_options}{'search_url'} .
 197 +    "?" . $options .
 198 +    "q=" . $native_query;
 199 +}
 200 +
 201  # private
 202 -sub native_retrieve_some
 203 -   {
 204 -   my ($self) = @_;
 205 -   print STDERR "**Google::native_retrieve_some()**\n" if $self->{_debug};
 206 -   # Fast exit if already done:
 207 -   return undef if (!defined($self->{_next_url}));
 208 -
 209 -   # If this is not the first page of results, sleep so as to not
 210 -   # overload the server:
 211 -   $self->user_agent_delay if 1 < $self->{'_next_to_retrieve'};
 212 -
 213 -   # Get some if were not already scoring somewhere else:
 214 -   print STDERR "*Sending request (",$self->{_next_url},")\n" if $self->{_debug};
 215 -   my($response) = $self->http_request('GET', $self->{_next_url});
 216 -   $self->{response} = $response;
 217 -   if (!$response->is_success)
 218 -     {
 219 -     return undef;
 220 -     }
 221 -   $self->{'_next_url'} = undef;
 222 -   print STDERR "**Response\n" if $self->{_debug};
 223 -
 224 -   # parse the output
 225 -   my ($HEADER, $START, $HITS, $NEXT) = qw(HE HI ST NX);
 226 -   my $hits_found = 0;
 227 -   my $state = $HEADER;
 228 -   my $hit = ();
 229 -   foreach ($self->split_lines($response->content()))
 230 -      {
 231 -      next if m@^$@; # short circuit for blank lines
 232 -      print STDERR " $state ===$_=== " if 2 <= $self->{'_debug'};
 233 -  if (m|<b>(\d+)</b></font> matches|i) {
 234 -      print STDERR "**Found Header Count**\n" if ($self->{_debug});
 235 -      $self->approximate_result_count($1);
 236 -      $state = $START;
 237 -      # set-up attempting the tricky task of
 238 -      # fetching the very first HIT line
 239 -      }
 240 -  elsif ($state eq $START && m|Search took|i)
 241 -      {
 242 -      print STDERR "**Found Start Line**\n" if ($self->{_debug});
 243 -      $state = $HITS;
 244 -      # Attempt to pull the very first hit line
 245 -      }
 246 -  if ($state eq $HITS) {
 247 -      print "\n**state == HITS**\n" if 2 <= $self->{_debug};
 248 -  }
 249 -  if ($state eq $HITS && m@^<p><a href=([^<]+)>(.*)</a>$@i)
 250 -      {
 251 -      print "**Found HIT**\n" if 2 <= $self->{_debug};
 252 -      my ($url, $title) = ($1,$2);
 253 -      if (defined($hit))
 254 -      {
 255 -      push(@{$self->{cache}}, $hit);
 256 -      };
 257 -      $hit = new WWW::SearchResult;
 258 -      # some queries *can* create internal junk in the url link
 259 -      # remove them!
 260 -      $url =~ s/\/url\?sa=U&start=\d+&q=//g;
 261 -      $hits_found++;
 262 -      $hit->add_url($url);
 263 -      $hit->title($title);
 264 -      $state = $HITS;
 265 -      }
 266 -  if ($state eq $HITS && m@^<font size=-1><br>(.*)@i)
 267 -      {
 268 -      print "**Found First Description**\n" if 2 <= $self->{_debug};
 269 -      $mDesc = $1;
 270 -      if (not $mDesc =~ m@&nbsp;@)
 271 -      {
 272 -      $mDesc =~ s/<.*?>//g;
 273 -      $mDesc =  $mDesc . '<br>' if not $mDesc =~ m@<br>@;
 274 -      $hit->description($mDesc);
 275 -      $state = $HITS;
 276 -      }
 277 -      }
 278 -  elsif ($state eq $HITS &&
 279 -           m@^(\.(.+))@i ||
 280 -           m@^<br><font color=green>(.*)\s@i) {
 281 -      print "**Found Second Description**\n" if 2 <= $self->{_debug};
 282 -      $sDesc = $1;
 283 -      $sDesc ||= '';
 284 -      $sDesc =~ s/<.*?>//g;
 285 -      $sDesc = $mDesc . $sDesc;
 286 -      $hit->description($sDesc);
 287 -      $sDesc ='';
 288 -      $state = $HITS;
 289 -      }
 290 -   elsif ($state eq $HITS &&
 291 -      m|<a href=([^<]+)><IMG SRC=/nav_next.gif.*?><br><.*?>.*?</A>|i) {
 292 -      my $nexturl = $self->{'_next_url'};
 293 -      if (defined $nexturl) {
 294 -       print STDERR "**Fetching Next URL-> ", $nexturl, "\n" if 2 <= $self->{_debug};
 295 -      } else {
 296 -       print STDERR "**Fetching Next URL-> UNDEF\n" if 2 <= $self->{_debug};
 297 -      }
 298 -
 299 -      my $iURL = $1;
 300 -      $self->{'_next_url'} = $self->{'search_base_url'} . $iURL;
 301 -      }
 302 -    else
 303 -      {
 304 -      print STDERR "**Nothing matched.**\n" if 2 <= $self->{_debug};
 305 -      }
 306 -      }
 307 -    if (defined($hit))
 308 -      {
 309 -      push(@{$self->{cache}}, $hit);
 310 -      }
 311 -      return $hits_found;
 312 -      } # native_retrieve_some
 313 -1;
 314 +sub begin_new_hit {
 315 +    my($self) = shift;
 316 +    my($old_hit) = shift;
 317 +    my($old_raw) = shift;
 318 +
 319 +    if (defined $old_hit) {
 320 +       $old_hit->raw($old_raw) if (defined $old_raw);
 321 +       push(@{$self->{cache}}, $old_hit);
 322 +    }
 323 +
 324 +    return (new WWW::SearchResult, '');
 325 +}
 326 +
 327 +sub native_retrieve_some {
 328 +    my ($self) = @_;
 329 +    # fast exit if already done
 330 +    return undef if (!defined $self->{_next_url});
 331 +
 332 +    # get some
 333 +    print STDERR "Fetching " . $self->{_next_url} . "\n" if ($self->{_debug});
 334 +    my($response) = $self->http_request('GET', $self->{_next_url});
 335 +    $self->{response} = $response;
 336 +
 337 +    return undef if (!$response->is_success);
 338 +
 339 +    # parse the output
 340 +    my($HEADER, $HITS, $TRAILER, $POST_NEXT) = (1..10);
 341 +    my($hits_found) = 0;
 342 +    my($state) = ($HEADER);
 343 +    my($hit) = undef;
 344 +    my($raw) = '';
 345 +
 346 +    foreach ($self->split_lines($response->content())) {
 347 +       next if m@^$@; # short circuit for blank lines
 348 +
 349 +       if ($state == $HEADER && m/about <b>([\d,]+)<\/b>/) {
 350 +           my($n) = $1;
 351 +           $self->approximate_result_count($n);
 352 +           print STDERR "Found Total: $n\n" if ($self->{_debug});
 353 +           $state = $HITS;
 354 +
 355 +       } elsif ($state == $HITS &&
 356 +               m|<a href=(\S+)\>(.*?)</a><br><font size=-1><font color=\"#008000\"><.*?>|i
 357 +       ) {
 358 +
 359 +           my ($url, $title) = ($1,$2);
 360 +           ($hit, $raw) = $self->begin_new_hit($hit, $raw);
 361 +           print STDERR "**Found HIT1 Line**\n" if ($self->{_debug});
 362 +           $raw .= $_;
 363 +           $url =~ s/(>.*)//g;
 364 +           $hit->add_url(strip_tags($url));
 365 +           $hits_found++;
 366 +           $title = "No Title" if ($title =~ /^\s+/);
 367 +           $hit->title(strip_tags($title));
 368 +           $state = $HITS;
 369 +
 370 +       } elsif ($state == $HITS &&
 371 +               m@^<p><a href=/url\?sa=U&start=\d+&q=([^<]+)\&.*?>(.*)</a><font size=-1><br>(.*)@i ||
 372 +               m@^<p><a href=(\S+)>(.*)</a>.*?<font size=-1>(.*)@i
 373 +       ) {
 374 +           print STDERR "**Found HIT2 Line**\n" if ($self->{_debug});
 375 +
 376 +           ($hit, $raw) = $self->begin_new_hit($hit, $raw);
 377 +
 378 +           my ($url, $title) = ($1,$2);
 379 +           $mDesc = $3;
 380 +
 381 +           $url =~ s/\/url\?sa=\w&start=\d+&q=//g;
 382 +           $url =~ s/\?lang=(\S+)$//g;
 383 +           $url =~ s/&(.*)//g;
 384 +           $url =~ s/(>.*)//g;
 385 +           $url =~ s/\/$//g;   # kill trailing slash.
 386 +
 387 +           $raw .= $_;
 388 +           $hit->add_url(strip_tags($url));
 389 +           $hits_found++;
 390 +
 391 +           $title = "No Title" if ($title =~ /^\s+/);
 392 +           $hit->title(strip_tags($title));
 393 +
 394 +           $mDesc =~ s/<.*?>//g;
 395 +###        $mDesc =  $mDesc . '<br>' if not $mDesc =~ m@<br>@;
 396 +           $hit->description($mDesc) if (defined $hit);
 397 +           $state = $HITS;
 398 +
 399 +# description parsing
 400 +       } elsif ($state == $HITS && m@<b>(\.\.(.+))</b> @i
 401 +       ) {
 402 +           print STDERR "**Parsing Description Line**\n" if ($self->{_debug});
 403 +           $raw .= $_;
 404 +           # uhm...
 405 +           $sDesc = $1 || "";
 406 +
 407 +           $sDesc =~ s/<.*?>//g;
 408 +           $mDesc ||= "";
 409 +           $sDesc = $mDesc . $sDesc;
 410 +#          $hit->description($sDesc) if $sDesc =~ m@^\.@;
 411 +           $sDesc = '';
 412 +           $state = $HITS;
 413 +
 414 +       } elsif ($state == $HITS && m@<div>@i
 415 +       ) {
 416 +           ($hit, $raw) = $self->begin_new_hit($hit, $raw);
 417 +           print STDERR "**Found Last Line**\n" if ($self->{_debug});
 418 +           # end of hits
 419 +           $state = $TRAILER;
 420 +
 421 +       } elsif ($state == $TRAILER &&
 422 +               m|<a href=([^<]+)><img src=/nav_next.gif.*?>.*?|i
 423 +       ) {
 424 +           my($relative_url) = $1;
 425 +           print STDERR "**Fetching >>Next<< Page**\n" if ($self->{_debug});
 426 +           $self->{_next_url} = 'http://www.google.com' . $relative_url;
 427 +           $state = $POST_NEXT;
 428 +       }
 429 +    }
 430 +
 431 +    if ($state != $POST_NEXT) {
 432 +       # No "Next" Tag
 433 +       $self->{_next_url} = undef;
 434 +       $self->begin_new_hit($hit, $raw) if ($state == $HITS);
 435 +       $self->{_next_url} = undef;
 436 +    }
 437 +
 438 +    # ZZZzzzzZZZZzzzzzzZZZZZZzzz
 439 +    $self->user_agent_delay if (defined($self->{_next_url}));
 440 +    return $hits_found;
 441 +}
 442 +
 443 +1;
 444 +