+++ /dev/null
-##########################################################
-# Google.pm
-# by Jim Smyser
-# Copyright (C) 1996-1999 by Jim Smyser & USC/ISI
-# $Id: Google.pm,v 1.1.1.1 2000/07/27 16:10:23 blootbot Exp $
-##########################################################
-
-
-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@ @)
- {
- $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;
projects / infobot.git / blobdiff