File Coverage

blib/lib/URI/ParseSearchString/More.pm

Criterion	Covered	Total	%
statement	119	136	87.5
branch	20	32	62.5
condition	1	6	16.6
subroutine	21	23	91.3
pod	8	8	100.0
total	169	205	82.4

use warnings;
use strict;

package URI::ParseSearchString::More;
our $VERSION = '0.18';
use base qw( URI::ParseSearchString );

use List::Compare        ();
use LWP::Protocol::https ();
use Params::Validate qw( validate SCALAR );
use Try::Tiny qw( catch try );
use URI ();
use URI::Heuristic qw(uf_uristr);
use URI::QueryParam        ();
use WWW::Mechanize::Cached ();

my %search_regex = (
    answers => [qr{(.*)}],
    aol     => [qr{(.*) - AOL Search Results}],
    as      => [qr{Starware (.*) Search Results}],
    dogpile => [qr{(.*) - Dogpile Web Search}],
);

my %url_regex = (
    answers => qr{answers.yahoo.com},
    aol     => qr{aol.com/(?:aol|aolcom)/search\?encquery=},
    as      => qr{as.\w+.com/dp/search\?x=},
    dogpile => qr{http://www.dogpile},
);

# local.yahoo.com should come before Yahoo as it has different
# params
# ie. this list is for ordering some of the engines in the regex.  if an
# engine has no reason to be at a certain point in the list, it should
# just be listed in the %query_lookup table

my @engines = (
    'local.google',       'maps.google',
    'googlesyndication',  'google',
    'local.yahoo.com',    'search.yahoo.com',
    'shopping.yahoo.com', 'yahoo',
    'alltheweb.com',      'errors.aol.com',
    'sucheaol.aol.de',    'aol',
    'ask.*',              'fastbrowsersearch.com',
    'as.*.com',           'att.net',
    'trustedsearch.com',
);

my %query_lookup = (

    'abcsok.no'                   => ['q'],
    'about.com'                   => ['terms'],
    'alltheweb.com'               => ['q'],
    'answers.com'                 => ['s'],
    'aol'                         => [ 'query', 'q' ],
    'as.*.com'                    => ['qry'],
    'ask.*'                       => ['q'],
    'att.net'                     => [ 'qry', 'q' ],
    'baidu.com'                   => ['bs'],
    'bing.com'                    => ['q'],
    'blingo.com'                  => ['q'],
    'citysearch.com'              => ['query'],
    'clicknow.org.uk'             => ['q'],
    'clusty.com'                  => ['query'],
    'comcast.net'                 => [ 'query', 'q' ],
    'cuil.com'                    => ['q'],
    'danielsearch.info'           => ['q'],
    'devilfinder.com'             => ['q'],
    'ebay'                        => ['satitle'],
    'education.yahoo.com'         => ['p'],
    'errors.aol.com'              => ['host'],
    'excite'                      => ['search'],
    'ez4search.com'               => ['searchname'],
    'fastbrowsersearch.com'       => ['q'],
    'fedstats.com'                => ['s'],
    'find.copernic.com'           => ['query'],
    'finna.is'                    => ['query'],
    'googlesyndication'           => [ 'q', 'ref', 'loc' ],
    'google'                      => [ 'q', 'as_q' ],
    'googel'                      => ['q'],
    'hotbot.lycos.com'            => ['query'],
    'isearch.com'                 => ['Terms'],
    'local.google'                => [ 'q', 'near' ],
    'local.yahoo.com'             => [ 'stx', 'csz' ],
    'looksmart.com'               => ['key'],
    'lycos'                       => ['query'],
    'maps.google'                 => [ 'q', 'near' ],
    'msntv.msn.com'               => ['q'],
    'munky.com'                   => ['term'],
    'mysearch.com'                => ['searchfor'],
    'mywebsearch.com'             => ['searchfor'],
    'mytelus.com'                 => ['q'],
    'netscape.com'                => ['query'],
    'nextag.com'                  => ['search'],
    'overture.com'                => ['Keywords'],
    'pricescan.com'               => ['SearchString'],
    'reviews.search.com'          => ['q'],
    'search.com'                  => ['q'],
    'searchalot.com'              => ['q'],
    'searchfusion.com'            => ['t'],
    'searchon.ca'                 => ['Terms'],
    'search.cnn.com'              => ['query'],
    'search.bearshare.com'        => ['q'],
    'search.comcast.net'          => ['q'],
    'search.dmoz.org'             => ['search'],
    'search.earthlink.net'        => ['q'],
    'search.findsall.info'        => ['s'],
    'search.freeserve.com'        => ['q'],
    'search.freeze.com'           => ['Keywords'],
    'search.go.com'               => ['search'],
    qr/search\d?.incredimail.com/ => ['q'],
    'search.juno.com'             => ['query'],
    'search.iol.ie'               => ['q'],
    'search.live.com'             => ['q'],
    'search.netzero.net'          => ['query'],
    'search.*.msn.'               => ['q'],
    'search.myway.com'            => ['searchfor'],
    'search.opera.com'            => ['search'],
    'search.rogers.com'           => [ 'qf', 'qo' ],
    'search.rr.com'               => ['qs'],
    'search.start.co.il'          => ['q'],
    'search.starware.com'         => ['qry'],
    'search.sympatico.msn.ca'     => ['q'],
    'search.sweetim.com'          => ['q'],
    'search.usatoday.com'         => ['kw'],
    'search.virgilio.it'          => ['qs'],
    'search.wanadoo.co.uk'        => ['q'],
    'search.yahoo.com'            => [ 'q', 'va', 'p' ],
    'searchservice.myspace.com'   => ['qry'],
    'shopping.yahoo.com'          => ['p'],
    'start.shaw.ca'               => ['q'],
    'startgoogle.startpagina.nl'  => ['q'],
    'stumbleupon.com'             => ['url'],
    'sucheaol.aol.de'             => ['q'],
    'teoma.com'                   => ['q'],
    'toronto.com'                 => ['query'],
    'trustedsearch.net'           => ['w'],
    'trustedsearch.com'           => ['w'],
    'yahoo'                       => ['p'],
    'yandex.ru'                   => ['text'],
    'youtube.com'                 => ['search_query'],
    'websearch.cbc.ca'            => ['query'],
    'websearch.cs.com'            => ['query'],
    'webtv.net'                   => ['q'],
    'www.bestsearchonearth.info'  => ['Keywords'],
    'www.boat.com'                => ['HotKeysTopCategory'],
    'www.factbites.com'           => ['kp'],
    'www.mweb.co.za'              => ['q'],
    'www.rr.com/html/search.cfm'  => ['query'],
    'www.wotbox.com'              => ['q'],
);

sub parse_search_string {
    my $self = shift;
    my $url  = shift;

    foreach my $engine ( keys %url_regex ) {

        if ( $url =~ $url_regex{$engine} ) {

            # fix funky URLs
            $url = uf_uristr($url);

            my $mech = $self->get_mech();

            try { $mech->get($url); }
            catch {
                warn "Issue with url: $url";
                warn $_;
            };

            if ( $mech->status && $mech->status == 403 ) {
                warn "403 returned for $url  Are you being blocked?";
            }

            if ( $mech->title() ) {
                my $search_term = $self->_apply_regex(
                    string => $mech->title(),
                    engine => $engine,
                );

                if ($search_term) {
                    $self->{'more'}->{'blame'} = __PACKAGE__;
                    return $search_term;
                }
            }
        }
    }

    my $terms = $self->parse_more($url);

    if ($terms) {
        $self->{'more'}->{'blame'} = __PACKAGE__;
        return $terms;
    }

    # We've come up empty.  Let's see what the superclass can do
    $self->{'more'}->{'blame'} = 'URI::ParseSearchString';
    return $self->SUPER::parse_search_string( $url, @_ );
}

sub se_term {
    my $self = shift;
    return $self->parse_search_string(@_);
}

sub parse_more {
    my $self = shift;
    my $url  = shift;

    die 'you need to supply at least one argument' unless $url;

    $self->{'more'} = undef;
    $self->{'more'}->{'string'} = $url;

    my $regex = join ' | ', $self->_get_engines;
    $self->{'more'}->{'regex'} = $regex;
    $self->{'more'}->{'url'}   = $url;

    if ( $url =~ m{ ( (?: $regex ) .* ?/ ) .* ?\? (.*)\z }xms ) {

        my $domain = $1;

        # remove trailing slash
        $domain =~ s{/\z}{};

        my @param_parts = ();
        my %params      = ();

        my $uri = URI->new($url);

    ENGINE:
        foreach my $engine ( $self->_get_engines ) {

            if ( $domain =~ /$engine/i ) {

                my @names = @{ $query_lookup{$engine} };

                $self->{'more'}->{'domain'} = $domain;
                $self->{'more'}->{'names'}  = \@names;

                foreach my $name (@names) {
                    push @param_parts, $uri->query_param($name);
                    $params{$name} = $uri->query_param($name);
                }

                last ENGINE;
            }
        }

        my $params = join( q{ }, @param_parts );
        my $orig_domain = $domain;
        $domain =~ s/\/.*//g;
        unless ( $domain =~ /\w/ ) {
            $domain = $orig_domain;
        }

        $self->{'more'}->{'terms'}  = \@param_parts;
        $self->{'more'}->{'params'} = \%params;

        return $params;
    }

    return;
}

sub blame {
    my $self = shift;
    return $self->{more}->{blame};
}

sub guess {
    my $self = shift;
    my $url = shift || $self->{'more'}->{'string'};

    my @guesses = ( 'q', 'query', 'searchfor' );

    my $uri = URI->new($url);
    if ( $uri->query_params ) {

        foreach my $guess (@guesses) {
            if ( $uri->query_param($guess) ) {
                return $uri->query_param($guess);
            }
        }
    }

    return;
}

sub set_cached {
    my $self   = shift;
    my $switch = shift;

    if ($switch) {
        $self->{'__more_cached'} = 1;
    }
    else {
        $self->{'__more_cached'} = 0;
    }

    return $self->{'__more_cached'};
}

sub get_cached {
    my $self = shift;

    return $self->{'__more_cached'};
}

sub get_mech {
    my $self  = shift;
    my $cache = $self->get_cached;

    if ($cache) {

        if ( !exists $self->{'__more_mech_cached'} ) {

            my $mech = WWW::Mechanize::Cached->new();
            $mech->agent('URI::ParseSearchString::More');
            $self->{'__more_mech_cached'} = $mech;

        }

        return $self->{'__more_mech_cached'};

    }

    # return a non-caching object
    if ( !exists $self->{'__more_mech'} ) {

        my $mech = WWW::Mechanize->new();
        $mech->agent('URI::ParseSearchString::More');
        $self->{'__more_mech'} = $mech;

    }

    return $self->{'__more_mech'};
}

sub _apply_regex {
    my $self  = shift;
    my %rules = (
        string => { type => SCALAR },
        engine => { type => SCALAR },
    );

    my %args = validate( @_, \%rules );

    foreach my $regex ( @{ $search_regex{ $args{'engine'} } } ) {
        if ( $args{'string'} =~ $regex ) {
            return $1;
        }
    }
    return;
}

sub _get_engines {
    my $lc = List::Compare->new( \@engines, [ keys %query_lookup ] );
    my @remaining_engines = $lc->get_complement;

    my @all_engines = @engines;
    push @all_engines, @remaining_engines;

    return @all_engines;
}

1;

# ABSTRACT: Extract search strings from more referrers.

__END__