/usr/share/perl5/WWW/Search/Simple.pm is in libwww-search-perl 2.51.30-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | package WWW::Search::Simple;
use strict;
use warnings;
=head1 NAME
WWW::Search::Simple - class for searching any web site
=head1 SYNOPSIS
require WWW::Search;
$search = new WWW::Search('Simple');
=head1 DESCRIPTION
This class is a specialization of WWW::Search for simple web based
search indices. It extracts all links from a given page.
This class exports no public interface; all interaction should be done
through WWW::Search objects.
Note that this module will probably get a lot of false hits.
=head1 AUTHOR
C<WWW::Search::Simple> is written by Paul Lindner, <lindner@itu.int>
=head1 COPYRIGHT
Copyright (c) 1997,98 by the United Nations Administrative Committee
on Coordination (ACC)
All rights reserved.
=cut
use base 'WWW::Search';
use Carp ();
use HTML::TreeBuilder;
use WWW::SearchResult;
my $debug = 0;
sub _native_setup_search
{
my ($self, $native_query, $native_opt) = @_;
my ($native_url);
my ($default_native_url) = "http://www.itu.int/cgi-bin/SFgate?application=itu&database=local//usr/local/wais/WWW/www-pages&listenv=table&httppath=/usr/local/www-data/&httpprefix=/&tie=and&maxhits=%n&text=%s";
if (defined($native_opt))
{
#print "Got " . join(' ', keys(%$native_opt)) . "\n";
# Process options..
# Substitute query terms for %s...
if ($self->{'search_url'} && $native_opt->{'search_args'})
{
$native_url = $native_opt->{'search_url'} . "?" . $native_opt->{'search_args'};
} # if
} # if
$native_url = $default_native_url if (!$native_url);
$native_url =~ s/%s/$native_query/g; # Substitute search terms...
$self->user_agent();
$self->{_next_to_retrieve} = 0;
$self->{_base_url} = $self->{_next_url} = $native_url;
} # _native_setup_search
sub _native_retrieve_some
{
my ($self) = @_;
my ($hit) = ();
my ($hits_found) = 0;
# fast exit if already done
return undef if (!defined($self->{_next_url}));
# get some
print "GET " . $self->{_next_url} . "\n" if ($debug);
my($response) = $self->http_request($self->{search_method},
$self->{_next_url});
$self->{response} = $response;
if (!$response->is_success)
{
print "Some problem\n" if ($debug);
return undef;
}
my $score = 800;
my $results = $response->content();
my($h) = new HTML::TreeBuilder;
$h->parse($results);
for (@{ $h->extract_links(qw(a)) })
{
my($link, $linkelem) = @$_;
my($linkobj) = new URI::URL $link, $self->{_next_url};
print "Fixing $link\n" if ($debug);
my($hit) = new WWW::SearchResult;
$hit->add_url($linkobj->abs->as_string());
$hit->title(join(' ',@{$linkelem->content}));
$hit->score($score);
$hit->normalized_score($score);
if ($hit->title !~ /HASH\(0x/)
{
$hits_found++;
push(@{$self->{cache}}, $hit);
} # if
$score = int ($score * .95);
} # for
$self->approximate_result_count($hits_found);
$self->{_next_url} = undef;
return($hits_found);
} # _native_retrieve_some
1;
|