WWW-Search-PubMed-1.004/0000755000076500007650000000000010712247273015016 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/Changes0000644000076500007650000000106610712130422016277 0ustar samofoolsamofoolRevision history for Perl extension WWW::Search::PubMed: 1.004 Wed Oct 31 2007 - Added WWW::Search::PubMed::Result class to allow for more result fields: - pmid - abstract 1.003 Mon Nov 27 2006 - More Kwalitee updates: - Updated META.yml 1.002 Wed Oct 11 2006 - Changes to conform to CPANTS Kwalitee: - Added pod tests. - Added Changes file. - Added examples directory. - Updated Makefile.PL to use Module::Install and provide licensing terms. 1.001 Thu Feb 09 2006 - Original version meant to replace the abandoned version by JSMYSER. WWW-Search-PubMed-1.004/examples/0000755000076500007650000000000010712247273016634 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/examples/motif_references.pl0000755000076500007650000000074610513273171022515 0ustar samofoolsamofool#!/usr/bin/perl use strict; use warnings; use lib qw(../lib); use WWW::Search; my $motif = shift || 'ACCTA'; my $s = new WWW::Search ('PubMed'); $s->native_query( $motif ); my $count = 0; while (my $r = $s->next_result) { unless ($count++) { print "The following abstracts mention the motif '${motif}':\n\n"; } print join(' ', "${count}.", $r->title, $r->description) . "\n\n"; } unless ($count) { print "No abstracts were found that mention the motif '${motif}'.\n"; } WWW-Search-PubMed-1.004/inc/0000755000076500007650000000000010712247273015567 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/inc/Module/0000755000076500007650000000000010712247273017014 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/inc/Module/Install/0000755000076500007650000000000010712247273020422 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/inc/Module/Install/Base.pm0000644000076500007650000000203510502142505021617 0ustar samofoolsamofool#line 1 package Module::Install::Base; $VERSION = '0.63'; # 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; } 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 138 WWW-Search-PubMed-1.004/inc/Module/Install/Makefile.pm0000644000076500007650000001337310502142505022471 0ustar samofoolsamofool#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.63'; $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, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; 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 ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $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->build_requires, $self->requires) ); # 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"; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; if ($self->admin->preop) { $args{dist} = $self->admin->preop; } 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 334 WWW-Search-PubMed-1.004/inc/Module/Install/MakeMaker.pm0000644000076500007650000000206410502142505022604 0ustar samofoolsamofool#line 1 package Module::Install::MakeMaker; use strict; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.63'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my $makefile; sub WriteMakefile { my ($self, %args) = @_; $makefile = $self->load('Makefile'); # mapping between MakeMaker and META.yml keys $args{MODULE_NAME} = $args{NAME}; unless ($args{NAME} = $args{DISTNAME} or !$args{MODULE_NAME}) { $args{NAME} = $args{MODULE_NAME}; $args{NAME} =~ s/::/-/g; } foreach my $key (qw(name module_name version version_from abstract author)) { my $value = delete($args{uc($key)}) or next; $self->$key($value); } if (my $prereq = delete($args{PREREQ_PM})) { while (my($k,$v) = each %$prereq) { $self->requires($k,$v); } } # put the remaining args to makemaker_args $self->makemaker_args(%args); } END { if ( $makefile ) { $makefile->write; $makefile->Meta->write; } } 1; WWW-Search-PubMed-1.004/inc/Module/Install/Metadata.pm0000644000076500007650000001747610502142505022504 0ustar samofoolsamofool#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.63'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_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 (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } 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, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } 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; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } 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', 0 ); require YAML; my $data = YAML::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 { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); 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 $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ 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', 'GNU public license' => 'gpl', 'GNU lesser public license' => 'gpl', 'BSD license' => 'bsd', 'Artistic license' => 'artistic', 'GPL' => 'gpl', 'LGPL' => 'lgpl', 'BSD' => 'bsd', 'Artistic' => 'artistic', ); while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; WWW-Search-PubMed-1.004/inc/Module/Install.pm0000644000076500007650000001761110502142505020753 0ustar samofoolsamofool#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.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.63'; } # 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 } use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; 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"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } 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"}; } sub preload { my ($self) = @_; 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"; 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) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $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; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1; WWW-Search-PubMed-1.004/lib/0000755000076500007650000000000010712247273015564 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/lib/WWW/0000755000076500007650000000000010712247273016250 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/lib/WWW/Search/0000755000076500007650000000000010712247273017455 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/lib/WWW/Search/PubMed/0000755000076500007650000000000010712247273020631 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/lib/WWW/Search/PubMed/Result.pm0000644000076500007650000000336210712227062022443 0ustar samofoolsamofoolpackage WWW::Search::PubMed::Result; =head1 NAME WWW::Search::PubMed::Result - NCBI Search Result =head1 SYNOPSIS use WWW::Search; my $s = new WWW::Search ('PubMed'); $s->native_query( 'ACGT' ); while (my $result = $s->next_result) { print $result->title . "\n"; print $result->description . "\n"; print $result->pmid . "\n"; print $result->abstract . "\n"; } =head1 DESCRIPTION WWW::Search::PubMed::Result objects represent query results returned from a WWW::Search::PubMed search. See L for more information. =head1 VERSION This document describes WWW::Search::PubMed version 1.004, released 31 October 2007. =head1 REQUIRES L =head1 METHODS =over 4 =cut our($VERSION) = '1.004'; use strict; use warnings; use base qw(WWW::Search::Result); our $debug = 0; =item C<< abstract >> The article abstract. =cut sub abstract { return shift->_elem('abstract', @_); } =item C<< pmid >> The article PMID. =cut sub pmid { return shift->_elem('pmid', @_); } =item C<< date >> The article's publication date ("YYYY Mon DD"). =cut sub date { return shift->_elem('date', @_); } =item C<< year >> The article's publication year. =cut sub year { return shift->_elem('year', @_); } =item C<< month >> The article's publication month. =cut sub month { return shift->_elem('month', @_); } =item C<< day >> The article's publication day. =cut sub day { return shift->_elem('day', @_); } 1; __END__ =back =head1 COPYRIGHT Copyright (c) 2003-2007 Gregory Todd Williams. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Gregory Todd Williams C<< >> =cut WWW-Search-PubMed-1.004/lib/WWW/Search/PubMed.pm0000644000076500007650000001551510712247153021173 0ustar samofoolsamofoolpackage WWW::Search::PubMed; =head1 NAME WWW::Search::PubMed - Search the NCBI PubMed abstract database. =head1 SYNOPSIS use WWW::Search; my $s = new WWW::Search ('PubMed'); $s->native_query( 'ACGT' ); while (my $r = $s->next_result) { print $r->title . "\n"; print $r->description . "\n"; } =head1 DESCRIPTION WWW::Search::PubMed provides a WWW::Search backend for searching the NCBI/PubMed abstracts database. =head1 VERSION This document describes WWW::Search::PubMed version 1.004, released 31 October 2007. =head1 REQUIRES L L =cut our($VERSION) = '1.004'; use strict; use warnings; require WWW::Search; require WWW::SearchResult; use WWW::Search::PubMed::Result; use base qw(WWW::Search); use XML::DOM; our $debug = 0; use constant ARTICLES_PER_REQUEST => 20; use constant QUERY_ARTICLE_LIST_URI => 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=pubmed&retmax=500'; # term=ACTG use constant QUERY_ARTICLE_INFO_URI => 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=pubmed'; # &id=12167276&retmode=xml =begin private =item C<< native_setup_search ( $query, $options ) >> Sets up the NCBI search using the supplied C<$query> string. =end private =cut sub native_setup_search { my $self = shift; my $query = shift; my $options = shift; $self->user_agent( "WWW::Search::PubMed/${VERSION} libwww-perl/${LWP::VERSION}; " ); my $ua = $self->user_agent(); my $url = QUERY_ARTICLE_LIST_URI . '&term=' . WWW::Search::escape_query($query); my $response = $ua->get( $url ); my $success = $response->is_success; if ($success) { my $parser = new XML::DOM::Parser; my $content = $response->content; $self->{'_xml_parser'} = $parser; my $doc = $parser->parse( $content ); $self->{'_count'} = eval { ($doc->getElementsByTagName('Count')->item(0)->getChildNodes)[0]->getNodeValue() } || 0; my @articles; my $ids = $doc->getElementsByTagName('Id'); my $n = $ids->getLength; foreach my $i (0 .. $n - 1) { my $node = $ids->item( $i ); my @children = $node->getChildNodes(); push(@articles, + $children[0]->getNodeValue() ); } $self->{'_article_ids'} = \@articles; } else { return undef; } } =begin private =item C<< native_retrieve_some >> Requests search results from NCBI, adding the results to the WWW::Search object's cache. =end private =cut sub native_retrieve_some { my $self = shift; return undef unless scalar (@{ $self->{'_article_ids'} || [] }); my $ua = $self->user_agent(); my $url = QUERY_ARTICLE_INFO_URI . '&id=' . join(',', splice(@{ $self->{'_article_ids'} },0,ARTICLES_PER_REQUEST)) . '&retmode=xml'; warn 'Fetching URL: ' . $url if ($debug); my $response = $ua->get( $url ); if ($response->is_success) { my $content = $response->content; if ($debug) { open (my $fh, ">/tmp/pubmed.article.info"); print { $fh } $content; close($fh); warn "Saved response in /tmp/pubmed.article.info\n"; } my $doc = $self->{'_xml_parser'}->parse( $content ); my $articles = $doc->getElementsByTagName('PubmedArticle'); my $n = $articles->getLength; warn "$n articles found\n" if ($debug); my $count = 0; foreach my $i (0 .. $n - 1) { my $article = $articles->item( $i ); my $id = ($article->getElementsByTagName('PMID')->item(0)->getChildNodes)[0]->getNodeValue(); warn "$id\n" if ($debug); my $title = ($article->getElementsByTagName('ArticleTitle')->item(0)->getChildNodes)[0]->getNodeValue(); warn "\t$title\n" if ($debug); my $url = 'http://www.ncbi.nlm.nih.gov:80/entrez/query.fcgi?cmd=Retrieve&db=PubMed&list_uids=' . $id . '&dopt=Abstract'; my @authors; my $authornodes = $article->getElementsByTagName('Author'); my $n = $authornodes->getLength; foreach my $i (0 .. $n - 1) { my ($author, $fname, $lname); eval { $author = $authornodes->item($i); $lname = ($author->getElementsByTagName('LastName')->item(0)->getChildNodes)[0]->getNodeValue(); $fname = substr( ($author->getElementsByTagName('ForeName')->item(0)->getChildNodes)[0]->getNodeValue(), 0, 1) . '.'; }; if ($@) { warn $@ if ($debug); next unless ($lname); } else { push(@authors, join(' ', $lname, $fname)); } } my $author = join(', ', @authors); warn "\t$author\n" if ($debug); my $journal = $self->get_text_node( $article, 'MedlineTA' ); my $page = $self->get_text_node( $article, 'MedlinePgn' ); my $volume = $self->get_text_node( $article, 'Volume' ); my $issue = $self->get_text_node( $article, 'Issue' ); my $pmid = $self->get_text_node( $article, 'PMID' ); my $abstract = $self->get_text_node( $article, 'AbstractText' ); my @date; { my $date = $article->getElementsByTagName('PubDate')->item(0); push(@date, $self->get_text_node( $date, 'Year' )); push(@date, $self->get_text_node( $date, 'Month' )); push(@date, $self->get_text_node( $date, 'Day' )); } my $hit = new WWW::Search::PubMed::Result; my $source = ''; my $date = join(' ', grep defined, @date); $hit->date( $date ); $hit->year( $date[0] ) if (defined($date[0])); $hit->month( $date[1] ) if (defined($date[1])); $hit->day( $date[2] ) if (defined($date[2])); $source = "${journal}. " . ($date ? "${date}; " : '') . ($volume ? "${volume}" : '') . ($issue ? "(${issue})" : '') . ($page ? ":$page" : ''); $source = "(${source})" if ($source); warn "\t$source\n" if ($debug); $hit->add_url( $url ); $hit->title( $title ); $hit->pmid( $pmid ); $hit->abstract( $abstract ) if ($abstract); my $desc = join(' ', grep {$_} ($author, $source)); $hit->description( $desc ); push( @{ $self->{'cache'} }, $hit ); $count++; warn "$count : $title\n" if ($debug); } return $count; } else { warn "Uh-oh." . $response->error_as_HTML(); return undef; } } =begin private =item C<< get_text_node ( $node, $name ) Returns the text contained in the named descendent of the XML $node. =end private =cut sub get_text_node { my $self = shift; my $node = shift; my $name = shift; my $text = eval { ($node->getElementsByTagName($name)->item(0)->getChildNodes)[0]->getNodeValue() }; if ($@) { warn "XML[$name]: $@" if ($debug); return undef; } else { warn "XML[$name]: $text\n" if ($debug); return $text; } } 1; __END__ =head1 SEE ALSO L L L L =head1 COPYRIGHT Copyright (c) 2003-2007 Gregory Todd Williams. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Gregory Todd Williams C<< >> =cut WWW-Search-PubMed-1.004/Makefile.PL0000644000076500007650000000065010513270320016755 0ustar samofoolsamofool# use ExtUtils::MakeMaker; use inc::Module::Install; license 'perl'; WriteMakefile( NAME => 'WWW::Search::PubMed', ABSTRACT => 'Search the NCBI PubMed abstract database.', VERSION_FROM => 'lib/WWW/Search/PubMed.pm', AUTHOR => 'Gregory Todd Williams ', PREREQ_PM => { 'WWW::Search' => 0, 'LWP::UserAgent' => 0, 'XML::DOM' => 0 }, ); WWW-Search-PubMed-1.004/MANIFEST0000644000076500007650000000062510712130526016142 0ustar samofoolsamofoolChanges lib/WWW/Search/PubMed.pm lib/WWW/Search/PubMed/Result.pm Makefile.PL MANIFEST META.yml Module meta-data (added by MakeMaker) README SIGNATURE t/1-test.t t/0-signature.t t/pod.t t/pod_coverage.t inc/Module/Install/Base.pm inc/Module/Install/Makefile.pm inc/Module/Install/MakeMaker.pm inc/Module/Install/Metadata.pm inc/Module/Install.pm examples/motif_references.pl WWW-Search-PubMed-1.004/META.yml0000644000076500007650000000102510712135350016255 0ustar samofoolsamofool--- #YAML:1.0 meta-spec: version: 1.3 url: http://module-build.sourceforge.net/META-spec-v1.3.html name: WWW-Search-PubMed version: 1.001 abstract: Search the NCBI PubMed abstract database. author: - Gregory Todd Williams build_requires: Test::More: 0.61 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 license: perl no_index: directory: - inc - t requires: LWP::UserAgent: 0 WWW::Search: 0 XML::DOM: 0 WWW-Search-PubMed-1.004/README0000644000076500007650000000206210532614556015700 0ustar samofoolsamofoolNAME WWW::Search::PubMed - Search the SYNOPSIS use WWW::Search; my $s = new WWW::Search ('PubMed'); $s->native_query( 'ACGT' ); while (my $r = $s->next_result) { print $r->title . "\n"; print $r->description . "\n"; } DESCRIPTION WWW::Search::PubMed proivides a WWW::Search backend for searching the NCBI/PubMed abstracts database. VERSION This document describes WWW::Search::PubMed version 1.003, released 27 November 2006. REQUIRES WWW::Search XML::DOM SEE ALSO AUTHOR Gregory Williams COPYRIGHT Copyright (c) 2003-2006 Gregory Todd Williams. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. WWW-Search-PubMed-1.004/SIGNATURE0000644000076500007650000000344410712247255016307 0ustar samofoolsamofoolThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 6e0489d58915f34f038d323b4cf2ae76600bc721 Changes SHA1 4e9146b8c7abf8c60bdf7917d115aea80557c34d MANIFEST SHA1 f1ea57f8331d4b929cd77abb2ab887cda1973b41 META.yml SHA1 d04584cf0a1e992a899ed39460214ef61cf51f15 Makefile.PL SHA1 fab4a3ca0759fc5718545846c517e8cb73009a79 README SHA1 5168ee5eb16428a0678eb049293b81613a12efe9 examples/motif_references.pl SHA1 017bedfcba1e0c72b36301e6ef21b8712b84d175 inc/Module/Install.pm SHA1 b1a70869c098ba602151631386fc510b5bfd3511 inc/Module/Install/Base.pm SHA1 d864f4a0dd148e4651cbe29c54c2ffc94d0f05f7 inc/Module/Install/MakeMaker.pm SHA1 176d68fe7c07b6ab7cfe09093078b8127bbde786 inc/Module/Install/Makefile.pm SHA1 8b37b38215d14f922b3d5132ce33d11d21d531ba inc/Module/Install/Metadata.pm SHA1 ffbb599c58b231b27c29b05b527070b7018b03d9 lib/WWW/Search/PubMed.pm SHA1 08435f200d4e05332f2b811eae2d98ce98b48fba lib/WWW/Search/PubMed/Result.pm SHA1 c555239a3baf28c0073aced65f1f9691c5eb7089 t/0-signature.t SHA1 c3f807313ae65f972143184a0490006175939159 t/1-test.t SHA1 fada08a138c7f5d0c435fbd184ebfbd975f5da7d t/pod.t SHA1 7dfbc25c2ead100477bc171b71bb85ba596adcc7 t/pod_coverage.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.3 (Darwin) iD8DBQFHKU6thPK6VMqoyC0RAhOuAJ4vQyAoxL1doNpvVM0t9sSOVWPmKwCfZDSl D6LccanKSckVDElM/eGIkhM= =1pPn -----END PGP SIGNATURE----- WWW-Search-PubMed-1.004/t/0000755000076500007650000000000010712247273015261 5ustar samofoolsamofoolWWW-Search-PubMed-1.004/t/0-signature.t0000644000076500007650000000120610372566220017601 0ustar samofoolsamofool#!/usr/bin/perl # $File: //member/autrijus/Module-Signature/t/0-signature.t $ $Author: greg $ # $Revision: 2 $ $Change: 7212 $ $DateTime: 2003/07/28 14:21:21 $ use strict; use Test::More tests => 1; SKIP: { if (!eval { require Module::Signature; 1 }) { skip("Next time around, consider install Module::Signature, ". "so you can verify the integrity of this distribution.", 1); } elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) { skip("Cannot connect to the keyserver", 1); } else { ok(Module::Signature::verify() == Module::Signature::SIGNATURE_OK() => "Valid signature" ); } } __END__ WWW-Search-PubMed-1.004/t/1-test.t0000755000076500007650000000057310712122116016557 0ustar samofoolsamofool#!/usr/bin/perl use lib 'lib'; use WWW::Search; use Test::More tests => 4; my $s = new WWW::Search('PubMed'); isa_ok( $s, 'WWW::Search' ); $s->native_query('ACGT'); my $r = $s->next_result(); ok( $r->title, 'Got title. Assuming everything is ok ;)' ); my $pmid = $r->pmid; like( $pmid, qr/^\d+$/, 'Got pmid' ); my $abst = $r->abstract; ok( length($abst), 'Got abstract' ); WWW-Search-PubMed-1.004/t/pod.t0000644000076500007650000000021510450023541016213 0ustar samofoolsamofooluse strict; 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(); WWW-Search-PubMed-1.004/t/pod_coverage.t0000644000076500007650000000025510450023541020072 0ustar samofoolsamofooluse strict; use Test::More; 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();