--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+#! /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 <don@donarmstrong.com>.
+# $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;
+}
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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<bibtex_mapping> 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<field> key contains the name of the function to call. The
+C<params> 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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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<bibtex_mapping> 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<field> key contains the name of the function to call. The
+C<params> 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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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*<PubmedArticleSet>\s*//gso;
+ $response =~ s#</PubmedArticleSet>\s*$##gso;
+
+ # Add the opt so we get an array of PubMedArticle
+ $response = "<opt>$response</opt>";
+
+ 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
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSearchResult PUBLIC "-//NLM//DTD eSearchResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSearch_020511.dtd">
+ # <eSearchResult>
+ # <Count>1</Count>
+ # <RetMax>1</RetMax>
+ # <RetStart>0</RetStart>
+ # <IdList>
+ # <Id>4559</Id>
+ #
+ # </IdList>
+ # <TranslationSet>
+ # </TranslationSet>
+ # <TranslationStack>
+ # <TermSet>
+ # <Term>0021-9258[All Fields]</Term>
+ # <Field>All Fields</Field>
+ # <Count>1</Count>
+ #
+ # <Explode>Y</Explode>
+ # </TermSet>
+ # </TranslationStack>
+ # </eSearchResult>
+
+ 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#<Id>\s*(\d+)\s*</Id>#i;
+
+ # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSummaryResult PUBLIC "-//NLM//DTD eSummaryResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSummary_020511.dtd">
+ # <eSummaryResult>
+ # <DocSum>
+ # <Id>4559</Id>
+ # <Item Name="Title" Type="String">The Journal of biological chemistry.</Item>
+ # <Item Name="MedAbbr" Type="String">J Biol Chem</Item>
+ # <Item Name="IsoAbbr" Type="String">J. Biol. Chem.</Item>
+ # <Item Name="NlmId" Type="String">2985121R</Item>
+ #
+ # <Item Name="pISSN" Type="String">0021-9258</Item>
+ # <Item Name="eISSN" Type="String">1083-351X</Item>
+ # <Item Name="PublicationStartYear" Type="String">1905</Item>
+ # <Item Name="PublicationEndYear" Type="String"></Item>
+ # <Item Name="Publisher" Type="String">American Society for Biochemistry and Molecular Biology</Item>
+ # <Item Name="Language" Type="String">eng</Item>
+ #
+ # <Item Name="Country" Type="String">United States</Item>
+ # </DocSum>
+ #
+ # </eSummaryResult>
+ $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*(?:(?:<id>\s*(\d+)</id>)| # Match ids
+ (?:<item\s+name=\"([^\"]+)\"\s+Type=\"String\">\s*([^<]+?)</item>))\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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+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
--- /dev/null
+#! /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 <don@donarmstrong.com>.
+# $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);
+ }
+}
--- /dev/null
+
+
+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
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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*<PubmedArticleSet>\s*//gso;
+ $response =~ s#</PubmedArticleSet>\s*$##gso;
+
+ # Add the opt so we get an array of PubMedArticle
+ $response = "<opt>$response</opt>";
+
+ 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
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSearchResult PUBLIC "-//NLM//DTD eSearchResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSearch_020511.dtd">
+ # <eSearchResult>
+ # <Count>1</Count>
+ # <RetMax>1</RetMax>
+ # <RetStart>0</RetStart>
+ # <IdList>
+ # <Id>4559</Id>
+ #
+ # </IdList>
+ # <TranslationSet>
+ # </TranslationSet>
+ # <TranslationStack>
+ # <TermSet>
+ # <Term>0021-9258[All Fields]</Term>
+ # <Field>All Fields</Field>
+ # <Count>1</Count>
+ #
+ # <Explode>Y</Explode>
+ # </TermSet>
+ # </TranslationStack>
+ # </eSearchResult>
+
+ 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#<Id>\s*(\d+)\s*</Id>#i;
+
+ # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSummaryResult PUBLIC "-//NLM//DTD eSummaryResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSummary_020511.dtd">
+ # <eSummaryResult>
+ # <DocSum>
+ # <Id>4559</Id>
+ # <Item Name="Title" Type="String">The Journal of biological chemistry.</Item>
+ # <Item Name="MedAbbr" Type="String">J Biol Chem</Item>
+ # <Item Name="IsoAbbr" Type="String">J. Biol. Chem.</Item>
+ # <Item Name="NlmId" Type="String">2985121R</Item>
+ #
+ # <Item Name="pISSN" Type="String">0021-9258</Item>
+ # <Item Name="eISSN" Type="String">1083-351X</Item>
+ # <Item Name="PublicationStartYear" Type="String">1905</Item>
+ # <Item Name="PublicationEndYear" Type="String"></Item>
+ # <Item Name="Publisher" Type="String">American Society for Biochemistry and Molecular Biology</Item>
+ # <Item Name="Language" Type="String">eng</Item>
+ #
+ # <Item Name="Country" Type="String">United States</Item>
+ # </DocSum>
+ #
+ # </eSummaryResult>
+ $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*(?:(?:<id>\s*(\d+)</id>)| # Match ids
+ (?:<item\s+name=\"([^\"]+)\"\s+Type=\"String\">\s*([^<]+?)\.?</item>))\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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+#! /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 <don@donarmstrong.com>.
+# $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__
--- /dev/null
+# 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$
+^#.*#$
+^\.#
--- /dev/null
+#!/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)],
+ );
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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<bibtex_mapping> 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<field> key contains the name of the function to call. The
+C<params> 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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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*<PubmedArticleSet>\s*//gso;
+ $response =~ s#</PubmedArticleSet>\s*$##gso;
+
+ # Add the opt so we get an array of PubMedArticle
+ $response = "<opt>$response</opt>";
+
+ 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
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSearchResult PUBLIC "-//NLM//DTD eSearchResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSearch_020511.dtd">
+ # <eSearchResult>
+ # <Count>1</Count>
+ # <RetMax>1</RetMax>
+ # <RetStart>0</RetStart>
+ # <IdList>
+ # <Id>4559</Id>
+ #
+ # </IdList>
+ # <TranslationSet>
+ # </TranslationSet>
+ # <TranslationStack>
+ # <TermSet>
+ # <Term>0021-9258[All Fields]</Term>
+ # <Field>All Fields</Field>
+ # <Count>1</Count>
+ #
+ # <Explode>Y</Explode>
+ # </TermSet>
+ # </TranslationStack>
+ # </eSearchResult>
+
+ 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#<Id>\s*(\d+)\s*</Id>#i;
+
+ # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSummaryResult PUBLIC "-//NLM//DTD eSummaryResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSummary_020511.dtd">
+ # <eSummaryResult>
+ # <DocSum>
+ # <Id>4559</Id>
+ # <Item Name="Title" Type="String">The Journal of biological chemistry.</Item>
+ # <Item Name="MedAbbr" Type="String">J Biol Chem</Item>
+ # <Item Name="IsoAbbr" Type="String">J. Biol. Chem.</Item>
+ # <Item Name="NlmId" Type="String">2985121R</Item>
+ #
+ # <Item Name="pISSN" Type="String">0021-9258</Item>
+ # <Item Name="eISSN" Type="String">1083-351X</Item>
+ # <Item Name="PublicationStartYear" Type="String">1905</Item>
+ # <Item Name="PublicationEndYear" Type="String"></Item>
+ # <Item Name="Publisher" Type="String">American Society for Biochemistry and Molecular Biology</Item>
+ # <Item Name="Language" Type="String">eng</Item>
+ #
+ # <Item Name="Country" Type="String">United States</Item>
+ # </DocSum>
+ #
+ # </eSummaryResult>
+ $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*(?:(?:<id>\s*(\d+)</id>)| # Match ids
+ (?:<item\s+name=\"([^\"]+)\"\s+Type=\"String\">\s*([^<]+?)</item>))\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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+#! /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 <don@donarmstrong.com>.
+# $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);
+ }
+}
--- /dev/null
+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
--- /dev/null
+# 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$
+^#.*#$
+^\.#
--- /dev/null
+# 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) '<SOFTPKG NAME="$(DISTNAME)" VERSION="">' > $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <ABSTRACT></ABSTRACT>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <AUTHOR></AUTHOR>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="x86_64-linux-gnu-thread-multi-5.14" />' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <CODEBASE HREF="" />' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' </IMPLEMENTATION>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) '</SOFTPKG>' >> $(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.
--- /dev/null
+#!/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)],
+ );
--- /dev/null
+
+
+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
--- /dev/null
+#! /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 <don@donarmstrong.com>.
+# $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);
+ }
+}
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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<bibtex_mapping> 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<field> key contains the name of the function to call. The
+C<params> 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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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*<PubmedArticleSet>\s*//gso;
+ $response =~ s#</PubmedArticleSet>\s*$##gso;
+
+ # Add the opt so we get an array of PubMedArticle
+ $response = "<opt>$response</opt>";
+
+ 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
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSearchResult PUBLIC "-//NLM//DTD eSearchResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSearch_020511.dtd">
+ # <eSearchResult>
+ # <Count>1</Count>
+ # <RetMax>1</RetMax>
+ # <RetStart>0</RetStart>
+ # <IdList>
+ # <Id>4559</Id>
+ #
+ # </IdList>
+ # <TranslationSet>
+ # </TranslationSet>
+ # <TranslationStack>
+ # <TermSet>
+ # <Term>0021-9258[All Fields]</Term>
+ # <Field>All Fields</Field>
+ # <Count>1</Count>
+ #
+ # <Explode>Y</Explode>
+ # </TermSet>
+ # </TranslationStack>
+ # </eSearchResult>
+
+ 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#<Id>\s*(\d+)\s*</Id>#i;
+
+ # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSummaryResult PUBLIC "-//NLM//DTD eSummaryResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSummary_020511.dtd">
+ # <eSummaryResult>
+ # <DocSum>
+ # <Id>4559</Id>
+ # <Item Name="Title" Type="String">The Journal of biological chemistry.</Item>
+ # <Item Name="MedAbbr" Type="String">J Biol Chem</Item>
+ # <Item Name="IsoAbbr" Type="String">J. Biol. Chem.</Item>
+ # <Item Name="NlmId" Type="String">2985121R</Item>
+ #
+ # <Item Name="pISSN" Type="String">0021-9258</Item>
+ # <Item Name="eISSN" Type="String">1083-351X</Item>
+ # <Item Name="PublicationStartYear" Type="String">1905</Item>
+ # <Item Name="PublicationEndYear" Type="String"></Item>
+ # <Item Name="Publisher" Type="String">American Society for Biochemistry and Molecular Biology</Item>
+ # <Item Name="Language" Type="String">eng</Item>
+ #
+ # <Item Name="Country" Type="String">United States</Item>
+ # </DocSum>
+ #
+ # </eSummaryResult>
+ $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*(?:(?:<id>\s*(\d+)</id>)| # Match ids
+ (?:<item\s+name=\"([^\"]+)\"\s+Type=\"String\">\s*([^<]+?)</item>))\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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+.\" 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
--- /dev/null
+.\" 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
--- /dev/null
+.\" 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'
--- /dev/null
+.\" 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
--- /dev/null
+.\" 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.
--- /dev/null
+.\" 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.
--- /dev/null
+.\" 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
--- /dev/null
+.\" 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
--- /dev/null
+.\" 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.
--- /dev/null
+.\" 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"
--- /dev/null
+.\" 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.
--- /dev/null
+#!/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 <don@donarmstrong.com>.
+# $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);
+ }
+}
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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<bibtex_mapping> 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<field> key contains the name of the function to call. The
+C<params> 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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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*<PubmedArticleSet>\s*//gso;
+ $response =~ s#</PubmedArticleSet>\s*$##gso;
+
+ # Add the opt so we get an array of PubMedArticle
+ $response = "<opt>$response</opt>";
+
+ 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
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSearchResult PUBLIC "-//NLM//DTD eSearchResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSearch_020511.dtd">
+ # <eSearchResult>
+ # <Count>1</Count>
+ # <RetMax>1</RetMax>
+ # <RetStart>0</RetStart>
+ # <IdList>
+ # <Id>4559</Id>
+ #
+ # </IdList>
+ # <TranslationSet>
+ # </TranslationSet>
+ # <TranslationStack>
+ # <TermSet>
+ # <Term>0021-9258[All Fields]</Term>
+ # <Field>All Fields</Field>
+ # <Count>1</Count>
+ #
+ # <Explode>Y</Explode>
+ # </TermSet>
+ # </TranslationStack>
+ # </eSearchResult>
+
+ 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#<Id>\s*(\d+)\s*</Id>#i;
+
+ # http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=journals&id=4559
+ # <?xml version="1.0"?>
+ # <!DOCTYPE eSummaryResult PUBLIC "-//NLM//DTD eSummaryResult, 11 May 2002//EN" "http://www.ncbi.nlm.nih.gov/entrez/query/DTD/eSummary_020511.dtd">
+ # <eSummaryResult>
+ # <DocSum>
+ # <Id>4559</Id>
+ # <Item Name="Title" Type="String">The Journal of biological chemistry.</Item>
+ # <Item Name="MedAbbr" Type="String">J Biol Chem</Item>
+ # <Item Name="IsoAbbr" Type="String">J. Biol. Chem.</Item>
+ # <Item Name="NlmId" Type="String">2985121R</Item>
+ #
+ # <Item Name="pISSN" Type="String">0021-9258</Item>
+ # <Item Name="eISSN" Type="String">1083-351X</Item>
+ # <Item Name="PublicationStartYear" Type="String">1905</Item>
+ # <Item Name="PublicationEndYear" Type="String"></Item>
+ # <Item Name="Publisher" Type="String">American Society for Biochemistry and Molecular Biology</Item>
+ # <Item Name="Language" Type="String">eng</Item>
+ #
+ # <Item Name="Country" Type="String">United States</Item>
+ # </DocSum>
+ #
+ # </eSummaryResult>
+ $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*(?:(?:<id>\s*(\d+)</id>)| # Match ids
+ (?:<item\s+name=\"([^\"]+)\"\s+Type=\"String\">\s*([^<]+?)</item>))\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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+# 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 <don@donarmstrong.com>.
+# $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__
+
+
+
+
+
+
--- /dev/null
+#! /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 <don@donarmstrong.com>.
+# $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__
projects / reference.git / commitdiff