src/Modules/W3Search.pl

   1 # WWWSearch backend, with queries updating the is-db (optionally)
   2 # Uses WWW::Search::Google and WWW::Search
   3 # originally Google.pl, drastically altered.
   4
   5 package W3Search;
   6
   7 use strict;
   8 use vars qw(@W3Search_engines $W3Search_regex);
   9 @W3Search_engines = qw(AltaVista Dejanews Excite Gopher HotBot Infoseek
  10                 Lycos Magellan PLweb SFgate Simple Verity Google);
  11 $W3Search_regex = join '|', @W3Search_engines;
  12
  13 my $maxshow     = 3;
  14
  15 sub W3Search {
  16     my ($where, $what, $type) = @_;
  17     my $retval = "$where can't find \002$what\002";
  18
  19     return unless &::loadPerlModule("WWW::Search");
  20
  21     if (defined $type) {
  22         &::DEBUG("W3S: type => $type");
  23     }
  24
  25     my @matches = grep { lc($_) eq lc($where) ? $_ : undef } @W3Search_engines;
  26     if (@matches) {
  27         $where = shift @matches;
  28     } else {
  29         &::msg($::who, "i don't know how to check '$where'");
  30     }
  31
  32     my $Search  = new WWW::Search($where);
  33     my $Query   = WWW::Search::escape_query($what);
  34     $Search->native_query($Query,
  35 #       {
  36 #               search_debug => 2,
  37 #               search_parse_debug => 2,
  38 #       }
  39     );
  40     $Search->http_proxy($::param{'httpProxy'}) if (&::IsParam("httpProxy"));
  41     my $max = $Search->maximum_to_retrieve(10); # DOES NOT WORK.
  42
  43     my (%results, $count, $r);
  44     while ($r = $Search->next_result()) {
  45         my $url = $r->url();
  46
  47         ### TODO: fix regex.
  48         ### TODO: use array to preserve order.
  49         if ($url =~ /^http:\/\/([\w\.]*)/) {
  50             my $hostname = $1;
  51             next if (exists $results{$hostname});
  52             $results{$hostname} = $url;
  53         } else {
  54             &::DEBUG("W3S: url isn't good? ($url).");
  55         }
  56
  57         last if ++$count >= $maxshow;
  58     }
  59
  60     if (scalar keys %results) {
  61         $retval = "$where says \002$what\002 is at ".
  62                 join(' or ', map { $results{$_} } sort keys %results);
  63     }
  64
  65     &::performStrictReply($retval);
  66 }
  67
  68 1;