WWW-Search-AltaVista-2.154/0000755000175600010010000000000011114365314014207 5ustar MartinNoneWWW-Search-AltaVista-2.154/Changes0000755000175600010010000000735410657350216015524 0ustar MartinNone2007-08-11 * various: improved pod coverage 2007-06-27 * lib/WWW/Search/AltaVista.pm (parse_tree): ignore advertised links; fix result-count parser 2007-05-20 * use strict in all modules 2004-04-05 Kingpin * lib/WWW/Search/AltaVista/News.pm: handle new HTML page format * lib/WWW/Search/AltaVista.pm: handle new HTML page format 2004-02-24 Kingpin * lib/WWW/Search/AltaVista/News.pm (parse_tree): use count_pattern() * lib/WWW/Search/AltaVista.pm (count_pattern): new method * lib/WWW/Search/AltaVista/Web.pm: add $VERSION 2004-02-06 Kingpin * lib/WWW/Search/AltaVista.pm (parse_tree): fixed undef error(s) 2004-01-16 Kingpin * lib/WWW/Search/AltaVista.pm (parse_tree): FIX urls being absolutized wrong 2004-01-09 Kingpin * lib/WWW/Search/AltaVista.pm (native_setup_search): FIX _qr_count pattern; FIX use Date::Manip; clean up old code 2003-12-16 Kingpin * lib/WWW/Search/AltaVista.pm (native_setup_search): add . to result-count patterns (thanks to Andre Halama) 2003-11-24 Kingpin * lib/WWW/Search/AltaVista/News.pm (parse_tree): new method * t/de.t: add content tests; call env_proxy() * t/news.t: add content tests; call env_proxy() * lib/WWW/Search/AltaVista.pm: re-write parser using HTML::Tree * t/altavista.t (my_engine): new file 2003-07-27 Kingpin * lib/WWW/Search/AltaVista/DE.pm: new backend (thanks to Dmitry Katsubo) * lib/WWW/Search/AltaVista.pm (native_retrieve_some): tweak result-count patterns for www.altavista.de 2003-03-30 Kingpin * lib/WWW/Search/AltaVista/News.pm (native_setup_search): new search URL * lib/WWW/Search/AltaVista.pm (native_retrieve_some): fix parsing of NEXT link; ignore image links 2003-01-08 Kingpin * lib/WWW/Search/AltaVista.pm (gui_query): new method (native_setup_search): new URL options (native_retrieve_some): parse new output format 2002-08-21 Kingpin * lib/WWW/Search/AltaVista.pm (native_retrieve_some): bail out if page says 0 hits 2002-08-20 Kingpin * lib/WWW/Search/AltaVista/AdvancedWeb.pm (native_setup_search): new CGI options * lib/WWW/Search/AltaVista.pm (native_retrieve_some): update for slightly changed output format 2002-07-18 Kingpin * lib/WWW/Search/AltaVista/NL.pm: delete un-parsable email from bottom of file 2002-03-25 Kingpin * test.pl: all tests pass * lib/WWW/Search/AltaVista.pm (native_retrieve_some): correctly parse result list of length one 2002-02-19 Kingpin * lib/WWW/Search/AltaVista/AdvancedWeb.pm (native_retrieve_some): unescape URL (native_retrieve_some): BUGFIX for undefined $hit (?) 2001-12-11 Kingpin * lib/WWW/Search/AltaVista.pm (native_retrieve_some): unescape URL 2001-11-30 Kingpin * lib/WWW/Search/AltaVista/Intranet3.pm: new backend supplied by Peter von Burg * lib/WWW/Search/AltaVista.pm (native_retrieve_some): do not use URI::URL (native_setup_search): reorder CGI args for Intranet3.pm * lib/WWW/Search/AltaVista/AdvancedWeb.pm (native_retrieve_some): do not use URI::URL 2001-10-09 Kingpin * lib/WWW/Search/AltaVista.pm (native_retrieve_some): BUGFIX for death when seeing (bogus) description without a URL (native_retrieve_some): FIX for getting count of News results 2001-07-05 Kingpin * FIRST RELEASE outside of the WWW::Search distribution WWW-Search-AltaVista-2.154/inc/0000755000175600010010000000000011114365314014760 5ustar MartinNoneWWW-Search-AltaVista-2.154/inc/Module/0000755000175600010010000000000011114365314016205 5ustar MartinNoneWWW-Search-AltaVista-2.154/inc/Module/Install/0000755000175600010010000000000011114365314017613 5ustar MartinNoneWWW-Search-AltaVista-2.154/inc/Module/Install/Base.pm0000755000175600010010000000216011114365307021027 0ustar MartinNone#line 1 package Module::Install::Base; $VERSION = '0.77'; # 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) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 101 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 146 WWW-Search-AltaVista-2.154/inc/Module/Install/Can.pm0000755000175600010010000000354511114365307020666 0ustar MartinNone#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $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 158 WWW-Search-AltaVista-2.154/inc/Module/Install/Fetch.pm0000755000175600010010000000476511114365307021223 0ustar MartinNone#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $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-AltaVista-2.154/inc/Module/Install/Makefile.pm0000755000175600010010000001514311114365307021677 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.77'; $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 @_; # Make sure we have a new enough require ExtUtils::MakeMaker; # 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->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); # Generate the 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 379 WWW-Search-AltaVista-2.154/inc/Module/Install/Metadata.pm0000755000175600010010000002776611114365307021720 0ustar MartinNone#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } 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 }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } 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 ( @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; }; } sub requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{requires} }, [ $module, $version ]; } $self->{values}{requires}; } sub build_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{build_requires} }, [ $module, $version ]; } $self->{values}{build_requires}; } sub configure_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{configure_requires} }, [ $module, $version ]; } $self->{values}{configure_requires}; } sub recommends { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{recommends} }, [ $module, $version ]; } $self->{values}{recommends}; } sub bundles { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{bundles} }, [ $module, $version ]; } $self->{values}{bundles}; } # 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 sign { my $self = shift; return $self->{values}{sign} if defined wantarray and ! @_; $self->{values}{sign} = ( @_ ? $_[0] : 1 ); return $self; } 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()" ); # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). $version =~ s/^(\d+)\.(\d+)\.(\d+)$/sprintf("%d.%03d%03d",$1,$2,$3)/e; $version =~ s/_.+$//; $version = $version + 0; # Numify unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}{perl_version} = $version; return 1; } 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 eq 'perl' ) { $self->resources( license => 'http://dev.perl.org/licenses/' ); } 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 ) { if ( $osi and $license_text =~ /All rights reserved/i ) { print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n"; } $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g; 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 install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; WWW-Search-AltaVista-2.154/inc/Module/Install/Win32.pm0000755000175600010010000000350211114365307021060 0ustar MartinNone#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.77'; @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-AltaVista-2.154/inc/Module/Install/WriteAll.pm0000755000175600010010000000137111114365307021703 0ustar MartinNone#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.77'; @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->Meta->write if $args{meta}; $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 => {} ); } if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } } 1; WWW-Search-AltaVista-2.154/inc/Module/Install.pm0000755000175600010010000002174311114365306020164 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 # } BEGIN { require 5.004; } use strict 'vars'; use vars qw{$VERSION}; 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.77'; *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 and (stat($0))[9] > time ) { die <<"END_DIE" } Your installer $0 has a modification time in the future. 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"; unless ( uc($1) eq $1 ) { 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"}; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $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 { 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; } ##################################################################### # 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; open FH, "< $_[0]" or die "open($_[0]): $!"; my $str = do { local $/; }; close FH or die "close($_[0]): $!"; return $str; } sub _write { local *FH; 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; $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; } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s ) ? $_[0] : undef; } 1; # Copyright 2008 Adam Kennedy. WWW-Search-AltaVista-2.154/lib/0000755000175600010010000000000011114365314014755 5ustar MartinNoneWWW-Search-AltaVista-2.154/lib/WWW/0000755000175600010010000000000011114365314015441 5ustar MartinNoneWWW-Search-AltaVista-2.154/lib/WWW/Search/0000755000175600010010000000000011114365314016646 5ustar MartinNoneWWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/0000755000175600010010000000000011114365314020536 5ustar MartinNoneWWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/AdvancedNews.pm0000755000175600010010000000461510744776633023471 0ustar MartinNone# by John Heidemann # Copyright (C) 1996 by USC/ISI # $Id: AdvancedNews.pm,v 1.4 2008/01/21 02:04:11 Daddy Exp $ # # Complete copyright notice follows below. =head1 NAME WWW::Search::AltaVista::AdvancedNews - class for advanced Alta Vista news searching =head1 SYNOPSIS use WWW::Search; my $oSearch = new WWW::Search('AltaVista::AdvancedNews'); =head1 DESCRIPTION This class implements the advanced AltaVista news search (specializing AltaVista and WWW::Search). It handles making and interpreting AltaVista web searches F. Details of AltaVista can be found at L. This class exports no public interface; all interaction should be done through WWW::Search objects. =head1 AUTHOR C is written by John Heidemann, . =head1 COPYRIGHT Copyright (c) 1996 University of Southern California. All rights reserved. Redistribution and use in source and binary forms are permitted provided that the above copyright notice and this paragraph are duplicated in all such forms and that any documentation, advertising materials, and other materials related to such distribution and use acknowledge that the software was developed by the University of Southern California, Information Sciences Institute. The name of the University may not be used to endorse or promote products derived from this software without specific prior written permission. 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::AltaVista::AdvancedNews; use strict; use warnings; use base 'WWW::Search::AltaVista'; =head2 native_setup_search This private method does the heavy lifting after native_query() is called. =cut sub native_setup_search { my($self) = shift; if (!defined($self->{_options})) { $self->{_options} = { pg => 'aq', 'text' => 'yes', what => 'news', fmt => 'd', 'search_url' => 'http://www.altavista.com/cgi-bin/query', }; }; # let AltaVista.pm finish up the hard work. return $self->SUPER::native_setup_search(@_); } # native_setup_search 1; __END__ WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/AdvancedWeb.pm0000755000175600010010000001446510744776702023273 0ustar MartinNone############################################################# # AdvancedWeb.pm # by Jim Smyser # Copyright (c) 1999 by Jim Smyser & USC/ISI # $Id: AdvancedWeb.pm,v 2.85 2008/01/21 02:04:50 Daddy Exp $ ############################################################# package WWW::Search::AltaVista::AdvancedWeb; use strict; use warnings; =head1 NAME WWW::Search::AltaVista::AdvancedWeb - class for advanced Alta Vista web searching =head1 SYNOPSIS use WWW::Search; my $search = new WWW::Search('AltaVista::AdvancedWeb'); $search->native_query(WWW::Search::escape_query('(bmw AND mercedes) AND NOT (used OR Ferrari)')); $search->maximum_to_retrieve('100'); while (my $result = $search->next_result()) { print $result->url, "\n"; } =head1 DESCRIPTION Class hack for Advance AltaVista web search mode originally written by John Heidemann F. This hack now allows for AltaVista AdvanceWeb search results to be sorted and relevant results returned first. Initially, this class had skiped the 'r' option which is used by AltaVista to sort search results for relevancy. Sending advance query using the 'q' option resulted in random returned search results which made it impossible to view best scored results first. This class exports no public interface; all interaction should be done through WWW::Search objects. =head1 HELP Use AND to join two terms that must both be present for a document to count as a match. Use OR to join two terms if either one counts. Use AND NOT to join two terms if the first must be present and the second must NOT. Use NEAR to join two terms if they both must appear and be within 10 words of each other. Try this example: cars AND bmw AND mercedes You don't have to capitalize the "operators" AND, OR, AND NOT, or NEAR. But many people do to make it clear what is a query term and what is an instruction to the search engine. One other wrinkle that's very handy: you can group steps together with parentheses to tell the system what order you want it to perform operations in. (bmw AND mercedes) NEAR cars AND NOT (used OR Ferrari) Keep in mind that grouping should be used as much as possible because if you attempt to enter a long query using AND to join the words you may not receive any results because the entire query would be like one long phrase. For best reuslts follow the example herein. =head1 AUTHOR C hack by Jim Smyser, . =head1 COPYRIGHT Copyright (c) 1996 University of Southern California. All rights reserved. Redistribution and use in source and binary forms are permitted provided that the above copyright notice and this paragraph are duplicated in all such forms and that any documentation, advertising materials, and other materials related to such distribution and use acknowledge that the software was developed by the University of Southern California, Information Sciences Institute. The name of the University may not be used to endorse or promote products derived from this software without specific prior written permission. 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 VERSION HISTORY 2.07 - unescape URLs, and bugfix for undefined $hit 2.06 - do not use URI::URL 2.02 - Added HELP POD. Misc. Clean-up for latest changes. 2.01 - Additional query modifiers added for even better results. 2.0 - Minor change to set lowercase Boolean operators to uppercase. 1.9 - First hack version release. =cut ##################################################################### use WWW::Search qw( generic_option ); use WWW::Search::AltaVista; use base 'WWW::Search::AltaVista'; our $VERSION = do { my @r = (q$Revision: 2.85 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; =head2 native_setup_search This private method does the heavy lifting after native_query() is called. =cut sub native_setup_search { my($self, $native_query, $native_options_ref) = @_; $self->user_agent('user'); $self->{_next_to_retrieve} = 0; # Upper case all lower case Boolean operators. Be nice if # I could just uppercase the entire string, but this may # have undesirable search side effects. if (!defined($self->{_options})) { $self->{_options} = { 'pg' => 'aq', 'avkw' => 'tgz', 'aqmode' => 'b', 'kl' => 'XX', 'nbq' => 50, 'd2' => 0, 'aqb' => $native_query, 'search_url' => 'http://www.altavista.com/sites/search/web', }; } # if my($options_ref) = $self->{_options}; if (defined($native_options_ref)) { # Copy in new options. foreach (keys %$native_options_ref) { $options_ref->{$_} = $native_options_ref->{$_}; }; }; # Process the options. my($options) = ''; foreach (keys %$options_ref) { # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n"; next if (generic_option($_)); $options .= $_ . '=' . $options_ref->{$_} . '&'; }; $self->{_debug} = $options_ref->{'search_debug'}; $self->{_debug} = 2 if ($options_ref->{'search_parse_debug'}); $self->{_debug} = 0 if (!defined($self->{_debug})); # Finally figure out the url. # Here I remove known Boolean operators from the 'r' query option # which is used by AltaVista to sort the results. Finally, clean # up by removing as many of the double ++'s as possibe left behind. $native_query =~ s/\bAND\b//ig; $native_query =~ s/\bOR\b//ig; $native_query =~ s/\bNOT\b//ig; $native_query =~ s/\bNEAR\b//ig; $native_query =~ s/"//g; $native_query =~ s/%28//g; $native_query =~ s/%29//g; $native_query =~ s/(\w)\053\053/$1\053/g; # strip down the query words $native_query =~ s/\W*(\w+\W+\w+\w+\W+\w+).*/$1/; $self->{_base_url} = $self->{_next_url} = $self->{_options}{'search_url'} . "?" . $options . "r=" . $native_query; } # native_setup_search # All other methods are inherited from WWW::Search::AltaVista 1; __END__ http://www.altavista.com/sites/search/web?pg=aq&avkw=tgz&aqa=&aqp=&aqn=&aqmode=b&aqb=LSAM+AND+AutoSearch&aqs=&kl=XX&dt=tmperiod&d2=0&d0=&d1=&rc=rgn&sgr=all&swd=&lh=&nbq=50 WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/Careers.pm0000755000175600010010000001311010744776633022501 0ustar MartinNone # $Id: Careers.pm,v 1.14 2008/01/21 02:04:11 Daddy Exp $ # AltaVistaCareers.pm # Author: Alexander Tkatchev # e-mail: Alexander.Tkatchev@cern.ch # # WWW::Search back-end for AltaVistaCareers # http://search.altavistacareers.com/cgi-bin/texis/jobbot/search =head1 NAME WWW::Search::AltaVista::Careers - class for searching www.altavistacareers.com =head1 SYNOPSIS use WWW::Search; my $oSearch = new WWW::Search('AltaVista::Careers'); my $sQuery = WWW::Search::escape_query("java c++)"); $oSearch->native_query($sQuery, {'state' => 'CA'}); while (my $res = $oSearch->next_result()) { print $res->title . "\t" . $res->change_date . "\t" . $res->location . "\t" . $res->url . "\n"; } =head1 DESCRIPTION This class is a AltaVistaCareers specialization of WWW::Search. It handles making and interpreting AltaVistaCareers searches F. The returned WWW::SearchResult objects contain B, B, B<location> and B<change_date> fields. =head1 OPTIONS The following search options can be activated by sending a hash as the second argument to native_query(). The only available options are to select a specific location. The default is to search all locations. To change it use =over 2 =item {'state' => $state} - Only jobs in state $state. =item {'city' => $city} - Only job in a specific $city =back =head1 AUTHOR C<WWW::Search::AltaVistaCareers> is written and maintained by Alexander Tkatchev (Alexander.Tkatchev@cern.ch). =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. =cut ##################################################################### package WWW::Search::AltaVista::Careers; use strict; use warnings; use base 'WWW::Search::AltaVista'; use Carp (); use HTML::TokeParser; use WWW::Search qw( generic_option ); use WWW::SearchResult; our $VERSION = do { my @r = (q$Revision: 1.14 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; =head2 native_setup_search This private method does the heavy lifting after native_query() is called. =cut sub native_setup_search { my($self, $native_query, $native_options_ref) = @_; $self->{agent_e_mail} = 'alexander.tkatchev@cern.ch'; $self->user_agent('non-robot'); if (!defined($self->{_options})) { $self->{'search_base_url'} = 'http://search.altavistacareers.com'; # $self->{'search_base_url'} = 'http://206.132.18.101'; $self->{_options} = { 'search_url' => $self->{'search_base_url'} . '/cgi-bin/texis/jobbot/search', 'query' => $native_query, 'city' => '', 'state' => '', 'sort' => 'J_AsOfDate' }; } # if my $options_ref = $self->{_options}; if (defined($native_options_ref)) { # Copy in new options. foreach (keys %$native_options_ref) { $options_ref->{$_} = $native_options_ref->{$_}; } # foreach } # if # Process the options. my($options) = ''; foreach (sort keys %$options_ref) { next if (generic_option($_)); $options .= $_ . '=' . $options_ref->{$_} . '&'; } # Finally figure out the url. $self->{_next_url} = $self->{_options}{'search_url'} .'?'. $options;; $self->{_debug} = $options_ref->{'search_debug'}; } # native_setup_search =head2 native_retrieve_some This private method does the heavy lifting of communicating with the server. =cut sub native_retrieve_some { my ($self) = @_; my $debug = $self->{_debug}; print STDERR " * AltaVista::native_retrieve_some()\n" if($debug); # fast exit if already done return undef if (!defined($self->{_next_url})); # get some print STDERR " * sending request (",$self->{_next_url},")\n" if($debug); my($response) = $self->http_request('GET', $self->{_next_url}); if (!$response->is_success) { print STDERR $response->error_as_HTML; return undef; }; $self->{'_next_url'} = undef; print STDERR " * got response\n" if($debug); if($response->content =~ m/Nothing matched your query/) { print STDERR "Nothing matched your query\n"; return 0; } my ($tag,$nexturl); my $p = new HTML::TokeParser(\$response->content()); if($response->content =~ m/\[\<b\>Next \>\;\>\;\<\/b\>\]/ ) { while(1) { $tag = $p->get_tag("a"); $nexturl = $self->{'search_base_url'} . $tag->[1]{href}; my $linktitle = $p->get_trimmed_text("/a"); last if($linktitle =~ m/\[Next \>\>\]/); } print STDERR "Next page url: $nexturl\n" if($debug); $self->{'_next_url'} = $nexturl; } else { print STDERR "No next page\n" if($debug); } my $pp = new HTML::TokeParser(\$response->content()); while(1) { $tag = $pp->get_tag("td"); my $data = $pp->get_trimmed_text("/td"); last if($data eq 'Location' || $data eq 'Date'); } $tag = $pp->get_tag("tr"); my($hits_found) = 0; my($hit) = (); while(1) { $tag = $pp->get_tag("a"); my $url = $tag->[1]{href}; $url =~ s|www|http://www|; $url =~ s|http://http://|http://|; my $title = $pp->get_trimmed_text("/a"); $tag = $pp->get_tag("td"); my $date = $pp->get_trimmed_text("/td"); last unless($date =~ m|(\d+)/(\d+)/(\d+)|); $tag = $pp->get_tag("td"); my $location = $pp->get_trimmed_text("/td"); $hit = new WWW::SearchResult; $hit->url($url); $hit->change_date($date); $hit->title($title); $hit->location($location); push(@{$self->{cache}}, $hit); $hits_found++; last if($hits_found == 10); } return $hits_found; } # native_retrieve_some 1; __END__ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/DE.pm�������������������������������������������0000755�0001756�0001001�00000002664�10744776633�021421� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# DE.pm # by Martin Thurn # $Id: DE.pm,v 1.5 2008/01/21 02:04:11 Daddy Exp $ =head1 NAME WWW::Search::AltaVista::DE - class for searching www.AltaVista.DE =head1 SYNOPSIS require WWW::Search; $search = new WWW::Search('AltaVista::DE'); =head1 DESCRIPTION This class handles making and interpreting AltaVista Germany searches F<http://www.altavista.de>. Details of AltaVista can be found at L<WWW::Search::AltaVista>. This class exports no public interface; all interaction should be done through WWW::Search objects. =head1 AUTHOR Martin Thurn C<mthurn@cpan.org> =cut ##################################################################### package WWW::Search::AltaVista::DE; use strict; use warnings; use base 'WWW::Search::AltaVista'; our $VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/o); =head2 native_setup_search This private method does the heavy lifting after native_query() is called. =cut sub native_setup_search { my $self = shift; my $sQuery = shift; if (!defined($self->{_options})) { $self->{_options} = { 'nbq' => '50', 'q' => $sQuery, 'search_host' => 'http://de.altavista.com', 'search_path' => '/web/results', }; }; # Let AltaVista.pm finish up the hard work: return $self->SUPER::native_setup_search($sQuery, @_); } # native_setup_search 1; __END__ ����������������������������������������������������������������������������WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/Intranet.pm�������������������������������������0000755�0001756�0001001�00000023056�10744776633�022713� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# AltaVista/Intranet.pm # by Martin Thurn # $Id: Intranet.pm,v 1.12 2008/01/21 02:04:11 Daddy Exp $ # # Complete copyright notice follows below. =head1 NAME WWW::Search::AltaVista::Intranet - class for searching via AltaVista Search Intranet 2.3 =head1 SYNOPSIS use WWW::Search; my $oSearch = new WWW::Search('AltaVista::Intranet', (_host => 'copper', _port => 9000),); my $sQuery = WWW::Search::escape_query("+investment +club"); $oSearch->native_query($sQuery); while (my $oResult = $oSearch->next_result()) { print $oResult->url, "\n"; } =head1 DESCRIPTION This class implements a search on AltaVista's Intranet ("AVI") Search. This class exports no public interface; all interaction should be done through WWW::Search objects. =head1 NOTES If your query includes characters outside the 7-bit ascii, you must tell AVI how to interpret 8-bit characters. Add an option for 'enc' to the native_query() call: $oSearch->native_query(WWW::Search::escape_query('Zürich'), { 'enc' => 'iso88591'}, ); Hopefully the correct values for various languages can be found in the AVI documentation (sorry, I haven't looked). =head1 TESTING There is no standard built-in test mechanism for this module, because very few users of WWW::Search will have AVI installed on their intranet. (How's that for an excuse? ;-) =head1 AUTHOR C<WWW::Search::AltaVista::Intranet> was written by Martin Thurn <mthurn@cpan.org> =head1 COPYRIGHT Copyright (c) 1996 University of Southern California. All rights reserved. Redistribution and use in source and binary forms are permitted provided that the above copyright notice and this paragraph are duplicated in all such forms and that any documentation, advertising materials, and other materials related to such distribution and use acknowledge that the software was developed by the University of Southern California, Information Sciences Institute. The name of the University may not be used to endorse or promote products derived from this software without specific prior written permission. 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 VERSION HISTORY If it''s not listed here, then it wasn''t a meaningful nor released revision. =head2 2.04, 2000-03-09 Added pod for selecting query language encoding =head2 2.03, 2000-02-14 Added support for score/rank (thanks to Peter bon Burg <pvonburg@aspes.ch>) =head2 2.02, 1999-11-29 Fixed to work with latest version of AltaVista.pm =head2 1.03, 1999-06-20 First publicly-released version. =cut ##################################################################### package WWW::Search::AltaVista::Intranet; use strict; use warnings; use base 'WWW::Search::AltaVista'; use Carp; our $VERSION = '2.04'; our $MAINTAINER = 'Martin Thurn <mthurn@cpan.org>'; our $TEST_CASES = <<"ENDTESTCASES"; &no_test('AltaVista::Intranet', '$MAINTAINER'); ENDTESTCASES =head2 native_setup_search This private method does the heavy lifting after native_query() is called. =cut sub native_setup_search { my ($self, $sQuery, $rhOptions) = @_; my $sMsg = ''; unless (defined($self->{_host}) && ($self->{_host} ne '')) { $sMsg .= " --- _host not specified in WWW::Search::AltaVista::Intranet object\n"; } unless (defined($self->{_port}) && ($self->{_port} ne '')) { $sMsg .= " --- _port not specified in WWW::Search::AltaVista::Intranet object\n"; } if ($sMsg ne '') { carp $sMsg; return undef; } # if $self->{_options} = { 'search_url' => 'http://'. $self->{_host} .':'. $self->{_port} .'/cgi-bin/query', 'text' => 'yes', 'mss' => 'simple', }; # let AltaVista.pm finish up the hard work. return $self->SUPER::native_setup_search($sQuery, $rhOptions); } # native_setup_search =head2 native_retrieve_some This private method does the heavy lifting of communicating with the server. =cut sub native_retrieve_some { my ($self) = @_; print STDERR " * AltaVista::Intranet::native_retrieve_some()\n" if $self->{_debug}; # fast exit if already done return undef if (!defined($self->{_next_url})); # If this is not the first page of results, sleep so as to not overload the server: $self->user_agent_delay if 1 < $self->{'_next_to_retrieve'}; # get some print STDERR " * sending request (",$self->{_next_url},")\n" if $self->{_debug}; my($response) = $self->http_request('GET', $self->{_next_url}); $self->{response} = $response; if (!$response->is_success) { return undef; } $self->{'_next_url'} = undef; print STDERR " * got response\n" if $self->{_debug}; # parse the output my ($HEADER, $HITS, $TITLE,$DESC,$DATE,$SIZE,$TRAILER) = qw(HE HI TI DE DA SI TR); my $hits_found = 0; my $state = ($HEADER); my $cite = ""; my $hit = (); foreach ($self->split_lines($response->content())) { next if m@^$@; # short circuit for blank lines print STDERR " * $state ===$_=== " if 2 <= $self->{'_debug'}; if ($state eq $HEADER && m/found\s+(\d+)\s+Web\s+pages\s+for\s+you/i) { # Actual line of input is: # <b><b><!-- avecho val="About " if="notexists $avs.header.isExact" -->AltaVista found 33 Web pages for you. </b></b> print STDERR "count line\n" if 2 <= $self->{_debug}; $self->approximate_result_count($1); $state = $HITS; } # COUNT line if ($state eq $HEADER && m/DOCUMENTS\s+\d+-\d+\s+OF+\s(\d+)/i) { # Actual line of input is: # <b> Documents 1-1 of 1 matching the query, best matches first.</b><dl> print STDERR "count line\n" if 2 <= $self->{_debug}; $self->approximate_result_count($1); $state = $HITS; } # COUNT line elsif ($state eq $HITS && m:\<dl>\<dt>\<b>(\d+)\.:i) { # Actual line of input is: # <dl><dt><b>1. </b> print STDERR "rank line\n" if 2 <= $self->{_debug}; $state = $TITLE; } elsif ($state eq $TITLE && m:\<a\shref=\"([^"]+)\">:i) { # Actual line of input is: # <!-- PAV 1 --><a href="http://www.tasc.com/news/prism/9811/51198.html"><!-- PAV end --><b>Arlington Pond Waterski Club 11/98 </b></a><dd> # <dt><a href="http://copper.dulles.tasc.com/SEVEN/TESTFILE1-header"><strong>TESTFILE1-header</strong></a><dd>dummy header line 1 dummy header line 2 dummy header line 3 dummy header line 4 DUCTAPE ENCODED 321 535 dummy header line 6 dummy header line 7 DEBUG THIS.<br><cite><a href="http://copper.dulles.tasc.com/SEVEN/TESTFILE1-header">http://copper.dulles.tasc.com/SEVEN/TESTFILE1-header</a><font size=-1> - size 1K</font></cite><br> print STDERR "title line\n" if 2 <= $self->{_debug}; if (ref($hit)) { push(@{$self->{cache}}, $hit); } $hit = new WWW::SearchResult; $hit->add_url($1); $hits_found++; if (m:\<b>(.+?)\</b>:i) { my $sTitle = $1; $sTitle =~ s/\s+$//; $hit->title($sTitle); } # if if (m:\<strong>(.+?)\</strong>:i) { my $sTitle = $1; $sTitle =~ s/\s+$//; $hit->title($sTitle); } # if $state = $DESC; } # TITLE line elsif ($state eq $DESC) { # Actual line of input is: # The Analytic Investment Club. TASC employees in Northern Virginia formed The Analytic Investment Club (TAIC) in June 1995. The goals of the club are to...<br> print STDERR "description line\n" if 2 <= $self->{_debug}; $hit->description($_); $state = $DATE; } # DESCRIPTION line elsif ($state eq $DATE && m:Last modified (.+)$:i) { # Actual lines of input are: # Last modified 15-Jan-1999 # <br>Rank: 170 - Last modified 11-Feb-2000 print STDERR "date line\n" if 2 <= $self->{_debug}; $hit->change_date($1); $hit->score($1) if m!Rank:\s+(\d+)!; $state = $SIZE; } # DATE line elsif ($state eq $SIZE && m:page size (\S+):i) { # Actual line of input is: # - page size 5K print STDERR "size line\n" if 2 <= $self->{_debug}; my $iSize = $1; $iSize *= 1024 if ($iSize =~ s@k$@@i); $iSize *= 1024*1024 if ($iSize =~ s@M$@@i); $hit->size($iSize); $state = $HITS; } # SIZE line elsif ($state eq $HITS && m:next\s*>>:i) { # Actual line of input is: # <a href="cgi-bin/query?mss=simple&what=web&pg=q&q=investment+club&text=yes&kl=XX&enc=iso88591&filter=intranet&stq=10">[<b>next >></b>]</a> print STDERR "next link line\n" if 2 <= $self->{_debug}; if (m:href=\"([^\"]+)\":i) { my $relative_url = $1; $self->{_next_url} = new URI::URL($relative_url, $self->{_base_url}); } # if $state = $TRAILER; } # NEXT line else { print STDERR "didn't match\n" if 2 <= $self->{_debug}; } } # foreach if (defined($hit)) { push(@{$self->{cache}}, $hit); } # if return $hits_found; } # native_retrieve_some 1; __END__ Here is a complete URL: http://copper.dulles.tasc.com:9000/cgi-bin/query?mss=simple&pg=q&what=web&user=searchintranet&text=yes&enc=iso88591&filter=intranet&kl=XX&q=forensics&act=Search This is the barest-bones version that still works: http://copper.dulles.tasc.com:9000/cgi-bin/query?mss=simple&text=yes&q=giraffe This is what we are generating with WWW::Search 2.06: http://copper:9000/cgi-bin/query?fmt=&mss=simple&pg=q&text=yes&what=web&q=giraffe ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/Intranet3.pm������������������������������������0000755�0001756�0001001�00000022334�10744776633�022774� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# AltaVista/Intranet3.pm # $Id: Intranet3.pm,v 1.5 2008/01/21 02:04:11 Daddy Exp $ # # Complete copyright notice follows below. =head1 NAME WWW::Search::AltaVista::Intranet3 - class for searching via AltaVista Search Intranet 3.0 =head1 SYNOPSIS use WWW::Search; my $oSearch = new WWW::Search('AltaVista::Intranet3', (_host => 'copper', _port => 9000),); my $sQuery = WWW::Search::escape_query("+investment +club"); $oSearch->native_query($sQuery); while (my $oResult = $oSearch->next_result()) { print $oResult->url, "\n"; } =head1 DESCRIPTION This class implements a search on AltaVista's Intranet ("AVI") Search. This class exports no public interface; all interaction should be done through WWW::Search objects. =head1 NOTES If your query includes characters outside the 7-bit ascii, you must tell AVI how to interpret 8-bit characters. Add an option for 'enc' to the native_query() call: $oSearch->native_query(WWW::Search::escape_query('Zürich'), { 'enc' => 'iso88591'}, ); Hopefully the correct values for various languages can be found in the AVI documentation (sorry, I haven't looked). =head1 TESTING There is no standard built-in test mechanism for this module, because very few users of WWW::Search will have AVI installed on their intranet. (How's that for an excuse? ;-) =head1 AUTHOR =head1 COPYRIGHT Copyright (c) 1996 University of Southern California. All rights reserved. Redistribution and use in source and binary forms are permitted provided that the above copyright notice and this paragraph are duplicated in all such forms and that any documentation, advertising materials, and other materials related to such distribution and use acknowledge that the software was developed by the University of Southern California, Information Sciences Institute. The name of the University may not be used to endorse or promote products derived from this software without specific prior written permission. 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 VERSION HISTORY If it''s not listed here, then it wasn''t a meaningful nor released revision. =head2 2.04, 2000-03-09 Added pod for selecting query language encoding =head2 2.03, 2000-02-14 Added support for score/rank (thanks to Peter von Burg <pvonburg@aspes.ch>) =head2 2.02, 1999-11-29 Fixed to work with latest version of AltaVista.pm =head2 1.03, 1999-06-20 First publicly-released version. =cut ##################################################################### package WWW::Search::AltaVista::Intranet3; use strict; use warnings; use base 'WWW::Search::AltaVista'; use Carp; our $VERSION = '2.04'; our $TEST_CASES = <<"ENDTESTCASES"; &no_test('AltaVista::Intranet3', '$MAINTAINER'); ENDTESTCASES $self->{_debug} = 1; # PvB # private sub native_setup_search { my ($self, $sQuery, $rhOptions) = @_; my $sMsg = ''; unless (defined($self->{_host}) && ($self->{_host} ne '')) { $sMsg .= " --- _host not specified in WWW::Search::AltaVista::Intranet object\n"; } unless (defined($self->{_port}) && ($self->{_port} ne '')) { $sMsg .= " --- _port not specified in WWW::Search::AltaVista::Intranet object\n"; } if ($sMsg ne '') { carp $sMsg; return undef; } # if $self->{_options} = { # PvB 'search_url' => 'http://' . $self->{_host} . ':' . $self->{_port} . '/cgi-bin/query', 'mss' => 'search', # AV Intranet 3.0 # 'mss' => 'simple', # AV Intranet 2.3 'kl' => '', 'i' => '', 'text' => 'yes', }; # $self->{_debug} = 1; # PvB if ($self->{_debug}) { # PvB print " Query: ", $sQuery, "\n"; print " Options: "; while (($k, $v) =each %$rhOptions) {print "$k => $v "}; print "\n"; } # let AltaVista.pm finish up the hard work. return $self->SUPER::native_setup_search($sQuery, $rhOptions); } # native_setup_search # private sub native_retrieve_some { my ($self) = @_; print STDERR " * AltaVista::Intranet::native_retrieve_some()\n" if $self->{_debug}; # fast exit if already done return undef if (!defined($self->{_next_url})); # If this is not the first page of results, sleep so as to not overload the server: $self->user_agent_delay if 1 < $self->{'_next_to_retrieve'}; # get some print STDERR " * sending request (",$self->{_next_url},")\n" if $self->{_debug}; my($response) = $self->http_request('GET', $self->{_next_url}); $self->{response} = $response; if (!$response->is_success) { return undef; } $self->{'_next_url'} = undef; print STDERR " * got response, start parsing\n" if $self->{_debug}; # parse the output my ($HEADER, $HITS, $TITLE,$DESC,$DATE,$SIZE,$TRAILER) = qw(HE HI TI DE DA SI TR); my $hits_found = 0; my $state = ($HEADER); my $cite = ""; my $hit = (); foreach ($self->split_lines($response->content())) { next if m@^$@; # short circuit for blank lines print STDERR " * $state ===$_=== \n" if 2 <= $self->{'_debug'}; if ($state eq $HEADER && m/<b>AltaVista found\s+(\d+)/i) # PvB { print "No of Pages Line --$_--\n" if 2 <= $self->{_debug}; # 1st parsing check: No of Pages # Actual line of input is: # print STDERR "found web pages count line\n" if 2 <= $self->{_debug}; $self->approximate_result_count($1); print "No of pages found: $1\n\n" if $self->{_debug}; # PvB $state = $HITS; } # COUNT line if ($state eq $HITS && m/Word count:/) # PvB { print "No of words Line --$_--\n" if 2 <= $self->{_debug}; # 2nd parsing check: No of Words # Actual line of input is: # print STDERR "count line\n" if 2 <= $self->{_debug}; $self->approximate_result_count($1); $state = $HITS; } # COUNT line elsif ($state eq $HITS && m/Begin results list/i) # PvB { $state = $TITLE; # PvB } elsif ($state eq $TITLE && m:\<a\shref=\"([^"]+)\">:i) # PvB *** begin found pages *** { print "title line: --$_--\n" if 2 <= $self->{_debug}; # 4nd parsing check: title # Actual line of input is: # # print STDERR "title line\n" if 2 <= $self->{_debug}; if (ref($hit)) { push(@{$self->{cache}}, $hit); } $hit = new WWW::SearchResult; $hit->add_url($1); print "Hit found: $1\n" if $self->{_debug}; $hits_found++; if (m:\<b>(.+?)\</b>:i) { my $sTitle = $1; $sTitle =~ s/\s+$//; $sTitle =~ s:</a>.*::; $sTitle =~ s:.*<a.*">::; print "Title of page found: ", $sTitle, "\n" if $self->{_debug}; $hit->title($sTitle); } # if if (m:\<strong>(.+?)\</strong>:i) { my $sTitle = $1; $sTitle =~ s/\s+$//; print "Title of page found: ", $sTitle, "\n" if $self->{_debug}; $hit->title($sTitle); } # if $state = $DESC; } # TITLE line elsif ($state eq $DESC) { # Actual line of input is: # $_ =~ s/<dd>//i; $_ =~ s/<br>//i; print STDERR "description line\n" if 2 <= $self->{_debug}; print STDERR "description: --$_-- \n" if 2 <= $self->{_debug}; $hit->description($_); $state = $DATE; print "Description of page found: ", $_, "\n" if $self->{_debug}; } # DESCRIPTION line elsif ($state eq $DATE && m:Last modified (.+)$:i) { # Actual lines of input are: # # print STDERR "relevance/date/size line\n" if 2 <= $self->{_debug}; $line = $_; $_ =~ s/.*modified on //i; $_ =~ s/ ·.*//i; print STDERR "last modified date: $_ \n" if $self->{_debug}; $hit->change_date($_); $_ = $line; $_ =~ s/Relevance //i; $_ =~ s/ ·.*//i; print STDERR "relevance: $_ \n" if $self->{_debug}; $hit->score($_); $_ = $line; $_ =~ s/.* · Last//i; $_ =~ s/.*? · //i; $_ =~ s/ bytes.*//i; my $iSize = $_; $iSize *= 1024 if ($iSize =~ s@k$@@i); $iSize *= 1024*1024 if ($iSize =~ s@M$@@i); print STDERR "size: $iSize \n\n" if $self->{_debug}; $hit->size($iSize); $state = $TITLE; } # REL/DATE/SIZE line elsif ($state eq $TRAILER && m:next\s*>>:i) { # Actual line of input is: # print STDERR "next link line\n" if 2 <= $self->{_debug}; $_ =~ s/\[<a href="//i; $_ =~ s/"><b>next.*//i; $_ = 'http://' . $self->{_host} .':'. $self->{_port} . $_ ; $self->{_next_url} = $_; print STDERR "next link url is: $_ \n" if $self->{_debug}; $state = $TRAILER; } # next AV result page elsif ($_ eq "<!-- End results list. -->") { print " * end of parsing reached\n" if $self->{_debug}; $state = $TRAILER; } # NEXT line else { print STDERR "didn't match\n" if 2 <= $self->{_debug}; } } # foreach if (defined($hit)) { push(@{$self->{cache}}, $hit); } # if print " * hits found: \n" if $self->{_debug}; return $hits_found; } # native_retrieve_some 1; __END__ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/News.pm�����������������������������������������0000755�0001756�0001001�00000013664�10744776633�022047� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# News.pm # by John Heidemann # Copyright (C) 1996 by USC/ISI # $Id: News.pm,v 2.108 2008/01/21 02:04:11 Daddy Exp $ # # Complete copyright notice follows below. =head1 NAME WWW::Search::AltaVista::News - class for Alta Vista news searching =head1 SYNOPSIS require WWW::Search; $search = new WWW::Search('AltaVista::News'); =head1 DESCRIPTION This class implements the AltaVista news search (specializing AltaVista and WWW::Search). It handles making and interpreting AltaVista news searches F<http://www.altavista.com>. Details of AltaVista can be found at L<WWW::Search::AltaVista>. This class exports no public interface; all interaction should be done through WWW::Search objects. =head1 METHODS =cut ##################################################################### package WWW::Search::AltaVista::News; use strict; use warnings; use base 'WWW::Search::AltaVista'; our $VERSION = do { my @r = (q$Revision: 2.108 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; our $MAINTAINER = 'Martin Thurn <mthurn@cpan.org>'; =head2 native_setup_search (private) This method does the heavy-lifting after native_query() is called. =cut sub native_setup_search { my $self = shift; my $sQuery = shift; if (!defined($self->{_options})) { # http://www.altavista.com/news/results?q=Ashburn&nc=0&nr=0&nd=2 $self->{_options} = { 'nbq' => '50', 'q' => $sQuery, 'search_host' => 'http://www.altavista.com', 'search_path' => '/news/results', }; } # if # Let AltaVista.pm finish up the hard work: return $self->SUPER::native_setup_search($sQuery, @_); } # native_setup_search sub _preprocess_results_page { my $self = shift; my $sPage = shift; # return $sPage; # For debugging only. Print the page contents and abort. print STDERR '='x 25, "\n\n", $sPage, "\n\n", '='x 25; exit 88; } # preprocess_results_page =head2 parse_tree This method parses the HTML of the search results. =cut sub parse_tree { my $self = shift; my $tree = shift; my $iHits = 0; my $WS = q{[\t\r\n\240\ ]}; # 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 $qrCount = $self->_count_pattern; # The hit count is inside a <B> tag: my @aoB = $tree->look_down('_tag' => 'b', 'class' => 'lbl', ); B_TAG: foreach my $oB (@aoB) { next unless ref $oB; print STDERR " + try B ==", $oB->as_HTML if 2 <= $self->{_debug}; my $s = $oB->as_text; print STDERR " + TEXT ==$s==\n" if 2 <= $self->{_debug}; if ($s =~ m!$qrCount!i) { my $iCount = $1; $iCount =~ s!,!!g; $self->approximate_result_count($iCount); last B_TAG; } # if } # foreach B_TAG } # if print STDERR " + found approx_h_c is ==", $self->approximate_hit_count(), "==\n" if 2 <= $self->{_debug}; # Get the hits: my @aoA = $tree->look_down('_tag' => 'a', 'class' => 'res', ); A_TAG: foreach my $oA (@aoA) { next A_TAG unless ref $oA; my $sURL = $oA->attr('href') || ''; next A_TAG unless ($sURL ne ''); my $sTitle = $oA->as_text; print STDERR " + oA ==", $oA->as_HTML, "==\n" if (2 <= $self->{_debug}); print STDERR " + sTitle ==$sTitle==\n" if (2 <= $self->{_debug}); my $oTD = $oA->parent; next A_TAG unless ref $oTD; my $oSPANdate = $oTD->look_down('_tag' => 'span', 'class' => 'ngrn'); next A_TAG unless ref $oSPANdate; my $sDate = $oSPANdate->as_text; my $oSPANsrc = $oTD->look_down('_tag' => 'span', 'style' => 'color:#4a4a4a'); next A_TAG unless ref $oSPANsrc; my $sSource = $oSPANsrc->as_text; my $oSPANdesc = $oTD->look_down('_tag' => 'span', 'class' => 's'); next A_TAG unless ref $oSPANdesc; my $sDescription = $oSPANdesc->as_text; my $oHit = new WWW::Search::Result; $oHit->add_url($self->absurl($self->{'_prev_url'}, $sURL)); $oHit->title(&WWW::Search::strip_tags($sTitle)); $oHit->source(&WWW::Search::strip_tags($sSource)); $oHit->description(&WWW::Search::strip_tags($sDescription)); $oHit->change_date(&WWW::Search::strip_tags($sDate)); push(@{$self->{cache}}, $oHit); $self->{'_num_hits'}++; $iHits++; # Make it easier to find the "Next" tag: $oA->detach; $oA->delete; } # foreach A_TAG # Find the 'next page' link: @aoA = $tree->look_down('_tag' => 'a', ); NEXT_TAG: foreach my $oA (@aoA) { next NEXT_TAG unless ref $oA; # Multilingual version: next NEXT_TAG unless $oA->as_text =~ m!\s>>\Z!; # English-only version: # next NEXT_TAG unless $oA->as_text eq q{Next >>}; $self->{_next_url} = $self->absurl($self->{'_prev_url'}, $oA->attr('href')); last NEXT_TAG; } # foreach return $iHits; } # parse_tree 1; =head1 AUTHOR C<WWW::Search> is written by John Heidemann, <johnh@isi.edu>. =head1 COPYRIGHT Copyright (c) 1996 University of Southern California. All rights reserved. Redistribution and use in source and binary forms are permitted provided that the above copyright notice and this paragraph are duplicated in all such forms and that any documentation, advertising materials, and other materials related to such distribution and use acknowledge that the software was developed by the University of Southern California, Information Sciences Institute. The name of the University may not be used to endorse or promote products derived from this software without specific prior written permission. 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 __END__ ����������������������������������������������������������������������������WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/NL.pm�������������������������������������������0000755�0001756�0001001�00000023516�10744776633�021441� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# # NL.pm # by Erik Smit # Copyright (C) 1996-1998 by USC/ISI # Copyright (C) 2001 by Different Soft # $Id: NL.pm,v 1.113 2008/01/21 02:04:11 Daddy Exp $ # # Complete copyright notice follows below. # =head1 NAME WWW::Search::AltaVista::NL - class for searching the dutch version of Alta Vista =head1 SYNOPSIS require WWW::Search; $search = new WWW::Search('AltaVista::NL'); =head1 DESCRIPTION This class is an modified version of the AltaVista specialization of WWW::Search. It handles making and interpreting Dutch AltaVista searches F<http://nl.altavista.com>. This class exports no public interface; all interaction should be done through WWW::Search objects. =head1 OPTIONS The default is for simple web queries. =over 8 =item search_url=URL Specifies who to query with the AltaVista protocol. The default is at C<http://nl.altavista.com/cgi-bin/query>; =item search_debug, search_parse_debug, search_ref Specified at L<WWW::Search>. =item pg=aq Do advanced queries. (It defaults to simple queries.) =back =head1 PUBLIC METHODS There are none defined here; see WWW::Search. =cut ##################################################################### package WWW::Search::AltaVista::NL; use strict; use warnings; use base 'WWW::Search::AltaVista'; use Carp (); use WWW::Search qw( generic_option ); use WWW::SearchResult; our $VERSION = do { my @r = (q$Revision: 1.113 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; =head1 PRIVATE METHODS =head2 native_setup_search This private method does the heavy lifting after you call native_query(). =cut sub native_setup_search { my($self, $native_query, $native_options_ref) = @_; $self->user_agent('user'); $self->{_next_to_retrieve} = 0; # set the text=yes option to provide next links with <a href> # (suggested by Guy Decoux <decoux@moulon.inra.fr>). if (!defined($self->{_options})) { $self->{_options} = { 'pg' => 'q', 'text' => 'yes', 'what' => 'nl', 'fmt' => 'd', 'search_url' => 'http://nl.altavista.com/cgi-bin/query', }; }; my($options_ref) = $self->{_options}; if (defined($native_options_ref)) { # Copy in new options. foreach (keys %$native_options_ref) { $options_ref->{$_} = $native_options_ref->{$_}; }; }; # Process the options. # (Now in sorted order for consistency regarless of hash ordering.) my($options) = ''; foreach (sort keys %$options_ref) { # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n"; next if (generic_option($_)); $options .= $_ . '=' . $options_ref->{$_} . '&'; }; $self->{_debug} = $options_ref->{'search_debug'}; $self->{_debug} = 2 if ($options_ref->{'search_parse_debug'}); $self->{_debug} = 0 if (!defined($self->{_debug})); # Finally figure out the url. $self->{_base_url} = $self->{_next_url} = $self->{_options}{'search_url'} . "?" . $options . "q=" . $native_query; print STDERR $self->{_base_url} . "\n" if ($self->{_debug}); } # private sub _save_old_hit { my($self) = shift; my($old_hit) = shift; my($old_raw) = shift; if (defined($old_hit)) { $old_hit->raw($old_raw) if (defined($old_raw)); push(@{$self->{cache}}, $old_hit); }; return(undef, undef); } # private sub _begin_new_hit { my($self) = shift; my($old_hit) = shift; my($old_raw) = shift; $self->_save_old_hit($old_hit, $old_raw); # Make a new hit. return (new WWW::SearchResult, ''); } =head2 native_retrieve_some This private method does the heavy lifting of fetching and parsing web pages. =cut sub native_retrieve_some { my ($self) = @_; # fast exit if already done return undef if (!defined($self->{_next_url})); # get some print STDERR "WWW::Search::AltaVistaNL::native_retrieve_some: fetching " . $self->{_next_url} . "\n" if ($self->{_debug}); my($response) = $self->http_request('GET', $self->{_next_url}); $self->{response} = $response; if (!$response->is_success) { return undef; }; # parse the output my($HEADER, $HITS, $INHIT, $TRAILER, $POST_NEXT) = (1..10); # order matters my($hits_found) = 0; my($state) = ($HEADER); my($hit) = undef; my($raw) = ''; foreach ($self->split_lines($response->content())) { next if m@^$@; # short circuit for blank lines ###### # HEADER PARSING: find the number of hits # if (0) { } elsif ($state == $HEADER && /AltaVista vond geen documenten voor uw zoekbewerking/i) { # 25-Oct-99 $self->approximate_result_count(0); $state = $TRAILER; print STDERR "PARSE(10:HEADER->HITS): no documents found.\n" if ($self->{_debug} >= 2); ###### } elsif ($state == $HEADER && /([\d,]+) gevonden? pagina's/i) { # 25-Oct-99 my($n) = $1; $n =~ s/,//g; $self->approximate_result_count($n); $state = $HITS; print STDERR "PARSE(10:HEADER->HITS): $n documents found.\n" if ($self->{_debug} >= 2); ###### # HITS PARSING: find each hit # } elsif ($state == $HITS && /(<table width="100%" align="center">)/i) { $state = $TRAILER; print STDERR "PARSE(11:HITS->TRAILER): done.\n" if ($self->{_debug} >= 2); } elsif ($state == $HITS && /<dl><dt>/i) { # 25-Oct-99 ($hit, $raw) = $self->_begin_new_hit($hit, $raw); $hits_found++; $raw .= $_; $state = $INHIT; print STDERR "PARSE(12:HITS->INHIT): hit start.\n" if ($self->{_debug} >= 2); } elsif ($state == $INHIT && /^<b>URL: <\/b><FONT color="#777777">([^"]+)<br>/i) { #" # 25-Oct-99 $raw .= $_; $hit->add_url($1); print STDERR "PARSE(13:INHIT): url: $1.\n" if ($self->{_debug} >= 2); } elsif ($state == $INHIT && /^<a.*HREF.*>(.+)<\/a>.*<\/dt>/i) { # 25-Oct-99 $raw .= $_; my($title) = $1; # $title =~ s/<\/?em>//ig; # strip keyword emphasis (use raw if you want to get it bacK) $hit->title($title); print STDERR "PARSE(13:INHIT): title: $1.\n" if ($self->{_debug} >= 2); } elsif ($state == $INHIT && /^<dd>(.*)<br>/i) { # 25-Oct-99 $raw .= $_; $hit->description($1); print STDERR "PARSE(13:INHIT): description.\n" if ($self->{_debug} >= 2); } elsif ($state == $INHIT && /^Laatste wijziging: (.*)$/i) { # 25-Oct-99 $raw .= $_; $hit->change_date($1); print STDERR "PARSE(13:INHIT): mod date.\n" if ($self->{_debug} >= 2); } elsif ($state == $INHIT && /^<\/dl>/i) { # 25-Oct-99 $raw .= $_; ($hit, $raw) = $self->_save_old_hit($hit, $raw); $state = $HITS; print STDERR "PARSE(13:INHIT->HITS): end hit.\n" if ($self->{_debug} >= 2); } elsif ($state == $INHIT) { # other random stuff in a hit---accumulate it $raw .= $_; print STDERR "PARSE(14:INHIT): no match.\n" if ($self->{_debug} >= 2); print STDERR ' 'x 12, "$_\n" if ($self->{_debug} >= 3); } elsif ($hits_found && ($state == $TRAILER || $state == $HITS) && /<a[^>]+href="([^"]+)".*\>\>/i) { # " # (above, note the trick $hits_found so we don't prematurely terminate.) # set up next page my($relative_url) = $1; # hack: make sure fmt=d stays on news URLs $relative_url =~ s/what=news/what=news\&fmt=d/ if ($relative_url !~ /fmt=d/i); my($n) = new URI::URL($relative_url, $self->{_base_url}); $n = $n->abs; $self->{_next_url} = $n; $state = $POST_NEXT; print STDERR "PARSE(15:->POST_NEXT): found next, $n.\n" if ($self->{_debug} >= 2); } else { # accumulate raw $raw .= $_; print STDERR "PARSE(RAW): $_\n" if ($self->{_debug} >= 3); }; }; if ($state != $POST_NEXT) { # end, no other pages (missed ``next'' tag) if ($state == $HITS) { $self->_begin_new_hit($hit, $raw); # save old one print STDERR "PARSE: never got to TRAILER.\n" if ($self->{_debug} >= 2); }; $self->{_next_url} = undef; }; # sleep so as to not overload altavista $self->user_agent_delay if (defined($self->{_next_url})); return $hits_found; } 1; __END__ =head1 SEE ALSO To make new back-ends, see L<WWW::Search>, =head1 HOW DOES IT WORK? C<native_setup_search> is called before we do anything. It initializes our private variables (which all begin with underscores) and sets up a URL to the first results page in C<{_next_url}>. C<native_retrieve_some> is called (from C<WWW::Search::retrieve_some>) whenever more hits are needed. It calls the LWP library to fetch the page specified by C<{_next_url}>. It parses this page, appending any search hits it finds to C<{cache}>. If it finds a ``next'' button in the text, it sets C<{_next_url}> to point to the page for the next set of results, otherwise it sets it to undef to indicate we're done. =head1 AUTHOR and CURRENT VERSION C<WWW::Search::AltaVista::NL> is written and maintained by Erik Smit, <zoiah@zoiah.nl>. The best place to obtain C<WWW::Search::AltaVista::NL> is from Martin Thurn's WWW::Search releases on CPAN. Because AltaVista sometimes changes its format in between his releases, sometimes more up-to-date versions can be found at F<http://www.zoiah.nl/programming/AltaVistaNL/index.html>. =head1 COPYRIGHT Copyright (c) 1996-1998 University of Southern California. All rights reserved. Redistribution and use in source and binary forms are permitted provided that the above copyright notice and this paragraph are duplicated in all such forms and that any documentation, advertising materials, and other materials related to such distribution and use acknowledge that the software was developed by the University of Southern California, Information Sciences Institute. The name of the University may not be used to endorse or promote products derived from this software without specific prior written permission. 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. ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista/Web.pm������������������������������������������0000755�0001756�0001001�00000000740�10744776633�021637� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� =head1 NAME WWW::Search::AltaVista::Web - deprecated, just use WWW::Search::AltaVista =head1 SYNOPSIS use WWW::Search; $search = new WWW::Search('AltaVista'); =head1 DESCRIPTION Details of searching AltaVista.com can be found at L<WWW::Search::AltaVista>. =cut package WWW::Search::AltaVista::Web; use strict; use warnings; use base 'WWW::Search::AltaVista'; our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; 1; __END__ ��������������������������������WWW-Search-AltaVista-2.154/lib/WWW/Search/AltaVista.pm����������������������������������������������0000755�0001756�0001001�00000027427�11065574327�021126� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# AltaVista.pm # by John Heidemann # Copyright (C) 1996-1998 by USC/ISI # $Id: AltaVista.pm,v 2.905 2008/01/21 02:04:11 Daddy Exp $ # # Complete copyright notice follows below. =head1 NAME WWW::Search::AltaVista - class for searching www.altavista.com =head1 SYNOPSIS require WWW::Search; $search = new WWW::Search('AltaVista'); =head1 DESCRIPTION This class is an AltaVista specialization of WWW::Search. It handles making and interpreting AltaVista searches F<http://www.altavista.com>. This class exports no public interface; all interaction should be done through WWW::Search objects. =head1 OPTIONS The default is "any of these words" (OR of query terms). =over 8 =item aqa=all+of+these+words Add the AND of these words to the query. =item aqp=this+exact+phrase Add "this exact phrase" to the query. =item aqo=any+of+these+words Add the OR of these words to the query. This is where the query is placed by default. =item aqn=none+of+these+words Add NOT these words to the query. =item aqb=(boolean+AND+expression)+NEAR+entry Add a boolean expression to the query. Operators are AND, OR, AND NOT, and NEAR. In the browser interface, the boolean expression can not be combined with any other query types listed above. You should probably build the boolean expression with parentheses and spaces and urlescape it. =item aqs=these+words Pages containing "these words" will be ranked highest. =item kgs=[0,1] To restrict the search to U.S. websites, set kgs=1. The default is world-wide, kgs=0. =item kls=[0,1] To restrict the search to pages in English and Spanish, set kls=1. The default is no language restrictions, kls=0. =item filetype=[html,pdf] To restrict the search to HTML pages only, set filetype=html. To restrict the search to PDF pages only, set filetype=pdf. The default is no restriction on page type, filetype=. =item rc=dmn&swd=net+org+or.jp To restrict the search to pages from certain domains, set rc=dmn and set swd to a list of desired toplevel domains. =item rc=url&lh=www.sandcrawler.com/SWB To restrict the search to pages from a particular site, set rc=url and set lh to the site name and path. Leave off the http:// from the site. =back =head1 PUBLIC METHODS =cut ##################################################################### package WWW::Search::AltaVista; use strict; use warnings; use Carp (); use Date::Manip; use WWW::Search qw( generic_option strip_tags unescape_query ); use WWW::Search::Result; use base 'WWW::Search'; our $MAINTAINER = 'Martin Thurn <mthurn@cpan.org>'; our $VERSION = do { my @r = (q$Revision: 2.905 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; sub _undef_to_emptystring { return defined($_[0]) ? $_[0] : ""; } # _undef_to_emptystring =head2 gui_query Call this instead of native_query() if you want to get the same results as your average Joe web surfer. =cut sub gui_query { my ($self, $sQuery, $rh) = @_; $self->{'_options'} = { 'search_host' => 'http://www.altavista.com', 'search_path' => '/web/results', 'q' => $sQuery, 'kls' => 0, avkw => 'qtrp', }; return $self->native_query($sQuery, $rh); } # gui_query =head1 PRIVATE METHODS =head2 native_setup_search This private method does the heavy lifting after you call native_query() or gui_query(). =cut sub native_setup_search { my ($self, $native_query, $native_options_ref) = @_; $self->user_agent('user'); $self->{_next_to_retrieve} = 0; if (!defined($self->{_options})) { $self->{_options} = { 'pg' => 'aq', 'avkw' => 'qtrp', 'aqmode' => 's', 'aqo' => $native_query, 'kgs' => 0, 'kls' => 0, # 'dt' => 'dtrange', 'rc' => 'dmn', 'nbq' => '50', 'search_host' => 'http://www.altavista.com', 'search_path' => '/web/results', }; if ((my $s = $self->date_from) ne '') { $s = &UnixDate($s, '%m/%d/%y'); $self->{_options}->{d0} = $s; $self->{_options}->{dt} = 'dtrange'; } # if if ((my $s = $self->date_to) ne '') { $s = &UnixDate($s, '%m/%d/%y'); $self->{_options}->{d1} = $s; $self->{_options}->{dt} = 'dtrange'; } # if } # if my($options_ref) = $self->{_options}; if (defined($native_options_ref)) { # Copy in new options. foreach (keys %$native_options_ref) { $options_ref->{$_} = $native_options_ref->{$_}; } # foreach } # if # Process the options. my $options = ''; # For Intranet search to work, mss option must be first: if (exists $options_ref->{'mss'}) { $options .= 'mss=' . $options_ref->{'mss'} . '&'; } # if foreach my $key (keys %$options_ref) { # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n"; next if (generic_option($key)); next if $key eq 'mss'; $options .= $key . '=' . $options_ref->{$key} . '&'; } # foreach chop $options; $self->{_debug} = $options_ref->{'search_debug'}; $self->{_debug} = 2 if ($options_ref->{'search_parse_debug'}); $self->{_debug} = 0 if (!defined($self->{_debug})); # Finally figure out the url. $self->{_base_url} = $self->{_next_url} = $self->{_options}{'search_host'} . $self->{_options}{'search_path'} .'?'. $options; # print STDERR $self->{_base_url} . "\n" if ($self->{_debug}); } # native_setup_search sub _count_pattern { # Pattern for matching result-count in many languages. # Language-specific subclasses might need to override this. return qr{\b(?:found|fand) \s+ ([0-9.,]+) \s+ # This covers English and German: (?:result|headline|Ergebnisse) }x; } # _count_pattern sub _preprocess_results_page { my $self = shift; my $sPage = shift; # return $sPage; # For debugging only. Print the page contents and abort. print STDERR '='x 25, "\n\n", $sPage, "\n\n", '='x 25; exit 88; } # _preprocess_results_page =head2 parse_tree This private method does the hard work of parsing the results out of the HTML. =cut sub parse_tree { my $self = shift; my $tree = shift; my $iHits = 0; my $iCountSpoof = 0; my $WS = q{[\t\r\n\240\ ]}; # 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) { # Sometimes the hit count is inside a <DIV> tag: my @aoDIV = $tree->look_down('_tag' => 'div', 'class' => 'xs', ); # Sometimes the hit count is inside a <SPAN> tag: push @aoDIV, $tree->look_down('_tag' => 'span', 'class' => 'y', ); my $qrCount = $self->_count_pattern; 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}; if ($s =~ m!$qrCount!i) { my $iCount = $1 || ''; $iCount =~ tr!.,!!d; $self->approximate_result_count($iCount); print STDERR " + found approx_h_c is ==", $self->approximate_hit_count(), "==\n" if (2 <= $self->{_debug}); last DIV_TAG; } # if } # foreach DIV_TAG } # if # Get the hits: my @aoA = $tree->look_down( '_tag' => 'a', 'class' => 'res', ); A_TAG: foreach my $oA (@aoA) { # <a class="res" href="/r?ck_sm=4bf6b336&ci=4939&av_tc=null&q=%7Cvirus+%7Cprotease&rpos=1&rpge=1&rsrc=U&ref=200020080&uid=1da8cd3e47b05cd0&r=http%3A%2F%2Fwww.mcafee.com%2F" onmouseout="status=''; return true;" onmouseover="status='http://www.mcafee.com/'; return true;">McAfee Security - Computer Virus Software and Internet Security For Your PC</a> next unless ref $oA; my $sA = $oA->as_HTML; print STDERR " + found A==$sA==\n" if (2 <= $self->{_debug}); my $sURL = $self->absurl($self->{'_prev_url'}, $oA->attr('href')); print STDERR " + the URL is ==$sURL==\n" if (2 <= $self->{_debug}); # Ignore advertising links: next if ($sURL =~ m!//rc10\.overture\.com!); my $sTitle = $oA->as_text; print STDERR " + the title is ==$sTitle==\n" if (2 <= $self->{_debug}); my $oSPAN = $oA; FIND_SPAN: while (1) { last FIND_SPAN if ! ref $oSPAN; last FIND_SPAN if ($oSPAN->tag eq 'span'); $oSPAN = $oSPAN->right; } # while if (ref $oSPAN) { # $oSPAN now is <span class=s> which contains the description # and the URL: print STDERR " + found SPAN==", $oSPAN->as_HTML, "==\n" if (2 <= $self->{_debug}); my $oHit = new WWW::Search::Result; $oHit->add_url($sURL); $oHit->title($sTitle); $oHit->description(&WWW::Search::strip_tags($oSPAN->as_text)); push(@{$self->{cache}}, $oHit); $self->{'_num_hits'}++; $iHits++; } # if $oA->detach; $oA->delete; } # foreach A_TAG # Find the 'next page' link: @aoA = $tree->look_down('_tag' => 'a', ); NEXT_TAG: foreach my $oA (@aoA) { next NEXT_TAG unless ref $oA; # Multilingual version: next NEXT_TAG unless $oA->as_text =~ m!\s>>\Z!; # English-only version: # next NEXT_TAG unless $oA->as_text eq q{Next >>}; $self->{_next_url} = $self->absurl($self->{'_prev_url'}, $oA->attr('href')); last NEXT_TAG; } # foreach return $iHits; } # parse_tree =head1 BUGS =over =item Not all of the above options have been tested. =item Please report bugs and send feature requests via email to C<bug-WWW-Search-AltaVista@rt.cpan.org>, or via the web interface at L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Search-AltaVista>. =back =head1 SEE ALSO To make new back-ends, see L<WWW::Search>, or the specialized AltaVista searches described in options. =head1 AUTHOR Written by John Heidemann, C<johnh@isi.edu>; maintained by Martin Thurn, C<mthurn@cpan.org>. =head1 LICENSE This software is released under the same license as Perl itself. =head1 COPYRIGHT Copyright (c) 1996-1998 University of Southern California. All rights reserved. Redistribution and use in source and binary forms are permitted provided that the above copyright notice and this paragraph are duplicated in all such forms and that any documentation, advertising materials, and other materials related to such distribution and use acknowledge that the software was developed by the University of Southern California, Information Sciences Institute. The name of the University may not be used to endorse or promote products derived from this software without specific prior written permission. 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 1; __END__ advanced search results: full URL, as of 2005-12 = http://www.altavista.com/web/results?itag=ody&pg=aq&aqmode=s&aqa=all&aqp=this+phrase&aqo=any&aqn=none&aqb=&kgs=1&kls=0&d2=0&dt=dtrange&dfr%5Bd%5D=1&dfr%5Bm%5D=1&dfr%5By%5D=1980&dto%5Bd%5D=14&dto%5Bm%5D=12&dto%5By%5D=1995&filetype=&rc=dmn&swd=&lh=&nbq=10 http://www.altavista.com/web/results?pg=aq&avkw=qtrp&aqmode=s&aqa=&aqp=&aqo=martin+thurn&aqn=&aqb=&aqs=&kgs=0&kls=0&dt=tmperiod&d2=0&d0=&d1=&filetype=&rc=dmn&swd=&lh=&nbq=50 gui query results: http://www.altavista.com/web/results?q=Rhonda+Thurn&kgs=0&kls=0&avkw=qtrp �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/Makefile.PL��������������������������������������������������������������0000755�0001756�0001001�00000001312�11114365252�016162� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# $Id: Makefile.PL,v 1.19 2008/11/28 17:56:47 Martin Exp $ use inc::Module::Install; all_from('lib/WWW/Search/AltaVista.pm'); version(2.154); requires( perl => 5.004 ); requires('Date::Manip'); requires('HTML::TokeParser'); # requires('HTML::TreeBuilder'); test_requires('Test::More'); test_recommends('Test::Pod'); test_recommends('Test::Pod::Coverage'); # We need the verson which correctly handles "old" backends which have # parse_tree() rather than the new _parse_tree(): requires('WWW::Search' => 2.561); # We need the version with tm_run_test(): requires('WWW::Search::Test' => 2.263); # We need the version with the fixed test_most_results(): requires('WWW::Search::Test' => 2.284); WriteAll; __END__ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/MANIFEST�����������������������������������������������������������������0000755�0001756�0001001�00000001320�11036544416�015344� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Changes 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/AltaVista.pm lib/WWW/Search/AltaVista/AdvancedNews.pm lib/WWW/Search/AltaVista/AdvancedWeb.pm lib/WWW/Search/AltaVista/Careers.pm lib/WWW/Search/AltaVista/DE.pm lib/WWW/Search/AltaVista/Intranet.pm lib/WWW/Search/AltaVista/Intranet3.pm lib/WWW/Search/AltaVista/News.pm lib/WWW/Search/AltaVista/NL.pm lib/WWW/Search/AltaVista/Web.pm Makefile.PL MANIFEST This list of files META.yml README t/altavista.t t/de.t t/news.t t/pod-coverage.t t/pod.t ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/META.yml�����������������������������������������������������������������0000755�0001756�0001001�00000001236�11114365307�015467� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- abstract: 'class for searching www.altavista.com' author: - 'Written by John Heidemann, C<johnh@isi.edu>;' build_requires: Test::More: 0 Test::Pod: 0 Test::Pod::Coverage: 0 distribution_type: module generated_by: 'Module::Install version 0.77' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 module_name: WWW::Search::AltaVista name: WWW-Search-AltaVista no_index: directory: - inc - t requires: Date::Manip: 0 HTML::TokeParser: 0 WWW::Search: 2.561 WWW::Search::Test: 2.284 perl: 5.004 resources: license: http://dev.perl.org/licenses/ version: 2.154 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/README�������������������������������������������������������������������0000755�0001756�0001001�00000000521�10350147217�015071� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� 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/WWW-Search-2.33.readme ) Read the ChangeLog file in this distribution to see what is new with this backend since the previous release. �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/t/�����������������������������������������������������������������������0000755�0001756�0001001�00000000000�11114365314�014452� 5����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/t/altavista.t������������������������������������������������������������0000755�0001756�0001001�00000005316�11114365071�016637� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# $rcs = ' $Id: altavista.t,v 1.14 2008/11/28 17:58:11 Martin Exp $ ' ; use ExtUtils::testlib; use Test::More no_plan; use WWW::Search; use WWW::Search::Test qw( tm_new_engine tm_run_test ); BEGIN { use_ok('WWW::Search::AltaVista') }; # BEGIN { use_ok('WWW::Search::AltaVista::AdvancedWeb') }; tm_new_engine('AltaVista'); my $iDebug = 0; my $iDump = 0; # goto DEBUG_NOW; # goto SKIP_BASIC; # These tests return no results (but we should not get an HTTP error): diag("Sending 0-page query to altavista.com..."); $iDebug = 0; $iDump = 0; tm_run_test(0, $WWW::Search::Test::bogus_query, 0, 0, $iDebug, $iDump); DEBUG_NOW: diag("Sending 1-page query to altavista.com..."); $iDebug = 0; $iDump = 0; tm_run_test(0, 'noo'.'teboooks', 1, 49, $iDebug, $iDump); my @ara = ( ['url', 'like', qr{\Ahttp://}, 'result URL is http'], ['title', 'ne', '', 'result Title is not empty'], ['description', 'ne', '', 'result description is not empty'], ); WWW::Search::Test::test_most_results(\@ara, 1.00); # goto SKIP_PHRASE_TEST; diag("Sending phrase query to altavista.com..."); $iDebug = 0; $iDump = 0; # $WWW::Search::Test::oSearch->{_allow_empty_query} = 1; $WWW::Search::Test::oSearch->native_query('junk crap bile', { search_debug => $iDebug, # Clear out the "OR" query: aqo => '', # Put our query in the # "PHRASE" slot: aqp => 'Thurn Martin', }); WWW::Search::Test::test_most_results(\@ara, 1.00); pass; SKIP_PHRASE_TEST: pass; goto ALL_DONE; # for debugging diag("Sending multi-page query to altavista.com..."); $iDebug = 0; $iDump = 0; tm_run_test(0, 'Martin '.'Thurn', 51, undef, $iDebug); SKIP_BASIC: pass; tm_new_engine('AltaVista::Web'); # goto SKIP_WEB; diag("Sending 0-page web query to altavista.com..."); $iDebug = 0; # This test returns no results (but we should not get an HTTP error): tm_run_test(0, $WWW::Search::Test::bogus_query, 0, 0, $iDebug); diag("Sending multi-page web query to altavista.com..."); # This query returns 3 (or more) pages of results: tm_run_test(0, 'Cheddar', 51, undef, $iDebug); SKIP_WEB: pass; DEBUG_NOW: pass; ADVANCEDWEB: pass; tm_new_engine('AltaVista::AdvancedWeb'); # goto SKIP_ADVANCEDWEB; diag("Sending 0-page advanced web query to altavista.com..."); $iDebug = 0; # These tests return no results (but we should not get an HTTP error): tm_run_test(0, $WWW::Search::Test::bogus_query, 0, 0, $iDebug); SKIP_ADVANCEDWEB: pass; ALL_DONE: exit 0; __END__ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/t/de.t�������������������������������������������������������������������0000755�0001756�0001001�00000002153�11114365203�015230� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� # $Id: de.t,v 1.9 2005/12/15 03:55:51 Daddy Exp $ use ExtUtils::testlib; use Test::More no_plan; use WWW::Search::Test 2.284; BEGIN { use_ok('WWW::Search::AltaVista'); use_ok('WWW::Search::AltaVista::DE'); } # end of BEGIN block # goto SKIP_BASIC; tm_new_engine('AltaVista::DE'); # goto DEBUG_NOW; my $iDebug = 0; diag("Sending 0-page query..."); # These tests return no results (but we should not get an HTTP error): tm_run_test(0, $WWW::Search::Test::bogus_query, 0, 0, $iDebug); diag("Sending 1-page query..."); # The following query returns one page of results: $iDebug = 0; tm_run_test(0, '"Martin Thurn-Mitt'.'hoff"', 1, 49, $iDebug); my @ara = ( ['url', 'like', qr{\Ahttp://}, 'result URL is http'], ['title', 'ne', '', 'result Title is not empty'], ['description', 'ne', '', 'result description is not empty'], ); WWW::Search::Test::test_most_results(\@ara, 1.00); DEBUG_NOW: pass; diag("Sending multi-page query..."); # The following query returns many pages of results: $iDebug = 0; tm_run_test(0, 'Berlin', 101, undef, $iDebug); ALL_DONE: pass; exit 0; __END__ ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/t/news.t�����������������������������������������������������������������0000755�0001756�0001001�00000003613�11114364574�015630� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� # $Id: news.t,v 1.9 2005/12/15 03:57:49 Daddy Exp $ use ExtUtils::testlib; use Test::More no_plan; use WWW::Search::Test 2.281; BEGIN { use_ok('WWW::Search::AltaVista') }; tm_new_engine('AltaVista::News'); # goto DEBUG_NOW; # goto SKIP_NEWS; my $iDebug = 0; my $iDump = 0; # These tests return no results (but we should not get an HTTP error): diag("Sending 0-page normal query..."); tm_run_test(0, $WWW::Search::Test::bogus_query, 0, 0, $iDebug); diag("Sending 0-page normal query with plus..."); tm_run_test(0, "+perl +$WWW::Search::Test::bogus_query", 0, 0, $iDebug); # This query returns 1 page of results: # This query returns 2 pages of results: DEBUG_NOW: diag("Sending multi-page normal query..."); $iDebug = 0; $iDump = 0; tm_run_test(0, 'Ashburn', 51, undef, $iDebug, $iDump); my @ao = $WWW::Search::Test::oSearch->results(); cmp_ok(0, '<=', scalar(@ao), 'got any results'); my @ara = ( ['url', 'like', qr{\Ahttp://}, 'result URL is http'], ['title', 'ne', q{}, 'result Title is not empty'], ['description', 'ne', q{}, 'result description is not empty'], ['source', 'ne', q{}, 'result source is not empty'], ['change_date', 'ne', q{}, 'result change_date is not empty'], ); WWW::Search::Test::test_most_results(\@ara, 0.90); SKIP_NEWS: pass; # As of 2002-08, altavista.com does not have an Advanced search for # news. tm_new_engine('AltaVista::AdvancedNews'); goto SKIP_ADVANCEDNEWS; $iDebug = 0; # These tests return no results (but we should not get an HTTP error): tm_run_test(0, $WWW::Search::Test::bogus_query, 0, 0, $iDebug); tm_run_test(0, "+perl +$WWW::Search::Test::bogus_query", 0, 0, $iDebug); # This query returns 1 page of results: # This query returns 2 pages of results: # This query returns 3 (or more) pages of results: $iDebug = 0; tm_run_test(0, 'li'.'nux', 61, undef, $iDebug); SKIP_ADVANCEDNEWS: pass; ALL_DONE: exit 0; __END__ ���������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/t/pod-coverage.t���������������������������������������������������������0000755�0001756�0001001�00000000501�10744777020�017222� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# $Id: pod-coverage.t,v 1.2 2008/01/21 02:06:08 Daddy Exp $ use Test::More; my $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r }; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); __END__ �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Search-AltaVista-2.154/t/pod.t������������������������������������������������������������������0000755�0001756�0001001�00000000275�10657350403�015434� 0����������������������������������������������������������������������������������������������������ustar �Martin��������������������������None�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# $Id: pod.t,v 1.1 2007/08/11 15:08:51 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__ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������