search.pm

Yahoo！search API. 用于搜索引擎接口

package Yahoo::Search;
use strict;
use Carp;
use Yahoo::Search::Request;

##
## This is the interface to Yahoo!'s web search API.
## Written by Jeffrey Friedl <[e-mail]>
##
## Copyright 2007 Yahoo! Inc.
##
## Master source:
##
##   http://search.cpan.org/search?mode=module&n=1&query=Yahoo::Search
##

our $VERSION = '1.10.13'; # Last num increases monotonically across all versions.
                          # See the "Changes" file (comes with the CPAN package)
                          # for version history.


##
## CLASS OVERVIEW
##
##      The main class
##        Yahoo::Search
##      begets
##        Yahoo::Search::Request
##      which begets
##        Yahoo::Search::Response
##      which begets a bunch of
##        Yahoo::Search::Result
##      which beget urls, summaries, etc.
##
## There are plenty of "convenience functions" which appear to bypass some
## of these steps as far as the user's view is concerned.
##

##
## Configuration details for each search space (Doc, Images, Video, ## etc.)...
##
my %Config =
(
  ######################################################################
  # Normal web search
  #
  Doc =>
  {
   Url        => 'http://search.yahooapis.com/WebSearchService/V1/webSearch',
   ContextUrl => 'http://search.yahooapis.com/WebSearchService/V1/contextSearch',

   MaxCount => 50,

   ## The 'Defaults' keys indicate the universe of allowable arguments,
   ## while the values are the defaults for those arguments.
   Defaults => {
                Mode         => undef,
                Context      => undef,
                Count        => 10,
                Start        => 0,
                Type         => 'any',
                AllowAdult   => 0,
                AllowSimilar => 0,
                Language     => undef,
                Country      => undef,
                License      => undef,
               },

   QueryOptional => 1,

   AllowedLicense => {
                      any           => 1, #default
                      cc_any        => 1,
                      cc_commercial => 1,
                      cc_modifiable => 1,
                        },

   AllowedMode => {
                   all    => 1,
                   any    => 1,
                   phrase => 1,
                  },

   AllowedType => {
                     all    => 1, # deprecated
                     any    => 1,

                     html   => 1,
                     msword => 1,
                     pdf    => 1,
                     ppt    => 1,
                     rss    => 1,
                     txt    => 1,
                     xls    => 1,
                    },
  },


  ######################################################################
  # Image search
  #
  Image =>
  {
   Url => 'http://search.yahooapis.com/ImageSearchService/V1/imageSearch',
   MaxCount => 50,

   Defaults => {
                Mode       => undef,
                Count      => 10,
                Start      => 0,
                Type       => 'any',
                AllowAdult => 0,
                Color      => undef,
               },

   AllowedMode => {
                   all    => 1,
                   any    => 1,
                   phrase => 1,
                  },

   AllowedType => {
                     all  => 1, # deprecated
                     any  => 1,

                     bmp  => 1,
                     gif  => 1,
                     jpeg => 1,
                     png  => 1,
                    },

   AllowedColor => {
                    any   => 1, # default
                    color => 1,
                    bw    => 1,
                   }

  },

  ######################################################################
  # Video file search
  #
  Video =>
  {
   Url => 'http://search.yahooapis.com/VideoSearchService/V1/videoSearch',

   MaxCount => 50,

   Defaults => {
                Mode       => undef,
                Count      => 10,
                Start      => 0,
                Type       => 'any',
                AllowAdult => 0,
               },

   AllowedMode => {
                   all    => 1,
                   any    => 1,
                   phrase => 1,
                  },

   AllowedType => {
                     all       => 1, # deprecated
                     any       => 1,

                     avi       => 1,
                     flash     => 1,
                     mpeg      => 1,
                     msmedia   => 1,
                     quicktime => 1,
                     realmedia => 1,
                    },
  },


  ######################################################################
  # "Y! Local" (like Yellow Pages) search
  #
  Local =>
  {
   Url => 'http://local.yahooapis.com/LocalSearchService/V1/localSearch',

   MaxCount => 20,

   Defaults => {
                Count      => 10,
                Start      => 0,
                Mode       => undef,
                Radius     => undef,
                Street     => undef,
                City       => undef,
                State      => undef,
                PostalCode => undef,
                Location   => undef,
                Lat        => undef,
                Long       => undef,
                Sort       => undef,
               },

   AllowedSort => {
                   relevance => 1,
                   distance  => 1,
                   rating    => 1,
                   title     => 1
                  }
  },


  ######################################################################
  # News search
  #
  News =>
  {
   Url => 'http://search.yahooapis.com/NewsSearchService/V1/newsSearch',

   MaxCount => 50,

   Defaults => {
                Mode     => undef,
                Count    => 10,
                Start    => 0,
                Sort     => undef,
                Language => undef,
               },

   AllowedMode => {
                   all    => 1,
                   any    => 1,
                   phrase => 1,
                  },

   AllowedSort => {
                   rank   => 1,
                   date   => 1,
                  },
  },


  Terms =>
  {
   Url => 'http://search.yahooapis.com/ContentAnalysisService/V1/termExtraction',

   Defaults => {
                Context => undef,
               },
   Required => {
                Context => 1,
               },
   QueryOptional => 1,
  },

  Spell =>
  {
   Url => 'http://search.yahooapis.com/WebSearchService/V1/spellingSuggestion',
  },

  Related =>
  {
   Url => 'http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion',
   Defaults => {
                Count => 10,
               },
  },
);

our $UseXmlSimple = $ENV{YAHOO_SEARCH_XMLSIMPLE}; ## used in Search/Request.pm
our $RecentRequestUrl; ## filled in Search/Request.pm


##
## These args are allowed for any Query()
##
my @ExtraQueryArgs = qw[AutoContinue Debug AppId];

##
## Global defaults -- this list may be modified via import()
## and Default();
##
my %GlobalDefault =
(
 ##
 ## Debug is a string with any of: url   (show the url as fetched)
 ##                                xml   (show the resulting xml)
 ##                                hash  (show the resulting hash)
 ##                                stdout (show to stdout instead of stderr)
 ## e.g. "url hash stdout"
 Debug => "",

 ##
 ## if AutoCarp is true (as it is by default), carp on programming errors
 ## (but not 404s, etc.)
 ##
 AutoCarp => 1,

 AutoContinue => 0,

 PreRequestCallback => undef,
);

##
## Helper function to set $@ and, if needed, carp.
##
sub _carp_on_error($)
{
    $@ = shift;
    if ($GlobalDefault{AutoCarp}) {
        carp $@;
    }

    return ();
}


##
## The following private subs are used to validate arguments. They are
## generally called with two args: the search space (Doc, Image, etc.), and
## the text to validate.
##
## If called without the "text to validate" arg, they return a description
## of what args are allowed (tailored to the search space, if appropriate).
##
## Otherwise, they return ($valid, $value).
##
my $allow_positive_integer = sub
{
    my $space = shift; # unused
    if (not @_) {
        return "positive integer";
    }
    my $val = shift;

    if (not $val =~ m/^\d+$/) {
        return (0); # invalid: not a number
    } elsif ($val == 0) {
        return (0); # invalid: not positive
    } else {
        return (1, $val);
    }
};

my $allow_nonnegative_integer = sub
{
    my $space = shift; # unused
    if (not @_) {
        return "non-negative integer";
    }
    my $val = shift;

    if (not $val =~ m/^\d+$/) {
        return (0); # invalid: not a number
    } else {
        return (1, $val);
    }
};

my $allow_positive_float = sub
{
    my $space = shift; # unused
    if (not @_) {
        return "positive number";
    }
    my $val = shift;

    if (not $val =~ m/^(?:  \d+(?: \.\d* )?$ | \.\d+$ )/x) {
        return (0); # invalid: not a number
    } elsif ($val == 0) {
        return (0); # invalid: not positive
    } else {
        return (1, $val);
    }
};

my $allow_float = sub
{
    my $space = shift; # unused
    if (not @_) {
        return "number";
    }
    my $val = shift;

    if (not $val =~ m/^-? (?:  \d+(?: \.\d* )?$ | \.\d+$ )/x) {
        return (0); # invalid: not a number
    } else {
        return (1, $val);
    }
};

my $allow_country_code = sub
{
    my $space = shift; # unused
    if (not @_) {
        return "country code";
    }
    my $val = shift;

    if (not $val =~ m/^(?: [a-z][a-z]$ | default$ )/x) {
        return (0); # not a country code and not "default"
    } else {
        return (1, $val);
    }
};

my $allow_language_code = sub
{
    my $space = shift; # unused
    if (not @_) {
        return "language code";
    }
    my $val = shift;

    if (not $val =~ m/^(?: [a-z][a-z][a-z]?$ | default$ )/x) {
        return (0); # not a language code and not "default"
    } else {
        return (1, $val);
    }
};


##
## This has different args than the others: it has two args ($allow_multi
## and $hashref) prepended before $space
##
my $allow_from_hash = sub
{
    my $allow_multi = shift;
    my $hashref = shift; #hash in which to check
    my $space   = shift; #unused

    if (not @_) {
        return join '|', sort keys %$hashref;
    }
    my $val = shift;

    if (not $hashref) {
        return (1, $val); # can't tell, so say it's valid
    }

    if (not defined($val) or not length($val))
    {
        return (0); # not valid
    }

    if (not $allow_multi)
    {
        if ($hashref->{$val}) {
            return (1, $val); # is specifically valid
        } else {
            return (0); # not valid
        }
    }
    else
    {
        my @items = split /[+,\s]+/, $val;
        if (not @items) {
            return (0); # not valid
        }

        for my $item (@items)
        {
            if (not $hashref->{$item}) {
                return (0); # not valid
            }
        }
        return (1, $val); # valid
    }
};

my $allow_boolean = sub
{
    my $space = shift; #unused
    if (not @_) {
        return "true or false";
    }
    my $val = shift;
    return (1, $val ? 1 : 0);
};

my $allow_any = sub
{
    my $space = shift; #unused
    if (not @_) {
        return "any value";
    }
    my $val = shift;
    return (1, $val);
};

my $allow_postal_code = sub
{
    my $space = shift; #unused
    ## only U.S. Zone Improvement Program codes allowed
    if (not @_) {
        return "a US ZIP code"
    }

    my $val = shift;
    if ($val =~ m/^\d\d\d\d\d(?:-?\d\d\d\d)?$/) {
        return (1, $val);
    } else {
        return (0);
    }
};

my $allow_coderef = sub
{
    my $space = shift; #unused
    my $val = shift;
    if (ref($val) eq 'CODE') {
        return (1, $val);
    } else {
        return (0);
    }
};

my $allow_appid = sub
{
    my $space = shift; #unused

    if (not @_) {
        return "something which matches /^[- A-Za-z0-9_()[\\]*+=,.:\@\\\\]{8,}\$/";
    }

    my $val = shift;
    if ($val =~ m/^[- A-Za-z0-9_()\[\]*+=,.:\@\\]{8,}$/) {
        return (1, $val);
    } else {
        return (0);
    }
};

our %KnownLanguage =
(
 default => 'any/all languages',

 ar  =>  'Arabic',
 bg  =>  'Bulgarian',
 ca  =>  'Catalan',
 szh =>  'Chinese (simplified)',
 tzh =>  'Chinese (traditional)',
 hr  =>  'Croatian',
 cs  =>  'Czech',
 da  =>  'Danish',
 nl  =>  'Dutch',
 en  =>  'English',
 et  =>  'Estonian',
 fi  =>  'Finnish',
 fr  =>  'French',