search.pm

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

 de  =>  'German',
 el  =>  'Greek',
 he  =>  'Hebrew',
 hu  =>  'Hungarian',
 is  =>  'Icelandic',
 it  =>  'Italian',
 ja  =>  'Japanese',
 ko  =>  'Korean',
 lv  =>  'Latvian',
 lt  =>  'Lithuanian',
 no  =>  'Norwegian',
 fa  =>  'Persian',
 pl  =>  'Polish',
 pt  =>  'Portuguese',
 ro  =>  'Romanian',
 ru  =>  'Russian',
 sk  =>  'Slovak',
 sl  =>  'Slovenian',
 es  =>  'Spanish',
 sv  =>  'Swedish',
 th  =>  'Thai',
 tr  =>  'Turkish',
);

our %KnownCountry =
(
 default => "any/all countries",

 ar => 'Argentina',
 au => 'Australia',
 at => 'Austria',
 be => 'Belgium',
 br => 'Brazil',
 ca => 'Canada',
 cn => 'China',
 cz => 'Czech Republic',
 dk => 'Denmark',
 fi => 'Finland',
 fr => 'France',
 de => 'Germany',
 it => 'Italy',
 jp => 'Japan',
 kr => 'Korea',
 nl => 'Netherlands',
 no => 'Norway',
 pl => 'Poland',
 rf => 'Russian Federation',
 es => 'Spain',
 se => 'Sweden',
 ch => 'Switzerland',
 tw => 'Taiwan',
 uk => 'United Kingdom',
 us => 'United States',
);


##
## Mapping from arg name to value validation routine.
##
my %ValidateRoutine =
(
 Count        => $allow_positive_integer,
 Start        => $allow_nonnegative_integer,

 Radius       => $allow_positive_float,

 AllowAdult   => $allow_boolean,
 AllowSimilar => $allow_boolean,

 Context      => $allow_any,

 Street       => $allow_any,
 City         => $allow_any,
 State        => $allow_any,
 Location     => $allow_any,
 Lat          => $allow_float,
 Long         => $allow_float,

 PostalCode   => $allow_postal_code,
 Language     => $allow_language_code,
 Country      => $allow_country_code,

 Mode      => sub { $allow_from_hash->(0, $Config{$_[0]}->{AllowedMode}, @_) },
 Sort      => sub { $allow_from_hash->(0, $Config{$_[0]}->{AllowedSort}, @_) },
 Type      => sub { $allow_from_hash->(0, $Config{$_[0]}->{AllowedType}, @_) },
 License   => sub { $allow_from_hash->(1, $Config{$_[0]}->{AllowedLicense}, @_) },
 Color     => sub { $allow_from_hash->(0, $Config{$_[0]}->{Color}, @_) },

 Debug        => $allow_any,
 AutoContinue => $allow_boolean,
 AutoCarp     => $allow_boolean,

 AppId        => $allow_appid,

 PreRequestCallback => $allow_coderef,
);

##
## returns ($newvalue, $error);
##
sub _validate($$$;$)
{
    my $global   = shift; # true if for a global setting
    my $space    = shift; # Doc, Image, etc.
    my $key      = shift; # "Count", "State", etc.
    my $have_val = @_ ? 1 : 0;
    my $val      = shift;

    if (not $ValidateRoutine{$key}) {
        return (undef, "unknown argument '$key'");
    }

    if (not $global and $key eq 'AutoCarp') {
        return (undef, "AutoCarp is a global setting which can not be used in this context");
    }

    if (not $have_val) {
        return (1);
    }

    my ($valid, $newval) = $ValidateRoutine{$key}->($space, $val);

    if ($valid) {
        return ($newval, undef);
    }

    my $expected = $ValidateRoutine{$key}->($space);
    if ($space) {
        return (undef, "invalid value \"$val\" for $space\'s \"$key\" argument, expected: $expected");
    } else {
        return (undef, "invalid value \"$val\" for \"$key\" argument, expected: $expected");
    }
}


##
## 'import' accepts key/value pairs:
##
sub import
{
    my $class = shift;

    if (@_ % 2 != 0) {
        Carp::confess("bad number of args to 'use $class'");
    }
    my %Args = @_;

    while (my ($key, $val) = each %Args)
    {
        my ($newval, $error) = _validate(1, undef, $key, $val);
        if ($error) {
            Carp::confess("$error, in 'use $class'");
        } else {
            $GlobalDefault{$key} = $newval;
        }
    }
}


##
## Get (or set) one of the default global values. They can be set this way
## (either as Yahoo::Search->Default or $SearchEngine->Default), or via
## Yahoo::Search->new(), or on the 'use' line.
##
## When used with a $SearchEngine object, the value returned is the value
## in effect, which is the global one if the $SearchEngine does not have
## one itself.
##
sub Default
{
    my $class_or_obj = shift; # Yahoo::Search->Default or $SearchEngine->Default
    my $key          = shift;
    my $have_val     = @_ ? 1 : 0;
    my $val          = shift;

    my $global = not ref $class_or_obj;

    my $old;
    if ($global or not exists $class_or_obj->{$key}) {
        $old = $GlobalDefault{$key};
    } else {
        $old = $class_or_obj->{$key};
    }

    if ($have_val)
    {
        my ($newval, $error) = _validate($global, undef, $key, $val);
        if ($error) {
            return _carp_on_error($error);
        }

        if (ref $class_or_obj) {
            $class_or_obj->{$key} = $newval;
        } else {
            $GlobalDefault{$key} = $newval;
        }
    }
    else
    {
        my ($okay, $error) = _validate($global, undef, $key);
        if ($error) {
            return _carp_on_error($error);
        }
    }

    return $old;
}



##
## Maps Yahoo::Search->Query arguments to Y! API parameters.
##
my %ArgToParam =
(
 AllowAdult   => 'adult_ok',
 AllowSimilar => 'similar_ok',
 AppId        => 'appid',
 City         => 'city',
 Context      => 'context',
 Count        => 'results',
 Country      => 'country',
 Color        => 'coloration',
 Language     => 'language',
 Lat          => 'latitude',
 License      => 'license',
 Location     => 'location',
 Long         => 'longitude',
 Mode         => 'type',
 PostalCode   => 'zip',
 Radius       => 'radius',
 Sort         => 'sort',
 Start        => 'start',
 State        => 'state',
 Street       => 'street',
 Type         => 'format',
);


##
## The search-engine constructor.
##
## No args are needed, but any of %ValidateRoutine keys except AutoCarp are
## allowed (they'll be used as the defaults when queries are later
## constructed via this object).
##
sub new
{
    my $class = shift;

    if (@_ % 2 != 0) {
        return _carp_on_error("wrong arg count to $class->new");
    }

    my $SearchEngine = { @_ };

    for my $key (keys %$SearchEngine)
    {
        my ($newval, $error)  = _validate(0, undef, $key, $SearchEngine->{$key});
        if ($error) {
            return _carp_on_error("$error, in call to $class->new");
        }
        $SearchEngine->{$key} = $newval;
    }

    return bless $SearchEngine, $class;
}

##
## Request method (can also be called like a constructor).
## Specs to a specific query are provided, and a Request object is returned.
##
sub Request
{
    my $SearchEngine = shift; # self
    my $SearchSpace  = shift; # "Doc", "Image", "News", etc..
    my $QueryText    = shift; # "Briteny", "egregious compensation semel", etc.

    if (@_ % 2 != 0) {
        return _carp_on_error("wrong arg count");
    }

    my %Args = @_;

    if (not defined $SearchSpace or not $Config{$SearchSpace}) {
        my $list = join '|', sort keys %Config;
        return _carp_on_error("bad search-space identifier, expecting one of: $list");
    }

    ##
    ## Ensure that required args are there
    ##
    if (my $ref = $Config{$SearchSpace}->{Required})
    {
        for my $arg (keys %$ref)
        {
            if (not defined($Args{$arg}) or not length($Args{$arg})) {
                return _carp_on_error("argument '$arg' required");
            }
        }
    }


    ##
    ## %Param holds the key/vals we'll send in the request to Yahoo!
    ##
    my %Param;

    ##
    ## Special case for some searches: query not required
    ##
    if (not defined($QueryText) or length($QueryText) == 0)
    {
        if ($Args{Context} and $Config{$SearchSpace}->{QueryOptional}) {
            ## query text not required
        } else {
            return _carp_on_error("missing query");
        }
    }
    else
    {
        ## normal query
        $Param{query} = $QueryText;
    }


    ##
    ## This can be called as a constructor -- if so, $SearchEngine will be
    ## the class name, and we'll want to turn into an object.
    ##
    if (not ref $SearchEngine) {
        $SearchEngine = $SearchEngine->new();
    }

    my %OtherRequestArgs;

    ##
    ## Go through most allowed args, taking the value from this call's arg
    ## list if provided, from the defaults that were registered with the
    ## SearchEngine, or failing those, the defaults for this type of query.
    ##
    for my $key (keys %{ $Config{$SearchSpace}->{Defaults} }, @ExtraQueryArgs)
    {
        ##
        ## Isolate the value we'll use for this request: from our args,
        ## from the defaults registered with the search-engine, or from
        ## the search-space defaults.
        ##
        my $val;
        if (exists $Args{$key}) {
            $val = delete $Args{$key};
        } elsif (exists $SearchEngine->{$key}) {
            $val = $SearchEngine->{$key};
        } elsif (exists $GlobalDefault{$key}) {
            $val = $GlobalDefault{$key};
        } elsif (exists $Config{$SearchSpace}->{Defaults}->{$key}) {
            $val = $Config{$SearchSpace}->{Defaults}->{$key};
        } else {
            $val = undef;
        }

        if (defined $val)
        {
            my ($newval, $error) = _validate(0, $SearchSpace, $key, $val);

            if ($error) {
                return _carp_on_error($error);
            }

            if (my $param = $ArgToParam{$key}) {
                $Param{$param} = $newval;
            } else {
                $OtherRequestArgs{$key} = $newval;
            }
        }
    }

    ##
    ## Any leftover args are bad
    ##
    if (%Args) {
        my $list = join(', ', keys %Args);
        return _carp_on_error("unknown args for '$SearchSpace' query: $list");
    }

    ##
    ## An AppId is required for all calls
    ##
    if (not $Param{'appid'})
    {
        return _carp_on_error("an AppId is required -- please make one up");
    }

    ##
    ## Do some special per-arg-type processing
    ##

    ##
    ## If we're doing a Doc context search, be sure to use the proper
    ## action url
    ##
    my $ActionUrl = $Config{$SearchSpace}->{Url};

    if ($Param{context} and $Config{$SearchSpace}->{ContextUrl}) {
        $ActionUrl = $Config{$SearchSpace}->{ContextUrl};
    }

    ##
    ## Ensure that the Count, if given, is not over max
    ##
    if (defined $Param{count} and $Param{count} > $Config{$SearchSpace}->{MaxCount}) {
        return _carp_on_error("maximum allowed Count for a $SearchSpace search is $Config{$SearchSpace}->{MaxCount}");
    }

    ##
    ## If License is given, it an have multiple values (space, comma, or
    ## plus-separated).
    ##
    if ($Param{license}) {
        $Param{license} = [ split /[+,\s]+/, $Param{license} ];
    }

    ##
    ## In Perl universe, Start is 0-based, but the Y! API's "start" is 1-based.
    ##
    $Param{start}++;

    # 'Local' has special required parameters
    if ($SearchSpace eq 'Local'
        and not
        ## the following are the allowed parameter sets... if one is there,
        ## we're okay
        ($Param{location}
         or
         $Param{'zip'}
         or
         ($Param{'state'} and $Param{'city'})
         or
         (defined($Param{'latitude'}) and defined($Param{'longitude'}))
        ))
    {
        ##
        ## The diff between $Param{} references in the if() above, and
        ## the arg names in the error below, is the %ArgToParam mapping
        ##
        return _carp_on_error("a 'Local' query must have at least Lat+Long, Location, PostalCode, or City+State");
    }

    ##
    ## Okay, we have everything we need to make a specific request object.
    ## Make it and return.
    ##
    return Yahoo::Search::Request->new(
                                       SearchEngine => $SearchEngine,
                                       Space  => $SearchSpace,
                                       Action => $ActionUrl,
                                       Params => \%Param,
                                       %OtherRequestArgs,
                                      );
}

##
## A way to bypass an explicit Request object, jumping from a SearchEngine
## (or nothing) directly to a Response object.
##
sub Query
{
    my $SearchEngine = shift;
    ##
    ## Can be called as a constructor -- if so, $SearchEngine will be the
    ## class name
    ##
    if (not ref $SearchEngine) {
        $SearchEngine = $SearchEngine->new();
    }

    if (my $Request = $SearchEngine->Request(@_)) {
        return $Request->Fetch();
    } else {
        # $@ already set
        return ();
    }
}


##
## A way to bypass explicit Request and Response objects, jumping from a
## SearchEngine (or nothing) directly to a list of Result objects.
##
sub Results
{
    my $Response = Query(@_);

    if (not $Response) {
        # $@ already set
        return ();
    }
    return $Response->Results;
}

##
## A way to bypass explicit Request and Response objects, jumping from a
## SearchEngine (or nothing) directly to a list of links.
##
sub Links
{
    return map { $_->Link } Results(@_);
}


##
## A way to bypass explicit Request and Response objects, jumping from a
## SearchEngine (or nothing) directly to a bunch of html results.
##
sub HtmlResults
{
    return map { $_->as_html } Results(@_);
}

##
## A way to bypass explicit Request and Response objects, jumping from a
## SearchEngine (or nothing) directly to a list of terms
## (For Spell, Related, and Terms searches)
##
sub Terms
{
    return map { $_->Term } Results(@_);
}


sub MaxCount
{
    if (@_) {
        ##
        ## We'll use only the last arg -- it can be called as either
        ## Yahoo::Search::MaxCount($SearchSpace) or
        ## Yahoo:Search->MaxCount($SearchSpace) and we don't care which.
        ## In either case, the final arg is the search space.
        ##
        my $SearchSpace = $_[-1];
        if ($Config{$SearchSpace} and $Config{$SearchSpace}->{MaxCount}) {
            return $Config{$SearchSpace}->{MaxCount};
        }
    }
    return (); # bad/missing arg
}