WWW-Search-Yahoo-2.415/0000755000175600010010000000000011177076260013406 5ustar MartinNoneWWW-Search-Yahoo-2.415/Changes0000755000175600010010000002314410772433167014713 0ustar MartinNone2008-03-26 * lib/WWW/Search/Yahoo/Japan/News.pm: removed to its own distribution 2008-03-25 * lib/WWW/Search/Yahoo.pm (_result_list_items): new private method 2008-03-23 * lib/WWW/Search/Yahoo/China.pm: removed to its own distribution 2007-07-02 * Yahoo/TV/Echostar.pm: removed because Yahoo does not provide TV listings search any more 2007-04-21 * lib/WWW/Search/Yahoo/News/Advanced.pm (native_setup_search): overhauled for new Yahoo web page format 2007-04-16 * lib/WWW/Search/Yahoo/Japan/News.pm (parse_tree): fixed for new page format * lib/WWW/Search/Yahoo/China.pm (parse_details): fixed for new page format * lib/WWW/Search/Yahoo.pm (parse_details): new sub-class-able method 2007-04-14 * lib/WWW/Search/Yahoo/News/Advanced.pm (parse_tree): fixed for new page format 2007-04-01 * lib/WWW/Search/Yahoo/China.pm (_result_list_tags): fix for new results page format 2007-03-28 * lib/WWW/Search/Yahoo.pm (parse_tree): don't return Yahoo links 2006-05-01 * lib/WWW/Search/Yahoo/China.pm (_result_list_tags): FIX for returning yahoo links as results * lib/WWW/Search/Yahoo/DE.pm (_result_list_tags): FIX for returning yahoo links as results * lib/WWW/Search/Yahoo/News/Advanced.pm (parse_tree): FIX for parsing result count with commas 2006-04-30 * lib/WWW/Search/Yahoo.pm (_result_list_tags): new private method 2005-10-24 * lib/WWW/Search/Yahoo/China.pm: add pod about UTF-8 * Yahoo.pm (parse_tree): fix next_url demangling 2005-07-02 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): fix for next-page url when query contains "http:" 2004-09-25 Kingpin * t/japan-news.t: use Encode instead of Jcode * lib/WWW/Search/Yahoo/Japan/News.pm (parse_tree): fix parse_debug level for msgs 2004-09-24 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): fix 'http%3A' in URLs 2004-09-19 Kingpin * lib/WWW/Search/Yahoo/DE.pm (_where_to_find_count): fix tag names (_string_has_count): fix pattern 2004-09-11 Kingpin * lib/WWW/Search/Yahoo/DE.pm (_where_to_find_count): new private method * lib/WWW/Search/Yahoo.pm (_where_to_find_count): new private method * lib/WWW/Search/Yahoo/News/Advanced.pm (parse_tree): handle new HTML formatting 2004-05-17 Kingpin * lib/WWW/Search/Yahoo/DE.pm: fix version number 2004-05-14 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): strip period out of numbers * lib/WWW/Search/Yahoo/DE.pm (_string_has_count): add . to number pattern 2004-05-13 Kingpin * lib/WWW/Search/Yahoo.pm (_string_has_count): new method (_a_is_next_link): new method * lib/WWW/Search/Yahoo/DE.pm (_a_is_next_link): new method (_string_has_count): new method * lib/WWW/Search/Yahoo/China.pm (_a_is_next_link): new method (_string_has_count): new method 2004-03-28 Kingpin * lib/WWW/Search/Yahoo/News/Advanced.pm (parse_tree): overhaul for new webpage format 2004-03-13 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): unescape URLs 2004-02-17 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): updates to support cn.yahoo.com * t/china.t: new file * lib/WWW/Search/Yahoo/China.pm: new file * lib/WWW/Search/Yahoo/Korea.pm: tiny pod fix; make VERSION 3 digits 2004-01-23 Kingpin * t/*.t: call env_proxy() on all WWW::Search objects 2004-01-18 Kingpin * t/echostar-advanced.t: make most tests TODO because yahoo.com is broken 2003-12-29 Kingpin * lib/WWW/Search/Yahoo/TV/Echostar.pm (parse_tree): fix date parsing for year-end wraparound! 2003-11-01 Kingpin * lib/WWW/Search/Yahoo/News/Advanced.pm (native_retrieve_some): follow next page of results 2003-09-20 Kingpin * lib/WWW/Search/Yahoo.pm: use strict 2003-08-31 Kingpin * t/echostar-advanced.t: new file * lib/WWW/Search/Yahoo/TV/Echostar.pm (native_setup_search): set _allow_empty_query if doing Advanced search; (parse_tree): parse result count in Advanced search results; added pod for how to do Advanced search 2003-08-27 Kingpin * lib/WWW/Search/Yahoo/News/Advanced.pm (native_retrieve_some): fixed for moreover.com links * lib/WWW/Search/Yahoo/TV/Echostar.pm (ignore_channels): new method * lib/WWW/Search/Yahoo/News/Advanced.pm (native_retrieve_some): fix parser for new page layout 2003-07-29 Kingpin * lib/WWW/Search/Yahoo/TV/Echostar.pm (native_setup_search): fix TZ setting(?); undo "fix" for preprocess_ bug * lib/WWW/Search/Yahoo/Japan/News.pm: undo "fix" for preprocess_ bug 2003-07-27 Kingpin * lib/WWW/Search/Yahoo/TV/Echostar.pm: move episode title to after show name 2003-07-14 Kingpin * lib/WWW/Search/Yahoo/TV/Echostar.pm: new backend 2003-07-13 Kingpin * lib/WWW/Search/Yahoo/DE.pm: new backend donated by Roland Moriz 2003-06-24 Kingpin * lib/WWW/Search/Yahoo/Japan/News.pm: fix parsing for new yahoo.co.jp page format 2003-05-14 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): fix parsing for new yahoo.com page format 2003-01-23 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): fix parsing for new yahoo.com page format 2002-12-20 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): make sure result count is taken from "Web Matches" section * lib/WWW/Search/Yahoo/Japan/News.pm (parse_tree): ignore yahoo.co.jp links that look like hit results: * lib/WWW/Search/Yahoo.pm (parse_tree): do not follow "next" link if result count is being spoofed 2002-11-08 Kingpin * Makefile.PL: add prereq Date::Manip * lib/WWW/Search/Yahoo.pm (parse_tree): FIX pattern for result-count integer match 2002-11-01 Kingpin * lib/WWW/Search/Yahoo.pm (native_setup_search): new URL (parse_tree): tweak parser for new webpage format * lib/WWW/Search/Yahoo/News/Advanced.pm (parse_tree): overhaul for new webpage format * test.pl: switch to Test::More; all tests pass as of today 2002-10-01 Kingpin * lib/WWW/Search/Yahoo.pm (gui_query): new URL google.yahoo.com 2002-03-29 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): even more cleanup of title & description 2002-03-28 Kingpin * lib/WWW/Search/Yahoo.pm (parse_tree): clean up description 2001-12-24 Kingpin * lib/WWW/Search/Yahoo.pm (gui_query): FIXED for not passing debug argument(s) (parse_tree): fix for slightly changed output format * lib/WWW/Search/Yahoo/News/Advanced.pm (parse_tree): handle new output format 2001-09-13 Kingpin * lib/WWW/Search/Yahoo/Japan/News.pm: bugfix, and update pod 2001-09-07 Kingpin * test.pl: fix all tests, and add new tests for Japan News * lib/WWW/Search/Yahoo/Japan/News.pm: new backend! 2001-08-07 Kingpin * lib/WWW/Search/Yahoo/News/Advanced.pm (native_setup_search): default to OR search * test.pl: fix all tests, and add new tests for Advanced News 2001-07-16 Kingpin * test.pl: fix old tests, and add new tests for Advanced News * lib/WWW/Search/Yahoo.pm (parse_tree): new method for subclasses to use * lib/WWW/Search/Yahoo/News/Advanced.pm: new backend 2001-03-31 Kingpin * VERSION 2.22 RELEASED 2001-03-30 Kingpin * lib/WWW/Search/Yahoo.pm (native_setup_search): added support for subclassing * lib/WWW/Search/Yahoo/UK.pm: new backend * lib/WWW/Search/Yahoo/Korea.pm: new backend 2000-12-16 * VERSION 2.21 RELEASED 2000-12-15 Kingpin * Yahoo.pm (native_retrieve_some): clean up URL parsing (yahoo.com added text to it) 2000-11-11 * VERSION 2.19 RELEASED 2000-11-10 Kingpin * Yahoo.pm (native_retrieve_some): rewrote parser using HTML::TreeBuilder 2000-09-23 * VERSION 2.17 RELEASED 2000-09-22 Kingpin * Yahoo.pm (native_retrieve_some): fix description parsing and URL parsing 2000-09-20 * VERSION 2.16 RELEASED 2000-09-19 Kingpin * Yahoo.pm (native_retrieve_some): fix gui-style results parsing 2000-09-15 * VERSION 2.15 RELEASED 2000-09-14 Kingpin * Yahoo.pm (native_retrieve_some): fix result-count parsing 2000-07-05 Kingpin * VERSION 2.14 RELEASED * Yahoo.pm (native_retrieve_some): fixed parsing for new output format 2000-05-11 Kingpin * VERSION 2.13 RELEASED 2000-05-10 Kingpin * Yahoo.pm: fixed parsing for all sections of gui_query results 2000-04-28 Kingpin * VERSION 2.11 RELEASED 2000-04-27 Kingpin * test.pl: new test case for gui_query * Yahoo.pm: new URL for gui_query 2000-04-03 Kingpin * VERSION 2.09 RELEASED 2000-03-27 Kingpin * test.pl: updated test cases * Yahoo.pm: (2.09) fixed for new CGI options 2000-03-20 Kingpin * test.pl: added "real" test Revision history for Perl extension WWW::Search::Yahoo. 2.07 Fri Feb 4 10:01:42 2000 - original version; created by h2xs 1.19 WWW-Search-Yahoo-2.415/inc/0000755000175600010010000000000011177076260014157 5ustar MartinNoneWWW-Search-Yahoo-2.415/inc/Module/0000755000175600010010000000000011177076260015404 5ustar MartinNoneWWW-Search-Yahoo-2.415/inc/Module/Install/0000755000175600010010000000000011177076260017012 5ustar MartinNoneWWW-Search-Yahoo-2.415/inc/Module/Install/Base.pm0000755000175600010010000000212311177076254020226 0ustar MartinNone#line 1 package Module::Install::Base; $VERSION = '0.82'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { next if defined &{"$class\::$method"}; *{"$class\::$method"} = sub { shift()->_top->$method(@_); }; } bless( \%args, $class ); } #line 62 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 79 sub _top { $_[0]->{_top}; } #line 94 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 110 sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 157 WWW-Search-Yahoo-2.415/inc/Module/Install/Can.pm0000755000175600010010000000344511177076254020065 0ustar MartinNone#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.82'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 156 WWW-Search-Yahoo-2.415/inc/Module/Install/Fetch.pm0000755000175600010010000000476311177076254020421 0ustar MartinNone#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.82'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; WWW-Search-Yahoo-2.415/inc/Module/Install/Makefile.pm0000755000175600010010000001641411177076254021101 0ustar MartinNone#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.82'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ( $self->{makemaker_args} ||= {} ); %$args = ( %$args, @_ ); return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # Merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 394 WWW-Search-Yahoo-2.415/inc/Module/Install/Metadata.pm0000755000175600010010000003474311177076254021111 0ustar MartinNone#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.82'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } my @boolean_keys = qw{ sign mymeta }; my @scalar_keys = qw{ name module_name abstract author version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords }; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}->{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the reall old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } sub _extract_bugtracker { my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than on rt.cpan.org link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { $v = $v + 0; # Numify } return $v; } ###################################################################### # MYMETA.yml Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta { my $self = shift; # If there's no existing META.yml there is nothing we can do return unless -f 'META.yml'; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = YAML::Tiny::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } 1; WWW-Search-Yahoo-2.415/inc/Module/Install/Win32.pm0000755000175600010010000000350211177076254020260 0ustar MartinNone#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.82'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; WWW-Search-Yahoo-2.415/inc/Module/Install/WriteAll.pm0000755000175600010010000000206011177076254021077 0ustar MartinNone#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.82'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. $self->Meta->write if $args{meta}; $self->Meta->write_mymeta if $self->mymeta; return 1; } 1; WWW-Search-Yahoo-2.415/inc/Module/Install.pm0000755000175600010010000002477411177076253017373 0ustar MartinNone#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.82'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); use Cwd (); use File::Find (); use File::Path (); use FindBin; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; # Save to the singleton $MAIN = $self; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; if ( $] >= 5.006 ) { open( FH, '<', $_[0] ) or die "open($_[0]): $!"; } else { open( FH, "< $_[0]" ) or die "open($_[0]): $!"; } my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } sub _write { local *FH; if ( $] >= 5.006 ) { open( FH, '>', $_[0] ) or die "open($_[0]): $!"; } else { open( FH, "> $_[0]" ) or die "open($_[0]): $!"; } foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[0]) <=> _version($_[1]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2009 Adam Kennedy. WWW-Search-Yahoo-2.415/lib/0000755000175600010010000000000011177076260014154 5ustar MartinNoneWWW-Search-Yahoo-2.415/lib/WWW/0000755000175600010010000000000011177076260014640 5ustar MartinNoneWWW-Search-Yahoo-2.415/lib/WWW/Search/0000755000175600010010000000000011177076260016045 5ustar MartinNoneWWW-Search-Yahoo-2.415/lib/WWW/Search/Yahoo/0000755000175600010010000000000011177076260017124 5ustar MartinNoneWWW-Search-Yahoo-2.415/lib/WWW/Search/Yahoo/Korea.pm0000755000175600010010000000355211177045211020523 0ustar MartinNone# $Id: Korea.pm,v 2.35 2009/05/02 13:28:41 Martin Exp $ =head1 NAME WWW::Search::Yahoo::Korea - class for searching Yahoo! Korea =head1 SYNOPSIS use WWW::Search; my $oSearch = new WWW::Search('Yahoo::Korea'); my $sQuery = WWW::Search::escape_query("Tokyo"); $oSearch->native_query($sQuery); while (my $oResult = $oSearch->next_result()) print $oResult->url, "\n"; =head1 DESCRIPTION This class is a Yahoo! Korea specialization of L. It handles making and interpreting searches on Yahoo! Korea F. This class exports no public interface; all interaction should be done through L objects. =head1 NOTES =head1 SEE ALSO To make new back-ends, see L. =head1 BUGS Please tell the maintainer if you find any! =head1 TESTING There are no tests defined for this module. =head1 AUTHOR C is maintained by Martin Thurn (mthurn@cpan.org). =head1 LEGALESE Copyright (C) 1998-2009 Martin 'Kingpin' Thurn THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut ##################################################################### package WWW::Search::Yahoo::Korea; use strict; use warnings; use WWW::Search::Yahoo; use base 'WWW::Search::Yahoo'; our $VERSION = do { my @r = (q$Revision: 2.35 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; our $MAINTAINER = 'Martin Thurn '; sub _native_setup_search { my ($self, $sQuery, $rh) = @_; $self->{'_options'} = { 'p' => $sQuery, }; $rh->{'search_base_url'} = 'http://kr.search.yahoo.com'; $rh->{'search_base_path'} = '/bin/search'; return $self->SUPER::_native_setup_search($sQuery, $rh); } # _native_setup_search 1; __END__ WWW-Search-Yahoo-2.415/lib/WWW/Search/Yahoo/News/0000755000175600010010000000000011177076260020040 5ustar MartinNoneWWW-Search-Yahoo-2.415/lib/WWW/Search/Yahoo/News/Advanced.pm0000755000175600010010000001714311177073775022124 0ustar MartinNone # $Id: Advanced.pm,v 2.62 2009/05/02 16:42:37 Martin Exp $ =head1 NAME WWW::Search::Yahoo::News::Advanced - search Yahoo!News using the "advanced" interface =head1 SYNOPSIS use WWW::Search; my $oSearch = new WWW::Search('Yahoo::News::Advanced'); my $sQuery = WWW::Search::escape_query("George Lucas"); $oSearch->date_from('7 days ago'); $oSearch->date_to ('now'); $oSearch->native_query($sQuery); while (my $oResult = $oSearch->next_result()) print $oResult->url, "\n"; =head1 DESCRIPTION This class is a Yahoo! News specialization of L. It handles making and interpreting searches on Yahoo! News F using the Advanced search interface. This class exports no public interface; all interaction should be done through L objects. =head1 NOTES This backend supports narrowing the search by date-range. Use date_from() and date_to() to set the endpoints of the desired date range. You can use any date format supported by the Date::Manip module. NOTE that Yahoo only seems to keep the last 60 days worth of news in its searchable index. At one time, News.yahoo.com would die if the unescaped query is longer than 485 characters or so. This backend does NOT check for that. =head1 SEE ALSO To make new back-ends, see L. =head1 BUGS To report a new bug, please use https://rt.cpan.org/Ticket/Create.html?Queue=WWW-Search-Yahoo =head1 AUTHOR C is maintained by Martin Thurn (mthurn@cpan.org). =head1 LEGALESE Copyright (C) 1998-2009 Martin 'Kingpin' Thurn THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut ##################################################################### package WWW::Search::Yahoo::News::Advanced; use strict; use warnings; use Data::Dumper; # for debugging only use Date::Manip; use WWW::Search qw( strip_tags ); use WWW::Search::Result; use WWW::Search::Yahoo; use base 'WWW::Search::Yahoo'; our $VERSION = do { my @r = (q$Revision: 2.62 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; our $MAINTAINER = 'Martin Thurn '; sub _native_setup_search { my ($self, $sQuery, $rh) = @_; # print STDERR " + in Y::N::A::_native_setup_search, rh is ", Dumper($rh); my $sDateFrom = $self->date_from || ''; my $sDateTo = $self->date_to || ''; my $iUseDate = 0; my ($iMonthFrom, $iDayFrom, $iMonthTo, $iDayTo); if ($sDateFrom ne '') { # User specified the beginning date. my $dateFrom = &ParseDate($sDateFrom); $iMonthFrom = &UnixDate($dateFrom, '%m'); $iDayFrom = &UnixDate($dateFrom, '%d'); $iUseDate = 1; } else { # User did not specify the beginning date. Set it to the distant # past. Yahoo.com barfs if it gets a date earlier than 1999, # though. $sDateFrom = &UnixDate(&ParseDate('1999-01-01'), '%m/%d/%y'); } if ($sDateTo ne '') { # User specified the ending date. my $date = &ParseDate($sDateTo); $iMonthTo = &UnixDate($date, '%m'); $iDayTo = &UnixDate($date, '%d'); $iUseDate = 1; } else { # User did not specify the ending date. Set it to the future: $sDateTo = &UnixDate(&ParseDate('tomorrow'), '%m/%d/%y'); } # With default search options: # http://news.search.yahoo.com/search/news?p=Aomori&c=&ei=UTF-8&fl=0&n=100&x=wrt $self->{'_options'} = { 'ei' => 'UTF-8', 'fl' => 0, 'n' => 100, # 10 for testing, 100 for release 'p' => $sQuery, }; if ($iUseDate) { # This is the url when user chose date range: # http://news.search.yahoo.com/search/news?ei=UTF-8&fr=&va=Aomori&va_vt=any&vp=&vp_vt=any&vo=&vo_vt=any&ve=&ve_vt=any&&pub=1&smonth=3&sday=22&emonth=3&eday=30&source=&location=&fl=0&n=100 $self->{'_options'}->{'pub'} = 1; delete $self->{'_options'}->{'fl'}; delete $self->{'_options'}->{'p'}; $self->{'_options'}->{'va'} = $sQuery; $self->{'_options'}->{'va_vt'} = 'any'; $self->{'_options'}->{'smonth'} = $iMonthFrom; $self->{'_options'}->{'sday'} = $iDayFrom; $self->{'_options'}->{'emonth'} = $iMonthTo; $self->{'_options'}->{'eday'} = $iDayTo; } # if $rh->{'search_base_url'} = 'http://news.search.yahoo.com'; $rh->{'search_base_path'} = '/search/news/'; # print STDERR " + Y::N::A::_native_setup_search() is calling SUPER::_native_setup_search()...\n"; return $self->SUPER::_native_setup_search($sQuery, $rh); } # _native_setup_search sub _parse_tree { my $self = shift; my $tree = shift; my $hits_found = 0; my @aoFONTcount = $tree->look_down('_tag', 'div', 'id' => 'yschtools', ); FONTcount_TAG: foreach my $oFONT (@aoFONTcount) { my $s = $oFONT->as_text; print STDERR " + FONTcount == ", $oFONT->as_HTML if 2 <= $self->{_debug}; # print STDERR " + TEXT == ", $s, "\n" if 2 <= $self->{_debug}; if ($s =~ m!Results\s+\d+\s*-\s*\d+\s+of\s+(?:about\s+)?([0-9,]+)!) { my $iCount = $1; $iCount =~ s!,!!g; # print STDERR " + found number $iCount\n" if 2 <= $self->{_debug}; $self->approximate_result_count($iCount); last FONTcount_TAG; } # if } # foreach FONT_TAG my @aoA = $tree->look_down('_tag' => 'a', 'class' => 'yschttl', ); A_TAG: foreach my $oA (@aoA) { printf STDERR "\n + A == %s", $oA->as_HTML if 2 <= $self->{_debug}; my $sMouseOver = $oA->attr('onmouseover'); next A_TAG unless ($sMouseOver =~ m!window\.status='(.+)'!); my $sURL = $1; next A_TAG unless defined($sURL); next A_TAG unless ($sURL ne ''); print STDERR " + URL == $sURL\n" if 2 <= $self->{_debug}; my $sTitle = $oA->as_text; print STDERR " + TITLE == $sTitle\n" if 2 <= $self->{_debug}; # In order to make it easier to parse, make sure everything is an object! my $oLI = $oA->look_up(_tag => 'li'); next A_TAG unless ref($oLI); $oA->detach; $oA->delete; my $oEM = $oLI->look_down('_tag' => 'em', class => 'yschurl'); next A_TAG unless ref($oEM); my $sEM = $oEM->as_text; my ($sSource, $sDate) = split(/[\s\240]-[\s\240]/, $sEM); my $oDIV = $oLI->look_down(_tag => 'div', class => 'yschabstr'); next A_TAG unless ref($oDIV); my $sDesc = &strip_tags($oDIV->as_text); print STDERR " + raw DESC == $sDesc\n" if 2 <= $self->{_debug}; $sDesc =~ s!Save to My Web\Z!!; my $hit = new WWW::Search::Result; $hit->add_url($sURL); $hit->title($sTitle); $hit->description($sDesc); $hit->change_date($sDate); push(@{$self->{cache}}, $hit); $self->{'_num_hits'}++; $hits_found++; } # foreach oFONT # The "next" link is a plain old : @aoA = $tree->look_down('_tag', 'a'); A_TAG: foreach my $oA (@aoA) { printf STDERR " + A == %s\n", $oA->as_HTML if 2 <= $self->{_debug}; # Next 20 > if ($oA->as_text eq 'Next') { $self->{_next_url} = $HTTP::URI_CLASS->new_abs($oA->attr('href'), $self->{'_prev_url'}); last A_TAG; } # if } # foreach $oA $tree->delete; return $hits_found; } # _parse_tree 1; __END__ As of 2007-04: http://news.search.yahoo.com/search/news?ei=UTF-8&fr=&va=Aomori&va_vt=any&vp=&vp_vt=any&vo=&vo_vt=any&ve=&ve_vt=any&&pub=1&smonth=3&sday=22&emonth=3&eday=30&source=&location=&fl=0&n=100 WWW-Search-Yahoo-2.415/lib/WWW/Search/Yahoo/UK.pm0000755000175600010010000000402311177045211017773 0ustar MartinNone# UK.pm # by Martin Thurn # $Id: UK.pm,v 1.10 2009/05/02 13:28:41 Martin Exp $ =head1 NAME WWW::Search::Yahoo::UK - class for searching Yahoo! UK (not Ireland) =head1 SYNOPSIS use WWW::Search; my $oSearch = new WWW::Search('Yahoo::UK'); my $sQuery = WWW::Search::escape_query("Surrey"); $oSearch->native_query($sQuery); while (my $oResult = $oSearch->next_result()) print $oResult->url, "\n"; =head1 DESCRIPTION This class is a Yahoo! UK specialization of L. It handles making and interpreting searches on Yahoo! UK F. This class exports no public interface; all interaction should be done through L objects. =head1 NOTES =head1 SEE ALSO To make new back-ends, see L. =head1 BUGS Please tell the maintainer if you find any! =head1 TESTING There are no tests defined for this module. =head1 AUTHOR C is maintained by Martin Thurn (mthurn@cpan.org). =head1 LEGALESE Copyright (C) 1998-2009 Martin 'Kingpin' Thurn THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut ##################################################################### package WWW::Search::Yahoo::UK; use strict; use warnings; use WWW::Search::Yahoo; use base 'WWW::Search::Yahoo'; our $VERSION = '2.022'; our $MAINTAINER = 'Martin Thurn '; sub _native_setup_search { my ($self, $sQuery, $rh) = @_; # print STDERR " + in UK::_native_setup_search, rh is ", Dumper($rh); $self->{'_options'} = { 'p' => $sQuery, 'y' => 'uk', }; $rh->{'search_base_url'} = 'http://uk.search.yahoo.com'; $rh->{'search_base_path'} = '/search/ukie'; # print STDERR " + Yahoo::UK::_native_setup_search() is calling SUPER::_native_setup_search()...\n"; return $self->SUPER::_native_setup_search($sQuery, $rh); } # _native_setup_search 1; __END__ WWW-Search-Yahoo-2.415/lib/WWW/Search/Yahoo.pm0000755000175600010010000003522411177045211017463 0ustar MartinNone # $Id: Yahoo.pm,v 2.380 2009/05/02 13:28:41 Martin Exp $ =head1 NAME WWW::Search::Yahoo - backend for searching www.yahoo.com =head1 SYNOPSIS use WWW::Search; my $oSearch = new WWW::Search('Yahoo'); my $sQuery = WWW::Search::escape_query("sushi restaurant Columbus Ohio"); $oSearch->native_query($sQuery); while (my $oResult = $oSearch->next_result()) print $oResult->url, "\n"; =head1 DESCRIPTION This class is a Yahoo specialization of L. It handles making and interpreting Yahoo searches F. This class exports no public interface; all interaction should be done through L objects. =head1 NOTES The default search is: Yahoo's web-based index (not Directory). =head1 PRIVATE METHODS If you just want to write Perl code to search Yahoo, you do NOT need to read any further here. Instead, just read the L documentation. If you want to write a subclass of this module (e.g. create a backend for another branch of Yahoo) then please read about the private methods here: =cut package WWW::Search::Yahoo; use strict; use warnings; use Carp (); use Data::Dumper; # for debugging only use HTML::TreeBuilder; use WWW::Search; use WWW::SearchResult; use URI; use URI::Escape; use vars qw( $iMustPause ); use base 'WWW::Search'; our $VERSION = do { my @r = (q$Revision: 2.380 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; our $MAINTAINER = 'Martin Thurn '; # Thanks to the hard work of Gil Vidals and his team at # positionresearch.com, we know the following: In early 2004, # yahoo.com implemented new robot-blocking tactics that look for # frequent requests from the same client IP. One way around these # blocks is to slow down and randomize the timing of our requests. We # therefore insert a random sleep before every request except the # first one. This variable is equivalent to a "first-time" flag for # this purpose: $iMustPause = 0; =head2 gui_query Yes, Virginia, we do try to emulate stupid-human queries. =cut sub gui_query { my ($self, $sQuery, $rh) = @_; $self->{'_options'} = { 'p' => $sQuery, # 'hc' => 0, # 'hs' => 0, 'ei' => 'UTF-8', }; # print STDERR " + Yahoo::gui_query() is calling native_query()...\n"; $rh->{'search_base_url'} = 'http://search.yahoo.com'; $rh->{'search_base_path'} = '/bin/query'; return $self->native_query($sQuery, $rh); } # gui_query sub _native_setup_search { my ($self, $native_query, $rhOptsArg) = @_; # print STDERR " + This is Yahoo::native_setup_search()...\n"; # print STDERR " + _options is ", $self->{'_options'}, "\n"; $self->{'_hits_per_page'} = 100; # $self->{'_hits_per_page'} = 10; # for debugging # www.yahoo.com refuses robots. $self->user_agent('non-robot'); # www.yahoo.com completely changes the HTML output depending on the # browser! # $self->{'agent_name'} = 'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)'; # $self->{agent_e_mail} = 'mthurn@cpan.org'; $self->{_next_to_retrieve} = 1; $self->{'search_base_url'} ||= 'http://search.yahoo.com'; $self->{'search_base_path'} ||= '/search'; if (! defined($self->{'_options'})) { # We do not clobber the existing _options hash, if there is one; # e.g. if gui_search() was already called on this object $self->{'_options'} = { 'vo' => $native_query, 'h' => 'w', # web sites 'n' => $self->{_hits_per_page}, # 'b' => $self->{_next_to_retrieve}-1, }; } # if my $rhOptions = $self->{'_options'}; if (defined($rhOptsArg)) { # Copy in new options, promoting special ones: foreach my $key (keys %$rhOptsArg) { # print STDERR " + inspecting option $key..."; if (WWW::Search::generic_option($key)) { # print STDERR "promote & delete\n"; $self->{$key} = $rhOptsArg->{$key} if defined($rhOptsArg->{$key}); delete $rhOptsArg->{$key}; } else { # print STDERR "copy\n"; $rhOptions->{$key} = $rhOptsArg->{$key} if defined($rhOptsArg->{$key}); } } # foreach # print STDERR " + resulting rhOptions is ", Dumper($rhOptions); # print STDERR " + resulting rhOptsArg is ", Dumper($rhOptsArg); } # if # Finally, figure out the url. $self->{'_next_url'} = $self->{'search_base_url'} . $self->{'search_base_path'} .'?'. $self->hash_to_cgi_string($rhOptions); $self->{_debug} = $self->{'search_debug'} || 0; $self->{_debug} = 2 if ($self->{'search_parse_debug'}); } # _native_setup_search =head2 need_to_delay This method tells the L controller code whether we need to pause and give the yahoo.com servers a breather. =cut sub need_to_delay { # print STDERR " + this is Yahoo::need_to_delay()\n"; return $iMustPause; } # need_to_delay =head2 user_agent_delay This method tells the L controller code how many seconds we should pause. =cut sub user_agent_delay { my $self = shift; my $iSecs = int(30 + rand(30)); print STDERR " + sleeping $iSecs seconds, to make yahoo.com think we're NOT a robot...\n" if (0 < $self->{_debug}); sleep($iSecs); } # user_agent_delay =head2 preprocess_results_page Clean up the Yahoo HTML before we attempt to parse it. =cut sub preprocess_results_page { my $self = shift; my $sPage = shift; if ($self->{_debug} == 77) { # For debugging only. Print the page contents and abort. print STDERR $sPage; exit 88; } # if # Delete the tag that appears BEFORE the tag (because # it causes HTML::TreeBuilder to NOT be able to parse it!) $sPage =~ s!]+>!!; return $sPage; } # preprocess_results_page =head2 _result_list_tags Returns a list, which will be passed as arguments to HTML::Element::look_down() in order to return a list of HTML::Element which contain the query results. =cut sub _result_list_tags { return (_tag => 'div', class => 'res', ); } # _result_list_tags =head2 _result_list_items Given an HTML::TreeBuilder tree, returns a list of HTML::Element, which contain the query results. =cut sub _result_list_items { my $self = shift; my $oTree = shift || die; my @ao = $oTree->look_down($self->_result_list_tags); return @ao; } # _result_list_items my $WS = q{[\t\r\n\240\ ]}; sub _parse_tree { my $self = shift; my $oTree = shift; print STDERR " + ::Yahoo got a tree $oTree\n" if (2 <= $self->{_debug}); # Every time we get a page from yahoo.com, we have to pause before # fetching another. $iMustPause++; my $hits_found = 0; # Only try to parse the hit count if we haven't done so already: print STDERR " + start, approx_h_c is ==", $self->approximate_hit_count(), "==\n" if (2 <= $self->{_debug}); if ($self->approximate_hit_count() < 1) { my $rh = $self->_where_to_find_count; my @aoDIV = $oTree->look_down(%$rh); DIV_TAG: foreach my $oDIV (@aoDIV) { next unless ref $oDIV; print STDERR " + try DIV ==", $oDIV->as_HTML if (2 <= $self->{_debug}); my $s = $oDIV->as_text; print STDERR " + TEXT ==$s==\n" if (2 <= $self->{_debug}); my $iCount = $self->_string_has_count($s); $iCount =~ tr!,\.!!d; if (0 <= $iCount) { $self->approximate_result_count($iCount); last DIV_TAG; } # if } # foreach DIV_TAG } # if print STDERR " + found approx_h_c is ==", $self->approximate_hit_count(), "==\n" if (2 <= $self->{_debug}); my @aoLI = $self->_result_list_items($oTree); print STDERR " DDD aoLI has ", scalar(@aoLI), " items...\n" if (2 <= $self->{_debug}); LI_TAG: foreach my $oLI (@aoLI) { # Sanity check: next LI_TAG unless ref($oLI); print STDERR " DDD found oLI is ==", $oLI->as_HTML, "==\n" if (2 <= $self->{_debug}); my $oA = $oLI->look_down(_tag => 'a'); next LI_TAG unless ref($oA); print STDERR " DDD found oA is ==", $oA->as_HTML, "==\n" if (2 <= $self->{_debug}); my $sTitle = $oA->as_text || ''; my $sURL = $oA->attr('href') || ''; next LI_TAG if ($sURL eq ''); print STDERR " + raw URL is ==$sURL==\n" if (2 <= $self->{_debug}); # Throw out various unwanted Yahoo links: next LI_TAG if ($sURL =~ m!\.yahoo\.com/(about|jobseeker|preferences|search)/!); next LI_TAG if ($sURL =~ m!//((answers|cgi|cn|de|docs|europe|help|local|myweb\d?|search|searchmarketing|video)\.)+yahoo\.com!); # Strip off the yahoo.com redirect part of the URL: $sURL =~ s!\A.*?\*-!!; $sURL =~ s!\Ahttp%3A!http:!i; print STDERR " + cooked URL is ==$sURL==\n" if (2 <= $self->{_debug}); my $hit = new WWW::SearchResult; $hit->description(q{}); $self->parse_details($oLI, $hit); $hit->add_url($sURL); $sTitle = $self->strip($sTitle); $hit->title($sTitle); push(@{$self->{cache}}, $hit); $hits_found++; } # foreach LI_TAG # Now try to find the "next page" link: my @aoA = $oTree->look_down('_tag' => 'a'); NEXT_A: foreach my $oA (reverse @aoA) { next NEXT_A unless ref($oA); my $sAhtml = $oA->as_HTML; printf STDERR (" + next A ==%s==\n", $sAhtml) if (2 <= $self->{_debug}); if ($self->_a_is_next_link($oA)) { # Here is an example of a raw next URL: # http://rds.yahoo.com/_ylt=A0Je5ra.FlVEwsQA1RhXNyoA/SIG=13517q7d2/EXP=1146513470/**http%3a//search.yahoo.com/search%3fn=100%26vo=pokemon%26ei=UTF-8%26pstart=1%26b=101 # http://rds.yahoo.com/;_ylt=AutpqXFv9tv2eTXen2Mw_c1XNyoA;_ylu=X3oDMTExN2UzODg3BGNvbG8DdwRzZWMDcGFnaW5hdGlvbgR2dGlkA0RGWDJfOQ--/SIG=19e131ad9/EXP=1130207429/**http%3A%2F%2Fsearch.yahoo.com%2Fsearch%3Fn%3D100%26vo%3Dpokemon%26ei%3DUTF-8%26xargs%3D12KPjg1hVSt4GmmvmnCOObHb%255F%252Dvj0Zlpi3g5UzTYR6a9RL8nQJDqADN%255F2aP%255FdLHL9y7XrQ0JOkvqV2HOs3qODiIxkSdWH8UbKsmJS5%255FIp9DLfdaXlzsbIu0%252Djv3NcQZy8nLl2qbeONz73ZI6L5Hk57%26pstart%3D6%26b%3D101 my $sURL = $oA->attr('href'); print STDERR " + raw next URL ==$sURL==\n" if (2 <= $self->{_debug}); # Delete Yahoo-redirect portion of URL: $sURL =~ s!\A.+?[-*]+(?=http)!!; print STDERR " + poached next URL ==$sURL==\n" if (2 <= $self->{_debug}); $sURL = WWW::Search::unescape_query($sURL); $self->{_next_url} = $self->absurl($self->{'_prev_url'}, $sURL); print STDERR " + cooked next URL ==$self->{_next_url}==\n" if (2 <= $self->{_debug}); last NEXT_A; } # if } # foreach NEXT_A return $hits_found; } # _parse_tree =head2 parse_details Given a (portion of an) HTML::TreeBuilder tree and a L object, parses one result out of the tree and populates the SearchResult. =cut sub parse_details { my $self = shift; # Required arg1 = (part of) an HTML parse tree: my $oLI = shift; # Required arg2 = a WWW::SearchResult object to fill in: my $hit = shift; my $oDIV = $oLI->look_down(_tag => 'div', class => 'abstr', ); if (ref($oDIV)) { my $sDesc = $oDIV->as_text; $hit->description($self->strip($sDesc)); } # if # Delete the useless human-readable restatement of the URL (first # tag we come across): my $oEM = $oLI->look_down(_tag => 'em'); if (ref($oEM)) { my $sSize = ''; $sSize = $1 if ($oLI->as_text =~ m!(\d+[kb]?)!gx); $hit->size($sSize); } # if return; # Delete any remaining tags: my @aoA = $oLI->look_down(_tag => 'a'); A_TAG: foreach my $oA (@aoA) { $oA->detach; $oA->delete; } # foreach A_TAG $oDIV = $oLI->look_down(_tag => 'div'); if (ref $oDIV) { $oDIV->detach; $oDIV->delete; } # if my $sDesc = $oLI->as_text; print STDERR " + raw sDesc is ==$sDesc==\n" if (2 <= $self->{_debug}); # Grab stuff off the end of the description: print STDERR " + cooked sDesc is ==$sDesc==\n" if (2 <= $self->{_debug}); $hit->description($self->strip($sDesc)); } # parse_details =head2 _where_to_find_count Returns a list, which will be passed as arguments to HTML::Element::look_down() in order to return an HTML::Element which contains the approximate result count. =cut sub _where_to_find_count { my %hash = ( _tag => 'div', # 'class' => 'ygbody', id => 'info', ); return \%hash; } # _where_to_find_count =head2 _string_has_count Given a string, returns the approximate result count if that string contains the approximate result count. =cut sub _string_has_count { my $self = shift; my $s = shift; # print STDERR " DDD Yahoo::string_has_count($s)?\n"; return $1 if ($s =~ m!\bof\s+(?:about\s+)?([,0-9]+)!i); return -1; } # _string_has_count =head2 _a_is_next_link Given an HTML::Element, returns true if it seems to contain the clickable "next page" widget. =cut sub _a_is_next_link { my $self = shift; my $oA = shift; return 0 if (! ref $oA); my $sID = $oA->attr('id') || ''; return 1 if ($sID eq 'pg-next'); my $s = $oA->as_text; print STDERR " + next A as_text ==$s==\n" if (2 <= $self->{_debug}); return ($s =~ m!\A$WS*Next$WS+>$WS*\z!i); } # _a_is_next_link =head2 strip Given a string, strips leading and trailing whitespace off of it. =cut sub strip { my $self = shift; my $s = &WWW::Search::strip_tags(shift); $s =~ s!\A$WS+ !!x; $s =~ s! $WS+\Z!!x; return $s; } # strip 1; __END__ GUI search: http://ink.yahoo.com/bin/query?p=sushi+restaurant+Columbus+Ohio&hc=0&hs=0 Advanced search: http://search.yahoo.com/search?h=w&fr=op&va=&vp=&vo=Martin+Thurn&ve=&bbase=Search&vl=&vc=&vd=all&vt=any&vss=i&vs=&vr=&vk= http://ink.yahoo.com/bin/query?o=1&p=LSAm&d=y&za=or&h=c&g=0&n=20 actual next link from page: http://google.yahoo.com/bin/query?p=%22Shelagh+Fraser%22&b=21&hc=0&hs=0&xargs= _next_url : http://google.yahoo.com/bin/query?%0Ap=%22Shelagh+Fraser%22&b=21&hc=0&hs=0&xargs= http://rds.yahoo.com/_ylt=A0Je5ra.FlVEwsQA1RhXNyoA/SIG=13517q7d2/EXP=1146513470/**http%3a//search.yahoo.com/search%3fn=100%26vo=pokemon%26ei=UTF-8%26pstart=1%26b=101 =head1 SEE ALSO To make new back-ends, see L. =head1 BUGS Please tell the maintainer if you find any! =head1 AUTHOR As of 1998-02-02, C is maintained by Martin Thurn (mthurn@cpan.org). C was originally written by Wm. L. Scheding, based on C. =head1 LEGALESE THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. =head1 LICENSE Copyright (C) 1998-2009 Martin 'Kingpin' Thurn This software is released under the same license as Perl itself. =cut WWW-Search-Yahoo-2.415/LICENSE0000755000175600010010000000010211121276072014377 0ustar MartinNone This software is released under the same license as Perl itself. WWW-Search-Yahoo-2.415/Makefile.PL0000755000175600010010000000115711177074044015365 0ustar MartinNone use inc::Module::Install; all_from('lib/WWW/Search/Yahoo.pm'); version(2.415); requires( perl => '5.004' ); requires('Data::Dumper'); requires('Date::Manip'); build_requires('Encode'); requires('HTML::TreeBuilder'); build_requires('I18N::Charset'); # Test::More is needed for `make test`: build_requires('Test::More'); requires('URI'); requires('URI::Escape'); # We need the version of WWW::Search that has the new underscore-named _methods: requires('WWW::Search' => 2.557); # We need the version of WWW::Search::Test that exports its tm_ # functions: build_requires('WWW::Search::Test' => 2.265); WriteAll; __END__ WWW-Search-Yahoo-2.415/MANIFEST0000755000175600010010000000076511132413032014531 0ustar MartinNoneChanges inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/WWW/Search/Yahoo.pm lib/WWW/Search/Yahoo/Korea.pm lib/WWW/Search/Yahoo/News/Advanced.pm lib/WWW/Search/Yahoo/UK.pm LICENSE Makefile.PL MANIFEST This list of files META.yml README t/gui.t t/news-advanced.t t/pod-coverage.t t/pod.t t/yahoo.t WWW-Search-Yahoo-2.415/META.yml0000755000175600010010000000144311177076255014670 0ustar MartinNone--- abstract: 'backend for searching www.yahoo.com' author: - 'As of 1998-02-02, C is maintained by Martin Thurn' build_requires: Encode: 0 ExtUtils::MakeMaker: 6.42 I18N::Charset: 0 Test::More: 0 WWW::Search::Test: 2.265 configure_requires: ExtUtils::MakeMaker: 6.42 distribution_type: module generated_by: 'Module::Install version 0.82' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 module_name: WWW::Search::Yahoo name: WWW-Search-Yahoo no_index: directory: - inc - t requires: Data::Dumper: 0 Date::Manip: 0 HTML::TreeBuilder: 0 URI: 0 URI::Escape: 0 WWW::Search: 2.557 perl: 5.004 resources: license: http://dev.perl.org/licenses/ version: 2.415 WWW-Search-Yahoo-2.415/README0000755000175600010010000000061410604047174014266 0ustar MartinNone This is a backend for use with the WWW::Search module. Please read the README for WWW::Search for general information. (One place to find it is http://www.perl.com/CPAN-local/modules/by-module/WWW/ ) Read the Changes file in this distribution to see what is new with this backend since the previous release. Please visit http://www.sandcrawler.com/SWB/cpan-modules.html for more information. WWW-Search-Yahoo-2.415/t/0000755000175600010010000000000011177076260013651 5ustar MartinNoneWWW-Search-Yahoo-2.415/t/gui.t0000755000175600010010000000154611177076246014637 0ustar MartinNone # $Id: gui.t,v 1.13 2009/05/02 17:02:30 Martin Exp $ use ExtUtils::testlib; use Test::More no_plan; use WWW::Search::Test; BEGIN { use_ok('WWW::Search::Yahoo') }; my $iDebug; my $iDump = 0; GUI_TEST: $iDebug = 0; tm_new_engine('Yahoo'); # goto MULTI; if (0) { # NOTE: As of 2009-05, the Yahoo GUI automatically does # spell-checking and if your query only returns one page of results, # it automatically chooses the closest word and shows those results # instead. diag("Sending 1-page query to yahoo.com..."); # This GUI query returns 1 page of results: $iDebug = 0; tm_run_test('gui', 'wiz'.'radary', 1, 9, $iDebug); } # if MULTI: diag("Sending multi-page query to yahoo.com..."); $iDebug = 0; # This GUI query returns many pages of results; gui search returns 10 # per page: tm_run_test('gui', 'pokemon', 21, undef, $iDebug); exit 0; __END__ WWW-Search-Yahoo-2.415/t/news-advanced.t0000755000175600010010000000237011177076246016566 0ustar MartinNone # $Id: news-advanced.t,v 1.21 2009/05/02 17:02:30 Martin Exp $ use ExtUtils::testlib; use Test::More no_plan; use Date::Manip; use WWW::Search::Test; BEGIN { use_ok('WWW::Search::Yahoo::News::Advanced') }; Date_Init('TZ=EST5EDT'); my $iDebug = 0; my $iDump = 0; NEWS_ADVANCED_TEST: tm_new_engine('Yahoo::News::Advanced'); # goto DEBUG_NOW; # This test returns no results (but we should not get an HTTP error): diag("Sending 0-page query to news.yahoo.com..."); $iDebug = 0; $iDump = 0; tm_run_test('normal', $WWW::Search::Test::bogus_query, 0, 0, $iDebug); DEBUG_NOW: diag("Sending 1-page query to news.yahoo.com..."); $iDebug = 0; $iDump = 0; tm_run_test('normal', 'thurn', 1, 99, $iDebug, $iDump); # goto ALL_DONE; # DEBUG_NOW: diag("Sending multi-page query to news.yahoo.com..."); $iDebug = 0; $iDump = 0; tm_run_test('normal', 'Japan', 51, undef, $iDebug, $iDump); goto ALL_DONE; pass; # TODO: { # $TODO = qq{yahoo.com advanced search is often broken.}; $WWW::Search::Test::oSearch->date_from('5 days ago'); $WWW::Search::Test::oSearch->date_to ('today'); $iDebug = 0; $iDump = 0; tm_run_test('normal', 'Aomori', 1, 20, $iDebug, $iDump); # $TODO = ''; } # end of TODO block SKIP_REST: pass; ALL_DONE: pass('all done'); exit 0; __END__ WWW-Search-Yahoo-2.415/t/pod-coverage.t0000755000175600010010000000131711132413060016376 0ustar MartinNone # $Id: pod-coverage.t,v 1.1 2009/01/11 15:54:24 Martin Exp $ use strict; use warnings; use Test::More; use blib; # BEGIN { sub Pod::Coverage::TRACE_ALL () { 1 } } # BEGIN { sub TRACE_ALL () { 1 } } # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); __END__ WWW-Search-Yahoo-2.415/t/pod.t0000755000175600010010000000027510612446204014617 0ustar MartinNone# $Id: pod.t,v 1.1 2007/04/21 17:40:20 Daddy Exp $ use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); __END__ WWW-Search-Yahoo-2.415/t/yahoo.t0000755000175600010010000000272010777754574015201 0ustar MartinNoneuse ExtUtils::testlib; use Test::More no_plan; BEGIN { use_ok('WWW::Search') }; BEGIN { use_ok('WWW::Search::Test') }; BEGIN { use_ok('WWW::Search::Yahoo') }; &tm_new_engine('Yahoo'); my $iDebug; my $iDump = 0; # goto MULTI_TEST; # goto TEST_NOW; # This test returns no results (but we should not get an HTTP error): diag("Sending 0-page query to yahoo.com..."); $iDebug = 0; $iDump = 0; &tm_run_test('normal', $WWW::Search::Test::bogus_query, 0, 0, $iDebug, $iDump); # goto THATS_ALL; TEST_NOW: $iDebug = 0; $iDump = 0; # This query returns 1 page of results: diag("Sending 1-page query to yahoo.com..."); &tm_run_test('normal', 'res'.'sultant', 1, 99, $iDebug, $iDump); my @ao = $WWW::Search::Test::oSearch->results(); my $iCount = scalar(@ao); my $iCountDesc = 0; SKIP: { skip 'got no results' unless cmp_ok(0, '<', $iCount, 'got any results'); foreach my $oResult (@ao) { like($oResult->url, qr{\Ahttps?://}, 'result URL is http'); cmp_ok($oResult->title, 'ne', '', 'result Title is not empty'); # cmp_ok($oResult->size, 'ne', '', 'result size is not empty'); $iCountDesc++ if ($oResult->description ne ''); } # foreach cmp_ok(0.95, '<', $iCountDesc/$iCount, 'mostly non-empty descriptions'); } # SKIP # goto THATS_ALL; MULTI_TEST: diag("Sending multi-page query to yahoo.com..."); $iDebug = 0; $iDump = 0; # This query returns MANY pages of results: &tm_run_test('normal', 'pok'.'emon', 101, undef, $iDebug, $iDump); THATS_ALL: exit 0; __END__