From: Don Armstrong Date: Thu, 12 Sep 2013 17:59:19 +0000 (-0700) Subject: Import original source of Reference 0-Reference X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=3f5579d4aafcb792f209032bb35b261692c1b098;p=reference.git Import original source of Reference 0-Reference --- 3f5579d4aafcb792f209032bb35b261692c1b098 diff --git a/.svn/entries b/.svn/entries new file mode 100644 index 0000000..48082f7 --- /dev/null +++ b/.svn/entries @@ -0,0 +1 @@ +12 diff --git a/.svn/format b/.svn/format new file mode 100644 index 0000000..48082f7 --- /dev/null +++ b/.svn/format @@ -0,0 +1 @@ +12 diff --git a/.svn/pristine/0d/0dcb745221b06785ae7983196d4e4cfe6535ac12.svn-base b/.svn/pristine/0d/0dcb745221b06785ae7983196d4e4cfe6535ac12.svn-base new file mode 100644 index 0000000..fc9b6cf --- /dev/null +++ b/.svn/pristine/0d/0dcb745221b06785ae7983196d4e4cfe6535ac12.svn-base @@ -0,0 +1,330 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. + +# Copyright 2003, 2004 by Don Armstrong . +# $Id$ + +package Reference::Field::Author; + +=head1 NAME + +Reference::Field::Author -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 TODO + +XXX Allow the corresponding author to be set explicitely + +XXX To do this, we need to break away from using the author field as +an arrayref, and instead use a hashref with the author fields, and a +specific corresponding author setting. [This should probaly be de +riguer for other fields as well.] + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 author + +=head3 Usage + + + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub author{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{author} = shift; + $params{output} = 'scalar'; + $params{add_author} = 0; + $params{del_author} = 0; + } + else { + %params = validate_with(params => \@_, + spec => {author => {type => ARRAYREF|SCALAR|HASHREF, + optional => 1, + }, + add_author => {type => BOOLEAN, + default => 0, + }, + del_author => {type => BOOLEAN, + default => 0, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{author}) { + $self->{reference}->{author} = {authors => [], + first_author => 0, + corresponding_author => -1, + } unless $params{add_author}; + # We can't handle things like Smith, Jones, Paul, Rue; for + # obvious reasons. If you must do something so broken, you + # have to go Smith, Jones; Paul, Rue; or Smith, Jones and + # Paul, Rue. + if (not ref($params{author}) and ($params{author} =~ /\sand\,?\s/ or $params{author} =~ /\w\;\s/)) { + $params{author} = [grep /\w/, split (/\s*and,?\s*|\;\s*/,$params{author})]; + } + $params{author} = [$params{author}] unless ref($params{author}) eq 'ARRAY'; + foreach my $author (@{$params{author}}) { + my $author_info = _parse_author($author); + if (not $params{del_author}) { + push @{$self->{reference}{author}{authors}},$author_info; + } + else { + _delete_author($author_info,$author->{reference}{author}{authors}); + } + } + } + + local $_ = $params{output}; + if (/bibtex/) { + return join(' and ',map {$_->{full}} @{$self->{reference}{author}{authors}}); + } + else { + return join(', ',map {$_->{full}} @{$self->{reference}{author}{authors}}); + } + +} + +=head2 corresponding_author + + my $corresponding_author = $ref->corresponding_author; + +Returns the corresponding author (the last author listed.) + +=cut + +sub corresponding_author{ + my $self = shift; + + my %params = validate_with(params => \@_, + spec => {output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + local $_ = $params{output}; + if (/bibtex/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full}; + } + elsif (/last/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{last}; + } + else { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full}; + } +} + +=head2 first_author + + my $first_author = $ref->first_author; + +Returns the first author (primary author.) + +=cut + +sub first_author{ + my $self = shift; + my %params = validate_with(params => \@_, + spec => {output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + local $_ = $params{output}; + if (/bibtex/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || ''; + } + elsif (/last/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{last}; + } + else { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || ''; + } +} + + +=head2 _parse_author + + my $author_info = _parse_author($author); + +Parses the author and returns an author record. + +Author record + +The author can be specified in a few different ways: + +=over + +=item SCALAR Author Name + +=over + +=item SMITH John W. + +=item Smith JW + +=item John W. Smith + +=item John Wilkenson Smith + +=item HASHREF Author structure + +=item ARRAYREF Author Name + +=back + +In these cases, the author's name should be parsed appropriately. [XXX +Needs to be extended to handle Smith, John W. appropriately.] + + +=cut + +sub _parse_author($){ + my ($author) = @_; + + warn "Undefined author" and return undef if not defined $author; + + # the author information + my %au = (); + if (not ref($author)) { + # UGH. Try to figure out the author. + if ($author =~ /^\s*([A-Z]+)\s+([\w\s]+?)(?:\s*([A-Z])\.)?\s*$/) { # SMITH John W. + $au{first} = ucfirst(lc($2)) || ''; + $au{last} = ucfirst(lc($1)) || ''; + $au{middle} = $3 || ''; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):''); + $au{full} = join(' ',grep /\w/,($au{first},$au{middle},$au{last})); + } + elsif ($author =~ /^\s*([A-Z][\w\s]*?)\s+([A-Z]+)\s*$/) { # Smith JW + $au{first} = $2 || ''; + $au{middle} = ''; + if (length $au{first} > 1) { + $au{middle} = substr($au{first},1); + $au{first} = substr($au{first},0,1); + } + $au{last} = $1; + $au{initials} = $2; + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})) + } + elsif ($author =~ /^\s*([A-Z][\w]*?)\s+(?:([A-Z])\.|([A-Z][\w\s]*?)\s+)?\s*([A-Z][\w]*)\s*$/){ # John W. Smith or John Wilkinson Smith + $au{first} = $1; + $au{middle} = $2 || $3 || ''; + $au{last} = $4; + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})); + } + # XXX Handle Smith, John Wilkinson; Smith, JW; and Smith, John W. + else { + warn "Couldn't handle author $author"; + $au{full} = $author; + } + } + elsif (ref $author eq 'ARRAY') { + warn "Author was empty" unless scalar @{$author}; + $au{full} = join(' ',grep /\w/, @{$author}); + $au{last} = $author->[-1]; + $au{first} = $author->[0] if scalar @{$author} > 1; + $au{middle} = join(' ',grep /\w/,@{$author}[1..($#{$author}-1)]) if scalar @{$author} > 2; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):''); + } + elsif (ref $author eq 'HASH') { + foreach my $key (qw(full last middle first initials)) { + $au{$key} = ''; + $au{$key} = $author->{$key} if exists $author->{$key} and defined $author->{$key}; + } + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})) if $au{full} eq ''; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):'') if $au{initials} eq ''; + } + else { + warn "Unknown reference: $author"; + return undef; + } + return \%au; +} + +=head2 _delete_author + + + + +XXX NOT IMPLEMENTED + +=cut + +sub _delete_author($$){ + my ($author_info,$author_list) = @_; + + die "NOT IMPLEMENTED"; +} + + +=head2 _init + +Called by Reference's new function + +Call superclass's _init function [C<$self->NEXT::_init>], sets up the +author list reference. + +=cut + +sub _init{ + my $self = shift; + + $self->{reference}->{author} = {authors => [], + first_author => 0, + corresponding_author => -1, + }; + + $self->NEXT::_init; + +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/27/27838510155caec110a4aad4738ea41e9434f92c.svn-base b/.svn/pristine/27/27838510155caec110a4aad4738ea41e9434f92c.svn-base new file mode 100644 index 0000000..8bfba68 --- /dev/null +++ b/.svn/pristine/27/27838510155caec110a4aad4738ea41e9434f92c.svn-base @@ -0,0 +1,100 @@ +#! /usr/bin/perl +# This program is part of da_reference, and is released under the +# terms of the GPL version 2, or any later version, at your +# option. See the file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id$ + + +use warnings; +use strict; + + +use Getopt::Long; +use Reference; +use Pod::Usage; + +=head1 NAME + +get_reference - Retrieve a reference from somewhere and output the +formatted reference to STDOUT. + +=head1 SYNOPSIS + +get_reference [options] referenceid [referenceid ...] + + Options: + --pmid,-p referenceid is a pub med id. (Default) + --bibtex,-b ouput in bibtex format (Default) + --debug, -d debugging level (Default 0) + --help,-h display this help + --man,-m display manual + +=head1 OPTIONS + +=over + +=item B<--pmid, -p> + +The referenceid listed is a Pub Med ID. (Default) + +=item B<--bibtex, -b> + +Output the listed referenceid in BibTeX format. (Default) + +=item B<--help, -h> + +Display brief useage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + + get_reference -p -b -d 1 123456; + + get_reference 123456; + +=cut + + + +use vars qw($DEBUG); + +my %options = (pmid => 1, + bibtex => 1, + debug => 0, + help => 0, + man => 0, + suggest_name => 0, + ); + +GetOptions(\%options,'pmid|p','bibtex|b','suggest_name|suggest-name','debug|d','help|h','man|m'); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + +if ($options{pmid} and $options{bibtex}) { + use Reference::Type::Article; + use Reference::Retrieve::PubMed; + use Reference::Output::Bibtex; + use Reference::Output::Filename; + $Reference::Retrieve::PubMed::DEBUG = $options{debug}; + foreach my $pmid (@ARGV) { + next unless ($pmid) = $pmid =~ /(\d+)/; + print STDERR "dealing with $pmid\n" if $DEBUG; + my $reference = scalar Reference::Retrieve::PubMed::get_reference_by_pmid(pmid => $pmid); + print STDERR "Unable to retrieve reference for $pmid\n" and next if not defined $reference; + if ($options{suggest_name}) { + # try to suggest a name for the reference + print '%Filename: '.lc(filename($reference))."\n"; + } + print scalar bibtex($reference); + } + exit 0; +} diff --git a/.svn/pristine/37/37d13632d4e1cc746576c92bb4d7055db21f8082.svn-base b/.svn/pristine/37/37d13632d4e1cc746576c92bb4d7055db21f8082.svn-base new file mode 100644 index 0000000..800c2ff --- /dev/null +++ b/.svn/pristine/37/37d13632d4e1cc746576c92bb4d7055db21f8082.svn-base @@ -0,0 +1,288 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id$ + +package Reference::Output::Bibtex; + +=head1 NAME + +Reference::Output::Bibtex -- Output references in BibTeX format + +=head1 SYNOPSIS + + print bibtex($reference); + +Returns a reference formatted in bibtex format. + +=head1 DESCRIPTION + +Knows how to handle the reference-> bibtex field mapping for many +reference types, but overridden types may need to provide their own +mapping. + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); + +use base qw(Exporter); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = qw(bibtex); + @EXPORT_OK = qw(); + %EXPORT_TAGS = (output => [qw(bibtex)], + ); + Exporter::export_ok_tags(qw(output)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +# Assigned and discussed at the end of this file +my %bibtex_mapping; + +use Carp; +use Params::Validate qw(:types validate_with); +use Text::Wrap; + + +=head2 bibtex + + print bibtex $reference; + %bibtex = bibtex $reference; + print bibtex($reference,mapping=>{...}) + +In scalar context, returns a formatted bibtex entry, suitable for +printing. In list context, returns a hash of key, value pairs which +can be used to print a formatted bibtex entry. + +You can also pass an optional mapping to be used for making the bibtex +entry. See B for the details. + +The mappings are obeyed in the following order, the first taking +precedence over the last. + +=over + +=item Passed mapping + +=item Object's bibtex_mapping + +=item Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping) + +=back + +Returns a SCALAR bibtex reference in scalar context, a HASH bibtex +reference in list context + +=cut + +sub bibtex{ + my $reference = shift; + + # Parse options if any + my %param = validate_with(params => \@_, + spec => {mapping => {type => HASHREF, + optional => 1, + }, + }, + ); + + my $mapping = undef; + + # Use our mapping by default if it exists + $mapping = $bibtex_mapping{lc($reference->{type})} if exists $bibtex_mapping{lc($reference->{type})}; + # Override that with the module's mapping + $mapping = $reference->{bibtex_mapping} if exists $reference->{bibtex_mapping}; + # Finally, override everything with passed mapping + $mapping = $param{mapping} if exists $param{mapping}; + + if (not defined $mapping) { + carp "This reference type doesn't support bibtex output."; + return undef; + } + + my %bibtex_entry; + foreach my $bibtex_field (keys %{$mapping->{mapping}}) { + my $params = []; + if (ref $bibtex_field) { + $params = $$bibtex_field{params} if exists $$bibtex_field{params}; + $bibtex_field = $$bibtex_field{field}; + } + my $function = $reference->can($mapping->{mapping}->{$bibtex_field}); + next unless $function; + $bibtex_entry{$bibtex_field} = &{$function}($reference,output=>'bibtex',@$params); + # dereference the entries if necessesary. + next unless wantarray; + # Make new copies of the entries if necessary so we can + # mogrify to our hearts content. + if (ref($bibtex_entry{$bibtex_field}) eq 'HASH') { + $bibtex_entry{$bibtex_field} = {%{$bibtex_entry{$bibtex_field}}}; + } + elsif (ref($bibtex_entry{$bibtex_field}) eq 'ARRAY') { + $bibtex_entry{$bibtex_field} = [@{$bibtex_entry{$bibtex_field}}]; + } + } + # Return the entries in hash form if desired. + return %bibtex_entry if wantarray; + # Ok, stich the bibtex entry together... + my $bibtex_entry; + $bibtex_entry = '@'.$mapping->{order}[0].'{'.$bibtex_entry{$mapping->{order}[0]}.",\n"; + foreach my $bibtex_field (@{$mapping->{order}}[1..$#{$mapping->{order}}]) { + next unless defined $bibtex_entry{$bibtex_field}; + if (ref $bibtex_entry{$bibtex_field} eq 'ARRAY') { + if (ref $mapping->{mapping}{$bibtex_field}) { + if (exists $mapping->{mapping}{$bibtex_field}{code}) { + local $_ = $bibtex_entry{$bibtex_field}; + eval $mapping->{mapping}{$bibtex_field}{code}; + carp "Error while executing code to assemble bibtex entry: $@" if $@; + } + elsif (exists $mapping->{mapping}{$bibtex_field}{join}) { + $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join}, + @{$bibtex_entry{$bibtex_field}}); + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + my $entry = $bibtex_entry{$bibtex_field}; + $entry =~ s/%/\\%/g; + $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = {".$entry."},\n"); + } + $bibtex_entry .= "}\n"; + return $bibtex_entry; +} + +=head2 bibtex_mapping + + $Reference::Output::Bibtex::bibtex_mapping{Article} = + {mapping => {author => {field => 'author', + join => ' and ', + params => [], + }, + volume => 'volume', + Articlce => 'name', + foo => 'bar', + }, + order => [qw(name author volume foo)], + }; + +This variable holds the mapping to bibtex output. + +Each type of reference has its own keys. Currently the following types +are supported by the Bibtex output method: + +=over + +=item article + +=item collection + +=item book + +=back + +If you wish to add support for your own custom reference type, you +merely need to add a bibtex_mapping element to your class's hashref, +or add to this variable. [Preferbly the former, as the latter should +only be used by the end user.] + +The mapping key in the reference type hashref is a hashref containing +key value pairs according to the following metric: + +=over + +=item If the mapping key value is not a reference, the value is used +as the name function to call via C<$reference->field>. [In the example +above, the volume mapping is built by a call to +C<$reference->volume>]. + +=item If the mapping key value is a hashref, the hashref contains two +keys. The C key contains the name of the function to call. The +C key contains the parameters + +=back + +The order key in the reference type hashref is an arrayref which +defines the order in which keys are listed in the BibTeX +output. Values in the arrayref should be the keys of the mapping +hashref. [The first value listed is the type of reference/reference +name pair.] + + +=cut + + +%bibtex_mapping = +(article => {mapping => {Article => 'name', + author => 'author', + title => 'title', + journal => 'journal', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + pmid => 'pmid', + mlid => 'medline_id', + doi => 'doi', + html => 'html', + pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract pmid mlid doi + html pdf), + ], + }, + book => {mapping => {Book => 'name', + author => 'author', + title => 'title', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + doi => 'doi', + # html => 'html', + # pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract doi html pdf), + ], + }, +); + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/3b/3b230680ee0646a5802fa31112bf96cbfad8035d.svn-base b/.svn/pristine/3b/3b230680ee0646a5802fa31112bf96cbfad8035d.svn-base new file mode 100644 index 0000000..61b3a3b --- /dev/null +++ b/.svn/pristine/3b/3b230680ee0646a5802fa31112bf96cbfad8035d.svn-base @@ -0,0 +1,375 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id$ + +package Reference::Output::Bibtex; + +=head1 NAME + +Reference::Output::Bibtex -- Output references in BibTeX format + +=head1 SYNOPSIS + + print bibtex($reference); + +Returns a reference formatted in bibtex format. + +=head1 DESCRIPTION + +Knows how to handle the reference-> bibtex field mapping for many +reference types, but overridden types may need to provide their own +mapping. + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); + +use base qw(Exporter); + +use Encode qw(encode_utf8 is_utf8 decode decode_utf8); +use Text::Iconv; + + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = qw(bibtex); + @EXPORT_OK = qw(); + %EXPORT_TAGS = (output => [qw(bibtex)], + ); + Exporter::export_ok_tags(qw(output)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +# Assigned and discussed at the end of this file +my %bibtex_mapping; + +use Carp; +use Params::Validate qw(:types validate_with); +use Text::Wrap; + + +=head2 bibtex + + print bibtex $reference; + %bibtex = bibtex $reference; + print bibtex($reference,mapping=>{...}) + +In scalar context, returns a formatted bibtex entry, suitable for +printing. In list context, returns a hash of key, value pairs which +can be used to print a formatted bibtex entry. + +You can also pass an optional mapping to be used for making the bibtex +entry. See B for the details. + +The mappings are obeyed in the following order, the first taking +precedence over the last. + +=over + +=item Passed mapping + +=item Object's bibtex_mapping + +=item Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping) + +=back + +Returns a SCALAR bibtex reference in scalar context, a HASH bibtex +reference in list context + +=cut + +sub bibtex{ + my $reference = shift; + + # Parse options if any + my %param = validate_with(params => \@_, + spec => {mapping => {type => HASHREF, + optional => 1, + }, + }, + ); + + my $mapping = undef; + + # Use our mapping by default if it exists + $mapping = $bibtex_mapping{lc($reference->{type})} if exists $bibtex_mapping{lc($reference->{type})}; + # Override that with the module's mapping + $mapping = $reference->{bibtex_mapping} if exists $reference->{bibtex_mapping}; + # Finally, override everything with passed mapping + $mapping = $param{mapping} if exists $param{mapping}; + + if (not defined $mapping) { + carp "This reference type doesn't support bibtex output."; + return undef; + } + + my %bibtex_entry; + foreach my $bibtex_field (keys %{$mapping->{mapping}}) { + my $params = []; + if (ref $bibtex_field) { + $params = $$bibtex_field{params} if exists $$bibtex_field{params}; + $bibtex_field = $$bibtex_field{field}; + } + my $function = $reference->can($mapping->{mapping}->{$bibtex_field}); + next unless $function; + $bibtex_entry{$bibtex_field} = &{$function}($reference,output=>'bibtex',@$params); + # dereference the entries if necessesary. + next unless wantarray; + # Make new copies of the entries if necessary so we can + # mogrify to our hearts content. + if (ref($bibtex_entry{$bibtex_field}) eq 'HASH') { + $bibtex_entry{$bibtex_field} = {%{$bibtex_entry{$bibtex_field}}}; + } + elsif (ref($bibtex_entry{$bibtex_field}) eq 'ARRAY') { + $bibtex_entry{$bibtex_field} = [@{$bibtex_entry{$bibtex_field}}]; + } + } + # Return the entries in hash form if desired. + return %bibtex_entry if wantarray; + # Ok, stich the bibtex entry together... + my $bibtex_entry; + $bibtex_entry = '@'.$mapping->{order}[0].'{'.$bibtex_entry{$mapping->{order}[0]}.",\n"; + foreach my $bibtex_field (@{$mapping->{order}}[1..$#{$mapping->{order}}]) { + next unless defined $bibtex_entry{$bibtex_field}; + if (ref $bibtex_entry{$bibtex_field} eq 'ARRAY') { + if (ref $mapping->{mapping}{$bibtex_field}) { + if (exists $mapping->{mapping}{$bibtex_field}{code}) { + local $_ = $bibtex_entry{$bibtex_field}; + eval $mapping->{mapping}{$bibtex_field}{code}; + carp "Error while executing code to assemble bibtex entry: $@" if $@; + } + elsif (exists $mapping->{mapping}{$bibtex_field}{join}) { + $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join}, + @{$bibtex_entry{$bibtex_field}}); + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + my $entry = $bibtex_entry{$bibtex_field}; + $entry =~ s/%/\\%/g; + $entry = encode_utf8(convert_to_utf8($entry)); + my $start = "{"; + my $stop = "}"; + if ($bibtex_field eq 'journal') { + $start = ""; + $stop = ""; + } + $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = $start".$entry."$stop,\n"); + } + $bibtex_entry .= "}\n"; + return $bibtex_entry; +} + +=head2 bibtex_mapping + + $Reference::Output::Bibtex::bibtex_mapping{Article} = + {mapping => {author => {field => 'author', + join => ' and ', + params => [], + }, + volume => 'volume', + Articlce => 'name', + foo => 'bar', + }, + order => [qw(name author volume foo)], + }; + +This variable holds the mapping to bibtex output. + +Each type of reference has its own keys. Currently the following types +are supported by the Bibtex output method: + +=over + +=item article + +=item collection + +=item book + +=back + +If you wish to add support for your own custom reference type, you +merely need to add a bibtex_mapping element to your class's hashref, +or add to this variable. [Preferbly the former, as the latter should +only be used by the end user.] + +The mapping key in the reference type hashref is a hashref containing +key value pairs according to the following metric: + +=over + +=item If the mapping key value is not a reference, the value is used +as the name function to call via C<$reference->field>. [In the example +above, the volume mapping is built by a call to +C<$reference->volume>]. + +=item If the mapping key value is a hashref, the hashref contains two +keys. The C key contains the name of the function to call. The +C key contains the parameters + +=back + +The order key in the reference type hashref is an arrayref which +defines the order in which keys are listed in the BibTeX +output. Values in the arrayref should be the keys of the mapping +hashref. [The first value listed is the type of reference/reference +name pair.] + + +=cut + + +%bibtex_mapping = +(article => {mapping => {Article => 'name', + author => 'author', + title => 'title', + journal => 'journal', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + pmid => 'pmid', + mlid => 'medline_id', + doi => 'doi', + html => 'html', + pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract pmid mlid doi + html pdf), + ], + }, + book => {mapping => {Book => 'name', + author => 'author', + title => 'title', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + doi => 'doi', + # html => 'html', + # pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract doi html pdf), + ], + }, +); + +=head2 convert_to_utf8 + + $utf8 = convert_to_utf8("text","charset"); + +=cut + +sub convert_to_utf8 { + my ($data,$charset,$internal_call) = @_; + $internal_call //= 0; + if (is_utf8($data)) { + # cluck("utf8 flag is set when calling convert_to_utf8"); + return $data; + } + $charset = uc($charset//'UTF-8'); + if ($charset eq 'RAW') { + # croak("Charset must not be raw when calling convert_to_utf8"); + } + my $iconv_converter; + eval { + $iconv_converter = Text::Iconv->new($charset,"UTF-8") or + die "Unable to create converter for '$charset'"; + }; + if ($@) { + return undef if $internal_call; + warn $@; + # We weren't able to create the converter, so use Encode + # instead + return __fallback_convert_to_utf8($data,$charset); + } + my $converted_data = $iconv_converter->convert($data); + # if the conversion failed, retval will be undefined or perhaps + # -1. + my $retval = $iconv_converter->retval(); + if (not defined $retval or + $retval < 0 + ) { + # try iso8559-1 first + if (not $internal_call) { + my $call_back_data = convert_to_utf8($data,'ISO8859-1',1); + # if there's an à (0xC3), it's probably something + # horrible, and we shouldn't try to convert it. + if (defined $call_back_data and $call_back_data !~ /\x{C3}/) { + # warn "failed to convert to utf8 (charset: $charset, data: $data), but succeeded with ISO8859-1: ".encode_utf8($call_back_data); + return $call_back_data; + } + } + warn "failed to convert to utf8 (charset: $charset, data: $data)"; + # Fallback to encode, which will probably also fail. + return __fallback_convert_to_utf8($data,$charset); + } + return decode("UTF-8",$converted_data); +} + +# this returns data in perl's internal encoding +sub __fallback_convert_to_utf8 { + my ($data, $charset) = @_; + # raw data just gets returned (that's the charset WordDecorder + # uses when it doesn't know what to do) + return $data if $charset eq 'raw'; + if (not defined $charset and not is_utf8($data)) { + warn ("Undefined charset, and string '$data' is not in perl's internal encoding"); + return $data; + } + # lets assume everything that doesn't have a charset is utf8 + $charset //= 'utf8'; + my $result; + eval { + $result = decode($charset,$data,0); + }; + if ($@) { + warn "Unable to decode charset; '$charset' and '$data': $@"; + return $data; + } + return $result; +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/40/4087eb7177bb14e94e5e1535ecbcbced384e458c.svn-base b/.svn/pristine/40/4087eb7177bb14e94e5e1535ecbcbced384e458c.svn-base new file mode 100644 index 0000000..c390b10 --- /dev/null +++ b/.svn/pristine/40/4087eb7177bb14e94e5e1535ecbcbced384e458c.svn-base @@ -0,0 +1,575 @@ +# This module is part of Refence, and is released under the terms of +# the GPL version 2, or any later version. See the file README and +# COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Retrieve::PubMed; + +=head1 NAME + +Reference::Retrieve::PubMed -- Reference Retrieval from PubMed + +=head1 SYNOPSIS + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',limit=>50); + + +=head1 DESCRIPTION + +Uh. Retreives references from pubmed. Yeah. + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); +use Carp; + +use LWP::UserAgent; +use XML::Simple qw(:strict); +use Reference; + +use HTML::Entities; + +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 get_reference + +=head3 Usage + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',-limit=>50); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>{author=>'John Smith', pages=>'230'},-limit=>50) + +=head3 Function + +Retrives a reference from pubmed + +=head3 Returns + +In scalar context, effectively assumes -limit=>1 and returns the +highest listed reference according to the order, etc. [Probably only +usefull with -pmid.] In list context, returns all results (or until it +hits the -limit.) + +=head3 Args + +list of arguments to select a reference or collection of references from. + + +=cut + +sub get_reference{ + my %options = validate_with(params => @_, + spec => {pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/query.fcgi?cmd=Text&db=PubMed&dopt=XML&uid='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + }, + allow_extra => 1, + ); + my $ua = new LWP::UserAgent(agent => $options{ua_agent}); +} + +sub get_reference_by_pmid($;@){ + my %options = validate_with(params => \@_, + spec => {pmid => {type => SCALAR|ARRAYREF, + #regex => qr/^\d+$/, + }, + pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/eutils/efetch.fcgi?db=pubmed&retmode=xml&rettype=full&id='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + useragent => {optional => 1}, + }, + allow_extra => 1, + ); + my $pmid = $options{pmid}; + + my $ua; + if ($options{useragent}) { + $ua = $options{useragent}; + } + else { + $ua = new LWP::UserAgent(agent=>$options{ua_agent}); + } + my $url = "$options{pubmed_site}$options{pmid_query}" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # For some dumb reason, they send us xml with html + # entities. Ditch them. + #$response = decode_entities($response); + # It's even more freaking broken; they don't double encode them. + #$response =~ s/\>(\s|$)/>$1/gso; + #$response =~ s/(?:(\s)\<|<(\/))/$1<$2/gso; + $response =~ s/"/"/gso; + + # Ditch any doctype + $response =~ s/^\s*<\?xml[^>]+>\s*//gso; + $response =~ s/^\s*<\!DOCTYPE[^>]+>\s*//gso; + # There is also a Pubmedarticleset + $response =~ s/^\s*\s*//gso; + $response =~ s#\s*$##gso; + + # Add the opt so we get an array of PubMedArticle + $response = "$response"; + + print STDERR $response if $DEBUG; + + # Figure out if there was an error in the search. + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => [ 'PubmedArticle' ],KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct) if $DEBUG; + # Handle the XML structure + my @references; + foreach my $ref (@{$ref_struct->{PubmedArticle}}) { + my $reference = _create_reference_from_xml($ref,$ua); + if (not defined $reference) { + warn "Unable to create reference for $ref->{MedlineCitation}->{PMID}\n"; + } + push @references, $reference; + } + if (wantarray) { + return @references; + } + return $references[0]; +} + +sub _create_reference_from_xml($$){ + my ($ref,$ua) = @_; + + # Figure out what type of reference this is. We only support + # Journal Articles right now. + my $types = {'journal article'=>'article', + 'letter' =>'article', + }; + my $ref_type = undef; + my $reference = undef; + foreach my $type (keys %{$types}) { + if (ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq 'ARRAY'){ + my $pubtypes; + @{$pubtypes}{map {lc} @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}} = + (1) x @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}; + if ($pubtypes->{$type}) { + $ref_type = $types->{$type}; + last; + } + else { + next; + } + } + elsif (lc($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq lc($type)) { + $ref_type = $types->{$type}; + last; + } + } + if (not defined $ref_type) { + warn "Unsupported PublicationType: ".(ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType})? + join(',',@{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}): + $ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}); + print STDERR Dumper($ref); + $ref_type = 'article'; + } + local $_ = $ref_type; + if (/article/) { + use Reference::Type::Article; + $reference = new Reference::Type::Article; + my $xml_mapping = {author => [ _fix_medline_authors($ref->{MedlineCitation}->{Article}->{AuthorList}) ], + title => [_fix_medline_title($ref->{MedlineCitation}->{Article}->{ArticleTitle})], + abstract => _fix_medline_abstract($ref->{MedlineCitation}->{Article}->{Abstract}->{AbstractText}), + journal => [_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua, + #@_, # configuration + )], + _fix_ids($ref), + # pmid => $ref->{MedlineCitation}->{PMID}, + # medline_id => $ref->{MedlineCitation}->{MedlineID}, + volume => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Volume})], + date => [_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})], + number => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Issue})], + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], +# keywords => [_fix_medline_keywords($ref->{MedlineCitation}->{MeshHeadingList}, +# $ref->{MedlineCitation}->{ChemicalList}, +# )], +# &_find_pubmed_links($ref->{MedlineCitation}->{PMID},$ua), + }; + # Deal with author + + foreach my $reference_key (keys %{$xml_mapping}) { + my $method = $reference->can($reference_key); + die "Reference::Type::Article was unable to handle $reference_key" if not $method; + if (defined $xml_mapping->{$reference_key} and $method) { + if (ref($xml_mapping->{$reference_key})) { + &{$method}($reference,@{$xml_mapping->{$reference_key}}); + } + else { + &{$method}($reference,$xml_mapping->{$reference_key}); + } + } + else { + warn "Reference_key $reference_key was not defined or unable to handle type of key." + if not defined $xml_mapping->{$reference_key} and $DEBUG; + } + } + return $reference; + } +} + +sub _fix_medline_title($){ + my $title = shift; + + $title =~ s/\.$//; + return $title; +} + +sub _fix_medline_abstract{ + my $abstract = shift; + my $ret = ''; + if (ref($abstract) and ref($abstract) eq 'ARRAY') { + for my $element (@{$abstract}) { + $ret .= "\n" if length $ret; + $ret .= $element->{Label}.': '.$element->{content}; + } + return $ret; + } else { + return $abstract; + } +} + + +sub _fix_medline_authors($){ + my $author_list = shift; + $author_list = $author_list->{Author}; + my @authors; + $author_list = [$author_list] if ref($author_list) ne 'ARRAY'; + foreach my $author (@{$author_list}) { + my %au; + $au{first} = $author->{ForeName} if exists $author->{ForeName}; + $au{last} = $author->{LastName} if exists $author->{LastName}; + $au{initials} = $author->{Initials} if exists $author->{Initials}; + $au{full}; + push @authors,\%au; + } + return (author=>\@authors); +} + +=head2 _fix_medline_journal + +=head3 Usage + + $reference->journal(_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua,)); + +=head3 Function + +From the medline citation informatino returns a properly formatted +list of information for the journal reference listing. + +=head3 Args + +Journal information hashref + +medline journal information hashref + +user agent + +=cut + +sub _fix_medline_journal($$$;){ + my ($journal,$medline_journal,$ua) = @_; + # journal takes fullname, issn, medlineabbr, pmid, and nlmuid + # Try to supply as much as possible. + # Use esearch to get pmjournalid + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=0021-9258 + # use esummary to retreive the journalid + # + # + # + # 1 + # 1 + # 0 + # + # 4559 + # + # + # + # + # + # + # 0021-9258[All Fields] + # All Fields + # 1 + # + # Y + # + # + # + + my $ISSN = $journal->{ISSN}; + if (ref $ISSN) { + $ISSN = $ISSN->{content}; + } + my $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=$ISSN); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my ($journal_id) = $response =~ m#\s*(\d+)\s*#i; + + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559 + # + # + # + # + # 4559 + # The Journal of biological chemistry. + # J Biol Chem + # J. Biol. Chem. + # 2985121R + # + # 0021-9258 + # 1083-351X + # 1905 + # + # American Society for Biochemistry and Molecular Biology + # eng + # + # United States + # + # + # + $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esummary.fcgi?db=journals&id=$journal_id); + print STDERR "url: $url" if $DEBUG; + $request = HTTP::Request->new('GET', $url); + $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my %journal; + while ($response =~ m{^\s*(?:(?:\s*(\d+))| # Match ids + (?:\s*([^<]+?)))\s* # Match item Name clauses + $}ixmg) { + if (not defined $2) { + $journal{id} = $1; + } + else { + $journal{lc($2)} = $3; + } + } + my %journal_mapping = (title => q(title), + medlineabbr => q(medabbr), + isoabbr => q(isoabbr), + nlmid => q(nlmid), + issn => q(pissn), + eissn => q(eissn), + publisher => q(publisher), + pmid => q(id) + ); + my @journal_entry; + foreach my $key (keys %journal_mapping) { + push @journal_entry,($key=>$journal{$journal_mapping{$key}}); + } + return @journal_entry; +} + +=head2 + +=head3 Usage + + $reference->date(_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})); + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _fix_medline_pubdate($){ + my ($date) = shift; + return (year=>$date->{Year},month=>$date->{Month},day=>$date->{Day}) if exists $date->{Year}; + # Ok... punt. + if (exists $date->{MedlineDate}) { + my ($year,$month,$day) = split /\s+/,$date->{MedlineDate}; + return (year=>$year,month=>$month,day=>$day) + } +} + +=head2 _fix_medline_pages + +=head3 Usage + + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], + +=head3 Function + +Returns output with a list of pages appropriate for an Article type of +reference. + +=cut + +sub _fix_medline_pages($){ + my ($pagination) = @_; + my ($start,$stop) = $pagination =~ /(\d*)\s*\-\s*(\d*)/; + if ($start > $stop) { + # this must be a reduced page listing; fix it up + $stop+=$start - $start % 10 ** (int(log($stop)/log(10))+1); + } + my @return; + push @return, (start=>$start) if defined $start and $start ne ''; + push @return, (stop=>$stop) if defined $stop and $stop ne ''; + return @return; +} + +sub _find_pubmed_links($$){ + my ($pmid,$ua) = @_; + return (); + #http://eutils.ncbi.nlm.nih.gov/entrez/query/static/elink_help.html + my $url = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/elink.fcgi?dbfrom=pubmed&cmd=llinks&id=" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => ['IdUrlSet'], KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct);# if $DEBUG; + # Rearange data around Id. + my $links = {}; + map {$links->{$_->{Id}}=$_->{ObjUrl}} @{$ref_struct->{LinkSet}->{IdUrlList}->{IdUrlSet}}; + foreach my $obj_url (@{$links->{$pmid}->{ObjUrl}}) { + next unless $obj_url->{SubjectType} = 'publishers/providers'; + #@links = _find_links_from_url($obj_url->{Url},$ua); + } + # Find publisher link + # If no publisher link, use the first aggregator link. +} + +=head2 _fix_ids + + _fix_ids + + + +=cut + +sub _fix_ids { + my ($ref) = @_; + + my %ids_known = (medline => 'medline_id', + pubmed => 'pmid', + doi => 'doi', + ); + my %ids; + if (exists $ref->{PubmedData}{ArticleIdList}{ArticleId}) { + for my $art_id (ref($ref->{PubmedData}{ArticleIdList}{ArticleId}) eq 'ARRAY' ? + @{$ref->{PubmedData}{ArticleIdList}{ArticleId}}: + ($ref->{PubmedData}{ArticleIdList}{ArticleId})) { + if (exists $ids_known{$art_id->{IdType}}) { + $ids{$ids_known{$art_id->{IdType}}} = $art_id->{content}; + } + } + } + if (not exists $ids{pmid}) { + $ids{pmid} = $ref->{MedlineCitation}->{PMID} if defined $ref->{MedlineCitation}->{PMID}; + } + if (not exists $ids{medline_id}) { + $ids{medline_id} = $ref->{MedlineCitation}->{MedlineID} if defined $ref->{MedlineCitation}->{MedlineID}; + } + return %ids; +} + + +=head2 _find_links_from_url + +=head3 Usage + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _find_links_from_url($$){ + my ($link,$ua) = @_; + + + +} + +sub _fix_medline_ditch_empty($){ + my ($value) = @_; + + if (ref($value)) { + if (ref($value) eq 'HASH') { + if (scalar keys %{$value} > 0) { + return $value; + } + else { + return ''; + } + } + elsif (ref($value) eq 'ARRAY') { + if (scalar @{$value} > 0) { + return $value; + } + else { + return ''; + } + } + else { + return ''; + } + } + else { + return $value if defined $value; + return ''; + } +} + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/60/6005276799cde29242f7fafd85d544e1e74ba30e.svn-base b/.svn/pristine/60/6005276799cde29242f7fafd85d544e1e74ba30e.svn-base new file mode 100644 index 0000000..cb724b0 --- /dev/null +++ b/.svn/pristine/60/6005276799cde29242f7fafd85d544e1e74ba30e.svn-base @@ -0,0 +1,224 @@ +# This module is part of , and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference; + +=head1 NAME + +Reference -- Reference superclass + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($VERSION $REVISION $DEBUG); +use Carp; + + +BEGIN{ + $REVISION = '0.01'; + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + +our $AUTOLOAD; + + +=head2 new + + my $reference = new Reference; + + +Creates a new reference object + +=cut + +sub new{ + my $class = shift; + + $class = ref $class if ref $class; + + my $self = {}; + + bless $self, $class; + + $self->_init; + + return $self; +} + + +=head2 ref_fields + + @$self->{ref_fields}{$self->ref_fields} = (1) x $self->ref_fields; + +Returns the fields that this reference knows how to deal with (or that +should be dealt with using ref_fields). + +This default implementation returns an empty list, and as such should +be overriden by all Reference::Type subclasses. + +=cut + +sub ref_fields{ + my $self = shift; + + return (); +} + + +=head2 ref_field + + $reference->ref_field('author',['John Q. Smith', 'Randal P. Swag']); + +Sets the reference field to the passed value (if any) and returns the +new value. This function is called through AUTOLOAD using the +$reference->field() syntax. + +Returns the new setting of passed field. + +Scalar fieldname, and an optional scalar, arrayref, or hashref to set +reference field. + +=cut + +sub ref_field($$;$){ + my ($self,$field_name,$field_value) = @_; + + if ($self->{ref_fields}->{lc($field_name)}) { + # Check to make sure that only 3 arguments are passed to + # avoid triggering on the Params::Variable style of calling. + # XXX We should check explicitly for this. [See Author.pm] + if (defined $field_value and scalar(@_) == 3) { + $self->{reference}->{lc($field_name)} = $field_value; + } + return $self->{reference}->{lc($field_name)}; + } + carp "Invalid field name $field_name"; +} + + +=head2 AUTOLOAD + +Dispatches calls to $reference->fieldname to +$reference->ref_field('fieldname'). + +XXX I really wish there was a way to tell perl that we don't want to +XXX handle a call to AUTOLOAD. + +=cut + +sub AUTOLOAD{ + my $function = $AUTOLOAD; + ($function) = $function =~ /\:?([^\:]+)$/; + my $self = shift; + if (ref $self and $self->{ref_fields}->{lc($function)}) { + # slap $self and $function into @_. + unshift @_, ($self,$function); + goto &ref_field; + } + else { + croak "Undefined subroutine $function"; + } +} + + +=head2 can + + $obj->can('METHOD'); + Class::Modular->can('METHOD'); + +Replaces UNIVERSAL's can method so that handled methods are reported +correctly. Calls UNIVERSAL::can in the places where we don't know +anything it doesn't. + +Returns a coderef to the method if the method is supported, undef +otherwise. + +=cut + +sub can{ + my ($self,$method,$vars) = @_; + + my $universal_can = UNIVERSAL::can($self,$method); + + if ($universal_can){ + return $universal_can; + } + elsif (ref $self and exists $self->{ref_fields}->{lc($method)}) { + # If there is no other method for dealing with this method, + # and we would normally autoload it, create an anonymous sub + # to deal with it appropriately. + return sub{my $self = shift; return $self->ref_field($method,@_);}; + } + else { + return undef; + } +} + + +=head2 _init + + $self->_init + +=cut + +sub _init($){ + my $self = shift; + + # ref_fields is used by AUTOLOAD to know when it's ok to set a + # particular field + my @ref_fields = $self->ref_fields; + @{$self->{ref_fields}}{@ref_fields} = (1) x scalar @ref_fields; +} + + + + + +# From http://www.ecst.csuchico.edu/~jacobsd/bib/formats/ + +# * BibTeX +# * INSPEC +# * MARC [MARC::Record] +# * Melvyl [Uses MARC] +# * RIS +# * MedLine +# * ISI Focus On +# * EMBL +# * BIDS +# * ProCite +# * EndNote +# * Computing Archives +# * Uniform Resource Citation +# * RFC 1807 (replaces RFC 1357) +# * Other formats + + + + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/62/627ae82969798f88b44a859559d55341197b0f39.svn-base b/.svn/pristine/62/627ae82969798f88b44a859559d55341197b0f39.svn-base new file mode 100644 index 0000000..1385046 --- /dev/null +++ b/.svn/pristine/62/627ae82969798f88b44a859559d55341197b0f39.svn-base @@ -0,0 +1,18 @@ +bin/find_link_testing.pl +bin/get_reference +lib/Reference.pm +lib/Reference/Field/Author.pm +lib/Reference/Field/Date.pm +lib/Reference/Field/Journal.pm +lib/Reference/Field/Pages.pm +lib/Reference/Output/Bibtex.pm +lib/Reference/Retrieve/HTML/Miner.pm +lib/Reference/Retrieve/PubMed.pm +lib/Reference/Type/Article.pm +Makefile.PL +MANIFEST This list of files +META.yml Module meta-data (added by MakeMaker) +NOTES +pm_to_blib +templates/perl_module_header.pm +templates/perl_program_header.pl diff --git a/.svn/pristine/6a/6af4ffedbfea09ff95669907dc91d39ef0f07c66.svn-base b/.svn/pristine/6a/6af4ffedbfea09ff95669907dc91d39ef0f07c66.svn-base new file mode 100644 index 0000000..7eeb556 --- /dev/null +++ b/.svn/pristine/6a/6af4ffedbfea09ff95669907dc91d39ef0f07c66.svn-base @@ -0,0 +1,111 @@ +#! /usr/bin/perl +# This program is part of da_reference, and is released under the +# terms of the GPL version 2, or any later version, at your +# option. See the file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id$ + + +use warnings; +use strict; + + +use Getopt::Long; +use Reference; +use Pod::Usage; + +=head1 NAME + +get_reference - Retrieve a reference from somewhere and output the +formatted reference to STDOUT. + +=head1 SYNOPSIS + +get_reference [options] referenceid [referenceid ...] + + Options: + --pmid,-p referenceid is a pub med id. (Default) + --bibtex,-b ouput in bibtex format (Default) + --debug, -d debugging level (Default 0) + --help,-h display this help + --man,-m display manual + +=head1 OPTIONS + +=over + +=item B<--pmid, -p> + +The referenceid listed is a Pub Med ID. (Default) + +=item B<--bibtex, -b> + +Output the listed referenceid in BibTeX format. (Default) + +=item B<--help, -h> + +Display brief useage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + + get_reference -p -b -d 1 123456; + + get_reference 123456; + +=cut + + + +use vars qw($DEBUG); + +my %options = (pmid => 1, + bibtex => 1, + debug => 0, + help => 0, + man => 0, + suggest_name => 0, + journal_titles => 0, + ); + +GetOptions(\%options,'pmid|p','bibtex|b','suggest_name|suggest-name','debug|d','help|h','man|m', + 'journal_titles|journal-titles|journal_title|journal-titles', + ); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + +if ($options{pmid} and $options{bibtex}) { + use Reference::Type::Article; + use Reference::Retrieve::PubMed; + use Reference::Output::Bibtex; + use Reference::Output::Filename; + use Encode qw(encode_utf8); + $Reference::Retrieve::PubMed::DEBUG = $options{debug}; + foreach my $pmid (@ARGV) { + next unless ($pmid) = $pmid =~ /(\d+)/; + print STDERR "dealing with $pmid\n" if $DEBUG; + my $reference = scalar Reference::Retrieve::PubMed::get_reference_by_pmid(pmid => $pmid); + print STDERR "Unable to retrieve reference for $pmid\n" and next if not defined $reference; + if ($options{suggest_name}) { + # try to suggest a name for the reference + print '%Filename: '.lc(encode_utf8(Reference::Output::Bibtex::convert_to_utf8(filename($reference))))."\n"; + } + if ($options{journal_titles}) { + print '%Medline: @string {'.$reference->journal(output=>'bibtex').'="'. + $reference->journal(output=>'medline').qq("}\n); + print '%isoabbr: @string {'.$reference->journal(output=>'bibtex').'="'. + $reference->journal(output=>'iso').qq("}\n); + print '%full: @string {'.$reference->journal(output=>'bibtex').'="'. + $reference->journal().qq("}\n); + } + print scalar bibtex($reference); + } +} diff --git a/.svn/pristine/79/7933fff86b028f376f3a1a151d80711d1b12948d.svn-base b/.svn/pristine/79/7933fff86b028f376f3a1a151d80711d1b12948d.svn-base new file mode 100644 index 0000000..aac6d98 --- /dev/null +++ b/.svn/pristine/79/7933fff86b028f376f3a1a151d80711d1b12948d.svn-base @@ -0,0 +1,8 @@ + + +Z39.50 support + Zoom API -- http://zoom.z3950.org/ + LOC Z39.50 -- http://lcweb.loc.gov/z3950/lcserver.html + Perl http://search.cpan.org/~mirk/Net-Z3950-0.41/Z3950.pm + + Melvyl z39.50 melvyl.cdlib.org port 210 \ No newline at end of file diff --git a/.svn/pristine/7a/7a7a014b8146bb7768477142a8f981333ed04bb2.svn-base b/.svn/pristine/7a/7a7a014b8146bb7768477142a8f981333ed04bb2.svn-base new file mode 100644 index 0000000..dd4efce --- /dev/null +++ b/.svn/pristine/7a/7a7a014b8146bb7768477142a8f981333ed04bb2.svn-base @@ -0,0 +1,178 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Field::Date; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); +use Date::Manip; + + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + +=head2 date + + + +XXX DOCUMENT ME + +=cut + + +sub date{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{date} = shift; + $params{output} = 'scalar'; + } + else { + %params = validate_with(params => \@_, + spec => {date => {type => ARRAYREF|SCALAR|HASHREF|UNDEF, + optional => 1, + }, + day => {type => SCALAR|UNDEF, + optional => 1, + }, + year => {type => SCALAR|UNDEF, + optional => 1, + }, + month => {type => SCALAR|UNDEF, + optional => 1, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{day} or defined $params{year} or defined $params{month}) { + $self->{reference}->{date}->{day} = $params{day} if defined $params{day}; + $self->{reference}->{date}->{year} = $params{year} if defined $params{year}; + $self->{reference}->{date}->{month} = $params{month} if defined $params{month}; + } + elsif (defined $params{date}) { + $self->{reference}->{date} = {day => undef, + year => undef, + month => undef, + }; + my $date = ParseDate($params{date}); + $self->{reference}->{date}->{unix} = $date; + ($self->{reference}->{date}->{day}, + $self->{reference}->{date}->{year}, + $self->{reference}->{date}->{month}) = UnixDate($date,qw(%e %Y %m)); + } + + local $_ = $params{output}; + if (/bibtex/) { + return UnixDate($self->{reference}->{date}->{unix},'%B %e %Y') if defined $self->{reference}->{date}->{unix}; + return join(' ',$self->{reference}->{date}->{day},$self->{reference}->{date}->{year},$self->{reference}->{date}->{month}); + } + elsif (/year/) { + return UnixDate($self->{reference}->{date}->{unix},'%Y') if defined $self->{reference}->{date}->{unix}; + return $self->{reference}->{date}->{year}; + } + else { + return UnixDate($self->{reference}->{date}->{unix},'%B %e %Y') if defined $self->{reference}->{date}->{unix}; + return join(' ',$self->{reference}->{date}->{day},$self->{reference}->{date}->{year},$self->{reference}->{date}->{month}); + } +} + +=head2 year + + + +Returns the year associated with the date field + + +=cut + + +sub year{ + my $self = shift; + + return $self->{reference}->{date}->{year}; +} + +=head2 day + + + +Returns the day associated with the date field + +=cut + +sub day{ + my $self = shift; + + return $self->{reference}->{date}->{day}; +} + +=head2 month + + + +Returns the month associated with the date field + +=cut + +sub month{ + my $self = shift; + + return $self->{reference}->{date}->{month}; +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{date} = {month => undef, + year => undef, + day => undef, + unix => undef, + }; + + $self->NEXT::_init; + +} + + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/84/84880ef6852ca8e21ddd0d86943069613512f497.svn-base b/.svn/pristine/84/84880ef6852ca8e21ddd0d86943069613512f497.svn-base new file mode 100644 index 0000000..ce6488a --- /dev/null +++ b/.svn/pristine/84/84880ef6852ca8e21ddd0d86943069613512f497.svn-base @@ -0,0 +1,166 @@ +# This module is part of , and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Type::Article; + +=head1 NAME + +Reference::Type::Article -- Article reference type + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($VERSION $DEBUG); +use Carp; + +use base qw(Reference Reference::Field::Author Reference::Field::Pages Reference::Field::Journal Reference::Field::Date); + +use NEXT; +use Reference; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($VERSION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 name + +=head3 Usage + + $article->name($article_name); + my $article_name = $article->name; + +=head3 Function + +Returns the article name if it has been set, or builds an article name +from the author, journal, volume, and page if none is set. + +=cut + +sub name{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{name} = shift; + } + else { + %params = validate_with(params => \@_, + spec => {name => {type => SCALAR, + optional => 1, + }, + output => {type => SCALAR, + default => 'scalar', + }, + }, + ); + } + + if (defined $params{name}) { + $self->{reference}->{name} = $params{name}; + return $params{name}; + } + if (not defined $self->{reference}->{name}) { + my ($name) = $self->first_author =~ /(\w+)$/; + if (not defined $name) { + no warnings qw(uninitialized); + $name = $self->journal . $self->volume . $self->pages; + } + $name .= $self->year if defined $self->year; + $self->{reference}->{name} = $name; + return $name; + } + else { + return $self->{reference}->{name}; + } +} + +=head2 ref_fields + +=head3 Usage + + my @ref_fields = $self->ref_fields; + +=head3 Returns + +Returns the list of reference fields which this type of reference +supports. + +=cut + +sub ref_fields($){ + my $self = shift; + + return qw(author title year abstract journal pmid medline_id volume date number pages keywords doi html pdf month); +} + + +=head2 _init + +=head3 Usage + +Called by Reference's new function + +=head3 Function + +Call superclass's _init function [C<$self->NEXT::_init>], set up the +bibtex_mapping and bibtex_order. + +=cut + +sub _init($){ + my $self = shift; + + $self->NEXT::_init; + $self->{type} = 'article'; +# $self->{bibtex_mapping} = {Article => 'name', +# author => 'author', +# title => 'title', +# journal => 'journal', +# year => 'year', +# key => 'keywords', +# volume => 'volume', +# number => 'number', +# pages => 'pages', +# month => 'month', +# abstract => 'abstract', +# pmid => 'pmid', +# mlid => 'medline_id', +# # doi => 'doi', +# # html => 'html', +# # pdf => 'pdf', +# }; +# $self->{bibtex_order} = [qw(Article author title journal +# year key volume number pages +# month abstract pmid mlid doi +# html pdf),]; +} + + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/91/915b76dcfb3f983021583df6d5230d1b8dfd9842.svn-base b/.svn/pristine/91/915b76dcfb3f983021583df6d5230d1b8dfd9842.svn-base new file mode 100644 index 0000000..d560275 --- /dev/null +++ b/.svn/pristine/91/915b76dcfb3f983021583df6d5230d1b8dfd9842.svn-base @@ -0,0 +1,45 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id$ + +package ; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/a4/a47a0b4624b67e44bc4036a82c57230aa306d670.svn-base b/.svn/pristine/a4/a47a0b4624b67e44bc4036a82c57230aa306d670.svn-base new file mode 100644 index 0000000..074f6cc --- /dev/null +++ b/.svn/pristine/a4/a47a0b4624b67e44bc4036a82c57230aa306d670.svn-base @@ -0,0 +1,557 @@ +# This module is part of Refence, and is released under the terms of +# the GPL version 2, or any later version. See the file README and +# COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Retrieve::PubMed; + +=head1 NAME + +Reference::Retrieve::PubMed -- Reference Retrieval from PubMed + +=head1 SYNOPSIS + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',limit=>50); + + +=head1 DESCRIPTION + +Uh. Retreives references from pubmed. Yeah. + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); +use Carp; + +use LWP::UserAgent; +use XML::Simple qw(:strict); +use Reference; + +use HTML::Entities; + +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 get_reference + +=head3 Usage + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',-limit=>50); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>{author=>'John Smith', pages=>'230'},-limit=>50) + +=head3 Function + +Retrives a reference from pubmed + +=head3 Returns + +In scalar context, effectively assumes -limit=>1 and returns the +highest listed reference according to the order, etc. [Probably only +usefull with -pmid.] In list context, returns all results (or until it +hits the -limit.) + +=head3 Args + +list of arguments to select a reference or collection of references from. + + +=cut + +sub get_reference{ + my %options = validate_with(params => @_, + spec => {pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/query.fcgi?cmd=Text&db=PubMed&dopt=XML&uid='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + }, + allow_extra => 1, + ); + my $ua = new LWP::UserAgent(agent => $options{ua_agent}); +} + +sub get_reference_by_pmid($;@){ + my %options = validate_with(params => \@_, + spec => {pmid => {type => SCALAR|ARRAYREF, + #regex => qr/^\d+$/, + }, + pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/eutils/efetch.fcgi?db=pubmed&retmode=xml&rettype=full&id='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + useragent => {optional => 1}, + }, + allow_extra => 1, + ); + my $pmid = $options{pmid}; + + my $ua; + if ($options{useragent}) { + $ua = $options{useragent}; + } + else { + $ua = new LWP::UserAgent(agent=>$options{ua_agent}); + } + my $url = "$options{pubmed_site}$options{pmid_query}" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # For some dumb reason, they send us xml with html + # entities. Ditch them. + #$response = decode_entities($response); + # It's even more freaking broken; they don't double encode them. + #$response =~ s/\>(\s|$)/>$1/gso; + #$response =~ s/(?:(\s)\<|<(\/))/$1<$2/gso; + $response =~ s/"/"/gso; + + # Ditch any doctype + $response =~ s/^\s*<\?xml[^>]+>\s*//gso; + $response =~ s/^\s*<\!DOCTYPE[^>]+>\s*//gso; + # There is also a Pubmedarticleset + $response =~ s/^\s*\s*//gso; + $response =~ s#\s*$##gso; + + # Add the opt so we get an array of PubMedArticle + $response = "$response"; + + print STDERR $response if $DEBUG; + + # Figure out if there was an error in the search. + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => [ 'PubmedArticle' ],KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct) if $DEBUG; + # Handle the XML structure + my @references; + foreach my $ref (@{$ref_struct->{PubmedArticle}}) { + my $reference = _create_reference_from_xml($ref,$ua); + if (not defined $reference) { + warn "Unable to create reference for $ref->{MedlineCitation}->{PMID}\n"; + } + push @references, $reference; + } + if (wantarray) { + return @references; + } + return $references[0]; +} + +sub _create_reference_from_xml($$){ + my ($ref,$ua) = @_; + + # Figure out what type of reference this is. We only support + # Journal Articles right now. + my $types = {'journal article'=>'article', + 'letter' =>'article', + }; + my $ref_type = undef; + my $reference = undef; + foreach my $type (keys %{$types}) { + if (ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq 'ARRAY'){ + my $pubtypes; + @{$pubtypes}{map {lc} @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}} = + (1) x @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}; + if ($pubtypes->{$type}) { + $ref_type = $types->{$type}; + last; + } + else { + next; + } + } + elsif (lc($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq lc($type)) { + $ref_type = $types->{$type}; + last; + } + } + if (not defined $ref_type) { + warn "Unsupported PublicationType: ".(ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType})? + join(',',@{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}): + $ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}); + print STDERR Dumper($ref); + $ref_type = 'article'; + } + local $_ = $ref_type; + if (/article/) { + use Reference::Type::Article; + $reference = new Reference::Type::Article; + my $xml_mapping = {author => [ _fix_medline_authors($ref->{MedlineCitation}->{Article}->{AuthorList}) ], + title => [_fix_medline_title($ref->{MedlineCitation}->{Article}->{ArticleTitle})], + abstract => $ref->{MedlineCitation}->{Article}->{Abstract}->{AbstractText}, + journal => [_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua, + #@_, # configuration + )], + _fix_ids($ref), + # pmid => $ref->{MedlineCitation}->{PMID}, + # medline_id => $ref->{MedlineCitation}->{MedlineID}, + volume => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Volume})], + date => [_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})], + number => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Issue})], + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], +# keywords => [_fix_medline_keywords($ref->{MedlineCitation}->{MeshHeadingList}, +# $ref->{MedlineCitation}->{ChemicalList}, +# )], +# &_find_pubmed_links($ref->{MedlineCitation}->{PMID},$ua), + }; + # Deal with author + + foreach my $reference_key (keys %{$xml_mapping}) { + my $method = $reference->can($reference_key); + die "Reference::Type::Article was unable to handle $reference_key" if not $method; + if (defined $xml_mapping->{$reference_key} and $method) { + if (ref($xml_mapping->{$reference_key})) { + &{$method}($reference,@{$xml_mapping->{$reference_key}}); + } + else { + &{$method}($reference,$xml_mapping->{$reference_key}); + } + } + else { + warn "Reference_key $reference_key was not defined or unable to handle type of key." + if not defined $xml_mapping->{$reference_key} and $DEBUG; + } + } + return $reference; + } +} + +sub _fix_medline_title($){ + my $title = shift; + + $title =~ s/\.$//; + return $title; +} + + +sub _fix_medline_authors($){ + my $author_list = shift; + $author_list = $author_list->{Author}; + my @authors; + $author_list = [$author_list] if ref($author_list) ne 'ARRAY'; + foreach my $author (@{$author_list}) { + my %au; + $au{first} = $author->{ForeName} if exists $author->{ForeName}; + $au{last} = $author->{LastName} if exists $author->{LastName}; + $au{initials} = $author->{Initials} if exists $author->{Initials}; + $au{full}; + push @authors,\%au; + } + return (author=>\@authors); +} + +=head2 _fix_medline_journal + +=head3 Usage + + $reference->journal(_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua,)); + +=head3 Function + +From the medline citation informatino returns a properly formatted +list of information for the journal reference listing. + +=head3 Args + +Journal information hashref + +medline journal information hashref + +user agent + +=cut + +sub _fix_medline_journal($$$;){ + my ($journal,$medline_journal,$ua) = @_; + # journal takes fullname, issn, medlineabbr, pmid, and nlmuid + # Try to supply as much as possible. + # Use esearch to get pmjournalid + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=0021-9258 + # use esummary to retreive the journalid + # + # + # + # 1 + # 1 + # 0 + # + # 4559 + # + # + # + # + # + # + # 0021-9258[All Fields] + # All Fields + # 1 + # + # Y + # + # + # + + my $ISSN = $journal->{ISSN}; + if (ref $ISSN) { + $ISSN = $ISSN->{content}; + } + my $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=$ISSN); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my ($journal_id) = $response =~ m#\s*(\d+)\s*#i; + + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559 + # + # + # + # + # 4559 + # The Journal of biological chemistry. + # J Biol Chem + # J. Biol. Chem. + # 2985121R + # + # 0021-9258 + # 1083-351X + # 1905 + # + # American Society for Biochemistry and Molecular Biology + # eng + # + # United States + # + # + # + $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esummary.fcgi?db=journals&id=$journal_id); + print STDERR "url: $url" if $DEBUG; + $request = HTTP::Request->new('GET', $url); + $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my %journal; + while ($response =~ m{^\s*(?:(?:\s*(\d+))| # Match ids + (?:\s*([^<]+?)\.?))\s* # Match item Name clauses + $}ixmg) { + if (not defined $2) { + $journal{id} = $1; + } + else { + $journal{lc($2)} = $3; + } + } + my %journal_mapping = (title => q(title), + medlineabbr => q(medabbr), + isoabbr => q(isoabbr), + nlmid => q(nlmid), + issn => q(pissn), + eissn => q(eissn), + publisher => q(publisher), + pmid => q(id) + ); + my @journal_entry; + foreach my $key (keys %journal_mapping) { + push @journal_entry,($key=>$journal{$journal_mapping{$key}}); + } + return @journal_entry; +} + +=head2 + +=head3 Usage + + $reference->date(_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})); + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _fix_medline_pubdate($){ + my ($date) = shift; + return (year=>$date->{Year},month=>$date->{Month},day=>$date->{Day}) if exists $date->{Year}; + # Ok... punt. + if (exists $date->{MedlineDate}) { + my ($year,$month,$day) = split /\s+/,$date->{MedlineDate}; + return (year=>$year,month=>$month,day=>$day) + } +} + +=head2 _fix_medline_pages + +=head3 Usage + + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], + +=head3 Function + +Returns output with a list of pages appropriate for an Article type of +reference. + +=cut + +sub _fix_medline_pages($){ + my ($pagination) = @_; + my ($start,$stop) = $pagination =~ /(\d*)\s*\-\s*(\d*)/; + my @return; + push @return, (start=>$start) if defined $start and $start ne ''; + push @return, (stop=>$stop) if defined $stop and $stop ne ''; + return @return; +} + +sub _find_pubmed_links($$){ + my ($pmid,$ua) = @_; + return (); + #http://eutils.ncbi.nlm.nih.gov/entrez/query/static/elink_help.html + my $url = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/elink.fcgi?dbfrom=pubmed&cmd=llinks&id=" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => ['IdUrlSet'], KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct);# if $DEBUG; + # Rearange data around Id. + my $links = {}; + map {$links->{$_->{Id}}=$_->{ObjUrl}} @{$ref_struct->{LinkSet}->{IdUrlList}->{IdUrlSet}}; + foreach my $obj_url (@{$links->{$pmid}->{ObjUrl}}) { + next unless $obj_url->{SubjectType} = 'publishers/providers'; + #@links = _find_links_from_url($obj_url->{Url},$ua); + } + # Find publisher link + # If no publisher link, use the first aggregator link. +} + +=head2 _fix_ids + + _fix_ids + + + +=cut + +sub _fix_ids { + my ($ref) = @_; + + my %ids_known = (medline => 'medline_id', + pubmed => 'pmid', + doi => 'doi', + ); + my %ids; + if (exists $ref->{PubmedData}{ArticleIdList}{ArticleId}) { + for my $art_id (ref($ref->{PubmedData}{ArticleIdList}{ArticleId}) eq 'ARRAY' ? + @{$ref->{PubmedData}{ArticleIdList}{ArticleId}}: + ($ref->{PubmedData}{ArticleIdList}{ArticleId})) { + if (exists $ids_known{$art_id->{IdType}}) { + $ids{$ids_known{$art_id->{IdType}}} = $art_id->{content}; + } + } + } + if (not exists $ids{pmid}) { + $ids{pmid} = $ref->{MedlineCitation}->{PMID} if defined $ref->{MedlineCitation}->{PMID}; + } + if (not exists $ids{medline_id}) { + $ids{medline_id} = $ref->{MedlineCitation}->{MedlineID} if defined $ref->{MedlineCitation}->{MedlineID}; + } + return %ids; +} + + +=head2 _find_links_from_url + +=head3 Usage + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _find_links_from_url($$){ + my ($link,$ua) = @_; + + + +} + +sub _fix_medline_ditch_empty($){ + my ($value) = @_; + + if (ref($value)) { + if (ref($value) eq 'HASH') { + if (scalar keys %{$value} > 0) { + return $value; + } + else { + return ''; + } + } + elsif (ref($value) eq 'ARRAY') { + if (scalar @{$value} > 0) { + return $value; + } + else { + return ''; + } + } + else { + return ''; + } + } + else { + return $value if defined $value; + return ''; + } +} + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/aa/aaff9dd4f00686f7990c7b60724b5c20b1d02fc9.svn-base b/.svn/pristine/aa/aaff9dd4f00686f7990c7b60724b5c20b1d02fc9.svn-base new file mode 100644 index 0000000..f7211ee --- /dev/null +++ b/.svn/pristine/aa/aaff9dd4f00686f7990c7b60724b5c20b1d02fc9.svn-base @@ -0,0 +1,109 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Field::Pages; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{pages} = {start => undef, + stop => undef, + }; + + $self->NEXT::_init; + +} + +sub pages{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{pages} = shift; + $params{output} = 'scalar'; + } + else { + %params = validate_with(params => \@_, + spec => {pages => {type => ARRAYREF|SCALAR|HASHREF, + optional => 1, + }, + start => {type => SCALAR, + optional => 1, + }, + stop => {type => SCALAR, + optional => 1, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{start} or defined $params{stop}) { + $self->{reference}->{pages}->{start} = $params{start} if defined $params{start}; + $self->{reference}->{pages}->{stop} = $params{stop} if defined $params{stop}; + } + elsif (defined $params{pages}) { + $self->{reference}->{pages} = {start => undef, + stop => undef, + }; + ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop}) = split(/\-+/,$params{pages}); + } + + if (wantarray) { + return grep {defined} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop}); + } + local $_ = $params{output}; + if (/bibtex/) { + return join('--',map {defined $_ ? $_ : ()} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop})); + } + else { + return join('-',map {defined $_ ? $_ : ()} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop})); + } + +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/ac/ac7ef2f46179ed36730ad1459a7463f3dba2e0f0.svn-base b/.svn/pristine/ac/ac7ef2f46179ed36730ad1459a7463f3dba2e0f0.svn-base new file mode 100644 index 0000000..2dd8150 --- /dev/null +++ b/.svn/pristine/ac/ac7ef2f46179ed36730ad1459a7463f3dba2e0f0.svn-base @@ -0,0 +1,229 @@ +# This module is part of , and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference; + +=head1 NAME + +Reference -- Reference superclass + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($VERSION $REVISION $DEBUG); +use Carp; + + +BEGIN{ + $REVISION = '0.01'; + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + +our $AUTOLOAD; + + +=head2 new + + my $reference = new Reference; + + +Creates a new reference object + +=cut + +sub new{ + my $class = shift; + + $class = ref $class if ref $class; + + my $self = {}; + + bless $self, $class; + + $self->_init; + + return $self; +} + + +=head2 ref_fields + + @$self->{ref_fields}{$self->ref_fields} = (1) x $self->ref_fields; + +Returns the fields that this reference knows how to deal with (or that +should be dealt with using ref_fields). + +This default implementation returns an empty list, and as such should +be overriden by all Reference::Type subclasses. + +=cut + +sub ref_fields{ + my $self = shift; + + return (); +} + + +=head2 ref_field + + $reference->ref_field('author',['John Q. Smith', 'Randal P. Swag']); + +Sets the reference field to the passed value (if any) and returns the +new value. This function is called through AUTOLOAD using the +$reference->field() syntax. + +Returns the new setting of passed field. + +Scalar fieldname, and an optional scalar, arrayref, or hashref to set +reference field. + +=cut + +sub ref_field($$;$){ + my ($self,$field_name,$field_value) = @_; + + if ($self->{ref_fields}->{lc($field_name)}) { + # Check to make sure that only 3 arguments are passed to + # avoid triggering on the Params::Variable style of calling. + # XXX We should check explicitly for this. [See Author.pm] + if (defined $field_value and scalar(@_) == 3) { + $self->{reference}->{lc($field_name)} = $field_value; + } + return $self->{reference}->{lc($field_name)}; + } + carp "Invalid field name $field_name"; +} + + +=head2 AUTOLOAD + +Dispatches calls to $reference->fieldname to +$reference->ref_field('fieldname'). + +XXX I really wish there was a way to tell perl that we don't want to +XXX handle a call to AUTOLOAD. + +=cut + +sub AUTOLOAD{ + my $function = $AUTOLOAD; + ($function) = $function =~ /\:?([^\:]+)$/; + my $self = shift; + if (ref $self and $self->{ref_fields}->{lc($function)}) { + # slap $self and $function into @_. + unshift @_, ($self,$function); + goto &ref_field; + } + else { + croak "Undefined subroutine $function"; + } +} + +# do nothing +sub DESTROY { + +} + + +=head2 can + + $obj->can('METHOD'); + Class::Modular->can('METHOD'); + +Replaces UNIVERSAL's can method so that handled methods are reported +correctly. Calls UNIVERSAL::can in the places where we don't know +anything it doesn't. + +Returns a coderef to the method if the method is supported, undef +otherwise. + +=cut + +sub can{ + my ($self,$method,$vars) = @_; + + my $universal_can = UNIVERSAL::can($self,$method); + + if ($universal_can){ + return $universal_can; + } + elsif (ref $self and exists $self->{ref_fields}->{lc($method)}) { + # If there is no other method for dealing with this method, + # and we would normally autoload it, create an anonymous sub + # to deal with it appropriately. + return sub{my $self = shift; return $self->ref_field($method,@_);}; + } + else { + return undef; + } +} + + +=head2 _init + + $self->_init + +=cut + +sub _init($){ + my $self = shift; + + # ref_fields is used by AUTOLOAD to know when it's ok to set a + # particular field + my @ref_fields = $self->ref_fields; + @{$self->{ref_fields}}{@ref_fields} = (1) x scalar @ref_fields; +} + + + + + +# From http://www.ecst.csuchico.edu/~jacobsd/bib/formats/ + +# * BibTeX +# * INSPEC +# * MARC [MARC::Record] +# * Melvyl [Uses MARC] +# * RIS +# * MedLine +# * ISI Focus On +# * EMBL +# * BIDS +# * ProCite +# * EndNote +# * Computing Archives +# * Uniform Resource Citation +# * RFC 1807 (replaces RFC 1357) +# * Other formats + + + + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/ad/ad7ab2475d69eac938bddfc03a4dbab87c53da63.svn-base b/.svn/pristine/ad/ad7ab2475d69eac938bddfc03a4dbab87c53da63.svn-base new file mode 100644 index 0000000..9e0f55e --- /dev/null +++ b/.svn/pristine/ad/ad7ab2475d69eac938bddfc03a4dbab87c53da63.svn-base @@ -0,0 +1,10 @@ +# http://module-build.sourceforge.net/META-spec.html +#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# +name: Reference +version: +version_from: +installdirs: site +requires: + +distribution_type: module +generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/.svn/pristine/b3/b36d574064ebc73915361222bda64c3728bb7430.svn-base b/.svn/pristine/b3/b36d574064ebc73915361222bda64c3728bb7430.svn-base new file mode 100644 index 0000000..b614068 --- /dev/null +++ b/.svn/pristine/b3/b36d574064ebc73915361222bda64c3728bb7430.svn-base @@ -0,0 +1,92 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2009 by Don Armstrong . +# $Id$ + +package Reference::Output::Filename; + +=head1 NAME + +Reference::Output::Filename -- Output a filename for the reference + +=head1 SYNOPSIS + + print filename($reference); + +Returns a filename for the reference + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); + +use base qw(Exporter); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 36 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = qw(filename); + @EXPORT_OK = qw(); + %EXPORT_TAGS = (output => [qw(filename)], + ); + Exporter::export_ok_tags(qw(output)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +# Assigned and discussed at the end of this file +my %bibtex_mapping; + +use Carp; + + +=head2 filename + + print filename($reference).'.pdf'; + +Returns a filename for a reference + +=cut + +sub filename{ + my $reference = shift; + + my $title = eval { $reference->title(); }; + my $fauthor = eval { $reference->first_author(output=>'last'); }; + my $cauthor = eval { $reference->corresponding_author(output=>'last');}; + if (defined $fauthor and defined $cauthor and $fauthor eq $cauthor) { + $fauthor = undef; + } + my $journal = eval { $reference->journal(output =>'bibtex');}; + my $volume = eval {$reference->volume();}; + my $number = eval {$reference->number();}; + my $page = eval{$reference->pages(output => 'bibtex');}; + $page =~ s/\s*--\s*\d+\s*// if defined $page; + my $year = eval{$reference->date(output=>'year');}; + my $pmid = eval{$reference->pmid();}; + + return join('_', + map {s/\W+/_/g; $_} map{defined $_ ?$_:()} + ($title,$fauthor,$cauthor, + $journal,$volume,$number,$page,$year,defined $pmid?"pmid_$pmid":undef)); + + + } + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/c6/c6de82ace4965920900adfcc6a828089f41f39be.svn-base b/.svn/pristine/c6/c6de82ace4965920900adfcc6a828089f41f39be.svn-base new file mode 100644 index 0000000..e0e8256 --- /dev/null +++ b/.svn/pristine/c6/c6de82ace4965920900adfcc6a828089f41f39be.svn-base @@ -0,0 +1,70 @@ +#! /usr/bin/perl +# This program is part of da_reference, and is released under the +# terms of the GPL version 2, or any later version, at your +# option. See the file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id$ + + +use warnings; +use strict; + + +use Getopt::Long; +use Pod::Usage; + +=head1 NAME + +foo - + +=head1 SYNOPSIS + +foo [options] + + Options: + --debug, -d debugging level (Default 0) + --help,-h display this help + --man,-m display manual + +=head1 OPTIONS + +=over + +=item B<--debug, -d> + +Debug verbosity. (Default 0) + +=item B<--help, -h> + +Display brief useage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + + +=cut + + + +use vars qw($DEBUG); + +my %options = (debug => 0, + help => 0, + man => 0, + ); + +GetOptions(\%options,'debug|d','help|h','man|m'); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + + + +__END__ diff --git a/.svn/pristine/d4/d48a2b57550595b377c1c09971495ffe1246d1f5.svn-base b/.svn/pristine/d4/d48a2b57550595b377c1c09971495ffe1246d1f5.svn-base new file mode 100644 index 0000000..03fd6d6 --- /dev/null +++ b/.svn/pristine/d4/d48a2b57550595b377c1c09971495ffe1246d1f5.svn-base @@ -0,0 +1,17 @@ +# Version control files and dirs. +\bRCS\b +\bCVS\b +,v$ +\B\.svn\b + +# Makemaker generated files and dirs. +^MANIFEST\. +^Makefile$ +^blib/ +^MakeMaker-\d + +# Temp, old and emacs backup files. +~$ +\.old$ +^#.*#$ +^\.# diff --git a/.svn/pristine/dd/dd9236e2f4397fc549fb9b63d96f2debf8cde523.svn-base b/.svn/pristine/dd/dd9236e2f4397fc549fb9b63d96f2debf8cde523.svn-base new file mode 100644 index 0000000..7e39912 --- /dev/null +++ b/.svn/pristine/dd/dd9236e2f4397fc549fb9b63d96f2debf8cde523.svn-base @@ -0,0 +1,11 @@ +#!/usr/bin/perl +# $Id$ + +use ExtUtils::MakeMaker; +require './lib/Reference.pm'; + +WriteMakefile(NAME => 'Reference', + DISTNAME => 'Reference', + VERSION => $Reference::VERSION, + EXE_FILES => [qw(bin/get_reference)], + ); diff --git a/.svn/pristine/e3/e3f7eb9e892fe449aac38969920404d96bb97fd1.svn-base b/.svn/pristine/e3/e3f7eb9e892fe449aac38969920404d96bb97fd1.svn-base new file mode 100644 index 0000000..c9db878 --- /dev/null +++ b/.svn/pristine/e3/e3f7eb9e892fe449aac38969920404d96bb97fd1.svn-base @@ -0,0 +1,379 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id$ + +package Reference::Output::Bibtex; + +=head1 NAME + +Reference::Output::Bibtex -- Output references in BibTeX format + +=head1 SYNOPSIS + + print bibtex($reference); + +Returns a reference formatted in bibtex format. + +=head1 DESCRIPTION + +Knows how to handle the reference-> bibtex field mapping for many +reference types, but overridden types may need to provide their own +mapping. + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); + +use base qw(Exporter); + +use Encode qw(encode_utf8 is_utf8 decode decode_utf8); +use Text::Iconv; + + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = qw(bibtex); + @EXPORT_OK = qw(); + %EXPORT_TAGS = (output => [qw(bibtex)], + ); + Exporter::export_ok_tags(qw(output)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +# Assigned and discussed at the end of this file +my %bibtex_mapping; + +use Carp; +use Params::Validate qw(:types validate_with); +use Text::Wrap; + + +=head2 bibtex + + print bibtex $reference; + %bibtex = bibtex $reference; + print bibtex($reference,mapping=>{...}) + +In scalar context, returns a formatted bibtex entry, suitable for +printing. In list context, returns a hash of key, value pairs which +can be used to print a formatted bibtex entry. + +You can also pass an optional mapping to be used for making the bibtex +entry. See B for the details. + +The mappings are obeyed in the following order, the first taking +precedence over the last. + +=over + +=item Passed mapping + +=item Object's bibtex_mapping + +=item Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping) + +=back + +Returns a SCALAR bibtex reference in scalar context, a HASH bibtex +reference in list context + +=cut + +sub bibtex{ + my $reference = shift; + + # Parse options if any + my %param = validate_with(params => \@_, + spec => {mapping => {type => HASHREF, + optional => 1, + }, + }, + ); + + my $mapping = undef; + + # Use our mapping by default if it exists + $mapping = $bibtex_mapping{lc($reference->{type})} if exists $bibtex_mapping{lc($reference->{type})}; + # Override that with the module's mapping + $mapping = $reference->{bibtex_mapping} if exists $reference->{bibtex_mapping}; + # Finally, override everything with passed mapping + $mapping = $param{mapping} if exists $param{mapping}; + + if (not defined $mapping) { + carp "This reference type doesn't support bibtex output."; + return undef; + } + + my %bibtex_entry; + foreach my $bibtex_field (keys %{$mapping->{mapping}}) { + my $params = []; + if (ref $bibtex_field) { + $params = $$bibtex_field{params} if exists $$bibtex_field{params}; + $bibtex_field = $$bibtex_field{field}; + } + my $function = $reference->can($mapping->{mapping}->{$bibtex_field}); + next unless $function; + $bibtex_entry{$bibtex_field} = &{$function}($reference,output=>'bibtex',@$params); + # dereference the entries if necessesary. + next unless wantarray; + # Make new copies of the entries if necessary so we can + # mogrify to our hearts content. + if (ref($bibtex_entry{$bibtex_field}) eq 'HASH') { + $bibtex_entry{$bibtex_field} = {%{$bibtex_entry{$bibtex_field}}}; + } + elsif (ref($bibtex_entry{$bibtex_field}) eq 'ARRAY') { + $bibtex_entry{$bibtex_field} = [@{$bibtex_entry{$bibtex_field}}]; + } + } + # Return the entries in hash form if desired. + return %bibtex_entry if wantarray; + # Ok, stich the bibtex entry together... + my $bibtex_entry; + $bibtex_entry = '@'.$mapping->{order}[0].'{'.encode_utf8(convert_to_utf8($bibtex_entry{$mapping->{order}[0]})).",\n"; + foreach my $bibtex_field (@{$mapping->{order}}[1..$#{$mapping->{order}}]) { + next unless defined $bibtex_entry{$bibtex_field}; + if (ref $bibtex_entry{$bibtex_field} eq 'ARRAY') { + next unless @{$bibtex_entry{$bibtex_field}}; + if (ref $mapping->{mapping}{$bibtex_field}) { + if (exists $mapping->{mapping}{$bibtex_field}{code}) { + local $_ = $bibtex_entry{$bibtex_field}; + eval $mapping->{mapping}{$bibtex_field}{code}; + carp "Error while executing code to assemble bibtex entry: $@" if $@; + } + elsif (exists $mapping->{mapping}{$bibtex_field}{join}) { + $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join}, + @{$bibtex_entry{$bibtex_field}}); + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + my $entry = $bibtex_entry{$bibtex_field}; + $entry =~ s/%/\\%/g; + $entry = encode_utf8(convert_to_utf8($entry)); + my $start = "{"; + my $stop = "}"; + if ($bibtex_field eq 'journal') { + $start = ""; + $stop = ""; + } + $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = $start".$entry."$stop,\n"); + } + $bibtex_entry .= "}\n"; + return $bibtex_entry; +} + +=head2 bibtex_mapping + + $Reference::Output::Bibtex::bibtex_mapping{Article} = + {mapping => {author => {field => 'author', + join => ' and ', + params => [], + }, + volume => 'volume', + Articlce => 'name', + foo => 'bar', + }, + order => [qw(name author volume foo)], + }; + +This variable holds the mapping to bibtex output. + +Each type of reference has its own keys. Currently the following types +are supported by the Bibtex output method: + +=over + +=item article + +=item collection + +=item book + +=back + +If you wish to add support for your own custom reference type, you +merely need to add a bibtex_mapping element to your class's hashref, +or add to this variable. [Preferbly the former, as the latter should +only be used by the end user.] + +The mapping key in the reference type hashref is a hashref containing +key value pairs according to the following metric: + +=over + +=item If the mapping key value is not a reference, the value is used +as the name function to call via C<$reference->field>. [In the example +above, the volume mapping is built by a call to +C<$reference->volume>]. + +=item If the mapping key value is a hashref, the hashref contains two +keys. The C key contains the name of the function to call. The +C key contains the parameters + +=back + +The order key in the reference type hashref is an arrayref which +defines the order in which keys are listed in the BibTeX +output. Values in the arrayref should be the keys of the mapping +hashref. [The first value listed is the type of reference/reference +name pair.] + + +=cut + + +%bibtex_mapping = +(article => {mapping => {Article => 'name', + author => 'author', + title => 'title', + journal => 'journal', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + pmid => 'pmid', + mlid => 'medline_id', + doi => 'doi', + html => 'html', + pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract pmid mlid doi + html pdf), + ], + }, + book => {mapping => {Book => 'name', + author => 'author', + title => 'title', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + doi => 'doi', + # html => 'html', + # pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract doi html pdf), + ], + }, +); + +=head2 convert_to_utf8 + + $utf8 = convert_to_utf8("text","charset"); + +=cut + +sub convert_to_utf8 { + my ($data,$charset,$internal_call) = @_; + $internal_call //= 0; + if (is_utf8($data)) { + # cluck("utf8 flag is set when calling convert_to_utf8"); + return $data; + } + if (not length $data) { + return $data; + } + $charset = uc($charset//'UTF-8'); + if ($charset eq 'RAW') { + # croak("Charset must not be raw when calling convert_to_utf8"); + } + my $iconv_converter; + eval { + $iconv_converter = Text::Iconv->new($charset,"UTF-8") or + die "Unable to create converter for '$charset'"; + }; + if ($@) { + return undef if $internal_call; + warn $@; + # We weren't able to create the converter, so use Encode + # instead + return __fallback_convert_to_utf8($data,$charset); + } + my $converted_data = $iconv_converter->convert($data); + # if the conversion failed, retval will be undefined or perhaps + # -1. + my $retval = $iconv_converter->retval(); + if (not defined $retval or + $retval < 0 + ) { + # try iso8559-1 first + if (not $internal_call) { + my $call_back_data = convert_to_utf8($data,'ISO8859-1',1); + # if there's an à (0xC3), it's probably something + # horrible, and we shouldn't try to convert it. + if (defined $call_back_data and $call_back_data !~ /\x{C3}/) { + # warn "failed to convert to utf8 (charset: $charset, data: $data), but succeeded with ISO8859-1: ".encode_utf8($call_back_data); + return $call_back_data; + } + } + warn "failed to convert to utf8 (charset: $charset, data: $data)"; + # Fallback to encode, which will probably also fail. + return __fallback_convert_to_utf8($data,$charset); + } + return decode("UTF-8",$converted_data); +} + +# this returns data in perl's internal encoding +sub __fallback_convert_to_utf8 { + my ($data, $charset) = @_; + # raw data just gets returned (that's the charset WordDecorder + # uses when it doesn't know what to do) + return $data if $charset eq 'raw'; + if (not defined $charset and not is_utf8($data)) { + warn ("Undefined charset, and string '$data' is not in perl's internal encoding"); + return $data; + } + # lets assume everything that doesn't have a charset is utf8 + $charset //= 'utf8'; + my $result; + eval { + $result = decode($charset,$data,0); + }; + if ($@) { + warn "Unable to decode charset; '$charset' and '$data': $@"; + return $data; + } + return $result; +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/e4/e47029d26c6aa59bbb1c4eb5f8b70850ff10c603.svn-base b/.svn/pristine/e4/e47029d26c6aa59bbb1c4eb5f8b70850ff10c603.svn-base new file mode 100644 index 0000000..5aa42c4 --- /dev/null +++ b/.svn/pristine/e4/e47029d26c6aa59bbb1c4eb5f8b70850ff10c603.svn-base @@ -0,0 +1,109 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Field::Pages; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{pages} = {start => undef, + stop => undef, + }; + + $self->NEXT::_init; + +} + +sub pages{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{pages} = shift; + $params{output} = 'scalar'; + } + else { + %params = validate_with(params => \@_, + spec => {pages => {type => ARRAYREF|SCALAR|HASHREF, + optional => 1, + }, + start => {type => SCALAR, + optional => 1, + }, + stop => {type => SCALAR, + optional => 1, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{start} or defined $params{stop}) { + $self->{reference}->{pages}->{start} = $params{start} if defined $params{start}; + $self->{reference}->{pages}->{stop} = $params{stop} if defined $params{stop}; + } + elsif (defined $params{pages}) { + $self->{reference}->{pages} = {start => undef, + stop => undef, + }; + ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop}) = split(/\-+/,$params{pages}); + } + + if (wantarray) { + return grep {defined} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop}); + } + local $_ = $params{output}; + if (/bibtex/) { + return join('--',map {$_ = '' if not defined $_; $_;} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop})); + } + else { + return join('-',map {$_ = '' if not defined $_; $_;} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop})); + } + +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/e5/e50cc9712302efacdf9200a3ed4e6be0d0c8e624.svn-base b/.svn/pristine/e5/e50cc9712302efacdf9200a3ed4e6be0d0c8e624.svn-base new file mode 100644 index 0000000..ceb3938 --- /dev/null +++ b/.svn/pristine/e5/e50cc9712302efacdf9200a3ed4e6be0d0c8e624.svn-base @@ -0,0 +1,110 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Field::Journal; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG @JOURNAL_FIELDS); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + @JOURNAL_FIELDS = qw(title medlineabbr isoabbr nlmid issn eissn publisher pmid); +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{journal} = {}; + @{$self->{reference}->{journal}}{@JOURNAL_FIELDS} = (undef) x scalar @JOURNAL_FIELDS; + + $self->NEXT::_init; + +} + +sub journal{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{journal} = shift; + $params{output} = 'scalar'; + } + else { + my %spec; + @spec{@JOURNAL_FIELDS} = ({type => SCALAR|UNDEF,optional=>1}) x scalar @JOURNAL_FIELDS; + %params = validate_with(params => \@_, + spec => {journal => {type => SCALAR, + optional => 1, + }, + output => {type => SCALAR, + default => 'scalar', + }, + %spec, + }, + ); + } + # Were we called using $reference->journal(foo=>bar) {ignoring journal=>bar} ? + my $using_param_call = 0; + foreach my $key (@JOURNAL_FIELDS) { + $using_param_call = 1 and last if exists $params{$key} and defined $params{$key}; + } + if ($using_param_call) { + foreach my $key (@JOURNAL_FIELDS) { + $self->{reference}->{journal}->{$key} = $params{$key} if exists $params{$key} and defined $params{$key}; + } + } + elsif (defined $params{journal}) { + $self->{reference}->{journal}->{title} = $params{journal}; + } + + local $_ = $params{output}; + if (/bibtex/) { + my $title = $self->{reference}->{journal}->{medlineabbr} || $self->{reference}->{journal}->{title}; + $title =~ s/\s//g; + return $title; + } elsif (/medline/) { + return $self->{reference}->{journal}->{medlineabbr} || $self->{reference}->{journal}->{title}; + } elsif (/iso/) { + return $self->{reference}->{journal}->{isoabbr} || $self->{reference}->{journal}->{title}; + } + else { + return $self->{reference}->{journal}->{title}; + } +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/e9/e94b700c09850a326eeea4564fde2a8999d5aba7.svn-base b/.svn/pristine/e9/e94b700c09850a326eeea4564fde2a8999d5aba7.svn-base new file mode 100644 index 0000000..f8bfd07 --- /dev/null +++ b/.svn/pristine/e9/e94b700c09850a326eeea4564fde2a8999d5aba7.svn-base @@ -0,0 +1,580 @@ +# This module is part of Refence, and is released under the terms of +# the GPL version 2, or any later version. See the file README and +# COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Retrieve::PubMed; + +=head1 NAME + +Reference::Retrieve::PubMed -- Reference Retrieval from PubMed + +=head1 SYNOPSIS + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',limit=>50); + + +=head1 DESCRIPTION + +Uh. Retreives references from pubmed. Yeah. + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); +use Carp; + +use LWP::UserAgent; +use XML::Simple qw(:strict); +use Reference; + +use HTML::Entities; + +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 get_reference + +=head3 Usage + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',-limit=>50); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>{author=>'John Smith', pages=>'230'},-limit=>50) + +=head3 Function + +Retrives a reference from pubmed + +=head3 Returns + +In scalar context, effectively assumes -limit=>1 and returns the +highest listed reference according to the order, etc. [Probably only +usefull with -pmid.] In list context, returns all results (or until it +hits the -limit.) + +=head3 Args + +list of arguments to select a reference or collection of references from. + + +=cut + +sub get_reference{ + my %options = validate_with(params => @_, + spec => {pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/query.fcgi?cmd=Text&db=PubMed&dopt=XML&uid='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + }, + allow_extra => 1, + ); + my $ua = new LWP::UserAgent(agent => $options{ua_agent}); +} + +sub get_reference_by_pmid($;@){ + my %options = validate_with(params => \@_, + spec => {pmid => {type => SCALAR|ARRAYREF, + #regex => qr/^\d+$/, + }, + pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/eutils/efetch.fcgi?db=pubmed&retmode=xml&rettype=full&id='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + useragent => {optional => 1}, + }, + allow_extra => 1, + ); + my $pmid = $options{pmid}; + + my $ua; + if ($options{useragent}) { + $ua = $options{useragent}; + } + else { + $ua = new LWP::UserAgent(agent=>$options{ua_agent}); + } + my $url = "$options{pubmed_site}$options{pmid_query}" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # For some dumb reason, they send us xml with html + # entities. Ditch them. + #$response = decode_entities($response); + # It's even more freaking broken; they don't double encode them. + #$response =~ s/\>(\s|$)/>$1/gso; + #$response =~ s/(?:(\s)\<|<(\/))/$1<$2/gso; + $response =~ s/"/"/gso; + + # Ditch any doctype + $response =~ s/^\s*<\?xml[^>]+>\s*//gso; + $response =~ s/^\s*<\!DOCTYPE[^>]+>\s*//gso; + # There is also a Pubmedarticleset + $response =~ s/^\s*\s*//gso; + $response =~ s#\s*$##gso; + + # Add the opt so we get an array of PubMedArticle + $response = "$response"; + + print STDERR $response if $DEBUG; + + # Figure out if there was an error in the search. + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => [ 'PubmedArticle' ],KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct) if $DEBUG; + # Handle the XML structure + my @references; + foreach my $ref (@{$ref_struct->{PubmedArticle}}) { + my $reference = _create_reference_from_xml($ref,$ua); + if (not defined $reference) { + warn "Unable to create reference for $ref->{MedlineCitation}->{PMID}\n"; + } + push @references, $reference; + } + if (wantarray) { + return @references; + } + return $references[0]; +} + +sub _create_reference_from_xml($$){ + my ($ref,$ua) = @_; + + # Figure out what type of reference this is. We only support + # Journal Articles right now. + my $types = {'journal article'=>'article', + 'letter' =>'article', + 'editorial' => 'article', + 'review' => 'article', + }; + my $ref_type = undef; + my $reference = undef; + foreach my $type (keys %{$types}) { + if (ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq 'ARRAY'){ + my $pubtypes; + @{$pubtypes}{map {lc} @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}} = + (1) x @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}; + if ($pubtypes->{$type}) { + $ref_type = $types->{$type}; + last; + } + else { + next; + } + } + elsif (lc($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq lc($type)) { + $ref_type = $types->{$type}; + last; + } + } + if (not defined $ref_type) { + warn "Unsupported PublicationType: ".(ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType})? + join(',',@{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}): + $ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}); + print STDERR Dumper($ref) if $DEBUG; + $ref_type = 'article'; + } + local $_ = $ref_type; + if (/article/) { + use Reference::Type::Article; + $reference = new Reference::Type::Article; + my $xml_mapping = {author => [ _fix_medline_authors($ref->{MedlineCitation}->{Article}->{AuthorList}) ], + title => [_fix_medline_title($ref->{MedlineCitation}->{Article}->{ArticleTitle})], + abstract => [_fix_medline_abstract($ref->{MedlineCitation}->{Article}->{Abstract}->{AbstractText})], + journal => [_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua, + #@_, # configuration + )], + _fix_ids($ref), + # pmid => $ref->{MedlineCitation}->{PMID}, + # medline_id => $ref->{MedlineCitation}->{MedlineID}, + volume => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Volume})], + date => [_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})], + number => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Issue})], + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], +# keywords => [_fix_medline_keywords($ref->{MedlineCitation}->{MeshHeadingList}, +# $ref->{MedlineCitation}->{ChemicalList}, +# )], +# &_find_pubmed_links($ref->{MedlineCitation}->{PMID},$ua), + }; + # Deal with author + + foreach my $reference_key (keys %{$xml_mapping}) { + my $method = $reference->can($reference_key); + die "Reference::Type::Article was unable to handle $reference_key" if not $method; + if (defined $xml_mapping->{$reference_key} and $method) { + if (ref($xml_mapping->{$reference_key})) { + &{$method}($reference,@{$xml_mapping->{$reference_key}}); + } + else { + &{$method}($reference,$xml_mapping->{$reference_key}); + } + } + else { + warn "Reference_key $reference_key was not defined or unable to handle type of key." + if not defined $xml_mapping->{$reference_key} and $DEBUG; + } + } + return $reference; + } +} + +sub _fix_medline_title($){ + my $title = shift; + + $title =~ s/\.$//; + return $title; +} + +sub _fix_medline_abstract{ + my $abstract = shift; + my $ret = ''; + if (ref($abstract) and ref($abstract) eq 'ARRAY') { + for my $element (@{$abstract}) { + $ret .= "\n" if length $ret; + $ret .= $element->{Label}.': '.$element->{content}; + } + return $ret; + } else { + return $abstract; + } +} + + +sub _fix_medline_authors($){ + my $author_list = shift; + $author_list = $author_list->{Author}; + my @authors; + $author_list = [$author_list] if ref($author_list) ne 'ARRAY'; + foreach my $author (@{$author_list}) { + my %au; + $au{first} = $author->{ForeName} if exists $author->{ForeName}; + $au{last} = $author->{LastName} if exists $author->{LastName}; + $au{initials} = $author->{Initials} if exists $author->{Initials}; + $au{full}; + push @authors,\%au; + } + return (author=>\@authors); +} + +=head2 _fix_medline_journal + +=head3 Usage + + $reference->journal(_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua,)); + +=head3 Function + +From the medline citation informatino returns a properly formatted +list of information for the journal reference listing. + +=head3 Args + +Journal information hashref + +medline journal information hashref + +user agent + +=cut + +sub _fix_medline_journal($$$;){ + my ($journal,$medline_journal,$ua) = @_; + # journal takes fullname, issn, medlineabbr, pmid, and nlmuid + # Try to supply as much as possible. + # Use esearch to get pmjournalid + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=0021-9258 + # use esummary to retreive the journalid + # + # + # + # 1 + # 1 + # 0 + # + # 4559 + # + # + # + # + # + # + # 0021-9258[All Fields] + # All Fields + # 1 + # + # Y + # + # + # + + my $ISSN = $journal->{ISSN}; + if (ref $ISSN) { + $ISSN = $ISSN->{content}; + } + my $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=$ISSN); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my ($journal_id) = $response =~ m#\s*(\d+)\s*#i; + + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559 + # + # + # + # + # 4559 + # The Journal of biological chemistry. + # J Biol Chem + # J. Biol. Chem. + # 2985121R + # + # 0021-9258 + # 1083-351X + # 1905 + # + # American Society for Biochemistry and Molecular Biology + # eng + # + # United States + # + # + # + $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esummary.fcgi?db=journals&id=$journal_id); + print STDERR "url: $url" if $DEBUG; + $request = HTTP::Request->new('GET', $url); + $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my %journal; + while ($response =~ m{^\s*(?:(?:\s*(\d+))| # Match ids + (?:\s*([^<]+?)))\s* # Match item Name clauses + $}ixmg) { + if (not defined $2) { + $journal{id} = $1; + } + else { + $journal{lc($2)} = $3; + } + } + my %journal_mapping = (title => q(title), + medlineabbr => q(medabbr), + isoabbr => q(isoabbr), + nlmid => q(nlmid), + issn => q(pissn), + eissn => q(eissn), + publisher => q(publisher), + pmid => q(id) + ); + my @journal_entry; + foreach my $key (keys %journal_mapping) { + push @journal_entry,($key=>$journal{$journal_mapping{$key}}); + } + return @journal_entry; +} + +=head2 + +=head3 Usage + + $reference->date(_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})); + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _fix_medline_pubdate($){ + my ($date) = shift; + return (year=>$date->{Year},month=>$date->{Month},day=>$date->{Day}) if exists $date->{Year}; + # Ok... punt. + if (exists $date->{MedlineDate}) { + my ($year,$month,$day) = split /\s+/,$date->{MedlineDate}; + return (year=>$year,month=>$month,day=>$day) + } +} + +=head2 _fix_medline_pages + +=head3 Usage + + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], + +=head3 Function + +Returns output with a list of pages appropriate for an Article type of +reference. + +=cut + +sub _fix_medline_pages($){ + my ($pagination) = @_; + my ($start,$stop) = $pagination =~ /(\d*)\s*\-\s*(\d*)/; + if (not defined $start) { + ($start) = $pagination =~ /(\d+)/ + } + if ($start > $stop and defined $stop) { + # this must be a reduced page listing; fix it up + $stop+=$start - $start % 10 ** (int(log($stop)/log(10))+1); + } + my @return; + push @return, (start=>$start) if defined $start and $start ne ''; + push @return, (stop=>$stop) if defined $stop and $stop ne ''; + return @return; +} + +sub _find_pubmed_links($$){ + my ($pmid,$ua) = @_; + return (); + #http://eutils.ncbi.nlm.nih.gov/entrez/query/static/elink_help.html + my $url = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/elink.fcgi?dbfrom=pubmed&cmd=llinks&id=" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => ['IdUrlSet'], KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct);# if $DEBUG; + # Rearange data around Id. + my $links = {}; + map {$links->{$_->{Id}}=$_->{ObjUrl}} @{$ref_struct->{LinkSet}->{IdUrlList}->{IdUrlSet}}; + foreach my $obj_url (@{$links->{$pmid}->{ObjUrl}}) { + next unless $obj_url->{SubjectType} = 'publishers/providers'; + #@links = _find_links_from_url($obj_url->{Url},$ua); + } + # Find publisher link + # If no publisher link, use the first aggregator link. +} + +=head2 _fix_ids + + _fix_ids + + + +=cut + +sub _fix_ids { + my ($ref) = @_; + + my %ids_known = (medline => 'medline_id', + pubmed => 'pmid', + doi => 'doi', + ); + my %ids; + if (exists $ref->{PubmedData}{ArticleIdList}{ArticleId}) { + for my $art_id (ref($ref->{PubmedData}{ArticleIdList}{ArticleId}) eq 'ARRAY' ? + @{$ref->{PubmedData}{ArticleIdList}{ArticleId}}: + ($ref->{PubmedData}{ArticleIdList}{ArticleId})) { + if (exists $ids_known{$art_id->{IdType}}) { + $ids{$ids_known{$art_id->{IdType}}} = $art_id->{content}; + } + } + } + if (not exists $ids{pmid}) { + $ids{pmid} = $ref->{MedlineCitation}->{PMID} if defined $ref->{MedlineCitation}->{PMID}; + } + if (not exists $ids{medline_id}) { + $ids{medline_id} = $ref->{MedlineCitation}->{MedlineID} if defined $ref->{MedlineCitation}->{MedlineID}; + } + return %ids; +} + + +=head2 _find_links_from_url + +=head3 Usage + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _find_links_from_url($$){ + my ($link,$ua) = @_; + + + +} + +sub _fix_medline_ditch_empty($){ + my ($value) = @_; + + if (ref($value)) { + if (ref($value) eq 'HASH') { + if (scalar keys %{$value} > 0) { + return $value; + } + else { + return (); + } + } + elsif (ref($value) eq 'ARRAY') { + if (scalar @{$value} > 0) { + return $value; + } + else { + return (); + } + } + else { + return (); + } + } + else { + return $value if defined $value; + return (); + } +} + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/ee/ee77c361e33d4b819f49ea3724877f9544b8cbfd.svn-base b/.svn/pristine/ee/ee77c361e33d4b819f49ea3724877f9544b8cbfd.svn-base new file mode 100644 index 0000000..5b22fba --- /dev/null +++ b/.svn/pristine/ee/ee77c361e33d4b819f49ea3724877f9544b8cbfd.svn-base @@ -0,0 +1,45 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package ; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/fb/fb163154a400250cee1a64ba030619d2730d133b.svn-base b/.svn/pristine/fb/fb163154a400250cee1a64ba030619d2730d133b.svn-base new file mode 100644 index 0000000..5e96856 --- /dev/null +++ b/.svn/pristine/fb/fb163154a400250cee1a64ba030619d2730d133b.svn-base @@ -0,0 +1,105 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id$ + +package Reference::Field::Journal; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG @JOURNAL_FIELDS); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + @JOURNAL_FIELDS = qw(title medlineabbr isoabbr nlmid issn eissn publisher pmid); +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{journal} = {}; + @{$self->{reference}->{journal}}{@JOURNAL_FIELDS} = (undef) x scalar @JOURNAL_FIELDS; + + $self->NEXT::_init; + +} + +sub journal{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{journal} = shift; + $params{output} = 'scalar'; + } + else { + my %spec; + @spec{@JOURNAL_FIELDS} = ({type => SCALAR|UNDEF,optional=>1}) x scalar @JOURNAL_FIELDS; + %params = validate_with(params => \@_, + spec => {journal => {type => SCALAR, + optional => 1, + }, + output => {type => SCALAR, + default => 'scalar', + }, + %spec, + }, + ); + } + # Were we called using $reference->journal(foo=>bar) {ignoring journal=>bar} ? + my $using_param_call = 0; + foreach my $key (@JOURNAL_FIELDS) { + $using_param_call = 1 and last if exists $params{$key} and defined $params{$key}; + } + if ($using_param_call) { + foreach my $key (@JOURNAL_FIELDS) { + $self->{reference}->{journal}->{$key} = $params{$key} if exists $params{$key} and defined $params{$key}; + } + } + elsif (defined $params{journal}) { + $self->{reference}->{journal}->{title} = $params{journal}; + } + + local $_ = $params{output}; + if (/bibtex/) { + return $self->{reference}->{journal}->{medlineabbr} || $self->{reference}->{journal}->{title}; + } + else { + return $self->{reference}->{journal}->{title}; + } + +} + + + +1; + + +__END__ + + + + + + diff --git a/.svn/pristine/fc/fc6dce9274527b60a9b01e9a01ec247284baf83d.svn-base b/.svn/pristine/fc/fc6dce9274527b60a9b01e9a01ec247284baf83d.svn-base new file mode 100644 index 0000000..34d77cf --- /dev/null +++ b/.svn/pristine/fc/fc6dce9274527b60a9b01e9a01ec247284baf83d.svn-base @@ -0,0 +1,108 @@ +#! /usr/bin/perl +# This program is part of da_reference, and is released under the +# terms of the GPL version 2, or any later version, at your +# option. See the file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id$ + + +use warnings; +use strict; + + +use Getopt::Long; +use Reference; +use Pod::Usage; + +=head1 NAME + +get_reference - Retrieve a reference from somewhere and output the +formatted reference to STDOUT. + +=head1 SYNOPSIS + +get_reference [options] referenceid [referenceid ...] + + Options: + --pmid,-p referenceid is a pub med id. (Default) + --bibtex,-b ouput in bibtex format (Default) + --debug, -d debugging level (Default 0) + --help,-h display this help + --man,-m display manual + +=head1 OPTIONS + +=over + +=item B<--pmid, -p> + +The referenceid listed is a Pub Med ID. (Default) + +=item B<--bibtex, -b> + +Output the listed referenceid in BibTeX format. (Default) + +=item B<--help, -h> + +Display brief useage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + + get_reference -p -b -d 1 123456; + + get_reference 123456; + +=cut + + + +use vars qw($DEBUG); + +my %options = (pmid => 1, + bibtex => 1, + debug => 0, + help => 0, + man => 0, + suggest_name => 0, + journal_titles => 0, + ); + +GetOptions(\%options,'pmid|p','bibtex|b','suggest_name|suggest-name','debug|d','help|h','man|m', + 'journal_titles|journal-titles|journal_title|journal-titles', + ); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + +if ($options{pmid} and $options{bibtex}) { + use Reference::Type::Article; + use Reference::Retrieve::PubMed; + use Reference::Output::Bibtex; + use Reference::Output::Filename; + $Reference::Retrieve::PubMed::DEBUG = $options{debug}; + foreach my $pmid (@ARGV) { + next unless ($pmid) = $pmid =~ /(\d+)/; + print STDERR "dealing with $pmid\n" if $DEBUG; + my $reference = scalar Reference::Retrieve::PubMed::get_reference_by_pmid(pmid => $pmid); + print STDERR "Unable to retrieve reference for $pmid\n" and next if not defined $reference; + if ($options{suggest_name}) { + # try to suggest a name for the reference + print '%Filename: '.lc(filename($reference))."\n"; + } + if ($options{journal_titles}) { + print '%Medline: @string {'.$reference->journal(output=>'bibtex').'="'. + $reference->journal(output=>'medline').qq("}\n); + print '%isoabbr: @string {'.$reference->journal(output=>'bibtex').'="'. + $reference->journal(output=>'iso').qq("}\n); + } + print scalar bibtex($reference); + } +} diff --git a/.svn/wc.db b/.svn/wc.db new file mode 100644 index 0000000..e1b06ec Binary files /dev/null and b/.svn/wc.db differ diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..1385046 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,18 @@ +bin/find_link_testing.pl +bin/get_reference +lib/Reference.pm +lib/Reference/Field/Author.pm +lib/Reference/Field/Date.pm +lib/Reference/Field/Journal.pm +lib/Reference/Field/Pages.pm +lib/Reference/Output/Bibtex.pm +lib/Reference/Retrieve/HTML/Miner.pm +lib/Reference/Retrieve/PubMed.pm +lib/Reference/Type/Article.pm +Makefile.PL +MANIFEST This list of files +META.yml Module meta-data (added by MakeMaker) +NOTES +pm_to_blib +templates/perl_module_header.pm +templates/perl_program_header.pl diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..03fd6d6 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,17 @@ +# Version control files and dirs. +\bRCS\b +\bCVS\b +,v$ +\B\.svn\b + +# Makemaker generated files and dirs. +^MANIFEST\. +^Makefile$ +^blib/ +^MakeMaker-\d + +# Temp, old and emacs backup files. +~$ +\.old$ +^#.*#$ +^\.# diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..4b92bbb --- /dev/null +++ b/Makefile @@ -0,0 +1,870 @@ +# This Makefile is for the Reference extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.57_05 (Revision: 65705) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: (q[INSTALLDIRS=vendor]) +# + +# MakeMaker Parameters: + +# BUILD_REQUIRES => { } +# DISTNAME => q[Reference] +# EXE_FILES => [q[bin/get_reference]] +# NAME => q[Reference] +# PREREQ_PM => { } +# VERSION => undef + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/lib/perl/5.14/Config.pm). +# They may have been overridden via Makefile.PL or on the command line. +AR = ar +CC = cc +CCCDLFLAGS = -fPIC +CCDLFLAGS = -Wl,-E +DLEXT = so +DLSRC = dl_dlopen.xs +EXE_EXT = +FULL_AR = /usr/bin/ar +LD = cc +LDDLFLAGS = -shared -L/usr/local/lib -fstack-protector +LDFLAGS = -fstack-protector -L/usr/local/lib +LIBC = +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = linux +OSVERS = 3.2.0-4-amd64 +RANLIB = : +SITELIBEXP = /usr/local/share/perl/5.14.2 +SITEARCHEXP = /usr/local/lib/perl/5.14.2 +SO = so +VENDORARCHEXP = /usr/lib/perl5 +VENDORLIBEXP = /usr/share/perl5 + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +DFSEP = $(DIRFILESEP) +NAME = Reference +NAME_SYM = Reference +VERSION = +VERSION_MACRO = VERSION +VERSION_SYM = +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = blib/arch +INST_SCRIPT = blib/script +INST_BIN = blib/bin +INST_LIB = blib/lib +INST_MAN1DIR = blib/man1 +INST_MAN3DIR = blib/man3 +MAN1EXT = 1p +MAN3EXT = 3pm +INSTALLDIRS = vendor +DESTDIR = +PREFIX = /usr +PERLPREFIX = $(PREFIX) +SITEPREFIX = $(PREFIX)/local +VENDORPREFIX = $(PREFIX) +INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.14 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.14.2 +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5 +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.14 +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.14.2 +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5 +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = $(PERLPREFIX)/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = $(SITEPREFIX)/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = $(VENDORPREFIX)/bin +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = $(PERLPREFIX)/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLSITESCRIPT = $(SITEPREFIX)/bin +DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT) +INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin +DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT) +INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1 +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1 +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3 +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3 +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/share/perl/5.14 +PERL_ARCHLIB = /usr/lib/perl/5.14 +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = Makefile.old +MAKE_APERL_FILE = Makefile.aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/lib/perl/5.14/CORE +PERL = /usr/bin/perl +FULLPERL = /usr/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_DIR = 755 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/share/perl/5.14/ExtUtils/MakeMaker.pm +MM_VERSION = 6.57_05 +MM_REVISION = 65705 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +MAKE = make +FULLEXT = Reference +BASEEXT = Reference +PARENT_NAME = +DLBASE = $(BASEEXT) +VERSION_FROM = +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic +BOOTDEP = + +# Handy lists of source code files: +XS_FILES = +C_FILES = +O_FILES = +H_FILES = +MAN1PODS = bin/get_reference +MAN3PODS = lib/Reference.pm \ + lib/Reference/Field/Author.pm \ + lib/Reference/Field/Date.pm \ + lib/Reference/Field/Journal.pm \ + lib/Reference/Field/Pages.pm \ + lib/Reference/Output/Bibtex.pm \ + lib/Reference/Output/Filename.pm \ + lib/Reference/Retrieve/HTML/Miner.pm \ + lib/Reference/Retrieve/PubMed.pm \ + lib/Reference/Type/Article.pm + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB) +INST_ARCHLIBDIR = $(INST_ARCHLIB) + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = lib/Reference.pm \ + lib/Reference/Field/Author.pm \ + lib/Reference/Field/Date.pm \ + lib/Reference/Field/Journal.pm \ + lib/Reference/Field/Pages.pm \ + lib/Reference/Output/Bibtex.pm \ + lib/Reference/Output/Filename.pm \ + lib/Reference/Retrieve/HTML/Miner.pm \ + lib/Reference/Retrieve/PubMed.pm \ + lib/Reference/Type/Article.pm + +PM_TO_BLIB = lib/Reference/Field/Journal.pm \ + blib/lib/Reference/Field/Journal.pm \ + lib/Reference/Output/Filename.pm \ + blib/lib/Reference/Output/Filename.pm \ + lib/Reference/Field/Author.pm \ + blib/lib/Reference/Field/Author.pm \ + lib/Reference/Output/Bibtex.pm \ + blib/lib/Reference/Output/Bibtex.pm \ + lib/Reference/Type/Article.pm \ + blib/lib/Reference/Type/Article.pm \ + lib/Reference.pm \ + blib/lib/Reference.pm \ + lib/Reference/Field/Date.pm \ + blib/lib/Reference/Field/Date.pm \ + lib/Reference/Field/Pages.pm \ + blib/lib/Reference/Field/Pages.pm \ + lib/Reference/Retrieve/HTML/Miner.pm \ + blib/lib/Reference/Retrieve/HTML/Miner.pm \ + lib/Reference/Retrieve/PubMed.pm \ + blib/lib/Reference/Retrieve/PubMed.pm + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 6.57_05 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' -- + + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(TRUE) +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' -- +EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' -- +FALSE = false +TRUE = true +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' -- +DOC_INSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'perllocal_install' -- +UNINSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'uninstall' -- +WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'warn_if_old_packlist' -- +MACROSTART = +MACROEND = +USEMAKEFILE = -f +FIXIN = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' -- + + +# --- MakeMaker makemakerdflt section: +makemakerdflt : all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section: +TAR = tar +TARFLAGS = cvf +ZIP = zip +ZIPFLAGS = -r +COMPRESS = gzip --best +SUFFIX = .gz +SHAR = shar +PREOP = $(NOECHO) $(NOOP) +POSTOP = $(NOECHO) $(NOOP) +TO_UNIX = $(NOECHO) $(NOOP) +CI = ci -u +RCS_LABEL = rcs -Nv$(VERSION_SYM): -q +DIST_CP = best +DIST_DEFAULT = tardist +DISTNAME = Reference +DISTVNAME = Reference- + + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + LD="$(LD)"\ + PREFIX="$(PREFIX)" + + +# --- MakeMaker special_targets section: +.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir + + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) blibdirs + $(NOECHO) $(NOOP) + +help : + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker blibdirs section: +blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists + $(NOECHO) $(NOOP) + +# Backwards compat with 6.18 through 6.25 +blibdirs.ts : blibdirs + $(NOECHO) $(NOOP) + +$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_LIBDIR) + $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists + +$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHLIB) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB) + $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists + +$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR) + $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists + +$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR) + $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists + +$(INST_BIN)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_BIN) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN) + $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists + +$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_SCRIPT) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT) + $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists + +$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN1DIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR) + $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists + +$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR) + $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists + + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all \ + bin/get_reference \ + lib/Reference/Field/Journal.pm \ + lib/Reference/Output/Filename.pm \ + lib/Reference/Field/Author.pm \ + lib/Reference/Output/Bibtex.pm \ + lib/Reference/Type/Article.pm \ + lib/Reference.pm \ + lib/Reference/Field/Date.pm \ + lib/Reference/Field/Pages.pm \ + lib/Reference/Retrieve/HTML/Miner.pm \ + lib/Reference/Retrieve/PubMed.pm + $(NOECHO) $(POD2MAN) --section=$(MAN1EXT) --perm_rw=$(PERM_RW) \ + bin/get_reference $(INST_MAN1DIR)/get_reference.$(MAN1EXT) + $(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \ + lib/Reference/Field/Journal.pm $(INST_MAN3DIR)/Reference::Field::Journal.$(MAN3EXT) \ + lib/Reference/Output/Filename.pm $(INST_MAN3DIR)/Reference::Output::Filename.$(MAN3EXT) \ + lib/Reference/Field/Author.pm $(INST_MAN3DIR)/Reference::Field::Author.$(MAN3EXT) \ + lib/Reference/Output/Bibtex.pm $(INST_MAN3DIR)/Reference::Output::Bibtex.$(MAN3EXT) \ + lib/Reference/Type/Article.pm $(INST_MAN3DIR)/Reference::Type::Article.$(MAN3EXT) \ + lib/Reference.pm $(INST_MAN3DIR)/Reference.$(MAN3EXT) \ + lib/Reference/Field/Date.pm $(INST_MAN3DIR)/Reference::Field::Date.$(MAN3EXT) \ + lib/Reference/Field/Pages.pm $(INST_MAN3DIR)/Reference::Field::Pages.$(MAN3EXT) \ + lib/Reference/Retrieve/HTML/Miner.pm $(INST_MAN3DIR)/Reference::Retrieve::HTML::Miner.$(MAN3EXT) \ + lib/Reference/Retrieve/PubMed.pm $(INST_MAN3DIR)/Reference::Retrieve::PubMed.$(MAN3EXT) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + +EXE_FILES = bin/get_reference + +pure_all :: $(INST_SCRIPT)/get_reference + $(NOECHO) $(NOOP) + +realclean :: + $(RM_F) \ + $(INST_SCRIPT)/get_reference + +$(INST_SCRIPT)/get_reference : bin/get_reference $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists + $(NOECHO) $(RM_F) $(INST_SCRIPT)/get_reference + $(CP) bin/get_reference $(INST_SCRIPT)/get_reference + $(FIXIN) $(INST_SCRIPT)/get_reference + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_SCRIPT)/get_reference + + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + - $(RM_F) \ + *$(LIB_EXT) core \ + core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \ + core.[0-9][0-9] $(BASEEXT).bso \ + pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \ + MYMETA.yml $(BASEEXT).x \ + $(BOOTSTRAP) perl$(EXE_EXT) \ + tmon.out *$(OBJ_EXT) \ + pm_to_blib $(INST_ARCHAUTODIR)/extralibs.ld \ + blibdirs.ts core.[0-9][0-9][0-9][0-9][0-9] \ + *perl.core core.*perl.*.? \ + $(MAKE_APERL_FILE) $(BASEEXT).def \ + perl core.[0-9][0-9][0-9] \ + mon.out lib$(BASEEXT).def \ + perlmain.c perl.exe \ + so_locations $(BASEEXT).exp + - $(RM_RF) \ + blib + - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker realclean section: +# Delete temporary files (via clean) and also delete dist files +realclean purge :: clean realclean_subdirs + - $(RM_F) \ + $(MAKEFILE_OLD) $(FIRST_MAKEFILE) + - $(RM_RF) \ + $(DISTVNAME) + + +# --- MakeMaker metafile section: +metafile : create_distdir + $(NOECHO) $(ECHO) Generating META.yml + $(NOECHO) $(ECHO) '--- #YAML:1.0' > META_new.yml + $(NOECHO) $(ECHO) 'name: Reference' >> META_new.yml + $(NOECHO) $(ECHO) 'version: ' >> META_new.yml + $(NOECHO) $(ECHO) 'abstract: ~' >> META_new.yml + $(NOECHO) $(ECHO) 'author: []' >> META_new.yml + $(NOECHO) $(ECHO) 'license: unknown' >> META_new.yml + $(NOECHO) $(ECHO) 'distribution_type: module' >> META_new.yml + $(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: 0' >> META_new.yml + $(NOECHO) $(ECHO) 'build_requires:' >> META_new.yml + $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: 0' >> META_new.yml + $(NOECHO) $(ECHO) 'requires: {}' >> META_new.yml + $(NOECHO) $(ECHO) 'no_index:' >> META_new.yml + $(NOECHO) $(ECHO) ' directory:' >> META_new.yml + $(NOECHO) $(ECHO) ' - t' >> META_new.yml + $(NOECHO) $(ECHO) ' - inc' >> META_new.yml + $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.57_05' >> META_new.yml + $(NOECHO) $(ECHO) 'meta-spec:' >> META_new.yml + $(NOECHO) $(ECHO) ' url: http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml + $(NOECHO) $(ECHO) ' version: 1.4' >> META_new.yml + -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml + + +# --- MakeMaker signature section: +signature : + cpansign -s + + +# --- MakeMaker dist_basics section: +distclean :: realclean distcheck + $(NOECHO) $(NOOP) + +distcheck : + $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck + +skipcheck : + $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck + +manifest : + $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest + +veryclean : realclean + $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old + + + +# --- MakeMaker dist_core section: + +dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) + $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \ + -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' -- + +tardist : $(DISTVNAME).tar$(SUFFIX) + $(NOECHO) $(NOOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +zipdist : $(DISTVNAME).zip + $(NOECHO) $(NOOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) + + +# --- MakeMaker distdir section: +create_distdir : + $(RM_RF) $(DISTVNAME) + $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" + +distdir : create_distdir distmeta + $(NOECHO) $(NOOP) + + + +# --- MakeMaker dist_test section: +disttest : distdir + cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL "INSTALLDIRS=vendor" + cd $(DISTVNAME) && $(MAKE) $(PASTHRU) + cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) + + + +# --- MakeMaker dist_ci section: + +ci : + $(PERLRUN) "-MExtUtils::Manifest=maniread" \ + -e "@all = keys %{ maniread() };" \ + -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \ + -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});" + + +# --- MakeMaker distmeta section: +distmeta : create_distdir metafile + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' -- + + + +# --- MakeMaker distsignature section: +distsignature : create_distdir + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' -- + $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE + cd $(DISTVNAME) && cpansign -s + + + +# --- MakeMaker install section: + +install :: pure_install doc_install + $(NOECHO) $(NOOP) + +install_perl :: pure_perl_install doc_perl_install + $(NOECHO) $(NOOP) + +install_site :: pure_site_install doc_site_install + $(NOECHO) $(NOOP) + +install_vendor :: pure_vendor_install doc_vendor_install + $(NOECHO) $(NOOP) + +pure_install :: pure_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +doc_install :: doc_$(INSTALLDIRS)_install + $(NOECHO) $(NOOP) + +pure__install : pure_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +doc__install : doc_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_perl_install :: all + $(NOECHO) umask 022; $(MOD_INSTALL) \ + $(INST_LIB) $(DESTINSTALLPRIVLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ + $(INST_BIN) $(DESTINSTALLBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(SITEARCHEXP)/auto/$(FULLEXT) + + +pure_site_install :: all + $(NOECHO) umask 02; $(MOD_INSTALL) \ + read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLSITELIB) \ + $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ + $(INST_BIN) $(DESTINSTALLSITEBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(PERL_ARCHLIB)/auto/$(FULLEXT) + +pure_vendor_install :: all + $(NOECHO) umask 022; $(MOD_INSTALL) \ + $(INST_LIB) $(DESTINSTALLVENDORLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ + $(INST_BIN) $(DESTINSTALLVENDORBIN) \ + $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) + +doc_perl_install :: all + +doc_site_install :: all + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod + -$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH) + -$(NOECHO) umask 02; $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLSITELIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLSITEARCH)/perllocal.pod + +doc_vendor_install :: all + + +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + $(NOECHO) $(NOOP) + +uninstall_from_perldirs :: + +uninstall_from_sitedirs :: + $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist + +uninstall_from_vendordirs :: + + + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE : + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) + -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) + $(PERLRUN) Makefile.PL "INSTALLDIRS=vendor" + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" + $(FALSE) + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = perl +FULLPERL = /usr/bin/perl + +$(MAP_TARGET) :: static $(MAKE_APERL_FILE) + $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ + +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib + $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) + $(NOECHO) $(PERLRUNINST) \ + Makefile.PL DIR= \ + MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ + MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= \ + INSTALLDIRS=vendor + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) subdirs-test + +subdirs-test :: + $(NOECHO) $(NOOP) + + $(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.' + +test_dynamic :: pure_all + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +testdb_static :: testdb_dynamic + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd : + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM) + $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \ + lib/Reference/Field/Journal.pm blib/lib/Reference/Field/Journal.pm \ + lib/Reference/Output/Filename.pm blib/lib/Reference/Output/Filename.pm \ + lib/Reference/Field/Author.pm blib/lib/Reference/Field/Author.pm \ + lib/Reference/Output/Bibtex.pm blib/lib/Reference/Output/Bibtex.pm \ + lib/Reference/Type/Article.pm blib/lib/Reference/Type/Article.pm \ + lib/Reference.pm blib/lib/Reference.pm \ + lib/Reference/Field/Date.pm blib/lib/Reference/Field/Date.pm \ + lib/Reference/Field/Pages.pm blib/lib/Reference/Field/Pages.pm \ + lib/Reference/Retrieve/HTML/Miner.pm blib/lib/Reference/Retrieve/HTML/Miner.pm \ + lib/Reference/Retrieve/PubMed.pm blib/lib/Reference/Retrieve/PubMed.pm + $(NOECHO) $(TOUCH) pm_to_blib + + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + + +# End. diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..7a00e0a --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,11 @@ +#!/usr/bin/perl +# $Id: Makefile.PL 35 2004-11-05 21:50:00Z don $ + +use ExtUtils::MakeMaker; +require './lib/Reference.pm'; + +WriteMakefile(NAME => 'Reference', + DISTNAME => 'Reference', + VERSION => $Reference::VERSION, + EXE_FILES => [qw(bin/get_reference)], + ); diff --git a/NOTES b/NOTES new file mode 100644 index 0000000..aac6d98 --- /dev/null +++ b/NOTES @@ -0,0 +1,8 @@ + + +Z39.50 support + Zoom API -- http://zoom.z3950.org/ + LOC Z39.50 -- http://lcweb.loc.gov/z3950/lcserver.html + Perl http://search.cpan.org/~mirk/Net-Z3950-0.41/Z3950.pm + + Melvyl z39.50 melvyl.cdlib.org port 210 \ No newline at end of file diff --git a/bin/get_reference b/bin/get_reference new file mode 100755 index 0000000..b042465 --- /dev/null +++ b/bin/get_reference @@ -0,0 +1,111 @@ +#! /usr/bin/perl +# This program is part of da_reference, and is released under the +# terms of the GPL version 2, or any later version, at your +# option. See the file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id: get_reference 45 2013-09-10 18:05:31Z don $ + + +use warnings; +use strict; + + +use Getopt::Long; +use Reference; +use Pod::Usage; + +=head1 NAME + +get_reference - Retrieve a reference from somewhere and output the +formatted reference to STDOUT. + +=head1 SYNOPSIS + +get_reference [options] referenceid [referenceid ...] + + Options: + --pmid,-p referenceid is a pub med id. (Default) + --bibtex,-b ouput in bibtex format (Default) + --debug, -d debugging level (Default 0) + --help,-h display this help + --man,-m display manual + +=head1 OPTIONS + +=over + +=item B<--pmid, -p> + +The referenceid listed is a Pub Med ID. (Default) + +=item B<--bibtex, -b> + +Output the listed referenceid in BibTeX format. (Default) + +=item B<--help, -h> + +Display brief useage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + + get_reference -p -b -d 1 123456; + + get_reference 123456; + +=cut + + + +use vars qw($DEBUG); + +my %options = (pmid => 1, + bibtex => 1, + debug => 0, + help => 0, + man => 0, + suggest_name => 0, + journal_titles => 0, + ); + +GetOptions(\%options,'pmid|p','bibtex|b','suggest_name|suggest-name','debug|d','help|h','man|m', + 'journal_titles|journal-titles|journal_title|journal-titles', + ); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + +if ($options{pmid} and $options{bibtex}) { + use Reference::Type::Article; + use Reference::Retrieve::PubMed; + use Reference::Output::Bibtex; + use Reference::Output::Filename; + use Encode qw(encode_utf8); + $Reference::Retrieve::PubMed::DEBUG = $options{debug}; + foreach my $pmid (@ARGV) { + next unless ($pmid) = $pmid =~ /(\d+)/; + print STDERR "dealing with $pmid\n" if $DEBUG; + my $reference = scalar Reference::Retrieve::PubMed::get_reference_by_pmid(pmid => $pmid); + print STDERR "Unable to retrieve reference for $pmid\n" and next if not defined $reference; + if ($options{suggest_name}) { + # try to suggest a name for the reference + print '@COMMENT{Filename: '.lc(encode_utf8(Reference::Output::Bibtex::convert_to_utf8(filename($reference))))."\n"; + } + if ($options{journal_titles}) { + print '@COMMENT{Medline: '.$reference->journal(output=>'bibtex').'="'. + $reference->journal(output=>'medline').qq("}\n); + print '@COMMENT{isoabbr: '.$reference->journal(output=>'bibtex').'="'. + $reference->journal(output=>'iso').qq("}\n); + print '@COMMENT{full: '.$reference->journal(output=>'bibtex').'="'. + $reference->journal().qq("}\n); + } + print scalar bibtex($reference); + } +} diff --git a/blib/arch/.exists b/blib/arch/.exists new file mode 100644 index 0000000..e69de29 diff --git a/blib/arch/auto/Reference/.exists b/blib/arch/auto/Reference/.exists new file mode 100644 index 0000000..e69de29 diff --git a/blib/bin/.exists b/blib/bin/.exists new file mode 100644 index 0000000..e69de29 diff --git a/blib/lib/.exists b/blib/lib/.exists new file mode 100644 index 0000000..e69de29 diff --git a/blib/lib/Reference.pm b/blib/lib/Reference.pm new file mode 100644 index 0000000..a650f1d --- /dev/null +++ b/blib/lib/Reference.pm @@ -0,0 +1,229 @@ +# This module is part of , and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Reference.pm 44 2013-09-10 00:37:13Z don $ + +package Reference; + +=head1 NAME + +Reference -- Reference superclass + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($VERSION $REVISION $DEBUG); +use Carp; + + +BEGIN{ + $REVISION = '0.01'; + ($REVISION) = q$LastChangedRevision: 44 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + +our $AUTOLOAD; + + +=head2 new + + my $reference = new Reference; + + +Creates a new reference object + +=cut + +sub new{ + my $class = shift; + + $class = ref $class if ref $class; + + my $self = {}; + + bless $self, $class; + + $self->_init; + + return $self; +} + + +=head2 ref_fields + + @$self->{ref_fields}{$self->ref_fields} = (1) x $self->ref_fields; + +Returns the fields that this reference knows how to deal with (or that +should be dealt with using ref_fields). + +This default implementation returns an empty list, and as such should +be overriden by all Reference::Type subclasses. + +=cut + +sub ref_fields{ + my $self = shift; + + return (); +} + + +=head2 ref_field + + $reference->ref_field('author',['John Q. Smith', 'Randal P. Swag']); + +Sets the reference field to the passed value (if any) and returns the +new value. This function is called through AUTOLOAD using the +$reference->field() syntax. + +Returns the new setting of passed field. + +Scalar fieldname, and an optional scalar, arrayref, or hashref to set +reference field. + +=cut + +sub ref_field($$;$){ + my ($self,$field_name,$field_value) = @_; + + if ($self->{ref_fields}->{lc($field_name)}) { + # Check to make sure that only 3 arguments are passed to + # avoid triggering on the Params::Variable style of calling. + # XXX We should check explicitly for this. [See Author.pm] + if (defined $field_value and scalar(@_) == 3) { + $self->{reference}->{lc($field_name)} = $field_value; + } + return $self->{reference}->{lc($field_name)}; + } + carp "Invalid field name $field_name"; +} + + +=head2 AUTOLOAD + +Dispatches calls to $reference->fieldname to +$reference->ref_field('fieldname'). + +XXX I really wish there was a way to tell perl that we don't want to +XXX handle a call to AUTOLOAD. + +=cut + +sub AUTOLOAD{ + my $function = $AUTOLOAD; + ($function) = $function =~ /\:?([^\:]+)$/; + my $self = shift; + if (ref $self and $self->{ref_fields}->{lc($function)}) { + # slap $self and $function into @_. + unshift @_, ($self,$function); + goto &ref_field; + } + else { + croak "Undefined subroutine $function"; + } +} + +# do nothing +sub DESTROY { + +} + + +=head2 can + + $obj->can('METHOD'); + Class::Modular->can('METHOD'); + +Replaces UNIVERSAL's can method so that handled methods are reported +correctly. Calls UNIVERSAL::can in the places where we don't know +anything it doesn't. + +Returns a coderef to the method if the method is supported, undef +otherwise. + +=cut + +sub can{ + my ($self,$method,$vars) = @_; + + my $universal_can = UNIVERSAL::can($self,$method); + + if ($universal_can){ + return $universal_can; + } + elsif (ref $self and exists $self->{ref_fields}->{lc($method)}) { + # If there is no other method for dealing with this method, + # and we would normally autoload it, create an anonymous sub + # to deal with it appropriately. + return sub{my $self = shift; return $self->ref_field($method,@_);}; + } + else { + return undef; + } +} + + +=head2 _init + + $self->_init + +=cut + +sub _init($){ + my $self = shift; + + # ref_fields is used by AUTOLOAD to know when it's ok to set a + # particular field + my @ref_fields = $self->ref_fields; + @{$self->{ref_fields}}{@ref_fields} = (1) x scalar @ref_fields; +} + + + + + +# From http://www.ecst.csuchico.edu/~jacobsd/bib/formats/ + +# * BibTeX +# * INSPEC +# * MARC [MARC::Record] +# * Melvyl [Uses MARC] +# * RIS +# * MedLine +# * ISI Focus On +# * EMBL +# * BIDS +# * ProCite +# * EndNote +# * Computing Archives +# * Uniform Resource Citation +# * RFC 1807 (replaces RFC 1357) +# * Other formats + + + + + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Field/Author.pm b/blib/lib/Reference/Field/Author.pm new file mode 100644 index 0000000..e0ff48c --- /dev/null +++ b/blib/lib/Reference/Field/Author.pm @@ -0,0 +1,330 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. + +# Copyright 2003, 2004 by Don Armstrong . +# $Id: Author.pm 42 2009-03-20 06:29:46Z don $ + +package Reference::Field::Author; + +=head1 NAME + +Reference::Field::Author -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 TODO + +XXX Allow the corresponding author to be set explicitely + +XXX To do this, we need to break away from using the author field as +an arrayref, and instead use a hashref with the author fields, and a +specific corresponding author setting. [This should probaly be de +riguer for other fields as well.] + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 42 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 author + +=head3 Usage + + + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub author{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{author} = shift; + $params{output} = 'scalar'; + $params{add_author} = 0; + $params{del_author} = 0; + } + else { + %params = validate_with(params => \@_, + spec => {author => {type => ARRAYREF|SCALAR|HASHREF, + optional => 1, + }, + add_author => {type => BOOLEAN, + default => 0, + }, + del_author => {type => BOOLEAN, + default => 0, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{author}) { + $self->{reference}->{author} = {authors => [], + first_author => 0, + corresponding_author => -1, + } unless $params{add_author}; + # We can't handle things like Smith, Jones, Paul, Rue; for + # obvious reasons. If you must do something so broken, you + # have to go Smith, Jones; Paul, Rue; or Smith, Jones and + # Paul, Rue. + if (not ref($params{author}) and ($params{author} =~ /\sand\,?\s/ or $params{author} =~ /\w\;\s/)) { + $params{author} = [grep /\w/, split (/\s*and,?\s*|\;\s*/,$params{author})]; + } + $params{author} = [$params{author}] unless ref($params{author}) eq 'ARRAY'; + foreach my $author (@{$params{author}}) { + my $author_info = _parse_author($author); + if (not $params{del_author}) { + push @{$self->{reference}{author}{authors}},$author_info; + } + else { + _delete_author($author_info,$author->{reference}{author}{authors}); + } + } + } + + local $_ = $params{output}; + if (/bibtex/) { + return join(' and ',map {$_->{full}} @{$self->{reference}{author}{authors}}); + } + else { + return join(', ',map {$_->{full}} @{$self->{reference}{author}{authors}}); + } + +} + +=head2 corresponding_author + + my $corresponding_author = $ref->corresponding_author; + +Returns the corresponding author (the last author listed.) + +=cut + +sub corresponding_author{ + my $self = shift; + + my %params = validate_with(params => \@_, + spec => {output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + local $_ = $params{output}; + if (/bibtex/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full}; + } + elsif (/last/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{last}; + } + else { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full}; + } +} + +=head2 first_author + + my $first_author = $ref->first_author; + +Returns the first author (primary author.) + +=cut + +sub first_author{ + my $self = shift; + my %params = validate_with(params => \@_, + spec => {output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + local $_ = $params{output}; + if (/bibtex/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || ''; + } + elsif (/last/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{last}; + } + else { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || ''; + } +} + + +=head2 _parse_author + + my $author_info = _parse_author($author); + +Parses the author and returns an author record. + +Author record + +The author can be specified in a few different ways: + +=over + +=item SCALAR Author Name + +=over + +=item SMITH John W. + +=item Smith JW + +=item John W. Smith + +=item John Wilkenson Smith + +=item HASHREF Author structure + +=item ARRAYREF Author Name + +=back + +In these cases, the author's name should be parsed appropriately. [XXX +Needs to be extended to handle Smith, John W. appropriately.] + + +=cut + +sub _parse_author($){ + my ($author) = @_; + + warn "Undefined author" and return undef if not defined $author; + + # the author information + my %au = (); + if (not ref($author)) { + # UGH. Try to figure out the author. + if ($author =~ /^\s*([A-Z]+)\s+([\w\s]+?)(?:\s*([A-Z])\.)?\s*$/) { # SMITH John W. + $au{first} = ucfirst(lc($2)) || ''; + $au{last} = ucfirst(lc($1)) || ''; + $au{middle} = $3 || ''; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):''); + $au{full} = join(' ',grep /\w/,($au{first},$au{middle},$au{last})); + } + elsif ($author =~ /^\s*([A-Z][\w\s]*?)\s+([A-Z]+)\s*$/) { # Smith JW + $au{first} = $2 || ''; + $au{middle} = ''; + if (length $au{first} > 1) { + $au{middle} = substr($au{first},1); + $au{first} = substr($au{first},0,1); + } + $au{last} = $1; + $au{initials} = $2; + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})) + } + elsif ($author =~ /^\s*([A-Z][\w]*?)\s+(?:([A-Z])\.|([A-Z][\w\s]*?)\s+)?\s*([A-Z][\w]*)\s*$/){ # John W. Smith or John Wilkinson Smith + $au{first} = $1; + $au{middle} = $2 || $3 || ''; + $au{last} = $4; + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})); + } + # XXX Handle Smith, John Wilkinson; Smith, JW; and Smith, John W. + else { + warn "Couldn't handle author $author"; + $au{full} = $author; + } + } + elsif (ref $author eq 'ARRAY') { + warn "Author was empty" unless scalar @{$author}; + $au{full} = join(' ',grep /\w/, @{$author}); + $au{last} = $author->[-1]; + $au{first} = $author->[0] if scalar @{$author} > 1; + $au{middle} = join(' ',grep /\w/,@{$author}[1..($#{$author}-1)]) if scalar @{$author} > 2; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):''); + } + elsif (ref $author eq 'HASH') { + foreach my $key (qw(full last middle first initials)) { + $au{$key} = ''; + $au{$key} = $author->{$key} if exists $author->{$key} and defined $author->{$key}; + } + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})) if $au{full} eq ''; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):'') if $au{initials} eq ''; + } + else { + warn "Unknown reference: $author"; + return undef; + } + return \%au; +} + +=head2 _delete_author + + + + +XXX NOT IMPLEMENTED + +=cut + +sub _delete_author($$){ + my ($author_info,$author_list) = @_; + + die "NOT IMPLEMENTED"; +} + + +=head2 _init + +Called by Reference's new function + +Call superclass's _init function [C<$self->NEXT::_init>], sets up the +author list reference. + +=cut + +sub _init{ + my $self = shift; + + $self->{reference}->{author} = {authors => [], + first_author => 0, + corresponding_author => -1, + }; + + $self->NEXT::_init; + +} + + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Field/Date.pm b/blib/lib/Reference/Field/Date.pm new file mode 100644 index 0000000..7768772 --- /dev/null +++ b/blib/lib/Reference/Field/Date.pm @@ -0,0 +1,178 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Date.pm 42 2009-03-20 06:29:46Z don $ + +package Reference::Field::Date; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); +use Date::Manip; + + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 42 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + +=head2 date + + + +XXX DOCUMENT ME + +=cut + + +sub date{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{date} = shift; + $params{output} = 'scalar'; + } + else { + %params = validate_with(params => \@_, + spec => {date => {type => ARRAYREF|SCALAR|HASHREF|UNDEF, + optional => 1, + }, + day => {type => SCALAR|UNDEF, + optional => 1, + }, + year => {type => SCALAR|UNDEF, + optional => 1, + }, + month => {type => SCALAR|UNDEF, + optional => 1, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{day} or defined $params{year} or defined $params{month}) { + $self->{reference}->{date}->{day} = $params{day} if defined $params{day}; + $self->{reference}->{date}->{year} = $params{year} if defined $params{year}; + $self->{reference}->{date}->{month} = $params{month} if defined $params{month}; + } + elsif (defined $params{date}) { + $self->{reference}->{date} = {day => undef, + year => undef, + month => undef, + }; + my $date = ParseDate($params{date}); + $self->{reference}->{date}->{unix} = $date; + ($self->{reference}->{date}->{day}, + $self->{reference}->{date}->{year}, + $self->{reference}->{date}->{month}) = UnixDate($date,qw(%e %Y %m)); + } + + local $_ = $params{output}; + if (/bibtex/) { + return UnixDate($self->{reference}->{date}->{unix},'%B %e %Y') if defined $self->{reference}->{date}->{unix}; + return join(' ',$self->{reference}->{date}->{day},$self->{reference}->{date}->{year},$self->{reference}->{date}->{month}); + } + elsif (/year/) { + return UnixDate($self->{reference}->{date}->{unix},'%Y') if defined $self->{reference}->{date}->{unix}; + return $self->{reference}->{date}->{year}; + } + else { + return UnixDate($self->{reference}->{date}->{unix},'%B %e %Y') if defined $self->{reference}->{date}->{unix}; + return join(' ',$self->{reference}->{date}->{day},$self->{reference}->{date}->{year},$self->{reference}->{date}->{month}); + } +} + +=head2 year + + + +Returns the year associated with the date field + + +=cut + + +sub year{ + my $self = shift; + + return $self->{reference}->{date}->{year}; +} + +=head2 day + + + +Returns the day associated with the date field + +=cut + +sub day{ + my $self = shift; + + return $self->{reference}->{date}->{day}; +} + +=head2 month + + + +Returns the month associated with the date field + +=cut + +sub month{ + my $self = shift; + + return $self->{reference}->{date}->{month}; +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{date} = {month => undef, + year => undef, + day => undef, + unix => undef, + }; + + $self->NEXT::_init; + +} + + + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Field/Journal.pm b/blib/lib/Reference/Field/Journal.pm new file mode 100644 index 0000000..ad5639a --- /dev/null +++ b/blib/lib/Reference/Field/Journal.pm @@ -0,0 +1,110 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Journal.pm 44 2013-09-10 00:37:13Z don $ + +package Reference::Field::Journal; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG @JOURNAL_FIELDS); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 44 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + @JOURNAL_FIELDS = qw(title medlineabbr isoabbr nlmid issn eissn publisher pmid); +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{journal} = {}; + @{$self->{reference}->{journal}}{@JOURNAL_FIELDS} = (undef) x scalar @JOURNAL_FIELDS; + + $self->NEXT::_init; + +} + +sub journal{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{journal} = shift; + $params{output} = 'scalar'; + } + else { + my %spec; + @spec{@JOURNAL_FIELDS} = ({type => SCALAR|UNDEF,optional=>1}) x scalar @JOURNAL_FIELDS; + %params = validate_with(params => \@_, + spec => {journal => {type => SCALAR, + optional => 1, + }, + output => {type => SCALAR, + default => 'scalar', + }, + %spec, + }, + ); + } + # Were we called using $reference->journal(foo=>bar) {ignoring journal=>bar} ? + my $using_param_call = 0; + foreach my $key (@JOURNAL_FIELDS) { + $using_param_call = 1 and last if exists $params{$key} and defined $params{$key}; + } + if ($using_param_call) { + foreach my $key (@JOURNAL_FIELDS) { + $self->{reference}->{journal}->{$key} = $params{$key} if exists $params{$key} and defined $params{$key}; + } + } + elsif (defined $params{journal}) { + $self->{reference}->{journal}->{title} = $params{journal}; + } + + local $_ = $params{output}; + if (/bibtex/) { + my $title = $self->{reference}->{journal}->{medlineabbr} || $self->{reference}->{journal}->{title}; + $title =~ s/\s//g; + return $title; + } elsif (/medline/) { + return $self->{reference}->{journal}->{medlineabbr} || $self->{reference}->{journal}->{title}; + } elsif (/iso/) { + return $self->{reference}->{journal}->{isoabbr} || $self->{reference}->{journal}->{title}; + } + else { + return $self->{reference}->{journal}->{title}; + } +} + + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Field/Pages.pm b/blib/lib/Reference/Field/Pages.pm new file mode 100644 index 0000000..8e1c1c2 --- /dev/null +++ b/blib/lib/Reference/Field/Pages.pm @@ -0,0 +1,109 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Pages.pm 45 2013-09-10 18:05:31Z don $ + +package Reference::Field::Pages; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 45 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{pages} = {start => undef, + stop => undef, + }; + + $self->NEXT::_init; + +} + +sub pages{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{pages} = shift; + $params{output} = 'scalar'; + } + else { + %params = validate_with(params => \@_, + spec => {pages => {type => ARRAYREF|SCALAR|HASHREF, + optional => 1, + }, + start => {type => SCALAR, + optional => 1, + }, + stop => {type => SCALAR, + optional => 1, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{start} or defined $params{stop}) { + $self->{reference}->{pages}->{start} = $params{start} if defined $params{start}; + $self->{reference}->{pages}->{stop} = $params{stop} if defined $params{stop}; + } + elsif (defined $params{pages}) { + $self->{reference}->{pages} = {start => undef, + stop => undef, + }; + ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop}) = split(/\-+/,$params{pages}); + } + + if (wantarray) { + return grep {defined} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop}); + } + local $_ = $params{output}; + if (/bibtex/) { + return join('--',map {defined $_ ? $_ : ()} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop})); + } + else { + return join('-',map {defined $_ ? $_ : ()} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop})); + } + +} + + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Output/Bibtex.pm b/blib/lib/Reference/Output/Bibtex.pm new file mode 100644 index 0000000..06cd71d --- /dev/null +++ b/blib/lib/Reference/Output/Bibtex.pm @@ -0,0 +1,379 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id: Bibtex.pm 45 2013-09-10 18:05:31Z don $ + +package Reference::Output::Bibtex; + +=head1 NAME + +Reference::Output::Bibtex -- Output references in BibTeX format + +=head1 SYNOPSIS + + print bibtex($reference); + +Returns a reference formatted in bibtex format. + +=head1 DESCRIPTION + +Knows how to handle the reference-> bibtex field mapping for many +reference types, but overridden types may need to provide their own +mapping. + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); + +use base qw(Exporter); + +use Encode qw(encode_utf8 is_utf8 decode decode_utf8); +use Text::Iconv; + + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 45 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = qw(bibtex); + @EXPORT_OK = qw(); + %EXPORT_TAGS = (output => [qw(bibtex)], + ); + Exporter::export_ok_tags(qw(output)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +# Assigned and discussed at the end of this file +my %bibtex_mapping; + +use Carp; +use Params::Validate qw(:types validate_with); +use Text::Wrap; + + +=head2 bibtex + + print bibtex $reference; + %bibtex = bibtex $reference; + print bibtex($reference,mapping=>{...}) + +In scalar context, returns a formatted bibtex entry, suitable for +printing. In list context, returns a hash of key, value pairs which +can be used to print a formatted bibtex entry. + +You can also pass an optional mapping to be used for making the bibtex +entry. See B for the details. + +The mappings are obeyed in the following order, the first taking +precedence over the last. + +=over + +=item Passed mapping + +=item Object's bibtex_mapping + +=item Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping) + +=back + +Returns a SCALAR bibtex reference in scalar context, a HASH bibtex +reference in list context + +=cut + +sub bibtex{ + my $reference = shift; + + # Parse options if any + my %param = validate_with(params => \@_, + spec => {mapping => {type => HASHREF, + optional => 1, + }, + }, + ); + + my $mapping = undef; + + # Use our mapping by default if it exists + $mapping = $bibtex_mapping{lc($reference->{type})} if exists $bibtex_mapping{lc($reference->{type})}; + # Override that with the module's mapping + $mapping = $reference->{bibtex_mapping} if exists $reference->{bibtex_mapping}; + # Finally, override everything with passed mapping + $mapping = $param{mapping} if exists $param{mapping}; + + if (not defined $mapping) { + carp "This reference type doesn't support bibtex output."; + return undef; + } + + my %bibtex_entry; + foreach my $bibtex_field (keys %{$mapping->{mapping}}) { + my $params = []; + if (ref $bibtex_field) { + $params = $$bibtex_field{params} if exists $$bibtex_field{params}; + $bibtex_field = $$bibtex_field{field}; + } + my $function = $reference->can($mapping->{mapping}->{$bibtex_field}); + next unless $function; + $bibtex_entry{$bibtex_field} = &{$function}($reference,output=>'bibtex',@$params); + # dereference the entries if necessesary. + next unless wantarray; + # Make new copies of the entries if necessary so we can + # mogrify to our hearts content. + if (ref($bibtex_entry{$bibtex_field}) eq 'HASH') { + $bibtex_entry{$bibtex_field} = {%{$bibtex_entry{$bibtex_field}}}; + } + elsif (ref($bibtex_entry{$bibtex_field}) eq 'ARRAY') { + $bibtex_entry{$bibtex_field} = [@{$bibtex_entry{$bibtex_field}}]; + } + } + # Return the entries in hash form if desired. + return %bibtex_entry if wantarray; + # Ok, stich the bibtex entry together... + my $bibtex_entry; + $bibtex_entry = '@'.$mapping->{order}[0].'{'.encode_utf8(convert_to_utf8($bibtex_entry{$mapping->{order}[0]})).",\n"; + foreach my $bibtex_field (@{$mapping->{order}}[1..$#{$mapping->{order}}]) { + next unless defined $bibtex_entry{$bibtex_field}; + if (ref $bibtex_entry{$bibtex_field} eq 'ARRAY') { + next unless @{$bibtex_entry{$bibtex_field}}; + if (ref $mapping->{mapping}{$bibtex_field}) { + if (exists $mapping->{mapping}{$bibtex_field}{code}) { + local $_ = $bibtex_entry{$bibtex_field}; + eval $mapping->{mapping}{$bibtex_field}{code}; + carp "Error while executing code to assemble bibtex entry: $@" if $@; + } + elsif (exists $mapping->{mapping}{$bibtex_field}{join}) { + $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join}, + @{$bibtex_entry{$bibtex_field}}); + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + my $entry = $bibtex_entry{$bibtex_field}; + $entry =~ s/%/\\%/g; + $entry = encode_utf8(convert_to_utf8($entry)); + my $start = "{"; + my $stop = "}"; + if ($bibtex_field eq 'journal') { + $start = ""; + $stop = ""; + } + $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = $start".$entry."$stop,\n"); + } + $bibtex_entry .= "}\n"; + return $bibtex_entry; +} + +=head2 bibtex_mapping + + $Reference::Output::Bibtex::bibtex_mapping{Article} = + {mapping => {author => {field => 'author', + join => ' and ', + params => [], + }, + volume => 'volume', + Articlce => 'name', + foo => 'bar', + }, + order => [qw(name author volume foo)], + }; + +This variable holds the mapping to bibtex output. + +Each type of reference has its own keys. Currently the following types +are supported by the Bibtex output method: + +=over + +=item article + +=item collection + +=item book + +=back + +If you wish to add support for your own custom reference type, you +merely need to add a bibtex_mapping element to your class's hashref, +or add to this variable. [Preferbly the former, as the latter should +only be used by the end user.] + +The mapping key in the reference type hashref is a hashref containing +key value pairs according to the following metric: + +=over + +=item If the mapping key value is not a reference, the value is used +as the name function to call via C<$reference->field>. [In the example +above, the volume mapping is built by a call to +C<$reference->volume>]. + +=item If the mapping key value is a hashref, the hashref contains two +keys. The C key contains the name of the function to call. The +C key contains the parameters + +=back + +The order key in the reference type hashref is an arrayref which +defines the order in which keys are listed in the BibTeX +output. Values in the arrayref should be the keys of the mapping +hashref. [The first value listed is the type of reference/reference +name pair.] + + +=cut + + +%bibtex_mapping = +(article => {mapping => {Article => 'name', + author => 'author', + title => 'title', + journal => 'journal', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + pmid => 'pmid', + mlid => 'medline_id', + doi => 'doi', + html => 'html', + pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract pmid mlid doi + html pdf), + ], + }, + book => {mapping => {Book => 'name', + author => 'author', + title => 'title', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + doi => 'doi', + # html => 'html', + # pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract doi html pdf), + ], + }, +); + +=head2 convert_to_utf8 + + $utf8 = convert_to_utf8("text","charset"); + +=cut + +sub convert_to_utf8 { + my ($data,$charset,$internal_call) = @_; + $internal_call //= 0; + if (is_utf8($data)) { + # cluck("utf8 flag is set when calling convert_to_utf8"); + return $data; + } + if (not length $data) { + return $data; + } + $charset = uc($charset//'UTF-8'); + if ($charset eq 'RAW') { + # croak("Charset must not be raw when calling convert_to_utf8"); + } + my $iconv_converter; + eval { + $iconv_converter = Text::Iconv->new($charset,"UTF-8") or + die "Unable to create converter for '$charset'"; + }; + if ($@) { + return undef if $internal_call; + warn $@; + # We weren't able to create the converter, so use Encode + # instead + return __fallback_convert_to_utf8($data,$charset); + } + my $converted_data = $iconv_converter->convert($data); + # if the conversion failed, retval will be undefined or perhaps + # -1. + my $retval = $iconv_converter->retval(); + if (not defined $retval or + $retval < 0 + ) { + # try iso8559-1 first + if (not $internal_call) { + my $call_back_data = convert_to_utf8($data,'ISO8859-1',1); + # if there's an à (0xC3), it's probably something + # horrible, and we shouldn't try to convert it. + if (defined $call_back_data and $call_back_data !~ /\x{C3}/) { + # warn "failed to convert to utf8 (charset: $charset, data: $data), but succeeded with ISO8859-1: ".encode_utf8($call_back_data); + return $call_back_data; + } + } + warn "failed to convert to utf8 (charset: $charset, data: $data)"; + # Fallback to encode, which will probably also fail. + return __fallback_convert_to_utf8($data,$charset); + } + return decode("UTF-8",$converted_data); +} + +# this returns data in perl's internal encoding +sub __fallback_convert_to_utf8 { + my ($data, $charset) = @_; + # raw data just gets returned (that's the charset WordDecorder + # uses when it doesn't know what to do) + return $data if $charset eq 'raw'; + if (not defined $charset and not is_utf8($data)) { + warn ("Undefined charset, and string '$data' is not in perl's internal encoding"); + return $data; + } + # lets assume everything that doesn't have a charset is utf8 + $charset //= 'utf8'; + my $result; + eval { + $result = decode($charset,$data,0); + }; + if ($@) { + warn "Unable to decode charset; '$charset' and '$data': $@"; + return $data; + } + return $result; +} + + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Output/Filename.pm b/blib/lib/Reference/Output/Filename.pm new file mode 100644 index 0000000..3fd2696 --- /dev/null +++ b/blib/lib/Reference/Output/Filename.pm @@ -0,0 +1,92 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2009 by Don Armstrong . +# $Id: Filename.pm 43 2009-03-20 06:33:14Z don $ + +package Reference::Output::Filename; + +=head1 NAME + +Reference::Output::Filename -- Output a filename for the reference + +=head1 SYNOPSIS + + print filename($reference); + +Returns a filename for the reference + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); + +use base qw(Exporter); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 36 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = qw(filename); + @EXPORT_OK = qw(); + %EXPORT_TAGS = (output => [qw(filename)], + ); + Exporter::export_ok_tags(qw(output)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +# Assigned and discussed at the end of this file +my %bibtex_mapping; + +use Carp; + + +=head2 filename + + print filename($reference).'.pdf'; + +Returns a filename for a reference + +=cut + +sub filename{ + my $reference = shift; + + my $title = eval { $reference->title(); }; + my $fauthor = eval { $reference->first_author(output=>'last'); }; + my $cauthor = eval { $reference->corresponding_author(output=>'last');}; + if (defined $fauthor and defined $cauthor and $fauthor eq $cauthor) { + $fauthor = undef; + } + my $journal = eval { $reference->journal(output =>'bibtex');}; + my $volume = eval {$reference->volume();}; + my $number = eval {$reference->number();}; + my $page = eval{$reference->pages(output => 'bibtex');}; + $page =~ s/\s*--\s*\d+\s*// if defined $page; + my $year = eval{$reference->date(output=>'year');}; + my $pmid = eval{$reference->pmid();}; + + return join('_', + map {s/\W+/_/g; $_} map{defined $_ ?$_:()} + ($title,$fauthor,$cauthor, + $journal,$volume,$number,$page,$year,defined $pmid?"pmid_$pmid":undef)); + + + } + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Retrieve/HTML/Miner.pm b/blib/lib/Reference/Retrieve/HTML/Miner.pm new file mode 100644 index 0000000..3c934f4 --- /dev/null +++ b/blib/lib/Reference/Retrieve/HTML/Miner.pm @@ -0,0 +1,45 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Miner.pm 30 2004-06-29 10:26:20Z don $ + +package ; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 30 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Retrieve/PubMed.pm b/blib/lib/Reference/Retrieve/PubMed.pm new file mode 100644 index 0000000..553245d --- /dev/null +++ b/blib/lib/Reference/Retrieve/PubMed.pm @@ -0,0 +1,580 @@ +# This module is part of Refence, and is released under the terms of +# the GPL version 2, or any later version. See the file README and +# COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: PubMed.pm 45 2013-09-10 18:05:31Z don $ + +package Reference::Retrieve::PubMed; + +=head1 NAME + +Reference::Retrieve::PubMed -- Reference Retrieval from PubMed + +=head1 SYNOPSIS + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',limit=>50); + + +=head1 DESCRIPTION + +Uh. Retreives references from pubmed. Yeah. + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); +use Carp; + +use LWP::UserAgent; +use XML::Simple qw(:strict); +use Reference; + +use HTML::Entities; + +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 45 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 get_reference + +=head3 Usage + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',-limit=>50); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>{author=>'John Smith', pages=>'230'},-limit=>50) + +=head3 Function + +Retrives a reference from pubmed + +=head3 Returns + +In scalar context, effectively assumes -limit=>1 and returns the +highest listed reference according to the order, etc. [Probably only +usefull with -pmid.] In list context, returns all results (or until it +hits the -limit.) + +=head3 Args + +list of arguments to select a reference or collection of references from. + + +=cut + +sub get_reference{ + my %options = validate_with(params => @_, + spec => {pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/query.fcgi?cmd=Text&db=PubMed&dopt=XML&uid='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + }, + allow_extra => 1, + ); + my $ua = new LWP::UserAgent(agent => $options{ua_agent}); +} + +sub get_reference_by_pmid($;@){ + my %options = validate_with(params => \@_, + spec => {pmid => {type => SCALAR|ARRAYREF, + #regex => qr/^\d+$/, + }, + pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/eutils/efetch.fcgi?db=pubmed&retmode=xml&rettype=full&id='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + useragent => {optional => 1}, + }, + allow_extra => 1, + ); + my $pmid = $options{pmid}; + + my $ua; + if ($options{useragent}) { + $ua = $options{useragent}; + } + else { + $ua = new LWP::UserAgent(agent=>$options{ua_agent}); + } + my $url = "$options{pubmed_site}$options{pmid_query}" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # For some dumb reason, they send us xml with html + # entities. Ditch them. + #$response = decode_entities($response); + # It's even more freaking broken; they don't double encode them. + #$response =~ s/\>(\s|$)/>$1/gso; + #$response =~ s/(?:(\s)\<|<(\/))/$1<$2/gso; + $response =~ s/"/"/gso; + + # Ditch any doctype + $response =~ s/^\s*<\?xml[^>]+>\s*//gso; + $response =~ s/^\s*<\!DOCTYPE[^>]+>\s*//gso; + # There is also a Pubmedarticleset + $response =~ s/^\s*\s*//gso; + $response =~ s#\s*$##gso; + + # Add the opt so we get an array of PubMedArticle + $response = "$response"; + + print STDERR $response if $DEBUG; + + # Figure out if there was an error in the search. + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => [ 'PubmedArticle' ],KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct) if $DEBUG; + # Handle the XML structure + my @references; + foreach my $ref (@{$ref_struct->{PubmedArticle}}) { + my $reference = _create_reference_from_xml($ref,$ua); + if (not defined $reference) { + warn "Unable to create reference for $ref->{MedlineCitation}->{PMID}\n"; + } + push @references, $reference; + } + if (wantarray) { + return @references; + } + return $references[0]; +} + +sub _create_reference_from_xml($$){ + my ($ref,$ua) = @_; + + # Figure out what type of reference this is. We only support + # Journal Articles right now. + my $types = {'journal article'=>'article', + 'letter' =>'article', + 'editorial' => 'article', + 'review' => 'article', + }; + my $ref_type = undef; + my $reference = undef; + foreach my $type (keys %{$types}) { + if (ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq 'ARRAY'){ + my $pubtypes; + @{$pubtypes}{map {lc} @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}} = + (1) x @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}; + if ($pubtypes->{$type}) { + $ref_type = $types->{$type}; + last; + } + else { + next; + } + } + elsif (lc($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq lc($type)) { + $ref_type = $types->{$type}; + last; + } + } + if (not defined $ref_type) { + warn "Unsupported PublicationType: ".(ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType})? + join(',',@{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}): + $ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}); + print STDERR Dumper($ref) if $DEBUG; + $ref_type = 'article'; + } + local $_ = $ref_type; + if (/article/) { + use Reference::Type::Article; + $reference = new Reference::Type::Article; + my $xml_mapping = {author => [ _fix_medline_authors($ref->{MedlineCitation}->{Article}->{AuthorList}) ], + title => [_fix_medline_title($ref->{MedlineCitation}->{Article}->{ArticleTitle})], + abstract => [_fix_medline_abstract($ref->{MedlineCitation}->{Article}->{Abstract}->{AbstractText})], + journal => [_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua, + #@_, # configuration + )], + _fix_ids($ref), + # pmid => $ref->{MedlineCitation}->{PMID}, + # medline_id => $ref->{MedlineCitation}->{MedlineID}, + volume => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Volume})], + date => [_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})], + number => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Issue})], + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], +# keywords => [_fix_medline_keywords($ref->{MedlineCitation}->{MeshHeadingList}, +# $ref->{MedlineCitation}->{ChemicalList}, +# )], +# &_find_pubmed_links($ref->{MedlineCitation}->{PMID},$ua), + }; + # Deal with author + + foreach my $reference_key (keys %{$xml_mapping}) { + my $method = $reference->can($reference_key); + die "Reference::Type::Article was unable to handle $reference_key" if not $method; + if (defined $xml_mapping->{$reference_key} and $method) { + if (ref($xml_mapping->{$reference_key})) { + &{$method}($reference,@{$xml_mapping->{$reference_key}}); + } + else { + &{$method}($reference,$xml_mapping->{$reference_key}); + } + } + else { + warn "Reference_key $reference_key was not defined or unable to handle type of key." + if not defined $xml_mapping->{$reference_key} and $DEBUG; + } + } + return $reference; + } +} + +sub _fix_medline_title($){ + my $title = shift; + + $title =~ s/\.$//; + return $title; +} + +sub _fix_medline_abstract{ + my $abstract = shift; + my $ret = ''; + if (ref($abstract) and ref($abstract) eq 'ARRAY') { + for my $element (@{$abstract}) { + $ret .= "\n" if length $ret; + $ret .= $element->{Label}.': '.$element->{content}; + } + return $ret; + } else { + return $abstract; + } +} + + +sub _fix_medline_authors($){ + my $author_list = shift; + $author_list = $author_list->{Author}; + my @authors; + $author_list = [$author_list] if ref($author_list) ne 'ARRAY'; + foreach my $author (@{$author_list}) { + my %au; + $au{first} = $author->{ForeName} if exists $author->{ForeName}; + $au{last} = $author->{LastName} if exists $author->{LastName}; + $au{initials} = $author->{Initials} if exists $author->{Initials}; + $au{full}; + push @authors,\%au; + } + return (author=>\@authors); +} + +=head2 _fix_medline_journal + +=head3 Usage + + $reference->journal(_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua,)); + +=head3 Function + +From the medline citation informatino returns a properly formatted +list of information for the journal reference listing. + +=head3 Args + +Journal information hashref + +medline journal information hashref + +user agent + +=cut + +sub _fix_medline_journal($$$;){ + my ($journal,$medline_journal,$ua) = @_; + # journal takes fullname, issn, medlineabbr, pmid, and nlmuid + # Try to supply as much as possible. + # Use esearch to get pmjournalid + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=0021-9258 + # use esummary to retreive the journalid + # + # + # + # 1 + # 1 + # 0 + # + # 4559 + # + # + # + # + # + # + # 0021-9258[All Fields] + # All Fields + # 1 + # + # Y + # + # + # + + my $ISSN = $journal->{ISSN}; + if (ref $ISSN) { + $ISSN = $ISSN->{content}; + } + my $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=$ISSN); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my ($journal_id) = $response =~ m#\s*(\d+)\s*#i; + + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559 + # + # + # + # + # 4559 + # The Journal of biological chemistry. + # J Biol Chem + # J. Biol. Chem. + # 2985121R + # + # 0021-9258 + # 1083-351X + # 1905 + # + # American Society for Biochemistry and Molecular Biology + # eng + # + # United States + # + # + # + $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esummary.fcgi?db=journals&id=$journal_id); + print STDERR "url: $url" if $DEBUG; + $request = HTTP::Request->new('GET', $url); + $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my %journal; + while ($response =~ m{^\s*(?:(?:\s*(\d+))| # Match ids + (?:\s*([^<]+?)))\s* # Match item Name clauses + $}ixmg) { + if (not defined $2) { + $journal{id} = $1; + } + else { + $journal{lc($2)} = $3; + } + } + my %journal_mapping = (title => q(title), + medlineabbr => q(medabbr), + isoabbr => q(isoabbr), + nlmid => q(nlmid), + issn => q(pissn), + eissn => q(eissn), + publisher => q(publisher), + pmid => q(id) + ); + my @journal_entry; + foreach my $key (keys %journal_mapping) { + push @journal_entry,($key=>$journal{$journal_mapping{$key}}); + } + return @journal_entry; +} + +=head2 + +=head3 Usage + + $reference->date(_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})); + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _fix_medline_pubdate($){ + my ($date) = shift; + return (year=>$date->{Year},month=>$date->{Month},day=>$date->{Day}) if exists $date->{Year}; + # Ok... punt. + if (exists $date->{MedlineDate}) { + my ($year,$month,$day) = split /\s+/,$date->{MedlineDate}; + return (year=>$year,month=>$month,day=>$day) + } +} + +=head2 _fix_medline_pages + +=head3 Usage + + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], + +=head3 Function + +Returns output with a list of pages appropriate for an Article type of +reference. + +=cut + +sub _fix_medline_pages($){ + my ($pagination) = @_; + my ($start,$stop) = $pagination =~ /(\d*)\s*\-\s*(\d*)/; + if (not defined $start) { + ($start) = $pagination =~ /(\d+)/ + } + if ($start > $stop and defined $stop) { + # this must be a reduced page listing; fix it up + $stop+=$start - $start % 10 ** (int(log($stop)/log(10))+1); + } + my @return; + push @return, (start=>$start) if defined $start and $start ne ''; + push @return, (stop=>$stop) if defined $stop and $stop ne ''; + return @return; +} + +sub _find_pubmed_links($$){ + my ($pmid,$ua) = @_; + return (); + #http://eutils.ncbi.nlm.nih.gov/entrez/query/static/elink_help.html + my $url = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/elink.fcgi?dbfrom=pubmed&cmd=llinks&id=" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => ['IdUrlSet'], KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct);# if $DEBUG; + # Rearange data around Id. + my $links = {}; + map {$links->{$_->{Id}}=$_->{ObjUrl}} @{$ref_struct->{LinkSet}->{IdUrlList}->{IdUrlSet}}; + foreach my $obj_url (@{$links->{$pmid}->{ObjUrl}}) { + next unless $obj_url->{SubjectType} = 'publishers/providers'; + #@links = _find_links_from_url($obj_url->{Url},$ua); + } + # Find publisher link + # If no publisher link, use the first aggregator link. +} + +=head2 _fix_ids + + _fix_ids + + + +=cut + +sub _fix_ids { + my ($ref) = @_; + + my %ids_known = (medline => 'medline_id', + pubmed => 'pmid', + doi => 'doi', + ); + my %ids; + if (exists $ref->{PubmedData}{ArticleIdList}{ArticleId}) { + for my $art_id (ref($ref->{PubmedData}{ArticleIdList}{ArticleId}) eq 'ARRAY' ? + @{$ref->{PubmedData}{ArticleIdList}{ArticleId}}: + ($ref->{PubmedData}{ArticleIdList}{ArticleId})) { + if (exists $ids_known{$art_id->{IdType}}) { + $ids{$ids_known{$art_id->{IdType}}} = $art_id->{content}; + } + } + } + if (not exists $ids{pmid}) { + $ids{pmid} = $ref->{MedlineCitation}->{PMID} if defined $ref->{MedlineCitation}->{PMID}; + } + if (not exists $ids{medline_id}) { + $ids{medline_id} = $ref->{MedlineCitation}->{MedlineID} if defined $ref->{MedlineCitation}->{MedlineID}; + } + return %ids; +} + + +=head2 _find_links_from_url + +=head3 Usage + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _find_links_from_url($$){ + my ($link,$ua) = @_; + + + +} + +sub _fix_medline_ditch_empty($){ + my ($value) = @_; + + if (ref($value)) { + if (ref($value) eq 'HASH') { + if (scalar keys %{$value} > 0) { + return $value; + } + else { + return (); + } + } + elsif (ref($value) eq 'ARRAY') { + if (scalar @{$value} > 0) { + return $value; + } + else { + return (); + } + } + else { + return (); + } + } + else { + return $value if defined $value; + return (); + } +} + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/Reference/Type/Article.pm b/blib/lib/Reference/Type/Article.pm new file mode 100644 index 0000000..b309071 --- /dev/null +++ b/blib/lib/Reference/Type/Article.pm @@ -0,0 +1,166 @@ +# This module is part of , and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Article.pm 30 2004-06-29 10:26:20Z don $ + +package Reference::Type::Article; + +=head1 NAME + +Reference::Type::Article -- Article reference type + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($VERSION $DEBUG); +use Carp; + +use base qw(Reference Reference::Field::Author Reference::Field::Pages Reference::Field::Journal Reference::Field::Date); + +use NEXT; +use Reference; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($VERSION) = q$LastChangedRevision: 30 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 name + +=head3 Usage + + $article->name($article_name); + my $article_name = $article->name; + +=head3 Function + +Returns the article name if it has been set, or builds an article name +from the author, journal, volume, and page if none is set. + +=cut + +sub name{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{name} = shift; + } + else { + %params = validate_with(params => \@_, + spec => {name => {type => SCALAR, + optional => 1, + }, + output => {type => SCALAR, + default => 'scalar', + }, + }, + ); + } + + if (defined $params{name}) { + $self->{reference}->{name} = $params{name}; + return $params{name}; + } + if (not defined $self->{reference}->{name}) { + my ($name) = $self->first_author =~ /(\w+)$/; + if (not defined $name) { + no warnings qw(uninitialized); + $name = $self->journal . $self->volume . $self->pages; + } + $name .= $self->year if defined $self->year; + $self->{reference}->{name} = $name; + return $name; + } + else { + return $self->{reference}->{name}; + } +} + +=head2 ref_fields + +=head3 Usage + + my @ref_fields = $self->ref_fields; + +=head3 Returns + +Returns the list of reference fields which this type of reference +supports. + +=cut + +sub ref_fields($){ + my $self = shift; + + return qw(author title year abstract journal pmid medline_id volume date number pages keywords doi html pdf month); +} + + +=head2 _init + +=head3 Usage + +Called by Reference's new function + +=head3 Function + +Call superclass's _init function [C<$self->NEXT::_init>], set up the +bibtex_mapping and bibtex_order. + +=cut + +sub _init($){ + my $self = shift; + + $self->NEXT::_init; + $self->{type} = 'article'; +# $self->{bibtex_mapping} = {Article => 'name', +# author => 'author', +# title => 'title', +# journal => 'journal', +# year => 'year', +# key => 'keywords', +# volume => 'volume', +# number => 'number', +# pages => 'pages', +# month => 'month', +# abstract => 'abstract', +# pmid => 'pmid', +# mlid => 'medline_id', +# # doi => 'doi', +# # html => 'html', +# # pdf => 'pdf', +# }; +# $self->{bibtex_order} = [qw(Article author title journal +# year key volume number pages +# month abstract pmid mlid doi +# html pdf),]; +} + + + + +1; + + +__END__ + + + + + + diff --git a/blib/lib/auto/Reference/.exists b/blib/lib/auto/Reference/.exists new file mode 100644 index 0000000..e69de29 diff --git a/blib/man1/.exists b/blib/man1/.exists new file mode 100644 index 0000000..e69de29 diff --git a/blib/man1/get_reference.1p b/blib/man1/get_reference.1p new file mode 100644 index 0000000..130f6e8 --- /dev/null +++ b/blib/man1/get_reference.1p @@ -0,0 +1,167 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "GET_REFERENCE 1p" +.TH GET_REFERENCE 1p "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +get_reference \- Retrieve a reference from somewhere and output the +formatted reference to STDOUT. +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +get_reference [options] referenceid [referenceid ...] +.PP +.Vb 6 +\& Options: +\& \-\-pmid,\-p referenceid is a pub med id. (Default) +\& \-\-bibtex,\-b ouput in bibtex format (Default) +\& \-\-debug, \-d debugging level (Default 0) +\& \-\-help,\-h display this help +\& \-\-man,\-m display manual +.Ve +.SH "OPTIONS" +.IX Header "OPTIONS" +.IP "\fB\-\-pmid, \-p\fR" 4 +.IX Item "--pmid, -p" +The referenceid listed is a Pub Med \s-1ID\s0. (Default) +.IP "\fB\-\-bibtex, \-b\fR" 4 +.IX Item "--bibtex, -b" +Output the listed referenceid in BibTeX format. (Default) +.IP "\fB\-\-help, \-h\fR" 4 +.IX Item "--help, -h" +Display brief useage information. +.IP "\fB\-\-man, \-m\fR" 4 +.IX Item "--man, -m" +Display this manual. +.SH "EXAMPLES" +.IX Header "EXAMPLES" +.Vb 1 +\& get_reference \-p \-b \-d 1 123456; +\& +\& get_reference 123456; +.Ve diff --git a/blib/man3/.exists b/blib/man3/.exists new file mode 100644 index 0000000..e69de29 diff --git a/blib/man3/Reference.3pm b/blib/man3/Reference.3pm new file mode 100644 index 0000000..b0faef4 --- /dev/null +++ b/blib/man3/Reference.3pm @@ -0,0 +1,197 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference 3pm" +.TH Reference 3pm "2013-09-09" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +Reference \-\- Reference superclass +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.SH "BUGS" +.IX Header "BUGS" +None known. +.SS "new" +.IX Subsection "new" +.Vb 1 +\& my $reference = new Reference; +.Ve +.PP +Creates a new reference object +.SS "ref_fields" +.IX Subsection "ref_fields" +.Vb 1 +\& @$self\->{ref_fields}{$self\->ref_fields} = (1) x $self\->ref_fields; +.Ve +.PP +Returns the fields that this reference knows how to deal with (or that +should be dealt with using ref_fields). +.PP +This default implementation returns an empty list, and as such should +be overriden by all Reference::Type subclasses. +.SS "ref_field" +.IX Subsection "ref_field" +.Vb 1 +\& $reference\->ref_field(\*(Aqauthor\*(Aq,[\*(AqJohn Q. Smith\*(Aq, \*(AqRandal P. Swag\*(Aq]); +.Ve +.PP +Sets the reference field to the passed value (if any) and returns the +new value. This function is called through \s-1AUTOLOAD\s0 using the +\&\f(CW$reference\fR\->\fIfield()\fR syntax. +.PP +Returns the new setting of passed field. +.PP +Scalar fieldname, and an optional scalar, arrayref, or hashref to set +reference field. +.SS "\s-1AUTOLOAD\s0" +.IX Subsection "AUTOLOAD" +Dispatches calls to \f(CW$reference\fR\->fieldname to +\&\f(CW$reference\fR\->ref_field('fieldname'). +.PP +\&\s-1XXX\s0 I really wish there was a way to tell perl that we don't want to +\&\s-1XXX\s0 handle a call to \s-1AUTOLOAD\s0. +.SS "can" +.IX Subsection "can" +.Vb 2 +\& $obj\->can(\*(AqMETHOD\*(Aq); +\& Class::Modular\->can(\*(AqMETHOD\*(Aq); +.Ve +.PP +Replaces \s-1UNIVERSAL\s0's can method so that handled methods are reported +correctly. Calls UNIVERSAL::can in the places where we don't know +anything it doesn't. +.PP +Returns a coderef to the method if the method is supported, undef +otherwise. +.SS "_init" +.IX Subsection "_init" +.Vb 1 +\& $self\->_init +.Ve diff --git a/blib/man3/Reference::Field::Author.3pm b/blib/man3/Reference::Field::Author.3pm new file mode 100644 index 0000000..afdd1b4 --- /dev/null +++ b/blib/man3/Reference::Field::Author.3pm @@ -0,0 +1,224 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Field::Author 3pm" +.TH Reference::Field::Author 3pm "2009-03-23" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +Reference::Field::Author \-\- +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.SH "TODO" +.IX Header "TODO" +\&\s-1XXX\s0 Allow the corresponding author to be set explicitely +.PP +\&\s-1XXX\s0 To do this, we need to break away from using the author field as +an arrayref, and instead use a hashref with the author fields, and a +specific corresponding author setting. [This should probaly be de +riguer for other fields as well.] +.SH "BUGS" +.IX Header "BUGS" +None known. +.SS "author" +.IX Subsection "author" +\fIUsage\fR +.IX Subsection "Usage" +.PP +\fIFunction\fR +.IX Subsection "Function" +.PP +\fIReturns\fR +.IX Subsection "Returns" +.PP +\fIArgs\fR +.IX Subsection "Args" +.SS "corresponding_author" +.IX Subsection "corresponding_author" +.Vb 1 +\& my $corresponding_author = $ref\->corresponding_author; +.Ve +.PP +Returns the corresponding author (the last author listed.) +.SS "first_author" +.IX Subsection "first_author" +.Vb 1 +\& my $first_author = $ref\->first_author; +.Ve +.PP +Returns the first author (primary author.) +.SS "_parse_author" +.IX Subsection "_parse_author" +.Vb 1 +\& my $author_info = _parse_author($author); +.Ve +.PP +Parses the author and returns an author record. +.PP +Author record +.PP +The author can be specified in a few different ways: +.IP "\s-1SCALAR\s0 Author Name" 4 +.IX Item "SCALAR Author Name" +.RS 4 +.PD 0 +.IP "\s-1SMITH\s0 John W." 4 +.IX Item "SMITH John W." +.IP "Smith \s-1JW\s0" 4 +.IX Item "Smith JW" +.IP "John W. Smith" 4 +.IX Item "John W. Smith" +.IP "John Wilkenson Smith" 4 +.IX Item "John Wilkenson Smith" +.IP "\s-1HASHREF\s0 Author structure" 4 +.IX Item "HASHREF Author structure" +.IP "\s-1ARRAYREF\s0 Author Name" 4 +.IX Item "ARRAYREF Author Name" +.RE +.RS 4 +.PD +.Sp +In these cases, the author's name should be parsed appropriately. [\s-1XXX\s0 +Needs to be extended to handle Smith, John W. appropriately.] +.RE +.SS "_delete_author" +.IX Subsection "_delete_author" +\&\s-1XXX\s0 \s-1NOT\s0 \s-1IMPLEMENTED\s0 +.SS "_init" +.IX Subsection "_init" +Called by Reference's new function +.PP +Call superclass's _init function [\f(CW\*(C`$self\-\*(C'\fRNEXT::_init>], sets up the +author list reference. +.SH "POD ERRORS" +.IX Header "POD ERRORS" +Hey! \fBThe above document had some coding errors, which are explained below:\fR +.IP "Around line 282:" 4 +.IX Item "Around line 282:" +You forgot a '=back' before '=head2' diff --git a/blib/man3/Reference::Field::Date.3pm b/blib/man3/Reference::Field::Date.3pm new file mode 100644 index 0000000..b9ee4b7 --- /dev/null +++ b/blib/man3/Reference::Field::Date.3pm @@ -0,0 +1,154 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Field::Date 3pm" +.TH Reference::Field::Date 3pm "2009-03-23" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +.Vb 1 +\& \-\- +.Ve +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.SH "BUGS" +.IX Header "BUGS" +None known. +.SS "date" +.IX Subsection "date" +\&\s-1XXX\s0 \s-1DOCUMENT\s0 \s-1ME\s0 +.SS "year" +.IX Subsection "year" +Returns the year associated with the date field +.SS "day" +.IX Subsection "day" +Returns the day associated with the date field +.SS "month" +.IX Subsection "month" +Returns the month associated with the date field diff --git a/blib/man3/Reference::Field::Journal.3pm b/blib/man3/Reference::Field::Journal.3pm new file mode 100644 index 0000000..fa8ceb4 --- /dev/null +++ b/blib/man3/Reference::Field::Journal.3pm @@ -0,0 +1,142 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Field::Journal 3pm" +.TH Reference::Field::Journal 3pm "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +.Vb 1 +\& \-\- +.Ve +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.SH "BUGS" +.IX Header "BUGS" +None known. diff --git a/blib/man3/Reference::Field::Pages.3pm b/blib/man3/Reference::Field::Pages.3pm new file mode 100644 index 0000000..d8762ae --- /dev/null +++ b/blib/man3/Reference::Field::Pages.3pm @@ -0,0 +1,142 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Field::Pages 3pm" +.TH Reference::Field::Pages 3pm "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +.Vb 1 +\& \-\- +.Ve +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.SH "BUGS" +.IX Header "BUGS" +None known. diff --git a/blib/man3/Reference::Output::Bibtex.3pm b/blib/man3/Reference::Output::Bibtex.3pm new file mode 100644 index 0000000..4d28c5c --- /dev/null +++ b/blib/man3/Reference::Output::Bibtex.3pm @@ -0,0 +1,231 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Output::Bibtex 3pm" +.TH Reference::Output::Bibtex 3pm "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +Reference::Output::Bibtex \-\- Output references in BibTeX format +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.Vb 1 +\& print bibtex($reference); +.Ve +.PP +Returns a reference formatted in bibtex format. +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +Knows how to handle the reference\-> bibtex field mapping for many +reference types, but overridden types may need to provide their own +mapping. +.SH "BUGS" +.IX Header "BUGS" +None known. +.SS "bibtex" +.IX Subsection "bibtex" +.Vb 3 +\& print bibtex $reference; +\& %bibtex = bibtex $reference; +\& print bibtex($reference,mapping=>{...}) +.Ve +.PP +In scalar context, returns a formatted bibtex entry, suitable for +printing. In list context, returns a hash of key, value pairs which +can be used to print a formatted bibtex entry. +.PP +You can also pass an optional mapping to be used for making the bibtex +entry. See \fBbibtex_mapping\fR for the details. +.PP +The mappings are obeyed in the following order, the first taking +precedence over the last. +.IP "Passed mapping" 4 +.IX Item "Passed mapping" +.PD 0 +.IP "Object's bibtex_mapping" 4 +.IX Item "Object's bibtex_mapping" +.IP "Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping)" 4 +.IX Item "Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping)" +.PD +.PP +Returns a \s-1SCALAR\s0 bibtex reference in scalar context, a \s-1HASH\s0 bibtex +reference in list context +.SS "bibtex_mapping" +.IX Subsection "bibtex_mapping" +.Vb 11 +\& $Reference::Output::Bibtex::bibtex_mapping{Article} = +\& {mapping => {author => {field => \*(Aqauthor\*(Aq, +\& join => \*(Aq and \*(Aq, +\& params => [], +\& }, +\& volume => \*(Aqvolume\*(Aq, +\& Articlce => \*(Aqname\*(Aq, +\& foo => \*(Aqbar\*(Aq, +\& }, +\& order => [qw(name author volume foo)], +\& }; +.Ve +.PP +This variable holds the mapping to bibtex output. +.PP +Each type of reference has its own keys. Currently the following types +are supported by the Bibtex output method: +.IP "article" 4 +.IX Item "article" +.PD 0 +.IP "collection" 4 +.IX Item "collection" +.IP "book" 4 +.IX Item "book" +.PD +.PP +If you wish to add support for your own custom reference type, you +merely need to add a bibtex_mapping element to your class's hashref, +or add to this variable. [Preferbly the former, as the latter should +only be used by the end user.] +.PP +The mapping key in the reference type hashref is a hashref containing +key value pairs according to the following metric: +.ie n .IP "If the mapping key value is not a reference, the value is used as the name function to call via ""$reference\-""field>. [In the example above, the volume mapping is built by a call to ""$reference\-""volume>]." 4 +.el .IP "If the mapping key value is not a reference, the value is used as the name function to call via \f(CW$reference\-\fRfield>. [In the example above, the volume mapping is built by a call to \f(CW$reference\-\fRvolume>]." 4 +.IX Item "If the mapping key value is not a reference, the value is used as the name function to call via $reference-field>. [In the example above, the volume mapping is built by a call to $reference-volume>]." +.PD 0 +.ie n .IP "If the mapping key value is a hashref, the hashref contains two keys. The ""field"" key contains the name of the function to call. The ""params"" key contains the parameters" 4 +.el .IP "If the mapping key value is a hashref, the hashref contains two keys. The \f(CWfield\fR key contains the name of the function to call. The \f(CWparams\fR key contains the parameters" 4 +.IX Item "If the mapping key value is a hashref, the hashref contains two keys. The field key contains the name of the function to call. The params key contains the parameters" +.PD +.PP +The order key in the reference type hashref is an arrayref which +defines the order in which keys are listed in the BibTeX +output. Values in the arrayref should be the keys of the mapping +hashref. [The first value listed is the type of reference/reference +name pair.] +.SS "convert_to_utf8" +.IX Subsection "convert_to_utf8" +.Vb 1 +\& $utf8 = convert_to_utf8("text","charset"); +.Ve diff --git a/blib/man3/Reference::Output::Filename.3pm b/blib/man3/Reference::Output::Filename.3pm new file mode 100644 index 0000000..138978a --- /dev/null +++ b/blib/man3/Reference::Output::Filename.3pm @@ -0,0 +1,150 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Output::Filename 3pm" +.TH Reference::Output::Filename 3pm "2009-03-23" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +Reference::Output::Filename \-\- Output a filename for the reference +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.Vb 1 +\& print filename($reference); +.Ve +.PP +Returns a filename for the reference +.SH "BUGS" +.IX Header "BUGS" +None known. +.SS "filename" +.IX Subsection "filename" +.Vb 1 +\& print filename($reference).\*(Aq.pdf\*(Aq; +.Ve +.PP +Returns a filename for a reference diff --git a/blib/man3/Reference::Retrieve::HTML::Miner.3pm b/blib/man3/Reference::Retrieve::HTML::Miner.3pm new file mode 100644 index 0000000..d8d4f71 --- /dev/null +++ b/blib/man3/Reference::Retrieve::HTML::Miner.3pm @@ -0,0 +1,142 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Retrieve::HTML::Miner 3pm" +.TH Reference::Retrieve::HTML::Miner 3pm "2007-07-03" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +.Vb 1 +\& \-\- +.Ve +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.SH "BUGS" +.IX Header "BUGS" +None known. diff --git a/blib/man3/Reference::Retrieve::PubMed.3pm b/blib/man3/Reference::Retrieve::PubMed.3pm new file mode 100644 index 0000000..df3edb7 --- /dev/null +++ b/blib/man3/Reference::Retrieve::PubMed.3pm @@ -0,0 +1,247 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Retrieve::PubMed 3pm" +.TH Reference::Retrieve::PubMed 3pm "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +Reference::Retrieve::PubMed \-\- Reference Retrieval from PubMed +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.Vb 2 +\& my $reference = Reference::Retrieve::PubMed::get_reference(\-pmid=>123456); +\& my @references = Reference::Retrieve::PubMed::get_reference(\-query=>\*(AqJohn Smith[AUTHOR] AND 230[Pages]\*(Aq,limit=>50); +.Ve +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +Uh. Retreives references from pubmed. Yeah. +.SH "BUGS" +.IX Header "BUGS" +None known. +.SS "get_reference" +.IX Subsection "get_reference" +\fIUsage\fR +.IX Subsection "Usage" +.PP +.Vb 3 +\& my $reference = Reference::Retrieve::PubMed::get_reference(\-pmid=>123456); +\& my @references = Reference::Retrieve::PubMed::get_reference(\-query=>\*(AqJohn Smith[AUTHOR] AND 230[Pages]\*(Aq,\-limit=>50); +\& my @references = Reference::Retrieve::PubMed::get_reference(\-query=>{author=>\*(AqJohn Smith\*(Aq, pages=>\*(Aq230\*(Aq},\-limit=>50) +.Ve +.PP +\fIFunction\fR +.IX Subsection "Function" +.PP +Retrives a reference from pubmed +.PP +\fIReturns\fR +.IX Subsection "Returns" +.PP +In scalar context, effectively assumes \-limit=>1 and returns the +highest listed reference according to the order, etc. [Probably only +usefull with \-pmid.] In list context, returns all results (or until it +hits the \-limit.) +.PP +\fIArgs\fR +.IX Subsection "Args" +.PP +list of arguments to select a reference or collection of references from. +.SS "_fix_medline_journal" +.IX Subsection "_fix_medline_journal" +\fIUsage\fR +.IX Subsection "Usage" +.PP +.Vb 3 +\& $reference\->journal(_fix_medline_journal($ref\->{MedlineCitation}\->{Article}\->{Journal}, +\& $ref\->{MedlineCitation}\->{Article}\->{MedlineJournalInfo}, +\& $ua,)); +.Ve +.PP +\fIFunction\fR +.IX Subsection "Function" +.PP +From the medline citation informatino returns a properly formatted +list of information for the journal reference listing. +.PP +\fIArgs\fR +.IX Subsection "Args" +.PP +Journal information hashref +.PP +medline journal information hashref +.PP +user agent +.SS "" +.IX Subsection "" +\fIUsage\fR +.IX Subsection "Usage" +.PP +.Vb 1 +\& $reference\->date(_fix_medline_pubdate($ref\->{MedlineCitation}\->{Article}\->{Journal}\->{JournalIssue}\->{PubDate})); +.Ve +.PP +\fIFunction\fR +.IX Subsection "Function" +.PP +\fIReturns\fR +.IX Subsection "Returns" +.PP +\fIArgs\fR +.IX Subsection "Args" +.SS "_fix_medline_pages" +.IX Subsection "_fix_medline_pages" +\fIUsage\fR +.IX Subsection "Usage" +.PP +.Vb 1 +\& pages => [_fix_medline_pages($ref\->{MedlineCitation}\->{Article}\->{Pagination}\->{MedlinePgn})], +.Ve +.PP +\fIFunction\fR +.IX Subsection "Function" +.PP +Returns output with a list of pages appropriate for an Article type of +reference. +.SS "_fix_ids" +.IX Subsection "_fix_ids" +.Vb 1 +\& _fix_ids +.Ve +.SS "_find_links_from_url" +.IX Subsection "_find_links_from_url" +\fIUsage\fR +.IX Subsection "Usage" +.PP +\fIFunction\fR +.IX Subsection "Function" +.PP +\fIReturns\fR +.IX Subsection "Returns" +.PP +\fIArgs\fR +.IX Subsection "Args" diff --git a/blib/man3/Reference::Type::Article.3pm b/blib/man3/Reference::Type::Article.3pm new file mode 100644 index 0000000..3ae18fd --- /dev/null +++ b/blib/man3/Reference::Type::Article.3pm @@ -0,0 +1,181 @@ +.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16) +.\" +.\" Standard preamble: +.\" ======================================================================== +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Vb \" Begin verbatim text +.ft CW +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. \*(C+ will +.\" give a nicer C++. Capital omega is used to do unbreakable dashes and +.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, +.\" nothing in troff, for use with C<>. +.tr \(*W- +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` "" +. ds C' "" +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" Escape single quotes in literal strings from groff's Unicode transform. +.ie \n(.g .ds Aq \(aq +.el .ds Aq ' +.\" +.\" If the F register is turned on, we'll generate index entries on stderr for +.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index +.\" entries marked with X<> in POD. Of course, you'll have to process the +.\" output yourself in some meaningful fashion. +.ie \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +.. +. nr % 0 +. rr F +.\} +.el \{\ +. de IX +.. +.\} +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +.\" ======================================================================== +.\" +.IX Title "Reference::Type::Article 3pm" +.TH Reference::Type::Article 3pm "2007-07-03" "perl v5.14.2" "User Contributed Perl Documentation" +.\" For nroff, turn off justification. Always turn off hyphenation; it makes +.\" way too many mistakes in technical documents. +.if n .ad l +.nh +.SH "NAME" +Reference::Type::Article \-\- Article reference type +.SH "SYNOPSIS" +.IX Header "SYNOPSIS" +.SH "DESCRIPTION" +.IX Header "DESCRIPTION" +.SH "BUGS" +.IX Header "BUGS" +None known. +.SS "name" +.IX Subsection "name" +\fIUsage\fR +.IX Subsection "Usage" +.PP +.Vb 2 +\& $article\->name($article_name); +\& my $article_name = $article\->name; +.Ve +.PP +\fIFunction\fR +.IX Subsection "Function" +.PP +Returns the article name if it has been set, or builds an article name +from the author, journal, volume, and page if none is set. +.SS "ref_fields" +.IX Subsection "ref_fields" +\fIUsage\fR +.IX Subsection "Usage" +.PP +.Vb 1 +\& my @ref_fields = $self\->ref_fields; +.Ve +.PP +\fIReturns\fR +.IX Subsection "Returns" +.PP +Returns the list of reference fields which this type of reference +supports. +.SS "_init" +.IX Subsection "_init" +\fIUsage\fR +.IX Subsection "Usage" +.PP +Called by Reference's new function +.PP +\fIFunction\fR +.IX Subsection "Function" +.PP +Call superclass's _init function [\f(CW\*(C`$self\-\*(C'\fRNEXT::_init>], set up the +bibtex_mapping and bibtex_order. diff --git a/blib/script/.exists b/blib/script/.exists new file mode 100644 index 0000000..e69de29 diff --git a/blib/script/get_reference b/blib/script/get_reference new file mode 100755 index 0000000..f71eb68 --- /dev/null +++ b/blib/script/get_reference @@ -0,0 +1,114 @@ +#!/usr/bin/perl + +eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if 0; # not running under some shell +# This program is part of da_reference, and is released under the +# terms of the GPL version 2, or any later version, at your +# option. See the file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id: get_reference 45 2013-09-10 18:05:31Z don $ + + +use warnings; +use strict; + + +use Getopt::Long; +use Reference; +use Pod::Usage; + +=head1 NAME + +get_reference - Retrieve a reference from somewhere and output the +formatted reference to STDOUT. + +=head1 SYNOPSIS + +get_reference [options] referenceid [referenceid ...] + + Options: + --pmid,-p referenceid is a pub med id. (Default) + --bibtex,-b ouput in bibtex format (Default) + --debug, -d debugging level (Default 0) + --help,-h display this help + --man,-m display manual + +=head1 OPTIONS + +=over + +=item B<--pmid, -p> + +The referenceid listed is a Pub Med ID. (Default) + +=item B<--bibtex, -b> + +Output the listed referenceid in BibTeX format. (Default) + +=item B<--help, -h> + +Display brief useage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + + get_reference -p -b -d 1 123456; + + get_reference 123456; + +=cut + + + +use vars qw($DEBUG); + +my %options = (pmid => 1, + bibtex => 1, + debug => 0, + help => 0, + man => 0, + suggest_name => 0, + journal_titles => 0, + ); + +GetOptions(\%options,'pmid|p','bibtex|b','suggest_name|suggest-name','debug|d','help|h','man|m', + 'journal_titles|journal-titles|journal_title|journal-titles', + ); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + +if ($options{pmid} and $options{bibtex}) { + use Reference::Type::Article; + use Reference::Retrieve::PubMed; + use Reference::Output::Bibtex; + use Reference::Output::Filename; + use Encode qw(encode_utf8); + $Reference::Retrieve::PubMed::DEBUG = $options{debug}; + foreach my $pmid (@ARGV) { + next unless ($pmid) = $pmid =~ /(\d+)/; + print STDERR "dealing with $pmid\n" if $DEBUG; + my $reference = scalar Reference::Retrieve::PubMed::get_reference_by_pmid(pmid => $pmid); + print STDERR "Unable to retrieve reference for $pmid\n" and next if not defined $reference; + if ($options{suggest_name}) { + # try to suggest a name for the reference + print '%Filename: '.lc(encode_utf8(Reference::Output::Bibtex::convert_to_utf8(filename($reference))))."\n"; + } + if ($options{journal_titles}) { + print '%Medline: @string {'.$reference->journal(output=>'bibtex').'="'. + $reference->journal(output=>'medline').qq("}\n); + print '%isoabbr: @string {'.$reference->journal(output=>'bibtex').'="'. + $reference->journal(output=>'iso').qq("}\n); + print '%full: @string {'.$reference->journal(output=>'bibtex').'="'. + $reference->journal().qq("}\n); + } + print scalar bibtex($reference); + } +} diff --git a/build-stamp b/build-stamp new file mode 100644 index 0000000..e69de29 diff --git a/install-stamp b/install-stamp new file mode 100644 index 0000000..e69de29 diff --git a/lib/Reference.pm b/lib/Reference.pm new file mode 100644 index 0000000..a650f1d --- /dev/null +++ b/lib/Reference.pm @@ -0,0 +1,229 @@ +# This module is part of , and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Reference.pm 44 2013-09-10 00:37:13Z don $ + +package Reference; + +=head1 NAME + +Reference -- Reference superclass + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($VERSION $REVISION $DEBUG); +use Carp; + + +BEGIN{ + $REVISION = '0.01'; + ($REVISION) = q$LastChangedRevision: 44 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + +our $AUTOLOAD; + + +=head2 new + + my $reference = new Reference; + + +Creates a new reference object + +=cut + +sub new{ + my $class = shift; + + $class = ref $class if ref $class; + + my $self = {}; + + bless $self, $class; + + $self->_init; + + return $self; +} + + +=head2 ref_fields + + @$self->{ref_fields}{$self->ref_fields} = (1) x $self->ref_fields; + +Returns the fields that this reference knows how to deal with (or that +should be dealt with using ref_fields). + +This default implementation returns an empty list, and as such should +be overriden by all Reference::Type subclasses. + +=cut + +sub ref_fields{ + my $self = shift; + + return (); +} + + +=head2 ref_field + + $reference->ref_field('author',['John Q. Smith', 'Randal P. Swag']); + +Sets the reference field to the passed value (if any) and returns the +new value. This function is called through AUTOLOAD using the +$reference->field() syntax. + +Returns the new setting of passed field. + +Scalar fieldname, and an optional scalar, arrayref, or hashref to set +reference field. + +=cut + +sub ref_field($$;$){ + my ($self,$field_name,$field_value) = @_; + + if ($self->{ref_fields}->{lc($field_name)}) { + # Check to make sure that only 3 arguments are passed to + # avoid triggering on the Params::Variable style of calling. + # XXX We should check explicitly for this. [See Author.pm] + if (defined $field_value and scalar(@_) == 3) { + $self->{reference}->{lc($field_name)} = $field_value; + } + return $self->{reference}->{lc($field_name)}; + } + carp "Invalid field name $field_name"; +} + + +=head2 AUTOLOAD + +Dispatches calls to $reference->fieldname to +$reference->ref_field('fieldname'). + +XXX I really wish there was a way to tell perl that we don't want to +XXX handle a call to AUTOLOAD. + +=cut + +sub AUTOLOAD{ + my $function = $AUTOLOAD; + ($function) = $function =~ /\:?([^\:]+)$/; + my $self = shift; + if (ref $self and $self->{ref_fields}->{lc($function)}) { + # slap $self and $function into @_. + unshift @_, ($self,$function); + goto &ref_field; + } + else { + croak "Undefined subroutine $function"; + } +} + +# do nothing +sub DESTROY { + +} + + +=head2 can + + $obj->can('METHOD'); + Class::Modular->can('METHOD'); + +Replaces UNIVERSAL's can method so that handled methods are reported +correctly. Calls UNIVERSAL::can in the places where we don't know +anything it doesn't. + +Returns a coderef to the method if the method is supported, undef +otherwise. + +=cut + +sub can{ + my ($self,$method,$vars) = @_; + + my $universal_can = UNIVERSAL::can($self,$method); + + if ($universal_can){ + return $universal_can; + } + elsif (ref $self and exists $self->{ref_fields}->{lc($method)}) { + # If there is no other method for dealing with this method, + # and we would normally autoload it, create an anonymous sub + # to deal with it appropriately. + return sub{my $self = shift; return $self->ref_field($method,@_);}; + } + else { + return undef; + } +} + + +=head2 _init + + $self->_init + +=cut + +sub _init($){ + my $self = shift; + + # ref_fields is used by AUTOLOAD to know when it's ok to set a + # particular field + my @ref_fields = $self->ref_fields; + @{$self->{ref_fields}}{@ref_fields} = (1) x scalar @ref_fields; +} + + + + + +# From http://www.ecst.csuchico.edu/~jacobsd/bib/formats/ + +# * BibTeX +# * INSPEC +# * MARC [MARC::Record] +# * Melvyl [Uses MARC] +# * RIS +# * MedLine +# * ISI Focus On +# * EMBL +# * BIDS +# * ProCite +# * EndNote +# * Computing Archives +# * Uniform Resource Citation +# * RFC 1807 (replaces RFC 1357) +# * Other formats + + + + + + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Field/Author.pm b/lib/Reference/Field/Author.pm new file mode 100644 index 0000000..e0ff48c --- /dev/null +++ b/lib/Reference/Field/Author.pm @@ -0,0 +1,330 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. + +# Copyright 2003, 2004 by Don Armstrong . +# $Id: Author.pm 42 2009-03-20 06:29:46Z don $ + +package Reference::Field::Author; + +=head1 NAME + +Reference::Field::Author -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 TODO + +XXX Allow the corresponding author to be set explicitely + +XXX To do this, we need to break away from using the author field as +an arrayref, and instead use a hashref with the author fields, and a +specific corresponding author setting. [This should probaly be de +riguer for other fields as well.] + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 42 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 author + +=head3 Usage + + + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub author{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{author} = shift; + $params{output} = 'scalar'; + $params{add_author} = 0; + $params{del_author} = 0; + } + else { + %params = validate_with(params => \@_, + spec => {author => {type => ARRAYREF|SCALAR|HASHREF, + optional => 1, + }, + add_author => {type => BOOLEAN, + default => 0, + }, + del_author => {type => BOOLEAN, + default => 0, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{author}) { + $self->{reference}->{author} = {authors => [], + first_author => 0, + corresponding_author => -1, + } unless $params{add_author}; + # We can't handle things like Smith, Jones, Paul, Rue; for + # obvious reasons. If you must do something so broken, you + # have to go Smith, Jones; Paul, Rue; or Smith, Jones and + # Paul, Rue. + if (not ref($params{author}) and ($params{author} =~ /\sand\,?\s/ or $params{author} =~ /\w\;\s/)) { + $params{author} = [grep /\w/, split (/\s*and,?\s*|\;\s*/,$params{author})]; + } + $params{author} = [$params{author}] unless ref($params{author}) eq 'ARRAY'; + foreach my $author (@{$params{author}}) { + my $author_info = _parse_author($author); + if (not $params{del_author}) { + push @{$self->{reference}{author}{authors}},$author_info; + } + else { + _delete_author($author_info,$author->{reference}{author}{authors}); + } + } + } + + local $_ = $params{output}; + if (/bibtex/) { + return join(' and ',map {$_->{full}} @{$self->{reference}{author}{authors}}); + } + else { + return join(', ',map {$_->{full}} @{$self->{reference}{author}{authors}}); + } + +} + +=head2 corresponding_author + + my $corresponding_author = $ref->corresponding_author; + +Returns the corresponding author (the last author listed.) + +=cut + +sub corresponding_author{ + my $self = shift; + + my %params = validate_with(params => \@_, + spec => {output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + local $_ = $params{output}; + if (/bibtex/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full}; + } + elsif (/last/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{last}; + } + else { + return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full}; + } +} + +=head2 first_author + + my $first_author = $ref->first_author; + +Returns the first author (primary author.) + +=cut + +sub first_author{ + my $self = shift; + my %params = validate_with(params => \@_, + spec => {output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + local $_ = $params{output}; + if (/bibtex/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || ''; + } + elsif (/last/) { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{last}; + } + else { + return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || ''; + } +} + + +=head2 _parse_author + + my $author_info = _parse_author($author); + +Parses the author and returns an author record. + +Author record + +The author can be specified in a few different ways: + +=over + +=item SCALAR Author Name + +=over + +=item SMITH John W. + +=item Smith JW + +=item John W. Smith + +=item John Wilkenson Smith + +=item HASHREF Author structure + +=item ARRAYREF Author Name + +=back + +In these cases, the author's name should be parsed appropriately. [XXX +Needs to be extended to handle Smith, John W. appropriately.] + + +=cut + +sub _parse_author($){ + my ($author) = @_; + + warn "Undefined author" and return undef if not defined $author; + + # the author information + my %au = (); + if (not ref($author)) { + # UGH. Try to figure out the author. + if ($author =~ /^\s*([A-Z]+)\s+([\w\s]+?)(?:\s*([A-Z])\.)?\s*$/) { # SMITH John W. + $au{first} = ucfirst(lc($2)) || ''; + $au{last} = ucfirst(lc($1)) || ''; + $au{middle} = $3 || ''; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):''); + $au{full} = join(' ',grep /\w/,($au{first},$au{middle},$au{last})); + } + elsif ($author =~ /^\s*([A-Z][\w\s]*?)\s+([A-Z]+)\s*$/) { # Smith JW + $au{first} = $2 || ''; + $au{middle} = ''; + if (length $au{first} > 1) { + $au{middle} = substr($au{first},1); + $au{first} = substr($au{first},0,1); + } + $au{last} = $1; + $au{initials} = $2; + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})) + } + elsif ($author =~ /^\s*([A-Z][\w]*?)\s+(?:([A-Z])\.|([A-Z][\w\s]*?)\s+)?\s*([A-Z][\w]*)\s*$/){ # John W. Smith or John Wilkinson Smith + $au{first} = $1; + $au{middle} = $2 || $3 || ''; + $au{last} = $4; + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})); + } + # XXX Handle Smith, John Wilkinson; Smith, JW; and Smith, John W. + else { + warn "Couldn't handle author $author"; + $au{full} = $author; + } + } + elsif (ref $author eq 'ARRAY') { + warn "Author was empty" unless scalar @{$author}; + $au{full} = join(' ',grep /\w/, @{$author}); + $au{last} = $author->[-1]; + $au{first} = $author->[0] if scalar @{$author} > 1; + $au{middle} = join(' ',grep /\w/,@{$author}[1..($#{$author}-1)]) if scalar @{$author} > 2; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):''); + } + elsif (ref $author eq 'HASH') { + foreach my $key (qw(full last middle first initials)) { + $au{$key} = ''; + $au{$key} = $author->{$key} if exists $author->{$key} and defined $author->{$key}; + } + $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})) if $au{full} eq ''; + $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') . + (($au{middle} ne '')?uc(substr($au{middle},0,1)):'') if $au{initials} eq ''; + } + else { + warn "Unknown reference: $author"; + return undef; + } + return \%au; +} + +=head2 _delete_author + + + + +XXX NOT IMPLEMENTED + +=cut + +sub _delete_author($$){ + my ($author_info,$author_list) = @_; + + die "NOT IMPLEMENTED"; +} + + +=head2 _init + +Called by Reference's new function + +Call superclass's _init function [C<$self->NEXT::_init>], sets up the +author list reference. + +=cut + +sub _init{ + my $self = shift; + + $self->{reference}->{author} = {authors => [], + first_author => 0, + corresponding_author => -1, + }; + + $self->NEXT::_init; + +} + + + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Field/Date.pm b/lib/Reference/Field/Date.pm new file mode 100644 index 0000000..7768772 --- /dev/null +++ b/lib/Reference/Field/Date.pm @@ -0,0 +1,178 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Date.pm 42 2009-03-20 06:29:46Z don $ + +package Reference::Field::Date; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); +use Date::Manip; + + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 42 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + +=head2 date + + + +XXX DOCUMENT ME + +=cut + + +sub date{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{date} = shift; + $params{output} = 'scalar'; + } + else { + %params = validate_with(params => \@_, + spec => {date => {type => ARRAYREF|SCALAR|HASHREF|UNDEF, + optional => 1, + }, + day => {type => SCALAR|UNDEF, + optional => 1, + }, + year => {type => SCALAR|UNDEF, + optional => 1, + }, + month => {type => SCALAR|UNDEF, + optional => 1, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{day} or defined $params{year} or defined $params{month}) { + $self->{reference}->{date}->{day} = $params{day} if defined $params{day}; + $self->{reference}->{date}->{year} = $params{year} if defined $params{year}; + $self->{reference}->{date}->{month} = $params{month} if defined $params{month}; + } + elsif (defined $params{date}) { + $self->{reference}->{date} = {day => undef, + year => undef, + month => undef, + }; + my $date = ParseDate($params{date}); + $self->{reference}->{date}->{unix} = $date; + ($self->{reference}->{date}->{day}, + $self->{reference}->{date}->{year}, + $self->{reference}->{date}->{month}) = UnixDate($date,qw(%e %Y %m)); + } + + local $_ = $params{output}; + if (/bibtex/) { + return UnixDate($self->{reference}->{date}->{unix},'%B %e %Y') if defined $self->{reference}->{date}->{unix}; + return join(' ',$self->{reference}->{date}->{day},$self->{reference}->{date}->{year},$self->{reference}->{date}->{month}); + } + elsif (/year/) { + return UnixDate($self->{reference}->{date}->{unix},'%Y') if defined $self->{reference}->{date}->{unix}; + return $self->{reference}->{date}->{year}; + } + else { + return UnixDate($self->{reference}->{date}->{unix},'%B %e %Y') if defined $self->{reference}->{date}->{unix}; + return join(' ',$self->{reference}->{date}->{day},$self->{reference}->{date}->{year},$self->{reference}->{date}->{month}); + } +} + +=head2 year + + + +Returns the year associated with the date field + + +=cut + + +sub year{ + my $self = shift; + + return $self->{reference}->{date}->{year}; +} + +=head2 day + + + +Returns the day associated with the date field + +=cut + +sub day{ + my $self = shift; + + return $self->{reference}->{date}->{day}; +} + +=head2 month + + + +Returns the month associated with the date field + +=cut + +sub month{ + my $self = shift; + + return $self->{reference}->{date}->{month}; +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{date} = {month => undef, + year => undef, + day => undef, + unix => undef, + }; + + $self->NEXT::_init; + +} + + + + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Field/Journal.pm b/lib/Reference/Field/Journal.pm new file mode 100644 index 0000000..ad5639a --- /dev/null +++ b/lib/Reference/Field/Journal.pm @@ -0,0 +1,110 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Journal.pm 44 2013-09-10 00:37:13Z don $ + +package Reference::Field::Journal; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG @JOURNAL_FIELDS); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 44 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + @JOURNAL_FIELDS = qw(title medlineabbr isoabbr nlmid issn eissn publisher pmid); +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{journal} = {}; + @{$self->{reference}->{journal}}{@JOURNAL_FIELDS} = (undef) x scalar @JOURNAL_FIELDS; + + $self->NEXT::_init; + +} + +sub journal{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{journal} = shift; + $params{output} = 'scalar'; + } + else { + my %spec; + @spec{@JOURNAL_FIELDS} = ({type => SCALAR|UNDEF,optional=>1}) x scalar @JOURNAL_FIELDS; + %params = validate_with(params => \@_, + spec => {journal => {type => SCALAR, + optional => 1, + }, + output => {type => SCALAR, + default => 'scalar', + }, + %spec, + }, + ); + } + # Were we called using $reference->journal(foo=>bar) {ignoring journal=>bar} ? + my $using_param_call = 0; + foreach my $key (@JOURNAL_FIELDS) { + $using_param_call = 1 and last if exists $params{$key} and defined $params{$key}; + } + if ($using_param_call) { + foreach my $key (@JOURNAL_FIELDS) { + $self->{reference}->{journal}->{$key} = $params{$key} if exists $params{$key} and defined $params{$key}; + } + } + elsif (defined $params{journal}) { + $self->{reference}->{journal}->{title} = $params{journal}; + } + + local $_ = $params{output}; + if (/bibtex/) { + my $title = $self->{reference}->{journal}->{medlineabbr} || $self->{reference}->{journal}->{title}; + $title =~ s/\s//g; + return $title; + } elsif (/medline/) { + return $self->{reference}->{journal}->{medlineabbr} || $self->{reference}->{journal}->{title}; + } elsif (/iso/) { + return $self->{reference}->{journal}->{isoabbr} || $self->{reference}->{journal}->{title}; + } + else { + return $self->{reference}->{journal}->{title}; + } +} + + + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Field/Pages.pm b/lib/Reference/Field/Pages.pm new file mode 100644 index 0000000..8e1c1c2 --- /dev/null +++ b/lib/Reference/Field/Pages.pm @@ -0,0 +1,109 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Pages.pm 45 2013-09-10 18:05:31Z don $ + +package Reference::Field::Pages; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +use NEXT; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 45 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +sub _init{ + my $self = shift; + + $self->{reference}->{pages} = {start => undef, + stop => undef, + }; + + $self->NEXT::_init; + +} + +sub pages{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{pages} = shift; + $params{output} = 'scalar'; + } + else { + %params = validate_with(params => \@_, + spec => {pages => {type => ARRAYREF|SCALAR|HASHREF, + optional => 1, + }, + start => {type => SCALAR, + optional => 1, + }, + stop => {type => SCALAR, + optional => 1, + }, + output => {default => 'scalar', + type => SCALAR, + }, + }, + ); + } + # Update author according to the passed information + if (defined $params{start} or defined $params{stop}) { + $self->{reference}->{pages}->{start} = $params{start} if defined $params{start}; + $self->{reference}->{pages}->{stop} = $params{stop} if defined $params{stop}; + } + elsif (defined $params{pages}) { + $self->{reference}->{pages} = {start => undef, + stop => undef, + }; + ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop}) = split(/\-+/,$params{pages}); + } + + if (wantarray) { + return grep {defined} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop}); + } + local $_ = $params{output}; + if (/bibtex/) { + return join('--',map {defined $_ ? $_ : ()} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop})); + } + else { + return join('-',map {defined $_ ? $_ : ()} ($self->{reference}->{pages}->{start},$self->{reference}->{pages}->{stop})); + } + +} + + + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Output/Bibtex.pm b/lib/Reference/Output/Bibtex.pm new file mode 100644 index 0000000..06cd71d --- /dev/null +++ b/lib/Reference/Output/Bibtex.pm @@ -0,0 +1,379 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id: Bibtex.pm 45 2013-09-10 18:05:31Z don $ + +package Reference::Output::Bibtex; + +=head1 NAME + +Reference::Output::Bibtex -- Output references in BibTeX format + +=head1 SYNOPSIS + + print bibtex($reference); + +Returns a reference formatted in bibtex format. + +=head1 DESCRIPTION + +Knows how to handle the reference-> bibtex field mapping for many +reference types, but overridden types may need to provide their own +mapping. + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); + +use base qw(Exporter); + +use Encode qw(encode_utf8 is_utf8 decode decode_utf8); +use Text::Iconv; + + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 45 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = qw(bibtex); + @EXPORT_OK = qw(); + %EXPORT_TAGS = (output => [qw(bibtex)], + ); + Exporter::export_ok_tags(qw(output)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +# Assigned and discussed at the end of this file +my %bibtex_mapping; + +use Carp; +use Params::Validate qw(:types validate_with); +use Text::Wrap; + + +=head2 bibtex + + print bibtex $reference; + %bibtex = bibtex $reference; + print bibtex($reference,mapping=>{...}) + +In scalar context, returns a formatted bibtex entry, suitable for +printing. In list context, returns a hash of key, value pairs which +can be used to print a formatted bibtex entry. + +You can also pass an optional mapping to be used for making the bibtex +entry. See B for the details. + +The mappings are obeyed in the following order, the first taking +precedence over the last. + +=over + +=item Passed mapping + +=item Object's bibtex_mapping + +=item Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping) + +=back + +Returns a SCALAR bibtex reference in scalar context, a HASH bibtex +reference in list context + +=cut + +sub bibtex{ + my $reference = shift; + + # Parse options if any + my %param = validate_with(params => \@_, + spec => {mapping => {type => HASHREF, + optional => 1, + }, + }, + ); + + my $mapping = undef; + + # Use our mapping by default if it exists + $mapping = $bibtex_mapping{lc($reference->{type})} if exists $bibtex_mapping{lc($reference->{type})}; + # Override that with the module's mapping + $mapping = $reference->{bibtex_mapping} if exists $reference->{bibtex_mapping}; + # Finally, override everything with passed mapping + $mapping = $param{mapping} if exists $param{mapping}; + + if (not defined $mapping) { + carp "This reference type doesn't support bibtex output."; + return undef; + } + + my %bibtex_entry; + foreach my $bibtex_field (keys %{$mapping->{mapping}}) { + my $params = []; + if (ref $bibtex_field) { + $params = $$bibtex_field{params} if exists $$bibtex_field{params}; + $bibtex_field = $$bibtex_field{field}; + } + my $function = $reference->can($mapping->{mapping}->{$bibtex_field}); + next unless $function; + $bibtex_entry{$bibtex_field} = &{$function}($reference,output=>'bibtex',@$params); + # dereference the entries if necessesary. + next unless wantarray; + # Make new copies of the entries if necessary so we can + # mogrify to our hearts content. + if (ref($bibtex_entry{$bibtex_field}) eq 'HASH') { + $bibtex_entry{$bibtex_field} = {%{$bibtex_entry{$bibtex_field}}}; + } + elsif (ref($bibtex_entry{$bibtex_field}) eq 'ARRAY') { + $bibtex_entry{$bibtex_field} = [@{$bibtex_entry{$bibtex_field}}]; + } + } + # Return the entries in hash form if desired. + return %bibtex_entry if wantarray; + # Ok, stich the bibtex entry together... + my $bibtex_entry; + $bibtex_entry = '@'.$mapping->{order}[0].'{'.encode_utf8(convert_to_utf8($bibtex_entry{$mapping->{order}[0]})).",\n"; + foreach my $bibtex_field (@{$mapping->{order}}[1..$#{$mapping->{order}}]) { + next unless defined $bibtex_entry{$bibtex_field}; + if (ref $bibtex_entry{$bibtex_field} eq 'ARRAY') { + next unless @{$bibtex_entry{$bibtex_field}}; + if (ref $mapping->{mapping}{$bibtex_field}) { + if (exists $mapping->{mapping}{$bibtex_field}{code}) { + local $_ = $bibtex_entry{$bibtex_field}; + eval $mapping->{mapping}{$bibtex_field}{code}; + carp "Error while executing code to assemble bibtex entry: $@" if $@; + } + elsif (exists $mapping->{mapping}{$bibtex_field}{join}) { + $bibtex_entry{$bibtex_field} = join($mapping->{mapping}{$bibtex_field}{join}, + @{$bibtex_entry{$bibtex_field}}); + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + else { + carp "$bibtex_field is an ARRAYREF, joining using commas"; + $bibtex_entry{$bibtex_field} = join(', ', @{$bibtex_entry{$bibtex_field}}); + } + } + my $entry = $bibtex_entry{$bibtex_field}; + $entry =~ s/%/\\%/g; + $entry = encode_utf8(convert_to_utf8($entry)); + my $start = "{"; + my $stop = "}"; + if ($bibtex_field eq 'journal') { + $start = ""; + $stop = ""; + } + $bibtex_entry .= wrap(' ' x 4,' ' x 8 . ' ' x length($bibtex_field),"$bibtex_field = $start".$entry."$stop,\n"); + } + $bibtex_entry .= "}\n"; + return $bibtex_entry; +} + +=head2 bibtex_mapping + + $Reference::Output::Bibtex::bibtex_mapping{Article} = + {mapping => {author => {field => 'author', + join => ' and ', + params => [], + }, + volume => 'volume', + Articlce => 'name', + foo => 'bar', + }, + order => [qw(name author volume foo)], + }; + +This variable holds the mapping to bibtex output. + +Each type of reference has its own keys. Currently the following types +are supported by the Bibtex output method: + +=over + +=item article + +=item collection + +=item book + +=back + +If you wish to add support for your own custom reference type, you +merely need to add a bibtex_mapping element to your class's hashref, +or add to this variable. [Preferbly the former, as the latter should +only be used by the end user.] + +The mapping key in the reference type hashref is a hashref containing +key value pairs according to the following metric: + +=over + +=item If the mapping key value is not a reference, the value is used +as the name function to call via C<$reference->field>. [In the example +above, the volume mapping is built by a call to +C<$reference->volume>]. + +=item If the mapping key value is a hashref, the hashref contains two +keys. The C key contains the name of the function to call. The +C key contains the parameters + +=back + +The order key in the reference type hashref is an arrayref which +defines the order in which keys are listed in the BibTeX +output. Values in the arrayref should be the keys of the mapping +hashref. [The first value listed is the type of reference/reference +name pair.] + + +=cut + + +%bibtex_mapping = +(article => {mapping => {Article => 'name', + author => 'author', + title => 'title', + journal => 'journal', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + pmid => 'pmid', + mlid => 'medline_id', + doi => 'doi', + html => 'html', + pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract pmid mlid doi + html pdf), + ], + }, + book => {mapping => {Book => 'name', + author => 'author', + title => 'title', + year => 'year', + key => 'keywords', + volume => 'volume', + number => 'number', + pages => 'pages', + month => 'month', + abstract => 'abstract', + doi => 'doi', + # html => 'html', + # pdf => 'pdf', + }, + order => [qw(Article author title journal + year key volume number pages + month abstract doi html pdf), + ], + }, +); + +=head2 convert_to_utf8 + + $utf8 = convert_to_utf8("text","charset"); + +=cut + +sub convert_to_utf8 { + my ($data,$charset,$internal_call) = @_; + $internal_call //= 0; + if (is_utf8($data)) { + # cluck("utf8 flag is set when calling convert_to_utf8"); + return $data; + } + if (not length $data) { + return $data; + } + $charset = uc($charset//'UTF-8'); + if ($charset eq 'RAW') { + # croak("Charset must not be raw when calling convert_to_utf8"); + } + my $iconv_converter; + eval { + $iconv_converter = Text::Iconv->new($charset,"UTF-8") or + die "Unable to create converter for '$charset'"; + }; + if ($@) { + return undef if $internal_call; + warn $@; + # We weren't able to create the converter, so use Encode + # instead + return __fallback_convert_to_utf8($data,$charset); + } + my $converted_data = $iconv_converter->convert($data); + # if the conversion failed, retval will be undefined or perhaps + # -1. + my $retval = $iconv_converter->retval(); + if (not defined $retval or + $retval < 0 + ) { + # try iso8559-1 first + if (not $internal_call) { + my $call_back_data = convert_to_utf8($data,'ISO8859-1',1); + # if there's an à (0xC3), it's probably something + # horrible, and we shouldn't try to convert it. + if (defined $call_back_data and $call_back_data !~ /\x{C3}/) { + # warn "failed to convert to utf8 (charset: $charset, data: $data), but succeeded with ISO8859-1: ".encode_utf8($call_back_data); + return $call_back_data; + } + } + warn "failed to convert to utf8 (charset: $charset, data: $data)"; + # Fallback to encode, which will probably also fail. + return __fallback_convert_to_utf8($data,$charset); + } + return decode("UTF-8",$converted_data); +} + +# this returns data in perl's internal encoding +sub __fallback_convert_to_utf8 { + my ($data, $charset) = @_; + # raw data just gets returned (that's the charset WordDecorder + # uses when it doesn't know what to do) + return $data if $charset eq 'raw'; + if (not defined $charset and not is_utf8($data)) { + warn ("Undefined charset, and string '$data' is not in perl's internal encoding"); + return $data; + } + # lets assume everything that doesn't have a charset is utf8 + $charset //= 'utf8'; + my $result; + eval { + $result = decode($charset,$data,0); + }; + if ($@) { + warn "Unable to decode charset; '$charset' and '$data': $@"; + return $data; + } + return $result; +} + + + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Output/Filename.pm b/lib/Reference/Output/Filename.pm new file mode 100644 index 0000000..3fd2696 --- /dev/null +++ b/lib/Reference/Output/Filename.pm @@ -0,0 +1,92 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2009 by Don Armstrong . +# $Id: Filename.pm 43 2009-03-20 06:33:14Z don $ + +package Reference::Output::Filename; + +=head1 NAME + +Reference::Output::Filename -- Output a filename for the reference + +=head1 SYNOPSIS + + print filename($reference); + +Returns a filename for the reference + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); + +use base qw(Exporter); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 36 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = qw(filename); + @EXPORT_OK = qw(); + %EXPORT_TAGS = (output => [qw(filename)], + ); + Exporter::export_ok_tags(qw(output)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +# Assigned and discussed at the end of this file +my %bibtex_mapping; + +use Carp; + + +=head2 filename + + print filename($reference).'.pdf'; + +Returns a filename for a reference + +=cut + +sub filename{ + my $reference = shift; + + my $title = eval { $reference->title(); }; + my $fauthor = eval { $reference->first_author(output=>'last'); }; + my $cauthor = eval { $reference->corresponding_author(output=>'last');}; + if (defined $fauthor and defined $cauthor and $fauthor eq $cauthor) { + $fauthor = undef; + } + my $journal = eval { $reference->journal(output =>'bibtex');}; + my $volume = eval {$reference->volume();}; + my $number = eval {$reference->number();}; + my $page = eval{$reference->pages(output => 'bibtex');}; + $page =~ s/\s*--\s*\d+\s*// if defined $page; + my $year = eval{$reference->date(output=>'year');}; + my $pmid = eval{$reference->pmid();}; + + return join('_', + map {s/\W+/_/g; $_} map{defined $_ ?$_:()} + ($title,$fauthor,$cauthor, + $journal,$volume,$number,$page,$year,defined $pmid?"pmid_$pmid":undef)); + + + } + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Retrieve/HTML/Miner.pm b/lib/Reference/Retrieve/HTML/Miner.pm new file mode 100644 index 0000000..3c934f4 --- /dev/null +++ b/lib/Reference/Retrieve/HTML/Miner.pm @@ -0,0 +1,45 @@ +# This module is part of da_reference, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Miner.pm 30 2004-06-29 10:26:20Z don $ + +package ; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 30 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Retrieve/PubMed.pm b/lib/Reference/Retrieve/PubMed.pm new file mode 100644 index 0000000..553245d --- /dev/null +++ b/lib/Reference/Retrieve/PubMed.pm @@ -0,0 +1,580 @@ +# This module is part of Refence, and is released under the terms of +# the GPL version 2, or any later version. See the file README and +# COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: PubMed.pm 45 2013-09-10 18:05:31Z don $ + +package Reference::Retrieve::PubMed; + +=head1 NAME + +Reference::Retrieve::PubMed -- Reference Retrieval from PubMed + +=head1 SYNOPSIS + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',limit=>50); + + +=head1 DESCRIPTION + +Uh. Retreives references from pubmed. Yeah. + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); +use Carp; + +use LWP::UserAgent; +use XML::Simple qw(:strict); +use Reference; + +use HTML::Entities; + +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 45 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 get_reference + +=head3 Usage + + my $reference = Reference::Retrieve::PubMed::get_reference(-pmid=>123456); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>'John Smith[AUTHOR] AND 230[Pages]',-limit=>50); + my @references = Reference::Retrieve::PubMed::get_reference(-query=>{author=>'John Smith', pages=>'230'},-limit=>50) + +=head3 Function + +Retrives a reference from pubmed + +=head3 Returns + +In scalar context, effectively assumes -limit=>1 and returns the +highest listed reference according to the order, etc. [Probably only +usefull with -pmid.] In list context, returns all results (or until it +hits the -limit.) + +=head3 Args + +list of arguments to select a reference or collection of references from. + + +=cut + +sub get_reference{ + my %options = validate_with(params => @_, + spec => {pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/query.fcgi?cmd=Text&db=PubMed&dopt=XML&uid='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + }, + allow_extra => 1, + ); + my $ua = new LWP::UserAgent(agent => $options{ua_agent}); +} + +sub get_reference_by_pmid($;@){ + my %options = validate_with(params => \@_, + spec => {pmid => {type => SCALAR|ARRAYREF, + #regex => qr/^\d+$/, + }, + pubmed_site => {default => 'http://www.ncbi.nlm.nih.gov'}, + pmid_query => {default => '/entrez/eutils/efetch.fcgi?db=pubmed&retmode=xml&rettype=full&id='}, + search_query => {default => '/htbin-post/Entrez/query?db=m&form=4&dispmax=100&html=no&dopt=u&term='}, + ua_agent => {default => "DA Reference::Retreive::PubMed/$REVISION"}, + email => {default => "don+referenceretrieve$REVISION\@donarmstrong.com"}, + useragent => {optional => 1}, + }, + allow_extra => 1, + ); + my $pmid = $options{pmid}; + + my $ua; + if ($options{useragent}) { + $ua = $options{useragent}; + } + else { + $ua = new LWP::UserAgent(agent=>$options{ua_agent}); + } + my $url = "$options{pubmed_site}$options{pmid_query}" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # For some dumb reason, they send us xml with html + # entities. Ditch them. + #$response = decode_entities($response); + # It's even more freaking broken; they don't double encode them. + #$response =~ s/\>(\s|$)/>$1/gso; + #$response =~ s/(?:(\s)\<|<(\/))/$1<$2/gso; + $response =~ s/"/"/gso; + + # Ditch any doctype + $response =~ s/^\s*<\?xml[^>]+>\s*//gso; + $response =~ s/^\s*<\!DOCTYPE[^>]+>\s*//gso; + # There is also a Pubmedarticleset + $response =~ s/^\s*\s*//gso; + $response =~ s#\s*$##gso; + + # Add the opt so we get an array of PubMedArticle + $response = "$response"; + + print STDERR $response if $DEBUG; + + # Figure out if there was an error in the search. + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => [ 'PubmedArticle' ],KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct) if $DEBUG; + # Handle the XML structure + my @references; + foreach my $ref (@{$ref_struct->{PubmedArticle}}) { + my $reference = _create_reference_from_xml($ref,$ua); + if (not defined $reference) { + warn "Unable to create reference for $ref->{MedlineCitation}->{PMID}\n"; + } + push @references, $reference; + } + if (wantarray) { + return @references; + } + return $references[0]; +} + +sub _create_reference_from_xml($$){ + my ($ref,$ua) = @_; + + # Figure out what type of reference this is. We only support + # Journal Articles right now. + my $types = {'journal article'=>'article', + 'letter' =>'article', + 'editorial' => 'article', + 'review' => 'article', + }; + my $ref_type = undef; + my $reference = undef; + foreach my $type (keys %{$types}) { + if (ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq 'ARRAY'){ + my $pubtypes; + @{$pubtypes}{map {lc} @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}} = + (1) x @{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}; + if ($pubtypes->{$type}) { + $ref_type = $types->{$type}; + last; + } + else { + next; + } + } + elsif (lc($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}) eq lc($type)) { + $ref_type = $types->{$type}; + last; + } + } + if (not defined $ref_type) { + warn "Unsupported PublicationType: ".(ref($ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType})? + join(',',@{$ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}}): + $ref->{MedlineCitation}->{Article}->{PublicationTypeList}->{PublicationType}); + print STDERR Dumper($ref) if $DEBUG; + $ref_type = 'article'; + } + local $_ = $ref_type; + if (/article/) { + use Reference::Type::Article; + $reference = new Reference::Type::Article; + my $xml_mapping = {author => [ _fix_medline_authors($ref->{MedlineCitation}->{Article}->{AuthorList}) ], + title => [_fix_medline_title($ref->{MedlineCitation}->{Article}->{ArticleTitle})], + abstract => [_fix_medline_abstract($ref->{MedlineCitation}->{Article}->{Abstract}->{AbstractText})], + journal => [_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua, + #@_, # configuration + )], + _fix_ids($ref), + # pmid => $ref->{MedlineCitation}->{PMID}, + # medline_id => $ref->{MedlineCitation}->{MedlineID}, + volume => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Volume})], + date => [_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})], + number => [_fix_medline_ditch_empty($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{Issue})], + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], +# keywords => [_fix_medline_keywords($ref->{MedlineCitation}->{MeshHeadingList}, +# $ref->{MedlineCitation}->{ChemicalList}, +# )], +# &_find_pubmed_links($ref->{MedlineCitation}->{PMID},$ua), + }; + # Deal with author + + foreach my $reference_key (keys %{$xml_mapping}) { + my $method = $reference->can($reference_key); + die "Reference::Type::Article was unable to handle $reference_key" if not $method; + if (defined $xml_mapping->{$reference_key} and $method) { + if (ref($xml_mapping->{$reference_key})) { + &{$method}($reference,@{$xml_mapping->{$reference_key}}); + } + else { + &{$method}($reference,$xml_mapping->{$reference_key}); + } + } + else { + warn "Reference_key $reference_key was not defined or unable to handle type of key." + if not defined $xml_mapping->{$reference_key} and $DEBUG; + } + } + return $reference; + } +} + +sub _fix_medline_title($){ + my $title = shift; + + $title =~ s/\.$//; + return $title; +} + +sub _fix_medline_abstract{ + my $abstract = shift; + my $ret = ''; + if (ref($abstract) and ref($abstract) eq 'ARRAY') { + for my $element (@{$abstract}) { + $ret .= "\n" if length $ret; + $ret .= $element->{Label}.': '.$element->{content}; + } + return $ret; + } else { + return $abstract; + } +} + + +sub _fix_medline_authors($){ + my $author_list = shift; + $author_list = $author_list->{Author}; + my @authors; + $author_list = [$author_list] if ref($author_list) ne 'ARRAY'; + foreach my $author (@{$author_list}) { + my %au; + $au{first} = $author->{ForeName} if exists $author->{ForeName}; + $au{last} = $author->{LastName} if exists $author->{LastName}; + $au{initials} = $author->{Initials} if exists $author->{Initials}; + $au{full}; + push @authors,\%au; + } + return (author=>\@authors); +} + +=head2 _fix_medline_journal + +=head3 Usage + + $reference->journal(_fix_medline_journal($ref->{MedlineCitation}->{Article}->{Journal}, + $ref->{MedlineCitation}->{Article}->{MedlineJournalInfo}, + $ua,)); + +=head3 Function + +From the medline citation informatino returns a properly formatted +list of information for the journal reference listing. + +=head3 Args + +Journal information hashref + +medline journal information hashref + +user agent + +=cut + +sub _fix_medline_journal($$$;){ + my ($journal,$medline_journal,$ua) = @_; + # journal takes fullname, issn, medlineabbr, pmid, and nlmuid + # Try to supply as much as possible. + # Use esearch to get pmjournalid + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=0021-9258 + # use esummary to retreive the journalid + # + # + # + # 1 + # 1 + # 0 + # + # 4559 + # + # + # + # + # + # + # 0021-9258[All Fields] + # All Fields + # 1 + # + # Y + # + # + # + + my $ISSN = $journal->{ISSN}; + if (ref $ISSN) { + $ISSN = $ISSN->{content}; + } + my $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=journals&term=$ISSN); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my ($journal_id) = $response =~ m#\s*(\d+)\s*#i; + + # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559 + # + # + # + # + # 4559 + # The Journal of biological chemistry. + # J Biol Chem + # J. Biol. Chem. + # 2985121R + # + # 0021-9258 + # 1083-351X + # 1905 + # + # American Society for Biochemistry and Molecular Biology + # eng + # + # United States + # + # + # + $url = qq(http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esummary.fcgi?db=journals&id=$journal_id); + print STDERR "url: $url" if $DEBUG; + $request = HTTP::Request->new('GET', $url); + $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + my %journal; + while ($response =~ m{^\s*(?:(?:\s*(\d+))| # Match ids + (?:\s*([^<]+?)))\s* # Match item Name clauses + $}ixmg) { + if (not defined $2) { + $journal{id} = $1; + } + else { + $journal{lc($2)} = $3; + } + } + my %journal_mapping = (title => q(title), + medlineabbr => q(medabbr), + isoabbr => q(isoabbr), + nlmid => q(nlmid), + issn => q(pissn), + eissn => q(eissn), + publisher => q(publisher), + pmid => q(id) + ); + my @journal_entry; + foreach my $key (keys %journal_mapping) { + push @journal_entry,($key=>$journal{$journal_mapping{$key}}); + } + return @journal_entry; +} + +=head2 + +=head3 Usage + + $reference->date(_fix_medline_pubdate($ref->{MedlineCitation}->{Article}->{Journal}->{JournalIssue}->{PubDate})); + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _fix_medline_pubdate($){ + my ($date) = shift; + return (year=>$date->{Year},month=>$date->{Month},day=>$date->{Day}) if exists $date->{Year}; + # Ok... punt. + if (exists $date->{MedlineDate}) { + my ($year,$month,$day) = split /\s+/,$date->{MedlineDate}; + return (year=>$year,month=>$month,day=>$day) + } +} + +=head2 _fix_medline_pages + +=head3 Usage + + pages => [_fix_medline_pages($ref->{MedlineCitation}->{Article}->{Pagination}->{MedlinePgn})], + +=head3 Function + +Returns output with a list of pages appropriate for an Article type of +reference. + +=cut + +sub _fix_medline_pages($){ + my ($pagination) = @_; + my ($start,$stop) = $pagination =~ /(\d*)\s*\-\s*(\d*)/; + if (not defined $start) { + ($start) = $pagination =~ /(\d+)/ + } + if ($start > $stop and defined $stop) { + # this must be a reduced page listing; fix it up + $stop+=$start - $start % 10 ** (int(log($stop)/log(10))+1); + } + my @return; + push @return, (start=>$start) if defined $start and $start ne ''; + push @return, (stop=>$stop) if defined $stop and $stop ne ''; + return @return; +} + +sub _find_pubmed_links($$){ + my ($pmid,$ua) = @_; + return (); + #http://eutils.ncbi.nlm.nih.gov/entrez/query/static/elink_help.html + my $url = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/elink.fcgi?dbfrom=pubmed&cmd=llinks&id=" . (ref($pmid) ? (join('&id=',@{$pmid})) : $pmid); + print STDERR "url: $url" if $DEBUG; + my $request = HTTP::Request->new('GET', $url); + my $response = $ua->request($request); + $response = $response->content; + print STDERR "response: $response" if $DEBUG; + + # Response should be in XML. Parse it. + my $xa = new XML::Simple; + + my $ref_struct = $xa->XMLin($response, ForceArray => ['IdUrlSet'], KeyAttr=>[]); + + use Data::Dumper; + print STDERR Dumper($ref_struct);# if $DEBUG; + # Rearange data around Id. + my $links = {}; + map {$links->{$_->{Id}}=$_->{ObjUrl}} @{$ref_struct->{LinkSet}->{IdUrlList}->{IdUrlSet}}; + foreach my $obj_url (@{$links->{$pmid}->{ObjUrl}}) { + next unless $obj_url->{SubjectType} = 'publishers/providers'; + #@links = _find_links_from_url($obj_url->{Url},$ua); + } + # Find publisher link + # If no publisher link, use the first aggregator link. +} + +=head2 _fix_ids + + _fix_ids + + + +=cut + +sub _fix_ids { + my ($ref) = @_; + + my %ids_known = (medline => 'medline_id', + pubmed => 'pmid', + doi => 'doi', + ); + my %ids; + if (exists $ref->{PubmedData}{ArticleIdList}{ArticleId}) { + for my $art_id (ref($ref->{PubmedData}{ArticleIdList}{ArticleId}) eq 'ARRAY' ? + @{$ref->{PubmedData}{ArticleIdList}{ArticleId}}: + ($ref->{PubmedData}{ArticleIdList}{ArticleId})) { + if (exists $ids_known{$art_id->{IdType}}) { + $ids{$ids_known{$art_id->{IdType}}} = $art_id->{content}; + } + } + } + if (not exists $ids{pmid}) { + $ids{pmid} = $ref->{MedlineCitation}->{PMID} if defined $ref->{MedlineCitation}->{PMID}; + } + if (not exists $ids{medline_id}) { + $ids{medline_id} = $ref->{MedlineCitation}->{MedlineID} if defined $ref->{MedlineCitation}->{MedlineID}; + } + return %ids; +} + + +=head2 _find_links_from_url + +=head3 Usage + +=head3 Function + +=head3 Returns + +=head3 Args + +=cut + +sub _find_links_from_url($$){ + my ($link,$ua) = @_; + + + +} + +sub _fix_medline_ditch_empty($){ + my ($value) = @_; + + if (ref($value)) { + if (ref($value) eq 'HASH') { + if (scalar keys %{$value} > 0) { + return $value; + } + else { + return (); + } + } + elsif (ref($value) eq 'ARRAY') { + if (scalar @{$value} > 0) { + return $value; + } + else { + return (); + } + } + else { + return (); + } + } + else { + return $value if defined $value; + return (); + } +} + + +1; + + +__END__ + + + + + + diff --git a/lib/Reference/Type/Article.pm b/lib/Reference/Type/Article.pm new file mode 100644 index 0000000..b309071 --- /dev/null +++ b/lib/Reference/Type/Article.pm @@ -0,0 +1,166 @@ +# This module is part of , and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2003 by Don Armstrong . +# $Id: Article.pm 30 2004-06-29 10:26:20Z don $ + +package Reference::Type::Article; + +=head1 NAME + +Reference::Type::Article -- Article reference type + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($VERSION $DEBUG); +use Carp; + +use base qw(Reference Reference::Field::Author Reference::Field::Pages Reference::Field::Journal Reference::Field::Date); + +use NEXT; +use Reference; +use Params::Validate qw(:types validate_with); + +BEGIN{ + ($VERSION) = q$LastChangedRevision: 30 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + +=head2 name + +=head3 Usage + + $article->name($article_name); + my $article_name = $article->name; + +=head3 Function + +Returns the article name if it has been set, or builds an article name +from the author, journal, volume, and page if none is set. + +=cut + +sub name{ + my $self = shift; + my %params; + if (scalar(@_) == 1) { + $params{name} = shift; + } + else { + %params = validate_with(params => \@_, + spec => {name => {type => SCALAR, + optional => 1, + }, + output => {type => SCALAR, + default => 'scalar', + }, + }, + ); + } + + if (defined $params{name}) { + $self->{reference}->{name} = $params{name}; + return $params{name}; + } + if (not defined $self->{reference}->{name}) { + my ($name) = $self->first_author =~ /(\w+)$/; + if (not defined $name) { + no warnings qw(uninitialized); + $name = $self->journal . $self->volume . $self->pages; + } + $name .= $self->year if defined $self->year; + $self->{reference}->{name} = $name; + return $name; + } + else { + return $self->{reference}->{name}; + } +} + +=head2 ref_fields + +=head3 Usage + + my @ref_fields = $self->ref_fields; + +=head3 Returns + +Returns the list of reference fields which this type of reference +supports. + +=cut + +sub ref_fields($){ + my $self = shift; + + return qw(author title year abstract journal pmid medline_id volume date number pages keywords doi html pdf month); +} + + +=head2 _init + +=head3 Usage + +Called by Reference's new function + +=head3 Function + +Call superclass's _init function [C<$self->NEXT::_init>], set up the +bibtex_mapping and bibtex_order. + +=cut + +sub _init($){ + my $self = shift; + + $self->NEXT::_init; + $self->{type} = 'article'; +# $self->{bibtex_mapping} = {Article => 'name', +# author => 'author', +# title => 'title', +# journal => 'journal', +# year => 'year', +# key => 'keywords', +# volume => 'volume', +# number => 'number', +# pages => 'pages', +# month => 'month', +# abstract => 'abstract', +# pmid => 'pmid', +# mlid => 'medline_id', +# # doi => 'doi', +# # html => 'html', +# # pdf => 'pdf', +# }; +# $self->{bibtex_order} = [qw(Article author title journal +# year key volume number pages +# month abstract pmid mlid doi +# html pdf),]; +} + + + + +1; + + +__END__ + + + + + + diff --git a/pm_to_blib b/pm_to_blib new file mode 100644 index 0000000..e69de29 diff --git a/templates/perl_module_header.pm b/templates/perl_module_header.pm new file mode 100644 index 0000000..2279439 --- /dev/null +++ b/templates/perl_module_header.pm @@ -0,0 +1,45 @@ +# This module is part of da_reference, and is released under the terms +# of the GPL version 2, or any later version, at your option. See the +# file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id: perl_module_header.pm 30 2004-06-29 10:26:20Z don $ + +package ; + +=head1 NAME + + -- + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + + +use strict; +use vars qw($REVISION $DEBUG); + +BEGIN{ + ($REVISION) = q$LastChangedRevision: 30 $ =~ /\$LastChangedRevision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; +} + + + +1; + + +__END__ + + + + + + diff --git a/templates/perl_program_header.pl b/templates/perl_program_header.pl new file mode 100644 index 0000000..09e90e7 --- /dev/null +++ b/templates/perl_program_header.pl @@ -0,0 +1,70 @@ +#! /usr/bin/perl +# This program is part of da_reference, and is released under the +# terms of the GPL version 2, or any later version, at your +# option. See the file README and COPYING for more information. +# Copyright 2004 by Don Armstrong . +# $Id: perl_program_header.pl 30 2004-06-29 10:26:20Z don $ + + +use warnings; +use strict; + + +use Getopt::Long; +use Pod::Usage; + +=head1 NAME + +foo - + +=head1 SYNOPSIS + +foo [options] + + Options: + --debug, -d debugging level (Default 0) + --help,-h display this help + --man,-m display manual + +=head1 OPTIONS + +=over + +=item B<--debug, -d> + +Debug verbosity. (Default 0) + +=item B<--help, -h> + +Display brief useage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + + +=cut + + + +use vars qw($DEBUG); + +my %options = (debug => 0, + help => 0, + man => 0, + ); + +GetOptions(\%options,'debug|d','help|h','man|m'); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + + + +__END__