———————————————————————————————————————————# Search.pm
# by John Heidemann
# Copyright (C) 1996 by USC/ISI
# $Id: Search.pm,v 2.42 2003-04-16 00:39:29-04 kingpin Exp kingpin $
#
# A complete copyright notice appears at the end of this file.
=head1 NAME
WWW::Search - Virtual base class for WWW searches
=head1 SYNOPSIS
require WWW::Search;
$sEngine = "AltaVista";
$oSearch = new WWW::Search($sEngine);
=head1 DESCRIPTION
This class is the parent for all access methods supported by the
C<WWW::Search> library. This library implements a Perl API
to web-based search engines.
See README for a list of search engines currently supported, and for a
lot of interesting high-level information about this distribution.
Search results can be limited, and there is a pause between each
request to avoid overloading either the client or the server.
=head2 Sample program
Here is a sample program:
my $sQuery = 'Columbus Ohio sushi restaurant';
my $oSearch = new WWW::Search('AltaVista');
$oSearch->native_query(WWW::Search::escape_query($sQuery));
$oSearch->login($sUser, $sPassword);
while (my $oResult = $oSearch->next_result())
{
print $oResult->url, "\n";
} # while
$oSearch->logout;
Results are objects of type C<WWW::Search::Result>
(see L<WWW::Search::Result> for details).
Note that different backends support different result fields.
All backends are required to support title and url.
=head1 SEE ALSO
For specific search engines, see L<WWW::Search::TheEngineName>
(replacing TheEngineName with a particular search engine).
For details about the results of a search,
see L<WWW::Search::Result>.
=head1 METHODS AND FUNCTIONS
Methods and functions marked as PRIVATE are, in general, only useful
to backend programmers.
=cut
#####################################################################
package
WWW::Search;
use
Carp ();
use
Exporter;
use
File::Find;
use
HTML::TreeBuilder;
use
HTTP::Cookies;
use
HTTP::Request;
use
HTTP::Response;
use
HTTP::Status;
use
LWP::MemberMixin;
use
LWP::RobotUA;
use
LWP::UserAgent;
use
URI;
use
URI::Escape;
use
User;
# Internal states:
@EXPORT
=
qw()
;
@EXPORT_OK
=
qw( escape_query unescape_query generic_option strip_tags )
;
@ISA
=
qw(Exporter LWP::MemberMixin)
;
$MAINTAINER
=
'Martin Thurn <mthurn@cpan.org>'
;
$VERSION
=
sprintf
(
"%d.%02d"
,
q$Revision: 2.42 $
=~ /(\d+)\.(\d+)/o);
=head2 new
To create a new WWW::Search, call
$oSearch = new WWW::Search('SearchEngineName');
where SearchEngineName is replaced with a particular search engine.
For example:
$oSearch = new WWW::Search('Yahoo');
If no search engine is specified, a default (currently 'Null::Empty')
will be chosen for you. The next step is usually:
$oSearch->native_query('search-engine-specific+query+string');
=cut
sub
new
{
my
$class
=
shift
;
my
$engine
=
shift
;
# Remaining arguments will become hash args
# the default (not currently more configurable :-< )
my
$default_engine
=
'Null::Empty'
;
my
$default_agent_name
=
"WWW::Search/$VERSION"
;
my
$default_agent_e_mail
= User->Login .
'@'
. hostfqdn;
$engine
=
$default_engine
if
(!
defined
(
$engine
));
# Load the engine, if necessary.
my
$subclass
=
"${class}::$engine"
;
if
(!
defined
(
&$subclass
))
{
eval
"use $subclass"
;
Carp::croak(
"unknown search engine backend $engine ($@)"
)
if
($@);
}
# if
my
$self
=
bless
{
engine
=>
$engine
,
maximum_to_retrieve
=> 500,
# both pages and hits
interrequest_delay
=> 0.25,
# in seconds
agent_name
=>
$default_agent_name
,
agent_e_mail
=>
$default_agent_e_mail
,
env_proxy
=> 0,
http_method
=>
'GET'
,
http_proxy
=>
''
,
http_proxy_user
=>
undef
,
http_proxy_pwd
=>
undef
,
timeout
=> 60,
_debug
=> 0,
_parse_debug
=> 0,
search_from_file
=>
undef
,
search_to_file
=>
undef
,
search_to_file_index
=> 0,
@_
,
# variable initialization goes here
},
$subclass
;
$self
->reset_search();
return
$self
;
}
# new
=head2 version
Returns the value of the $VERSION variable of the backend engine, or
$WWW::Search::VERSION if the backend does not contain $VERSION.
=cut
sub
version
{
my
$self
=
shift
;
my
$iVersion
=
eval
'$'
.
ref
(
$self
).
'::VERSION'
;
# print STDERR " + iVersion = >>>$iVersion<<<\n";
$iVersion
||=
$VERSION
;
return
$iVersion
;
}
# version
=head2 maintainer
Returns the value of the $MAINTAINER variable of the backend engine,
or $WWW::Search::MAINTAINER if the backend does not contain
$MAINTAINER.
=cut
sub
maintainer
{
my
$self
=
shift
;
my
$sMaintainer
=
eval
'$'
.
ref
(
$self
).
'::MAINTAINER'
;
# print STDERR " + sMaintainer = >>>$sMaintainer<<<\n";
$sMaintainer
||=
$MAINTAINER
;
return
$sMaintainer
;
}
# maintainer
=head2 installed_engines
Returns a list of the names of all installed backends.
We can not tell if they are up-to-date or working, though.
use WWW::Search;
my @asEngines = sort &WWW::Search::installed_engines();
local $" = ', ';
print (" + These WWW::Search backends are installed: @asEngines\n");
# Choose a backend at random:
my $oSearch = WWW::Search->new($asEngines[rand(scalar(@asEngines))]);
=cut
sub
wanted
{
# Code adapted from the following netnews post (Thank you, Tom!):
# From: Tom Christiansen (tchrist@mox.perl.com)
# Subject: SRC: pminst - find modules whose names match this pattern
# Newsgroups: comp.lang.perl.misc
# Date: 1999/02/15
my
$startdir
=
shift
;
my
$sFullPath
=
$File::Find::name
;
# print STDERR " + wanted($startdir, $sFullPath)\n" if DEBUG_FIND;
if
(-d && /^[a-z]/)
{
# this is so we don't go down site_perl etc too early
$File::Find::prune
= 1;
# print STDERR " + prune\n" if DEBUG_FIND;
return
;
}
# if
unless
(
$sFullPath
=~ s!\.pm\Z!!)
{
# print STDERR " + not .pm\n" if DEBUG_FIND;
return
;
}
# unless
# Delete absolute path off front of file path:
$sFullPath
=~ s{^\Q
$startdir
/}{};
unless
(
$sFullPath
=~ s!\AWWW/Search!!)
{
# print STDERR " + not WWW/Search\n" if DEBUG_FIND;
return
;
}
# unless
STDERR
" + found $sFullPath\n"
if
DEBUG_FIND;
$sFullPath
=~ s{/}{::}g;
$sFullPath
=~ s!\A::!!;
return
$sFullPath
;
}
# wanted
sub
installed_engines
{
# Does NOT need a WWW::Search object to operate
my
%hsi
;
foreach
my
$sDir
(
@INC
)
{
File::Find::find(
sub
{
$hsi
{
&wanted
(
$sDir
) ||
'JUNKJUNK'
}++;
},
$sDir
);
}
# foreach
delete
$hsi
{
'JUNKJUNK'
};
delete
$hsi
{
'Test'
};
delete
$hsi
{
'Result'
};
return
keys
%hsi
;
}
# installed_engines
=head2 native_query
Specify a query (and optional options) to the current search object.
Previous query (if any) and its cached results (if any) will be thrown away.
The option values and the query must be escaped; call L<WWW::Search::escape_query()>
to escape a string.
The search process is not actually begun until C<results> or
C<next_result> is called (lazy!), so native_query does not return anything.
Example:
$oSearch->native_query('search-engine-specific+escaped+query+string',
{ option1 => 'able', option2 => 'baker' } );
The hash of options following the query string is optional.
The query string is backend-specific.
There are two kinds of options:
options specific to the backend,
and generic options applicable to multiple backends.
Generic options all begin with 'search_'.
Currently a few are supported:
=over 4
=item search_url
Specifies the base URL for the search engine.
=item search_debug
Enables backend debugging. The default is 0 (no debugging).
=item search_parse_debug
Enables backend parser debugging. The default is 0 (no debugging).
=item search_to_file FILE
Causes the search results to be saved in a set of files
prefixed by FILE.
(Used internally by the test-suite, not intended for general use.)
=item search_from_file FILE
Reads a search from a set of files prefixed by FILE.
(Used internally by the test-suite, not intended for general use.)
=back
Some backends may not implement these generic options,
but any which do implement them must provide these semantics.
Backend-specific options are described
in the documentation for each backend.
In most cases the options and their values are packed together to create the query portion of
the final URL.
Details about how the search string and option hash are interpreted
might be found in the search-engine-specific manual pages
(WWW::Search::SearchEngineName).
After C<native_query>, the next step is usually:
while ($oResult = $oSearch->next_result())
{
# do_something($oResult);
}
=cut
sub
native_query
{
my
$self
=
shift
;
STDERR
" + native_query($_[0])\n"
if
$self
->{_debug};
$self
->reset_search();
$self
->{
'native_query'
} =
$_
[0];
$self
->{
'native_options'
} =
$_
[1];
# promote generic options
my
$opts_ref
=
$_
[1];
foreach
my
$sKey
(
keys
%$opts_ref
)
{
if
(generic_option(
$sKey
))
{
STDERR
" + promoting $sKey to $self\n"
if
$self
->{_debug};
$self
->{
$sKey
} =
$opts_ref
->{
$sKey
};
# delete $opts_ref->{$sKey};
}
# if
}
# foreach
}
# native_query
=head2 gui_query
Specify a query to the current search object;
the query will be performed with the engine's default options,
as if it were typed by a user in a browser window.
Same arguments as C<native_query> above.
Currently, this feature is supported by only a few backends;
consult the documentation for each backend to see if it is implemented.
=cut
sub
gui_query
{
# This function is a stub to prevent runtime errors. This function
# should be defined in each backend as appropriate. See Yahoo.pm in
# the WWW-Search-Yahoo distribution for an example of how to
# implement it.
my
$self
=
shift
;
return
$self
->native_query(
@_
);
}
# gui_query
=head2 cookie_jar
Call this method (anytime before asking for results) if you want to
communicate cookie data with the search engine. Takes one argument,
either a filename or an HTTP::Cookies object. If you give a filename,
WWW::Search will attempt to read/store cookies there (by in turn
passing the filename to HTTP::Cookies::new).
$oSearch->cookie_jar('/tmp/my_cookies');
If you give an HTTP::Cookies object, it is up to you to save the
cookies if/when you wish.
use HTTP::Cookies;
my $oJar = HTTP::Cookies->new(...);
$oSearch->cookie_jar($oJar);
If you pass in no arguments, the cookie jar (if any) is returned.
my $oJar = $oSearch->cookie_jar;
unless (ref $oJar) { print "No jar" };
=cut
sub
cookie_jar
{
my
$self
=
shift
;
if
(!
@_
)
{
return
$self
->{
'_cookie_jar'
};
}
# if no arguments
my
$arg
=
shift
;
if
(
ref
(
$arg
) eq
'HTTP::Cookies'
)
{
STDERR
" + WWW::Search using caller's HTTP::Cookies object\n"
if
DEBUG_COOKIES;
$self
->{
'_cookie_jar'
} =
$arg
;
$self
->{
'_cookie_jar_we_save'
} = 0;
}
# if
elsif
(!
ref
(
$arg
))
{
# Assume that $arg is a file name:
STDERR
" + WWW::Search using Cookies from file $arg\n"
if
DEBUG_COOKIES;
$self
->{
'_cookie_jar'
} = HTTP::Cookies->new(
'file'
=>
$arg
,
'autosave'
=> 1,
'ignore_discard'
=> 1,
);
$self
->{
'_cookie_jar'
}->load;
$self
->{
'_cookie_jar_we_save'
} = 1;
# print STDERR " + WWW::Search just loaded cookies from $arg\n";
}
else
{
Carp::carp
"argument to WWW::Search::cookie_jar() must be HTTP::Cookies or scalar"
;
}
}
# cookie_jar
=head2 date_from
Set/get the start date for limiting the query by a date range. See
the documentation for each backend to find out if date ranges are
supported for each search engine.
=head2 date_to
Set/get the end date for limiting the query by a date range. See the
documentation for each backend to find out if date ranges are
supported for each search engine.
=cut
sub
date_from
{
return
shift
->_elem(
'date_from'
,
@_
) ||
''
;
}
# date_from
sub
date_to
{
return
shift
->_elem(
'date_to'
,
@_
) ||
''
;
}
# date_to
=head2 env_proxy
Enable loading proxy settings from *_proxy environment variables.
This routine should be called before the first retrieval is attempted.
Example:
$oSearch->env_proxy('yes'); # Turn on with any true value
...
$oSearch->env_proxy(0); # Turn off with zero or undef
...
if ($oSearch->env_proxy) # Test
=cut
# contributed by Klaus Johannes Rusch
sub
env_proxy {
return
shift
->_elem(
'env_proxy'
,
@_
); }
=head2 http_proxy
Set-up an HTTP proxy
(for connections from behind a firewall).
This routine should be called before calling any of the result
functions (next_result or results).
Example:
$oSearch->http_proxy('http://gateway:8080'); # Turn on and set address
...
$oSearch->http_proxy(''); # Turn off
=cut
sub
http_proxy {
return
shift
->_elem(
'http_proxy'
,
@_
); }
=head2 http_proxy_user, http_proxy_pwd
Set/get HTTP proxy authentication data.
These routines set/get username and password used in proxy
authentication. Authentication is performed only if proxy, username
and password are available.
Example:
$oSearch->http_proxy_user("myuser");
$oSearch->http_proxy_pwd("mypassword");
$oSearch->http_proxy_user(undef); # Example for no authentication
$username = $oSearch->http_proxy_user();
=cut
sub
http_proxy_user
{
my
$obj
=
shift
;
@_
?
$obj
->{http_proxy_user} =
shift
() :
$obj
->{http_proxy_user};
}
sub
http_proxy_pwd
{
my
$obj
=
shift
;
@_
?
$obj
->{http_proxy_pwd} =
shift
() :
$obj
->{http_proxy_pwd};
}
=head2 is_http_proxy_auth_data (PRIVATE)
Checks if authentication data (proxy name, username, and password) are available.
In this case proxy authentication is performed.
=cut
sub
is_http_proxy_auth_data
{
my
$self
=
shift
;
return
(
(
$self
->http_proxy ne
''
) &&
defined
(
$self
->http_proxy_user) &&
defined
(
$self
->http_proxy_pwd)
);
}
# is_http_proxy_auth_data
=head2 maximum_to_retrieve
Set the maximum number of hits to return.
Queries resulting in more than this many hits will return
the first hits, up to this limit.
Although this specifies a maximum limit,
search engines might return less than this number.
Defaults to 500.
Example:
$max = $oSearch->maximum_to_retrieve(100);
You can also spell this method "maximum_to_return".
=cut
sub
maximum_to_retrieve {
return
shift
->_elem(
'maximum_to_retrieve'
,
@_
); }
sub
maximum_to_return {
return
shift
->_elem(
'maximum_to_retrieve'
,
@_
); }
=head2 timeout
The maximum length of time any portion of the query should take,
in seconds.
Defaults to 60.
Example:
$oSearch->timeout(120);
=cut
sub
timeout {
return
shift
->_elem(
'timeout'
,
@_
); }
=head2 approximate_result_count
Some backends indicate how many hits they have found.
Typically this is an approximate value.
=cut
sub
approximate_hit_count
{
shift
->approximate_result_count(
@_
);
}
# approximate_hit_count
sub
approximate_result_count
{
my
$self
=
shift
;
# prime the pump:
$self
->retrieve_some()
if
(
$self
->{
'state'
} == SEARCH_BEFORE);
return
$self
->_elem(
'approx_count'
,
@_
);
}
# approximate_result_count
=head2 results
Return all the results of a query as an array of WWW::Search::Result objects.
Example:
@results = $oSearch->results();
foreach $oResult (@results) {
print $oResult->url(), "\n";
};
On error, results() will return undef and set C<response()>
to the HTTP response code.
=cut
sub
results
{
my
$self
=
shift
;
STDERR
" + results("
,
$self
->{
'native_query'
},
")\n"
if
$self
->{_debug};
# Put all the search results into the cache:
1
while
(
$self
->retrieve_some());
$self
->{cache} ||= [];
my
$iMax
=
scalar
(@{
$self
->{cache}});
# print STDERR " + mtr is ", $self->{maximum_to_retrieve}, "\n" if $self->{_debug};
# print STDERR " + cache contains $iMax results\n" if $self->{_debug};
$iMax
=
$self
->{maximum_to_retrieve}
if
(
$self
->{maximum_to_retrieve} <
$iMax
);
# print STDERR " + returning $iMax results\n" if $self->{_debug};
return
@{
$self
->{cache}}[0..
$iMax
-1];
}
# results
=head2 next_result
Call this method repeatedly to return each result of a query as a
WWW::Search::Result object. Example:
while ($oResult = $oSearch->next_result())
{
print $oResult->url(), "\n";
} # while
On error, next_result() will return undef and set C<response()>
to an HTTP response object.
=cut
sub
next_result
{
my
$self
=
shift
;
# Carp::croak "search not yet specified" if (!defined($self->{'native_query'}));
return
undef
if
(
$self
->{next_to_return} >=
$self
->{maximum_to_retrieve});
while
(1)
{
if
(
$self
->{next_to_return} <= $
#{$self->{cache}})
{
# The cache already contains the desired element; return it:
my
$i
= (
$self
->{next_to_return})++;
return
${
$self
->{cache}}[
$i
];
}
# if
# If we get here, then the desired element is beyond the end of
# the cache.
if
(
$self
->{state} == SEARCH_DONE)
{
# There are no more results to be gotten; fail & bail:
return
undef
;
}
# if
# Get some more results into the cache:
$self
->retrieve_some();
# Go back and try again:
}
# while infinite
}
# next_result
=head2 login
Backends which need to login to the search engine should implement
this function. Takes two arguments, user and password.
=head2 logout
Backends which need to logout from the search engine should implement
this function.
=cut
sub
login
{
my
$self
=
shift
;
my
(
$sUser
,
$sPassword
) =
@_
;
# Here is just a stub.
}
# login
sub
logout
{
my
$self
=
shift
;
# no other args
# Here is just a stub.
}
# logout
=head2 response
Returns the an HTTP::Response object which resulted from the
most-recently-sent query (see L<HTTP::Response>). If the query
returns no results (i.e. $oSearch->results is C<undef>), errors can
be reported like this:
my $response = $oSearch->response();
if ($response->is_success) {
print "normal end of result list\n";
} else {
print "error: " . $response->as_string() . "\n";
}
Note to backend authors: even if the backend does not involve the web,
it should return an HTTP::Response object.
=cut
sub
response
{
my
$self
=
shift
;
$self
->{response} ||= new HTTP::Response(RC_OK);
return
$self
->{response};
}
# response
=head2 seek_result($offset)
Set which result C<next_result> should be returned next time
next_result() is called. Results are zero-indexed.
The only guaranteed valid offset is 0,
which will replay the results from the beginning.
In particular, seeking past the end of the current cached
results probably will not do what you might think it should.
Results are cached, so this does not re-issue the query
or cause IO (unless you go off the end of the results).
To re-do the query, create a new search object.
Example:
$oSearch->seek_result(0);
=cut
sub
seek_result
{
my
(
$self
,
$desired
) =
@_
;
my
$old
=
$self
->{next_to_return};
$self
->{next_to_return} =
$desired
if
(
defined
(
$desired
) and (0 <=
$desired
));
return
$old
;
}
# seek_result
=head2 reset_search (PRIVATE)
Resets internal data structures to start over with a new search (on
the same engine).
=cut
sub
reset_search
{
my
$self
=
shift
;
STDERR
" + reset_search("
,
$self
->{
'native_query'
},
")\n"
if
$self
->{_debug};
$self
->{
'cache'
} = ();
$self
->{
'native_query'
} =
''
;
$self
->{
'next_to_retrieve'
} = 1;
$self
->{
'next_to_return'
} = 0;
$self
->{
'number_retrieved'
} = 0;
$self
->{
'requests_made'
} = 0;
$self
->{
'state'
} = SEARCH_BEFORE;
$self
->{
'_next_url'
} =
''
;
$self
->_elem(
'approx_count'
, 0);
# This method is called by native_query(). native_query() is called
# either by gui_query() or by the user. In the case that
# gui_query() was called, we do NOT want to clear out the _options
# hash. For now, I implement a pretty ugly hack to make this work:
if
(
caller
(2))
{
my
@as
=
caller
(2);
if
(1 <
scalar
(
@as
))
{
# print STDERR " in reset_search(), as is (", join(',', @as), ")\n";
return
if
$as
[3] =~ m/gui_query/;
}
# if
}
# if
$self
->{_options} = ();
}
# reset_search
=head2 submit
This method can be used to submit URLs to the search engines for indexing.
Consult the documentation for each backend to find out if it is implemented there,
and if so what the arguments are.
Returns an HTTP::Response object describing the result of the submission request.
Consult the documentation for each backend to find out the meaning of the response.
=cut
sub
submit
{
return
new HTTP::Response(788,
'Sorry, this backend does not support the submit() method.'
);
}
# submit
=head2 opaque
This function provides an application a place to store
one opaque data element (or many, via a Perl reference).
This facility is useful to (for example),
maintain client-specific information in each active query
when you have multiple concurrent queries.
=cut
sub
opaque {
return
shift
->_elem(
'opaque'
,
@_
); }
=head2 escape_query
Escape a query.
Before queries are sent to the internet, special characters must be escaped
so that a proper URL can be formed.
This is like escaping a URL,
but all non-alphanumeric characters are escaped and
and spaces are converted to "+"s.
Example:
$escaped = WWW::Search::escape_query('+hi +mom');
(Returns "%2Bhi+%2Bmom").
See also C<unescape_query>.
NOTE that this is not a method, it is a plain function.
=cut
sub
escape_query
{
my
$text
=
join
(
' '
,
@_
);
$text
||=
''
;
# print STDERR " + escape_query($text)\n";
$text
=~ s/([^ A-Za-z0-9])/
$URI::Escape::escapes
{$1}/g;
#"
# print STDERR " + escape_query($text)\n";
$text
=~ s/ /+/g;
# print STDERR " + escape_query($text)\n";
return
$text
;
}
# escape_query
=head2 unescape_query
Unescape a query.
See C<escape_query> for details.
Example:
$unescaped = WWW::Search::unescape_query('%22hi+mom%22');
(Returns '"hi mom"').
NOTE that this is not a method, it is a plain function.
=cut
sub
unescape_query
{
# code stolen from URI::Escape.pm.
my
@copy
=
@_
;
for
(
@copy
)
{
s/\+/ /g;
s/%([\dA-Fa-f]{2})/
chr
(
hex
($1))/eg;
}
# for
return
wantarray
?
@copy
:
$copy
[0];
}
# unescape_query
=head2 strip_tags
Given a string, returns a copy of that string with HTML tags removed.
This should be used by each backend as they insert the title and
description values into the search results objects.
NOTE that this is not a method, it is a plain function.
=cut
sub
strip_tags
{
# This is not a method; there is no $self
my
@as
=
@_
;
STRING:
foreach
(
@as
)
{
next
STRING
unless
$_
;
# Special case: change BR to space:
s!<BR>! !gi;
# We assume for now that we will not be encountering tags with
# embedded '>' characters!
s/\074.+?\076//g;
s/
 
;/ /g;
s/
"
;/\042/g;
s/
&
;/\046/g;
s/
<
;/\074/g;
s/
>
;/\076/g;
}
# foreach
return
wantarray
?
@as
:
shift
@as
;
}
# strip_tags
=head2 hash_to_cgi_string (PRIVATE) (DEPRECATED)
Deprecated.
Given a reference to a hash of string => string, constructs a CGI
parameter string that looks like 'key1=value1&key2=value2'.
If the value is undef, the key will not be added to the string.
At one time, for testing purposes, we asked backends to use this
function rather than piecing the URL together by hand, to ensure that
URLs are identical across platforms and software versions. But this
is no longer necessary.
Example:
$self->{_options} = {
'opt3' => 'val3',
'search_url' => 'http://www.deja.com/dnquery.xp',
'opt1' => 'val1',
'QRY' => $native_query,
'opt2' => 'val2',
};
$self->{_next_url} = $self->{_options}{'search_url'} .'?'.
$self->hash_to_cgi_string($self->{_options});
=cut
sub
hash_to_cgi_string
{
my
$self
=
shift
;
# Because of the design of our test suite, we need our generated
# URLs to be identical on all systems, all versions of perl. Ergo
# we must explicitly control the order in which our CGI parameter
# strings are cobbled together. For now, I assume sorting the hash
# keys will suffice.
my
$rh
=
shift
;
my
$ret
=
''
;
foreach
my
$key
(
sort
keys
%$rh
)
{
# printf STDERR "option: $key is " . $rh->{$key} . "\n";
next
if
generic_option(
$key
);
# Throw out keys with undef values.
next
unless
defined
(
$rh
->{
$key
});
# If we want to let the user delete options, uncomment the next
# line. (They can still blank them out, which may or may not have
# the same effect):
# next unless $rh->{$key} ne '';
$ret
.=
$key
.
'='
.
$rh
->{
$key
} .
'&'
;
}
# foreach $key
# Remove the trailing '&':
chop
$ret
;
return
$ret
;
}
# hash_to_cgi_string
=head2 user_agent($NON_ROBOT) (PRIVATE)
This internal routine creates a user-agent for derived classes that
query the web. If non-false argument $non_robot is given, a normal
user-agent (rather than a robot-style user-agent) is used.
If a backend needs the low-level LWP::UserAgent or LWP::RobotUA to
have a particular name, $oSearch->{'agent_name'} (and possibly
$oSearch->{'agent_e_mail'}) should be set to the desired values before
calling $oSearch->user_agent():
$oSearch = new WWW::Search('NewBackend');
$oSearch->{'agent_e_mail'} = $oSearch->{'agent_name'};
$oSearch->{'agent_name'} = 'Mozilla/5.5';
$oSearch->user_agent('non-robot');
Backends should use robot-style user-agents whenever possible.
=cut
sub
user_agent
{
my
$self
=
shift
;
unless
(
@_
)
{
# If NO ARGS, return the previously-created agent (if any):
return
$self
->{
'user_agent'
}
if
ref
(
$self
->{
'user_agent'
});
}
# unless
my
$non_robot
=
shift
|| 0;
my
$ua
;
if
(
$non_robot
)
{
$ua
= new LWP::UserAgent;
$ua
->agent(
$self
->{
'agent_name'
});
$ua
->from(
$self
->{
'agent_e_mail'
});
}
else
{
$ua
= new LWP::RobotUA(
$self
->{
'agent_name'
},
$self
->{
'agent_e_mail'
});
$ua
->delay(
$self
->{
'interrequest_delay'
}/60.0);
}
$ua
->timeout(
$self
->{
'timeout'
});
$ua
->proxy(
'http'
,
$self
->{
'http_proxy'
})
if
(
$self
->{
'http_proxy'
} ne
''
);
$ua
->env_proxy
if
$self
->{
'env_proxy'
};
$self
->{
'user_agent'
} =
$ua
;
return
$ua
;
}
# user_agent
=head2 http_referer (PRIVATE)
Get / set the value of the HTTP_REFERER variable for this search object.
Some search engines might only accept requests that originated at some specific previous page.
This method lets backend authors "fake" the previous page.
Call this method before calling http_request.
$oSearch->http_referer('http://prev.engine.com/wherever/setup.html');
$oResponse = $oSearch->http_request('GET', $url);
=cut
sub
http_referer {
return
shift
->_elem(
'_http_referer'
,
@_
); }
=head2 http_method (PRIVATE)
Get / set the method to be used for the HTTP request.
Must be either 'GET' or 'POST'.
Call this method before calling http_request.
(Normally you would set this during native_setup_search.)
The default is 'GET'.
$oSearch->http_method('POST');
=cut
sub
http_method {
shift
->_elem(
'http_method'
,
@_
); }
=head2 http_request($method, $url)
Return the response from an http request.
Similar to LWP::UserAgent::request.
Handles cookies, follows redirects, etc.
Requires that http_referer already be set up, if needed.
=cut
sub
http_request
{
my
$self
=
shift
;
my
(
$method
,
$url
) =
@_
;
my
$response
;
if
(50 <=
$self
->{_debug})
{
eval
q{ use LWP::Debug qw(+) }
;
}
# if
if
(
$self
->{search_from_file})
{
$response
=
$self
->http_request_from_file(
$url
);
}
else
{
# fetch it
my
$request
;
if
(
$method
eq
'POST'
)
{
my
$uri_url
= URI->new(
$url
);
my
$equery
=
$uri_url
->query;
$uri_url
->query(
undef
);
# we will handle the query ourselves
$request
= new HTTP::Request(
$method
,
$uri_url
);
$request
->header(
'Content-Type'
,
'application/x-www-form-urlencoded'
);
$request
->header(
'Content-Length'
,
length
$equery
);
$request
->content(
$equery
);
}
else
{
$request
= new HTTP::Request(
$method
,
$url
);
}
if
(
$self
->is_http_proxy_auth_data)
{
$request
->proxy_authorization_basic(
$self
->http_proxy_user,
$self
->http_proxy_pwd);
}
# if
$self
->{
'_cookie_jar'
}->add_cookie_header(
$request
)
if
ref
(
$self
->{
'_cookie_jar'
});
if
(
$self
->{
'_http_referer'
} && (
$self
->{
'_http_referer'
} ne
''
))
{
my
$s
= uri_escape(
$self
->{
'_http_referer'
});
# print STDERR " + referer($s), ref(s) = ", ref($s), "\n";
$s
=
$s
->as_string
if
ref
(
$s
) =~ m!URI!;
$request
->referer(
$s
);
}
# if referer
STDERR
" + original HTTP::Request is:\n"
,
$request
->as_string
if
(3 <=
$self
->{_debug});
my
$ua
=
$self
->user_agent();
while
(1)
{
$response
=
$ua
->request(
$request
);
STDERR
" + got HTTP::Response:\n"
,
$response
->headers->as_string
if
3 <=
$self
->{_debug};
if
(
ref
(
$self
->{
'_cookie_jar'
}))
{
$self
->{
'_cookie_jar'
}->extract_cookies(
$response
);
$self
->{
'_cookie_jar'
}->save
if
$self
->{
'_cookie_jar_we_save'
};
STDERR
" + WWW::Search just extracted cookies\n"
if
DEBUG_COOKIES;
STDERR
$self
->{
'_cookie_jar'
}->as_string
if
DEBUG_COOKIES;
# print STDERR Dumper($self->{'_cookie_jar'}) if DEBUG_COOKIES;
}
# if
if
(
$self
->{
'search_to_file'
} &&
$response
->is_success)
{
$self
->http_request_to_file(
$url
,
$response
);
}
# if
last
if
(
$response
->is_success);
last
if
(
$response
->is_error);
if
(
$response
->is_redirect || (
$response
->message =~ m!Object moved!i))
{
# Some engines spoof us with a false 302 code.
$request
= new HTTP::Request(
'GET'
,
URI->new_abs(
$response
->headers->header(
'Location'
),
$response
->request->uri),
);
$request
->referer(
$response
->request->uri->as_string);
$self
->{
'_cookie_jar'
}->add_cookie_header(
$request
)
if
ref
(
$self
->{
'_cookie_jar'
});
STDERR
" + Object moved, new HTTP::Request is:\n"
,
$request
->as_string
if
3 <=
$self
->{_debug};
# Go back and try again
}
# if
}
# while infinite
}
# if not from_file
return
$response
;
}
# http_request
sub
http_request_get_filename {
my
$self
=
shift
;
my
$fn
;
# filename?
if
(!
defined
(
$self
->{search_filename})) {
$fn
=
$self
->{search_from_file};
$fn
=
$self
->{search_to_file}
if
(!
defined
(
$fn
));
$self
->{search_filename} = WWW::Search::unescape_query(
$fn
);
}
$fn
=
$self
->{search_filename};
die
"$0: bogus filename.\n"
if
(!
defined
(
$fn
));
return
$fn
;
}
sub
http_request_from_file {
my
$self
=
shift
;
my
(
$url
) =
@_
;
my
$fn
=
$self
->http_request_get_filename();
# read index?
if
(!
defined
(
$self
->{search_from_file_hash})) {
open
(TABLE,
"<$fn"
) ||
die
"$0: open $fn failed.\n"
;
my
$i
= 0;
while
(<TABLE>) {
chomp
;
$self
->{search_from_file_hash}{
$_
} =
$i
;
# print STDERR "$0: file index: $i <$_>\n";
$i
++;
};
close
TABLE;
};
# read file
my
$i
=
$self
->{search_from_file_hash}{
$url
};
if
(
defined
(
$i
)) {
# print STDERR "$0: saved request <$url> found in $fn.$i\n";
# read the data
open
(FILE,
"<$fn.$i"
) ||
die
"$0: open $fn.$i\n"
;
my
$d
=
''
;
while
(<FILE>) {
$d
.=
$_
;
};
close
FILE;
# make up the response
my
$r
= new HTTP::Response(RC_OK);
$r
->content(
$d
);
return
$r
;
}
else
{
STDERR
"$0: saved request <$url> not found.\n"
;
my
$r
= new HTTP::Response(RC_NOT_FOUND);
return
$r
;
};
}
sub
http_request_to_file {
my
$self
=
shift
;
# The LAST arg is a LWP::Response object:
my
$response
=
pop
;
# The only other arg we care about is the FIRST arg, a url:
my
(
$url
, ) =
@_
;
my
$fn
=
$self
->http_request_get_filename();
unlink
(
$fn
)
if
(
$self
->{search_to_file_index} == 0);
open
(TABLE,
">>$fn"
) ||
die
"$0: open $fn\n"
;
TABLE
"$url\n"
;
close
TABLE;
my
$i
= (
$self
->{search_to_file_index})++;
open
(FILE,
">$fn.$i"
) ||
die
"$0: open $fn.$i\n"
;
FILE
$response
->content();
close
FILE;
}
=head2 next_url (PRIVATE)
Get or set the URL for the next backend request. This can be used to
save the WWW::Search state between sessions (e.g. if you are showing
pages of results to the user in a web browser). Before closing down a
session, save the value of next_url:
...
$oSearch->maximum_to_return(10);
while ($oSearch->next_result) { ... }
my $urlSave = $oSearch->next_url;
Then, when you start up the next session (e.g. after the user clicks
your "next" button), restore this value before calling for the results:
$oSearch->native_query(...);
$oSearch->next_url($urlSave);
$oSearch->maximum_to_return(20);
while ($oSearch->next_result) { ... }
WARNING: It is entirely up to you to keep your interface in sync with
the number of hits per page being returned from the backend. And, we
make no guarantees whether this method will work for any given
backend. (Their caching scheme might not enable you to jump into the
middle of a list of search results, for example.)
=cut
sub
next_url {
return
shift
->_elem(
'_next_url'
,
@_
); }
=head2 split_lines (PRIVATE)
This internal routine splits data (typically the result of the web
page retrieval) into lines in a way that is OS independent. If the
first argument is a reference to an array, that array is taken to be a
list of possible delimiters for this split. For example, Yahoo.pm
uses <p> and <dd><li> as "line" delimiters for convenience.
=cut
sub
split_lines
{
# This probably fails on an EBCDIC box where input is in text mode.
# Too bad Macs do not just use binmode like Windows boxen.
my
$self
=
shift
;
my
$s
=
shift
;
my
$patt
=
'\015?\012'
;
if
(
ref
(
$s
))
{
$patt
=
'('
.
$patt
;
foreach
(
@$s
)
{
$patt
.=
"|$_"
;
}
# foreach
$patt
.=
')'
;
# print STDERR " + patt is >>>$patt<<<\n";
$s
=
shift
;
}
# if
return
split
(/
$patt
/i,
$s
);
# If we require perl 5.005, this can be done by:
# use Socket qw(:crlf :DEFAULT);
# split(/$CR?$LF/,$_[0])
}
# split_lines
=head2 generic_option (PRIVATE)
This internal routine checks if an option
is generic or backend specific.
Currently all generic options begin with 'search_'.
This routine is not a method.
=cut
sub
generic_option
{
my
$option
=
shift
||
''
;
return
(
$option
=~ /^search_/);
}
# generic_option
=head2 setup_search (PRIVATE)
This internal routine does generic Search setup.
It calls C<native_setup_search> to do backend specific setup.
=cut
sub
setup_search
{
my
(
$self
) =
@_
;
STDERR
" + setup_search("
,
$self
->{
'native_query'
},
")\n"
if
$self
->{_debug};
$self
->{cache} = ();
$self
->{next_to_retrieve} = 1;
$self
->{number_retrieved} = 0;
$self
->{state} = SEARCH_UNDERWAY;
# $self->{_options} = ();
$self
->native_setup_search(
$self
->{
'native_query'
},
$self
->{
'native_options'
});
}
# setup_search
=head2 user_agent_delay (PRIVATE)
Derived classes should call this between requests to remote
servers to avoid overloading them with many, fast back-to-back requests.
=cut
sub
user_agent_delay {
my
(
$self
) =
@_
;
# sleep for a quarter second
select
(
undef
,
undef
,
undef
,
$self
->{interrequest_delay})
if
(
$self
->{robot_p});
}
=head2 absurl (PRIVATE)
An internal routine to convert a relative URL into a absolute URL. It
takes two arguments, the 'base' url (usually the search engine CGI
URL) and the URL to be converted. Returns a URI object.
=cut
sub
absurl
{
my
(
$self
,
$base
,
$url
) =
@_
;
$base
||=
''
;
# print STDERR " + this is WWW::Search::absurl($base,$url)\n" if 1 < $self->{_debug};
$base
=
$self
->{_prev_url}
if
$base
eq
''
;
my
$link
= URI->new_abs(
$url
,
$base
);
return
$link
;
}
# absurl
=head2 retrieve_some (PRIVATE)
An internal routine to interface with C<native_retrieve_some>.
Checks for overflow.
=cut
sub
retrieve_some
{
my
$self
=
shift
;
STDERR
" + retrieve_some("
,
$self
->{
'native_query'
},
")\n"
if
$self
->{_debug};
return
undef
if
(
$self
->{state} == SEARCH_DONE);
$self
->setup_search()
if
(
$self
->{state} == SEARCH_BEFORE);
if
(!
$self
->{
'_allow_empty_query'
})
{
if
(!
defined
(
$self
->{
'native_query'
}))
{
$self
->{response} = new HTTP::Response(500,
"query string is not defined"
);
$self
->{state} = SEARCH_DONE;
return
;
}
# if
if
(
$self
->{
'native_query'
} eq
''
)
{
$self
->{response} = new HTTP::Response(500,
"query string is empty"
);
$self
->{state} = SEARCH_DONE;
return
;
}
# if
}
# if
# got enough already?
if
(
$self
->{number_retrieved} >=
$self
->{
'maximum_to_retrieve'
})
{
$self
->{state} = SEARCH_DONE;
return
;
}
# if
# spinning our wheels?
if
(
$self
->{requests_made} >
$self
->{
'maximum_to_retrieve'
}) {
$self
->{state} = SEARCH_DONE;
return
;
}
# if
# need more results
my
$res
=
$self
->native_retrieve_some() || 0;
STDERR
" + native_retrieve_some() returned $res\n"
if
$self
->{_debug};
$self
->{requests_made}++;
$self
->{number_retrieved} +=
$res
;
$self
->{state} = SEARCH_DONE
if
(
$res
== 0);
return
$res
;
}
# retrieve_some
sub
HTML::TreeBuilder::www_search_reset
{
# If a reset() method becomes available in HTML::TreeBuilder, we
# won't need this any more.
my
$self
=
shift
;
$self
->
delete
;
# These 4 lines copied from HTML::TreeBuilder::new
$self
->{
'_head'
} =
$self
->insert_element(
'head'
,1);
$self
->{
'_pos'
} =
undef
;
# pull it back up
$self
->{
'_body'
} =
$self
->insert_element(
'body'
,1);
$self
->{
'_pos'
} =
undef
;
# pull it back up again
}
# HTML::TreeBuilder::www_search_reset
=head2 native_retrieve_some (PRIVATE)
Fetch the next page of results from the web engine, parse the results,
and prepare for the next page of results.
If a backend defines this method, it is in total control of the WWW
fetch, parsing, and preparing for the next page of results. See the
WWW::Search::AltaVista module for example usage of the
native_retrieve_some method.
An easier way to achieve this is to inherit native_retrieve_some from
WWW::Search, and do only the parsing in the backend code. Simply
define a method parse_tree which takes one argument, an
HTML::TreeBuilder object, and returns an integer, the number of
results found on this page. See the WWW::Search::Yahoo module for
example usage of the parse_tree method.
A backend should, in general, define either parse_tree() or
native_retrieve_some(), but not both.
Additional features of the default native_retrieve_some method:
Sets $self->{_prev_url} to the URL of the page just retrieved.
Calls $self->preprocess_results_page() on the raw HTML of the page.
Then, parses the page with an HTML::TreeBuilder object and passes that
populated object to $self->parse_tree().
Additional notes on using the parse_tree method:
The built-in HTML::TreeBuilder object used to parse the page has
store_comments turned ON. If a backend needs to use a subclassed or
modified HTML::TreeBuilder object, the backend should set
$self->{'_treebuilder'} to that object before any results are
retrieved. The best place to do this is at the end of
native_setup_search.
my $oTree = new myTreeBuilder;
$oTree->store_pis(1); # for example
$self->{'_treebuilder'} = $oTree;
When parse_tree() is called, the $self->next_url is cleared.
During parsing, the backend should set $self->next_url to the appropriate URL for the next page of results.
(If parse_tree() does not set the value, the search will end after parsing this page of results.)
When parse_tree() is called, the URL for the page being parsed can be
found in $self->{_prev_url}.
=cut
sub
native_retrieve_some
{
my
(
$self
) =
@_
;
# printf STDERR (" + %s::native_retrieve_some()\n", __PACKAGE__) 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 one page of results:
STDERR
" + submitting URL ("
,
$self
->{
'_next_url'
},
")\n"
if
$self
->{_debug};
my
$response
=
$self
->http_request(
$self
->http_method,
$self
->{
'_next_url'
});
STDERR
" + got response\n"
,
$response
->headers->as_string,
"\n"
if
2 <=
$self
->{_debug};
$self
->{_prev_url} =
$self
->{_next_url};
# Assume there are no more results, unless we find out otherwise
# when we parse the html:
$self
->{_next_url} =
undef
;
$self
->{response} =
$response
;
# print STDERR " --- HTTP response is:\n", $response->as_string if 4 < $self->{_debug};
if
(!
$response
->is_success)
{
if
(
$self
->{_debug})
{
STDERR
" --- HTTP request failed, response is:\n"
,
$response
->as_string;
}
# if
return
undef
;
}
# if
# Pre-process the output:
my
$sPage
=
$self
->preprocess_results_page(
$response
->content);
# Parse the output:
my
$tree
;
if
(
ref
$self
->{
'_treebuilder'
})
{
# print STDERR " + using existing _treebuilder\n" if 1 < $self->{_debug};
# Assume that the backend has installed their own TreeBuilder
$tree
=
$self
->{
'_treebuilder'
};
}
else
{
# print STDERR " + creating new _treebuilder\n" if 1 < $self->{_debug};
$tree
= HTML::TreeBuilder->new(
# use all default options
);
$tree
->store_comments(
'yes'
);
$self
->{
'_treebuilder'
} =
$tree
;
}
# If a reset() method becomes available in HTML::TreeBuilder, we can
# change this:
$tree
->www_search_reset;
# print STDERR " + parsing content, tree is ", Dumper(\$tree) if 1 < $self->{_debug};
$tree
->parse(
$sPage
);
# print STDERR " + done parsing content.\n" if 1 < $self->{_debug};
$tree
->
eof
();
# print STDERR " + calling parse_tree...\n" if 1 < $self->{_debug};
return
$self
->parse_tree(
$tree
);
}
# native_retrieve_some
=head2 preprocess_results_page (PRIVATE)
A filter on the raw HTML of the results page.
This allows the backend to alter the HTML before it is parsed,
such as to correct for known problems, HTML that can not be parsed correctly, etc.
Takes one argument, a string (the HTML webpage);
returns one string (the same HTML, modified).
This method is called from within native_retrieve_some (above)
before the HTML of the page is parsed.
See the WWW::Search::Ebay distribution 2.07 or higher for example
usage.
=cut
sub
preprocess_results_page
{
# Here is just a stub. Return our argument(s) without modification.
my
$self
=
shift
;
@_
;
}
# preprocess_results_page
=head2 test_cases (deprecated)
Deprecated.
Returns the value of the $TEST_CASES variable of the backend engine.
=cut
sub
test_cases
{
my
$self
=
shift
;
return
eval
'$'
.
ref
(
$self
).
'::TEST_CASES'
;
}
# test_cases
=head1 IMPLEMENTING NEW BACKENDS
C<WWW::Search> supports backends to separate search engines. Each
backend is implemented as a subclass of C<WWW::Search>.
L<WWW::Search::Yahoo> provides a good sample backend.
A backend must have the routine C<native_setup_search>. A backend
must have the routine C<native_retrieve_some> or C<parse_tree>.
C<native_setup_search> is invoked before the search. It is passed a
single argument: the escaped, native version of the query.
C<native_retrieve_some> is the core of a backend. It will be called
periodically to fetch URLs. It should retrieve several hits from the
search service and add them to the cache. It should return the number
of hits found, or undef when there are no more hits.
Internally, C<native_retrieve_some> typically sends an HTTP request to
the search service, parses the HTML, extracts the links and
descriptions, then saves the URL for the next page of results. See
the code for the C<WWW::Search::AltaVista> module for an example.
Alternatively, a backend can define the method C<parse_tree> instead
of C<native_retrieve_some>. See the C<WWW::Search::Ebay> module for a
good example.
If you implement a new backend, please let the authors know.
=head1 BUGS AND DESIRED FEATURES
The bugs are there for you to find (some people call them Easter Eggs).
Desired features:
=over 4
=item A portable query language.
A portable language would easily allow you to move queries easily
between different search engines. A query abstraction is non-trivial
and unfortunately will not be done anytime soon by the current
maintainers. If you want to take a shot at it, please let me know.
=back
=head1 AUTHOR
C<WWW::Search> was written by John Heidemann, C<johnh@isi.edu>.
C<WWW::Search> is currently maintained by Martin Thurn, C<mthurn@cpan.org>.
backends and applications for WWW::Search were originally written by
John Heidemann,
Wm. L. Scheding,
Cesare Feroldi de Rosa,
and
GLen Pringle.
=head1 COPYRIGHT
Copyright (c) 1996 University of Southern California.
All rights reserved.
Redistribution and use in source and binary forms are permitted
provided that the above copyright notice and this paragraph are
duplicated in all such forms and that any documentation, advertising
materials, and other materials related to such distribution and use
acknowledge that the software was developed by the University of
Southern California, Information Sciences Institute. The name of the
University may not be used to endorse or promote products derived from
this software without specific prior written permission.
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
1;