]> git.donarmstrong.com Git - reference.git/commitdiff
Import original source of Reference 0-Reference
authorDon Armstrong <don@donarmstrong.com>
Thu, 12 Sep 2013 17:59:19 +0000 (10:59 -0700)
committerDon Armstrong <don@donarmstrong.com>
Thu, 12 Sep 2013 17:59:19 +0000 (10:59 -0700)
81 files changed:
.svn/entries [new file with mode: 0644]
.svn/format [new file with mode: 0644]
.svn/pristine/0d/0dcb745221b06785ae7983196d4e4cfe6535ac12.svn-base [new file with mode: 0644]
.svn/pristine/27/27838510155caec110a4aad4738ea41e9434f92c.svn-base [new file with mode: 0644]
.svn/pristine/37/37d13632d4e1cc746576c92bb4d7055db21f8082.svn-base [new file with mode: 0644]
.svn/pristine/3b/3b230680ee0646a5802fa31112bf96cbfad8035d.svn-base [new file with mode: 0644]
.svn/pristine/40/4087eb7177bb14e94e5e1535ecbcbced384e458c.svn-base [new file with mode: 0644]
.svn/pristine/60/6005276799cde29242f7fafd85d544e1e74ba30e.svn-base [new file with mode: 0644]
.svn/pristine/62/627ae82969798f88b44a859559d55341197b0f39.svn-base [new file with mode: 0644]
.svn/pristine/6a/6af4ffedbfea09ff95669907dc91d39ef0f07c66.svn-base [new file with mode: 0644]
.svn/pristine/79/7933fff86b028f376f3a1a151d80711d1b12948d.svn-base [new file with mode: 0644]
.svn/pristine/7a/7a7a014b8146bb7768477142a8f981333ed04bb2.svn-base [new file with mode: 0644]
.svn/pristine/84/84880ef6852ca8e21ddd0d86943069613512f497.svn-base [new file with mode: 0644]
.svn/pristine/91/915b76dcfb3f983021583df6d5230d1b8dfd9842.svn-base [new file with mode: 0644]
.svn/pristine/a4/a47a0b4624b67e44bc4036a82c57230aa306d670.svn-base [new file with mode: 0644]
.svn/pristine/aa/aaff9dd4f00686f7990c7b60724b5c20b1d02fc9.svn-base [new file with mode: 0644]
.svn/pristine/ac/ac7ef2f46179ed36730ad1459a7463f3dba2e0f0.svn-base [new file with mode: 0644]
.svn/pristine/ad/ad7ab2475d69eac938bddfc03a4dbab87c53da63.svn-base [new file with mode: 0644]
.svn/pristine/b3/b36d574064ebc73915361222bda64c3728bb7430.svn-base [new file with mode: 0644]
.svn/pristine/c6/c6de82ace4965920900adfcc6a828089f41f39be.svn-base [new file with mode: 0644]
.svn/pristine/d4/d48a2b57550595b377c1c09971495ffe1246d1f5.svn-base [new file with mode: 0644]
.svn/pristine/dd/dd9236e2f4397fc549fb9b63d96f2debf8cde523.svn-base [new file with mode: 0644]
.svn/pristine/e3/e3f7eb9e892fe449aac38969920404d96bb97fd1.svn-base [new file with mode: 0644]
.svn/pristine/e4/e47029d26c6aa59bbb1c4eb5f8b70850ff10c603.svn-base [new file with mode: 0644]
.svn/pristine/e5/e50cc9712302efacdf9200a3ed4e6be0d0c8e624.svn-base [new file with mode: 0644]
.svn/pristine/e9/e94b700c09850a326eeea4564fde2a8999d5aba7.svn-base [new file with mode: 0644]
.svn/pristine/ee/ee77c361e33d4b819f49ea3724877f9544b8cbfd.svn-base [new file with mode: 0644]
.svn/pristine/fb/fb163154a400250cee1a64ba030619d2730d133b.svn-base [new file with mode: 0644]
.svn/pristine/fc/fc6dce9274527b60a9b01e9a01ec247284baf83d.svn-base [new file with mode: 0644]
.svn/wc.db [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
MANIFEST.SKIP [new file with mode: 0644]
Makefile [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
NOTES [new file with mode: 0644]
bin/get_reference [new file with mode: 0755]
blib/arch/.exists [new file with mode: 0644]
blib/arch/auto/Reference/.exists [new file with mode: 0644]
blib/bin/.exists [new file with mode: 0644]
blib/lib/.exists [new file with mode: 0644]
blib/lib/Reference.pm [new file with mode: 0644]
blib/lib/Reference/Field/Author.pm [new file with mode: 0644]
blib/lib/Reference/Field/Date.pm [new file with mode: 0644]
blib/lib/Reference/Field/Journal.pm [new file with mode: 0644]
blib/lib/Reference/Field/Pages.pm [new file with mode: 0644]
blib/lib/Reference/Output/Bibtex.pm [new file with mode: 0644]
blib/lib/Reference/Output/Filename.pm [new file with mode: 0644]
blib/lib/Reference/Retrieve/HTML/Miner.pm [new file with mode: 0644]
blib/lib/Reference/Retrieve/PubMed.pm [new file with mode: 0644]
blib/lib/Reference/Type/Article.pm [new file with mode: 0644]
blib/lib/auto/Reference/.exists [new file with mode: 0644]
blib/man1/.exists [new file with mode: 0644]
blib/man1/get_reference.1p [new file with mode: 0644]
blib/man3/.exists [new file with mode: 0644]
blib/man3/Reference.3pm [new file with mode: 0644]
blib/man3/Reference::Field::Author.3pm [new file with mode: 0644]
blib/man3/Reference::Field::Date.3pm [new file with mode: 0644]
blib/man3/Reference::Field::Journal.3pm [new file with mode: 0644]
blib/man3/Reference::Field::Pages.3pm [new file with mode: 0644]
blib/man3/Reference::Output::Bibtex.3pm [new file with mode: 0644]
blib/man3/Reference::Output::Filename.3pm [new file with mode: 0644]
blib/man3/Reference::Retrieve::HTML::Miner.3pm [new file with mode: 0644]
blib/man3/Reference::Retrieve::PubMed.3pm [new file with mode: 0644]
blib/man3/Reference::Type::Article.3pm [new file with mode: 0644]
blib/script/.exists [new file with mode: 0644]
blib/script/get_reference [new file with mode: 0755]
build-stamp [new file with mode: 0644]
install-stamp [new file with mode: 0644]
lib/Reference.pm [new file with mode: 0644]
lib/Reference/Field/Author.pm [new file with mode: 0644]
lib/Reference/Field/Date.pm [new file with mode: 0644]
lib/Reference/Field/Journal.pm [new file with mode: 0644]
lib/Reference/Field/Pages.pm [new file with mode: 0644]
lib/Reference/Output/Bibtex.pm [new file with mode: 0644]
lib/Reference/Output/Filename.pm [new file with mode: 0644]
lib/Reference/Retrieve/HTML/Miner.pm [new file with mode: 0644]
lib/Reference/Retrieve/PubMed.pm [new file with mode: 0644]
lib/Reference/Type/Article.pm [new file with mode: 0644]
pm_to_blib [new file with mode: 0644]
templates/perl_module_header.pm [new file with mode: 0644]
templates/perl_program_header.pl [new file with mode: 0644]

diff --git a/.svn/entries b/.svn/entries
new file mode 100644 (file)
index 0000000..48082f7
--- /dev/null
@@ -0,0 +1 @@
+12
diff --git a/.svn/format b/.svn/format
new file mode 100644 (file)
index 0000000..48082f7
--- /dev/null
@@ -0,0 +1 @@
+12
diff --git a/.svn/pristine/0d/0dcb745221b06785ae7983196d4e4cfe6535ac12.svn-base b/.svn/pristine/0d/0dcb745221b06785ae7983196d4e4cfe6535ac12.svn-base
new file mode 100644 (file)
index 0000000..fc9b6cf
--- /dev/null
@@ -0,0 +1,330 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+
+# Copyright 2003, 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/27/27838510155caec110a4aad4738ea41e9434f92c.svn-base b/.svn/pristine/27/27838510155caec110a4aad4738ea41e9434f92c.svn-base
new file mode 100644 (file)
index 0000000..8bfba68
--- /dev/null
@@ -0,0 +1,100 @@
+#! /usr/bin/perl
+# This program is part of da_reference, and is released under the
+# terms of the GPL version 2, or any later version, at your
+# option. See the file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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;
+}
diff --git a/.svn/pristine/37/37d13632d4e1cc746576c92bb4d7055db21f8082.svn-base b/.svn/pristine/37/37d13632d4e1cc746576c92bb4d7055db21f8082.svn-base
new file mode 100644 (file)
index 0000000..800c2ff
--- /dev/null
@@ -0,0 +1,288 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/3b/3b230680ee0646a5802fa31112bf96cbfad8035d.svn-base b/.svn/pristine/3b/3b230680ee0646a5802fa31112bf96cbfad8035d.svn-base
new file mode 100644 (file)
index 0000000..61b3a3b
--- /dev/null
@@ -0,0 +1,375 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/40/4087eb7177bb14e94e5e1535ecbcbced384e458c.svn-base b/.svn/pristine/40/4087eb7177bb14e94e5e1535ecbcbced384e458c.svn-base
new file mode 100644 (file)
index 0000000..c390b10
--- /dev/null
@@ -0,0 +1,575 @@
+# This module is part of Refence, and is released under the terms of
+# the GPL version 2, or any later version. See the file README and
+# COPYING for more information.
+# Copyright 2003 by Don Armstrong <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/\&gt;(\s|$)/>$1/gso;
+     #$response =~ s/(?:(\s)\&lt;|&lt;(\/))/$1<$2/gso;
+     $response =~ s/&quot;/"/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__
+
+
+
+
+
+
diff --git a/.svn/pristine/60/6005276799cde29242f7fafd85d544e1e74ba30e.svn-base b/.svn/pristine/60/6005276799cde29242f7fafd85d544e1e74ba30e.svn-base
new file mode 100644 (file)
index 0000000..cb724b0
--- /dev/null
@@ -0,0 +1,224 @@
+# This module is part of , and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/62/627ae82969798f88b44a859559d55341197b0f39.svn-base b/.svn/pristine/62/627ae82969798f88b44a859559d55341197b0f39.svn-base
new file mode 100644 (file)
index 0000000..1385046
--- /dev/null
@@ -0,0 +1,18 @@
+bin/find_link_testing.pl
+bin/get_reference
+lib/Reference.pm
+lib/Reference/Field/Author.pm
+lib/Reference/Field/Date.pm
+lib/Reference/Field/Journal.pm
+lib/Reference/Field/Pages.pm
+lib/Reference/Output/Bibtex.pm
+lib/Reference/Retrieve/HTML/Miner.pm
+lib/Reference/Retrieve/PubMed.pm
+lib/Reference/Type/Article.pm
+Makefile.PL
+MANIFEST                       This list of files
+META.yml                       Module meta-data (added by MakeMaker)
+NOTES
+pm_to_blib
+templates/perl_module_header.pm
+templates/perl_program_header.pl
diff --git a/.svn/pristine/6a/6af4ffedbfea09ff95669907dc91d39ef0f07c66.svn-base b/.svn/pristine/6a/6af4ffedbfea09ff95669907dc91d39ef0f07c66.svn-base
new file mode 100644 (file)
index 0000000..7eeb556
--- /dev/null
@@ -0,0 +1,111 @@
+#! /usr/bin/perl
+# This program is part of da_reference, and is released under the
+# terms of the GPL version 2, or any later version, at your
+# option. See the file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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);
+     }
+}
diff --git a/.svn/pristine/79/7933fff86b028f376f3a1a151d80711d1b12948d.svn-base b/.svn/pristine/79/7933fff86b028f376f3a1a151d80711d1b12948d.svn-base
new file mode 100644 (file)
index 0000000..aac6d98
--- /dev/null
@@ -0,0 +1,8 @@
+
+
+Z39.50 support
+ Zoom API -- http://zoom.z3950.org/
+ LOC Z39.50 -- http://lcweb.loc.gov/z3950/lcserver.html
+ Perl http://search.cpan.org/~mirk/Net-Z3950-0.41/Z3950.pm
+
+ Melvyl z39.50 melvyl.cdlib.org port 210
\ No newline at end of file
diff --git a/.svn/pristine/7a/7a7a014b8146bb7768477142a8f981333ed04bb2.svn-base b/.svn/pristine/7a/7a7a014b8146bb7768477142a8f981333ed04bb2.svn-base
new file mode 100644 (file)
index 0000000..dd4efce
--- /dev/null
@@ -0,0 +1,178 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/84/84880ef6852ca8e21ddd0d86943069613512f497.svn-base b/.svn/pristine/84/84880ef6852ca8e21ddd0d86943069613512f497.svn-base
new file mode 100644 (file)
index 0000000..ce6488a
--- /dev/null
@@ -0,0 +1,166 @@
+# This module is part of , and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/91/915b76dcfb3f983021583df6d5230d1b8dfd9842.svn-base b/.svn/pristine/91/915b76dcfb3f983021583df6d5230d1b8dfd9842.svn-base
new file mode 100644 (file)
index 0000000..d560275
--- /dev/null
@@ -0,0 +1,45 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/a4/a47a0b4624b67e44bc4036a82c57230aa306d670.svn-base b/.svn/pristine/a4/a47a0b4624b67e44bc4036a82c57230aa306d670.svn-base
new file mode 100644 (file)
index 0000000..074f6cc
--- /dev/null
@@ -0,0 +1,557 @@
+# This module is part of Refence, and is released under the terms of
+# the GPL version 2, or any later version. See the file README and
+# COPYING for more information.
+# Copyright 2003 by Don Armstrong <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/\&gt;(\s|$)/>$1/gso;
+     #$response =~ s/(?:(\s)\&lt;|&lt;(\/))/$1<$2/gso;
+     $response =~ s/&quot;/"/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__
+
+
+
+
+
+
diff --git a/.svn/pristine/aa/aaff9dd4f00686f7990c7b60724b5c20b1d02fc9.svn-base b/.svn/pristine/aa/aaff9dd4f00686f7990c7b60724b5c20b1d02fc9.svn-base
new file mode 100644 (file)
index 0000000..f7211ee
--- /dev/null
@@ -0,0 +1,109 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/ac/ac7ef2f46179ed36730ad1459a7463f3dba2e0f0.svn-base b/.svn/pristine/ac/ac7ef2f46179ed36730ad1459a7463f3dba2e0f0.svn-base
new file mode 100644 (file)
index 0000000..2dd8150
--- /dev/null
@@ -0,0 +1,229 @@
+# This module is part of , and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/ad/ad7ab2475d69eac938bddfc03a4dbab87c53da63.svn-base b/.svn/pristine/ad/ad7ab2475d69eac938bddfc03a4dbab87c53da63.svn-base
new file mode 100644 (file)
index 0000000..9e0f55e
--- /dev/null
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Reference
+version:      
+version_from: 
+installdirs:  site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
diff --git a/.svn/pristine/b3/b36d574064ebc73915361222bda64c3728bb7430.svn-base b/.svn/pristine/b3/b36d574064ebc73915361222bda64c3728bb7430.svn-base
new file mode 100644 (file)
index 0000000..b614068
--- /dev/null
@@ -0,0 +1,92 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2009 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/c6/c6de82ace4965920900adfcc6a828089f41f39be.svn-base b/.svn/pristine/c6/c6de82ace4965920900adfcc6a828089f41f39be.svn-base
new file mode 100644 (file)
index 0000000..e0e8256
--- /dev/null
@@ -0,0 +1,70 @@
+#! /usr/bin/perl
+# This program is part of da_reference, and is released under the
+# terms of the GPL version 2, or any later version, at your
+# option. See the file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__
diff --git a/.svn/pristine/d4/d48a2b57550595b377c1c09971495ffe1246d1f5.svn-base b/.svn/pristine/d4/d48a2b57550595b377c1c09971495ffe1246d1f5.svn-base
new file mode 100644 (file)
index 0000000..03fd6d6
--- /dev/null
@@ -0,0 +1,17 @@
+# Version control files and dirs.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Makemaker generated files and dirs.
+^MANIFEST\.
+^Makefile$
+^blib/
+^MakeMaker-\d
+
+# Temp, old and emacs backup files.
+~$
+\.old$
+^#.*#$
+^\.#
diff --git a/.svn/pristine/dd/dd9236e2f4397fc549fb9b63d96f2debf8cde523.svn-base b/.svn/pristine/dd/dd9236e2f4397fc549fb9b63d96f2debf8cde523.svn-base
new file mode 100644 (file)
index 0000000..7e39912
--- /dev/null
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+# $Id$
+
+use ExtUtils::MakeMaker;
+require './lib/Reference.pm';
+
+WriteMakefile(NAME      => 'Reference',
+             DISTNAME  => 'Reference',
+             VERSION   => $Reference::VERSION,
+             EXE_FILES => [qw(bin/get_reference)],
+            );
diff --git a/.svn/pristine/e3/e3f7eb9e892fe449aac38969920404d96bb97fd1.svn-base b/.svn/pristine/e3/e3f7eb9e892fe449aac38969920404d96bb97fd1.svn-base
new file mode 100644 (file)
index 0000000..c9db878
--- /dev/null
@@ -0,0 +1,379 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/e4/e47029d26c6aa59bbb1c4eb5f8b70850ff10c603.svn-base b/.svn/pristine/e4/e47029d26c6aa59bbb1c4eb5f8b70850ff10c603.svn-base
new file mode 100644 (file)
index 0000000..5aa42c4
--- /dev/null
@@ -0,0 +1,109 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/e5/e50cc9712302efacdf9200a3ed4e6be0d0c8e624.svn-base b/.svn/pristine/e5/e50cc9712302efacdf9200a3ed4e6be0d0c8e624.svn-base
new file mode 100644 (file)
index 0000000..ceb3938
--- /dev/null
@@ -0,0 +1,110 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/e9/e94b700c09850a326eeea4564fde2a8999d5aba7.svn-base b/.svn/pristine/e9/e94b700c09850a326eeea4564fde2a8999d5aba7.svn-base
new file mode 100644 (file)
index 0000000..f8bfd07
--- /dev/null
@@ -0,0 +1,580 @@
+# This module is part of Refence, and is released under the terms of
+# the GPL version 2, or any later version. See the file README and
+# COPYING for more information.
+# Copyright 2003 by Don Armstrong <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/\&gt;(\s|$)/>$1/gso;
+     #$response =~ s/(?:(\s)\&lt;|&lt;(\/))/$1<$2/gso;
+     $response =~ s/&quot;/"/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__
+
+
+
+
+
+
diff --git a/.svn/pristine/ee/ee77c361e33d4b819f49ea3724877f9544b8cbfd.svn-base b/.svn/pristine/ee/ee77c361e33d4b819f49ea3724877f9544b8cbfd.svn-base
new file mode 100644 (file)
index 0000000..5b22fba
--- /dev/null
@@ -0,0 +1,45 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/fb/fb163154a400250cee1a64ba030619d2730d133b.svn-base b/.svn/pristine/fb/fb163154a400250cee1a64ba030619d2730d133b.svn-base
new file mode 100644 (file)
index 0000000..5e96856
--- /dev/null
@@ -0,0 +1,105 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/.svn/pristine/fc/fc6dce9274527b60a9b01e9a01ec247284baf83d.svn-base b/.svn/pristine/fc/fc6dce9274527b60a9b01e9a01ec247284baf83d.svn-base
new file mode 100644 (file)
index 0000000..34d77cf
--- /dev/null
@@ -0,0 +1,108 @@
+#! /usr/bin/perl
+# This program is part of da_reference, and is released under the
+# terms of the GPL version 2, or any later version, at your
+# option. See the file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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);
+     }
+}
diff --git a/.svn/wc.db b/.svn/wc.db
new file mode 100644 (file)
index 0000000..e1b06ec
Binary files /dev/null and b/.svn/wc.db differ
diff --git a/MANIFEST b/MANIFEST
new file mode 100644 (file)
index 0000000..1385046
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,18 @@
+bin/find_link_testing.pl
+bin/get_reference
+lib/Reference.pm
+lib/Reference/Field/Author.pm
+lib/Reference/Field/Date.pm
+lib/Reference/Field/Journal.pm
+lib/Reference/Field/Pages.pm
+lib/Reference/Output/Bibtex.pm
+lib/Reference/Retrieve/HTML/Miner.pm
+lib/Reference/Retrieve/PubMed.pm
+lib/Reference/Type/Article.pm
+Makefile.PL
+MANIFEST                       This list of files
+META.yml                       Module meta-data (added by MakeMaker)
+NOTES
+pm_to_blib
+templates/perl_module_header.pm
+templates/perl_program_header.pl
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644 (file)
index 0000000..03fd6d6
--- /dev/null
@@ -0,0 +1,17 @@
+# Version control files and dirs.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Makemaker generated files and dirs.
+^MANIFEST\.
+^Makefile$
+^blib/
+^MakeMaker-\d
+
+# Temp, old and emacs backup files.
+~$
+\.old$
+^#.*#$
+^\.#
diff --git a/Makefile b/Makefile
new file mode 100644 (file)
index 0000000..4b92bbb
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,870 @@
+# This Makefile is for the Reference extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# 6.57_05 (Revision: 65705) from the contents of
+# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
+#
+#       ANY CHANGES MADE HERE WILL BE LOST!
+#
+#   MakeMaker ARGV: (q[INSTALLDIRS=vendor])
+#
+
+#   MakeMaker Parameters:
+
+#     BUILD_REQUIRES => {  }
+#     DISTNAME => q[Reference]
+#     EXE_FILES => [q[bin/get_reference]]
+#     NAME => q[Reference]
+#     PREREQ_PM => {  }
+#     VERSION => undef
+
+# --- MakeMaker post_initialize section:
+
+
+# --- MakeMaker const_config section:
+
+# These definitions are from config.sh (via /usr/lib/perl/5.14/Config.pm).
+# They may have been overridden via Makefile.PL or on the command line.
+AR = ar
+CC = cc
+CCCDLFLAGS = -fPIC
+CCDLFLAGS = -Wl,-E
+DLEXT = so
+DLSRC = dl_dlopen.xs
+EXE_EXT = 
+FULL_AR = /usr/bin/ar
+LD = cc
+LDDLFLAGS = -shared -L/usr/local/lib -fstack-protector
+LDFLAGS =  -fstack-protector -L/usr/local/lib
+LIBC = 
+LIB_EXT = .a
+OBJ_EXT = .o
+OSNAME = linux
+OSVERS = 3.2.0-4-amd64
+RANLIB = :
+SITELIBEXP = /usr/local/share/perl/5.14.2
+SITEARCHEXP = /usr/local/lib/perl/5.14.2
+SO = so
+VENDORARCHEXP = /usr/lib/perl5
+VENDORLIBEXP = /usr/share/perl5
+
+
+# --- MakeMaker constants section:
+AR_STATIC_ARGS = cr
+DIRFILESEP = /
+DFSEP = $(DIRFILESEP)
+NAME = Reference
+NAME_SYM = Reference
+VERSION = 
+VERSION_MACRO = VERSION
+VERSION_SYM = 
+DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
+XS_VERSION = 
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
+INST_ARCHLIB = blib/arch
+INST_SCRIPT = blib/script
+INST_BIN = blib/bin
+INST_LIB = blib/lib
+INST_MAN1DIR = blib/man1
+INST_MAN3DIR = blib/man3
+MAN1EXT = 1p
+MAN3EXT = 3pm
+INSTALLDIRS = vendor
+DESTDIR = 
+PREFIX = /usr
+PERLPREFIX = $(PREFIX)
+SITEPREFIX = $(PREFIX)/local
+VENDORPREFIX = $(PREFIX)
+INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.14
+DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
+INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.14.2
+DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
+INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5
+DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
+INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.14
+DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
+INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.14.2
+DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
+INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5
+DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
+INSTALLBIN = $(PERLPREFIX)/bin
+DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
+INSTALLSITEBIN = $(SITEPREFIX)/bin
+DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
+INSTALLVENDORBIN = $(VENDORPREFIX)/bin
+DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
+INSTALLSCRIPT = $(PERLPREFIX)/bin
+DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
+INSTALLSITESCRIPT = $(SITEPREFIX)/bin
+DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
+INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin
+DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
+INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1
+DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
+INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1
+DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
+INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1
+DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
+INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3
+DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
+INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3
+DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
+INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3
+DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
+PERL_LIB = /usr/share/perl/5.14
+PERL_ARCHLIB = /usr/lib/perl/5.14
+LIBPERL_A = libperl.a
+FIRST_MAKEFILE = Makefile
+MAKEFILE_OLD = Makefile.old
+MAKE_APERL_FILE = Makefile.aperl
+PERLMAINCC = $(CC)
+PERL_INC = /usr/lib/perl/5.14/CORE
+PERL = /usr/bin/perl
+FULLPERL = /usr/bin/perl
+ABSPERL = $(PERL)
+PERLRUN = $(PERL)
+FULLPERLRUN = $(FULLPERL)
+ABSPERLRUN = $(ABSPERL)
+PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+PERL_CORE = 0
+PERM_DIR = 755
+PERM_RW = 644
+PERM_RWX = 755
+
+MAKEMAKER   = /usr/share/perl/5.14/ExtUtils/MakeMaker.pm
+MM_VERSION  = 6.57_05
+MM_REVISION = 65705
+
+# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
+MAKE = make
+FULLEXT = Reference
+BASEEXT = Reference
+PARENT_NAME = 
+DLBASE = $(BASEEXT)
+VERSION_FROM = 
+OBJECT = 
+LDFROM = $(OBJECT)
+LINKTYPE = dynamic
+BOOTDEP = 
+
+# Handy lists of source code files:
+XS_FILES = 
+C_FILES  = 
+O_FILES  = 
+H_FILES  = 
+MAN1PODS = bin/get_reference
+MAN3PODS = lib/Reference.pm \
+       lib/Reference/Field/Author.pm \
+       lib/Reference/Field/Date.pm \
+       lib/Reference/Field/Journal.pm \
+       lib/Reference/Field/Pages.pm \
+       lib/Reference/Output/Bibtex.pm \
+       lib/Reference/Output/Filename.pm \
+       lib/Reference/Retrieve/HTML/Miner.pm \
+       lib/Reference/Retrieve/PubMed.pm \
+       lib/Reference/Type/Article.pm
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
+
+# Where to build things
+INST_LIBDIR      = $(INST_LIB)
+INST_ARCHLIBDIR  = $(INST_ARCHLIB)
+
+INST_AUTODIR     = $(INST_LIB)/auto/$(FULLEXT)
+INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
+
+INST_STATIC      = 
+INST_DYNAMIC     = 
+INST_BOOT        = 
+
+# Extra linker info
+EXPORT_LIST        = 
+PERL_ARCHIVE       = 
+PERL_ARCHIVE_AFTER = 
+
+
+TO_INST_PM = lib/Reference.pm \
+       lib/Reference/Field/Author.pm \
+       lib/Reference/Field/Date.pm \
+       lib/Reference/Field/Journal.pm \
+       lib/Reference/Field/Pages.pm \
+       lib/Reference/Output/Bibtex.pm \
+       lib/Reference/Output/Filename.pm \
+       lib/Reference/Retrieve/HTML/Miner.pm \
+       lib/Reference/Retrieve/PubMed.pm \
+       lib/Reference/Type/Article.pm
+
+PM_TO_BLIB = lib/Reference/Field/Journal.pm \
+       blib/lib/Reference/Field/Journal.pm \
+       lib/Reference/Output/Filename.pm \
+       blib/lib/Reference/Output/Filename.pm \
+       lib/Reference/Field/Author.pm \
+       blib/lib/Reference/Field/Author.pm \
+       lib/Reference/Output/Bibtex.pm \
+       blib/lib/Reference/Output/Bibtex.pm \
+       lib/Reference/Type/Article.pm \
+       blib/lib/Reference/Type/Article.pm \
+       lib/Reference.pm \
+       blib/lib/Reference.pm \
+       lib/Reference/Field/Date.pm \
+       blib/lib/Reference/Field/Date.pm \
+       lib/Reference/Field/Pages.pm \
+       blib/lib/Reference/Field/Pages.pm \
+       lib/Reference/Retrieve/HTML/Miner.pm \
+       blib/lib/Reference/Retrieve/HTML/Miner.pm \
+       lib/Reference/Retrieve/PubMed.pm \
+       blib/lib/Reference/Retrieve/PubMed.pm
+
+
+# --- MakeMaker platform_constants section:
+MM_Unix_VERSION = 6.57_05
+PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
+
+
+# --- MakeMaker tool_autosplit section:
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(ABSPERLRUN)  -e 'use AutoSplit;  autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' --
+
+
+
+# --- MakeMaker tool_xsubpp section:
+
+
+# --- MakeMaker tools_other section:
+SHELL = /bin/sh
+CHMOD = chmod
+CP = cp
+MV = mv
+NOOP = $(TRUE)
+NOECHO = @
+RM_F = rm -f
+RM_RF = rm -rf
+TEST_F = test -f
+TOUCH = touch
+UMASK_NULL = umask 0
+DEV_NULL = > /dev/null 2>&1
+MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' --
+EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' --
+FALSE = false
+TRUE = true
+ECHO = echo
+ECHO_N = echo -n
+UNINST = 0
+VERBINST = 0
+MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' --
+DOC_INSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'perllocal_install' --
+UNINSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'uninstall' --
+WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'warn_if_old_packlist' --
+MACROSTART = 
+MACROEND = 
+USEMAKEFILE = -f
+FIXIN = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' --
+
+
+# --- MakeMaker makemakerdflt section:
+makemakerdflt : all
+       $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dist section:
+TAR = tar
+TARFLAGS = cvf
+ZIP = zip
+ZIPFLAGS = -r
+COMPRESS = gzip --best
+SUFFIX = .gz
+SHAR = shar
+PREOP = $(NOECHO) $(NOOP)
+POSTOP = $(NOECHO) $(NOOP)
+TO_UNIX = $(NOECHO) $(NOOP)
+CI = ci -u
+RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
+DIST_CP = best
+DIST_DEFAULT = tardist
+DISTNAME = Reference
+DISTVNAME = Reference-
+
+
+# --- MakeMaker macro section:
+
+
+# --- MakeMaker depend section:
+
+
+# --- MakeMaker cflags section:
+
+
+# --- MakeMaker const_loadlibs section:
+
+
+# --- MakeMaker const_cccmd section:
+
+
+# --- MakeMaker post_constants section:
+
+
+# --- MakeMaker pasthru section:
+
+PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
+       LINKTYPE="$(LINKTYPE)"\
+       LD="$(LD)"\
+       PREFIX="$(PREFIX)"
+
+
+# --- MakeMaker special_targets section:
+.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
+
+.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
+
+
+
+# --- MakeMaker c_o section:
+
+
+# --- MakeMaker xs_c section:
+
+
+# --- MakeMaker xs_o section:
+
+
+# --- MakeMaker top_targets section:
+all :: pure_all manifypods
+       $(NOECHO) $(NOOP)
+
+
+pure_all :: config pm_to_blib subdirs linkext
+       $(NOECHO) $(NOOP)
+
+subdirs :: $(MYEXTLIB)
+       $(NOECHO) $(NOOP)
+
+config :: $(FIRST_MAKEFILE) blibdirs
+       $(NOECHO) $(NOOP)
+
+help :
+       perldoc ExtUtils::MakeMaker
+
+
+# --- MakeMaker blibdirs section:
+blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists
+       $(NOECHO) $(NOOP)
+
+# Backwards compat with 6.18 through 6.25
+blibdirs.ts : blibdirs
+       $(NOECHO) $(NOOP)
+
+$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
+       $(NOECHO) $(MKPATH) $(INST_LIBDIR)
+       $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_LIBDIR)
+       $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
+
+$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
+       $(NOECHO) $(MKPATH) $(INST_ARCHLIB)
+       $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB)
+       $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
+
+$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
+       $(NOECHO) $(MKPATH) $(INST_AUTODIR)
+       $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR)
+       $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
+
+$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
+       $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
+       $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR)
+       $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
+
+$(INST_BIN)$(DFSEP).exists :: Makefile.PL
+       $(NOECHO) $(MKPATH) $(INST_BIN)
+       $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN)
+       $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
+
+$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
+       $(NOECHO) $(MKPATH) $(INST_SCRIPT)
+       $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT)
+       $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
+
+$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
+       $(NOECHO) $(MKPATH) $(INST_MAN1DIR)
+       $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR)
+       $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
+
+$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
+       $(NOECHO) $(MKPATH) $(INST_MAN3DIR)
+       $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR)
+       $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
+
+
+
+# --- MakeMaker linkext section:
+
+linkext :: $(LINKTYPE)
+       $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dlsyms section:
+
+
+# --- MakeMaker dynamic section:
+
+dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
+       $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dynamic_bs section:
+
+BOOTSTRAP =
+
+
+# --- MakeMaker dynamic_lib section:
+
+
+# --- MakeMaker static section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+static :: $(FIRST_MAKEFILE) $(INST_STATIC)
+       $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker static_lib section:
+
+
+# --- MakeMaker manifypods section:
+
+POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
+POD2MAN = $(POD2MAN_EXE)
+
+
+manifypods : pure_all  \
+       bin/get_reference \
+       lib/Reference/Field/Journal.pm \
+       lib/Reference/Output/Filename.pm \
+       lib/Reference/Field/Author.pm \
+       lib/Reference/Output/Bibtex.pm \
+       lib/Reference/Type/Article.pm \
+       lib/Reference.pm \
+       lib/Reference/Field/Date.pm \
+       lib/Reference/Field/Pages.pm \
+       lib/Reference/Retrieve/HTML/Miner.pm \
+       lib/Reference/Retrieve/PubMed.pm
+       $(NOECHO) $(POD2MAN) --section=$(MAN1EXT) --perm_rw=$(PERM_RW) \
+         bin/get_reference $(INST_MAN1DIR)/get_reference.$(MAN1EXT) 
+       $(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \
+         lib/Reference/Field/Journal.pm $(INST_MAN3DIR)/Reference::Field::Journal.$(MAN3EXT) \
+         lib/Reference/Output/Filename.pm $(INST_MAN3DIR)/Reference::Output::Filename.$(MAN3EXT) \
+         lib/Reference/Field/Author.pm $(INST_MAN3DIR)/Reference::Field::Author.$(MAN3EXT) \
+         lib/Reference/Output/Bibtex.pm $(INST_MAN3DIR)/Reference::Output::Bibtex.$(MAN3EXT) \
+         lib/Reference/Type/Article.pm $(INST_MAN3DIR)/Reference::Type::Article.$(MAN3EXT) \
+         lib/Reference.pm $(INST_MAN3DIR)/Reference.$(MAN3EXT) \
+         lib/Reference/Field/Date.pm $(INST_MAN3DIR)/Reference::Field::Date.$(MAN3EXT) \
+         lib/Reference/Field/Pages.pm $(INST_MAN3DIR)/Reference::Field::Pages.$(MAN3EXT) \
+         lib/Reference/Retrieve/HTML/Miner.pm $(INST_MAN3DIR)/Reference::Retrieve::HTML::Miner.$(MAN3EXT) \
+         lib/Reference/Retrieve/PubMed.pm $(INST_MAN3DIR)/Reference::Retrieve::PubMed.$(MAN3EXT) 
+
+
+
+
+# --- MakeMaker processPL section:
+
+
+# --- MakeMaker installbin section:
+
+EXE_FILES = bin/get_reference
+
+pure_all :: $(INST_SCRIPT)/get_reference
+       $(NOECHO) $(NOOP)
+
+realclean ::
+       $(RM_F) \
+         $(INST_SCRIPT)/get_reference 
+
+$(INST_SCRIPT)/get_reference : bin/get_reference $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
+       $(NOECHO) $(RM_F) $(INST_SCRIPT)/get_reference
+       $(CP) bin/get_reference $(INST_SCRIPT)/get_reference
+       $(FIXIN) $(INST_SCRIPT)/get_reference
+       -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_SCRIPT)/get_reference
+
+
+
+# --- MakeMaker subdirs section:
+
+# none
+
+# --- MakeMaker clean_subdirs section:
+clean_subdirs :
+       $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker clean section:
+
+# Delete temporary files but do not touch installed files. We don't delete
+# the Makefile here so a later make realclean still has a makefile to use.
+
+clean :: clean_subdirs
+       - $(RM_F) \
+         *$(LIB_EXT) core \
+         core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \
+         core.[0-9][0-9] $(BASEEXT).bso \
+         pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \
+         MYMETA.yml $(BASEEXT).x \
+         $(BOOTSTRAP) perl$(EXE_EXT) \
+         tmon.out *$(OBJ_EXT) \
+         pm_to_blib $(INST_ARCHAUTODIR)/extralibs.ld \
+         blibdirs.ts core.[0-9][0-9][0-9][0-9][0-9] \
+         *perl.core core.*perl.*.? \
+         $(MAKE_APERL_FILE) $(BASEEXT).def \
+         perl core.[0-9][0-9][0-9] \
+         mon.out lib$(BASEEXT).def \
+         perlmain.c perl.exe \
+         so_locations $(BASEEXT).exp 
+       - $(RM_RF) \
+         blib 
+       - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
+
+
+# --- MakeMaker realclean_subdirs section:
+realclean_subdirs :
+       $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker realclean section:
+# Delete temporary files (via clean) and also delete dist files
+realclean purge ::  clean realclean_subdirs
+       - $(RM_F) \
+         $(MAKEFILE_OLD) $(FIRST_MAKEFILE) 
+       - $(RM_RF) \
+         $(DISTVNAME) 
+
+
+# --- MakeMaker metafile section:
+metafile : create_distdir
+       $(NOECHO) $(ECHO) Generating META.yml
+       $(NOECHO) $(ECHO) '--- #YAML:1.0' > META_new.yml
+       $(NOECHO) $(ECHO) 'name:               Reference' >> META_new.yml
+       $(NOECHO) $(ECHO) 'version:            ' >> META_new.yml
+       $(NOECHO) $(ECHO) 'abstract:           ~' >> META_new.yml
+       $(NOECHO) $(ECHO) 'author:  []' >> META_new.yml
+       $(NOECHO) $(ECHO) 'license:            unknown' >> META_new.yml
+       $(NOECHO) $(ECHO) 'distribution_type:  module' >> META_new.yml
+       $(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml
+       $(NOECHO) $(ECHO) '    ExtUtils::MakeMaker:  0' >> META_new.yml
+       $(NOECHO) $(ECHO) 'build_requires:' >> META_new.yml
+       $(NOECHO) $(ECHO) '    ExtUtils::MakeMaker:  0' >> META_new.yml
+       $(NOECHO) $(ECHO) 'requires:  {}' >> META_new.yml
+       $(NOECHO) $(ECHO) 'no_index:' >> META_new.yml
+       $(NOECHO) $(ECHO) '    directory:' >> META_new.yml
+       $(NOECHO) $(ECHO) '        - t' >> META_new.yml
+       $(NOECHO) $(ECHO) '        - inc' >> META_new.yml
+       $(NOECHO) $(ECHO) 'generated_by:       ExtUtils::MakeMaker version 6.57_05' >> META_new.yml
+       $(NOECHO) $(ECHO) 'meta-spec:' >> META_new.yml
+       $(NOECHO) $(ECHO) '    url:      http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml
+       $(NOECHO) $(ECHO) '    version:  1.4' >> META_new.yml
+       -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
+
+
+# --- MakeMaker signature section:
+signature :
+       cpansign -s
+
+
+# --- MakeMaker dist_basics section:
+distclean :: realclean distcheck
+       $(NOECHO) $(NOOP)
+
+distcheck :
+       $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
+
+skipcheck :
+       $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
+
+manifest :
+       $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
+
+veryclean : realclean
+       $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old 
+
+
+
+# --- MakeMaker dist_core section:
+
+dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
+       $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \
+         -e '    if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' --
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+       $(NOECHO) $(NOOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+       uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+       $(PREOP)
+       $(TO_UNIX)
+       $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+       $(RM_RF) $(DISTVNAME)
+       $(COMPRESS) $(DISTVNAME).tar
+       $(POSTOP)
+
+zipdist : $(DISTVNAME).zip
+       $(NOECHO) $(NOOP)
+
+$(DISTVNAME).zip : distdir
+       $(PREOP)
+       $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+       $(RM_RF) $(DISTVNAME)
+       $(POSTOP)
+
+shdist : distdir
+       $(PREOP)
+       $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+       $(RM_RF) $(DISTVNAME)
+       $(POSTOP)
+
+
+# --- MakeMaker distdir section:
+create_distdir :
+       $(RM_RF) $(DISTVNAME)
+       $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
+               -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
+
+distdir : create_distdir distmeta 
+       $(NOECHO) $(NOOP)
+
+
+
+# --- MakeMaker dist_test section:
+disttest : distdir
+       cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL "INSTALLDIRS=vendor"
+       cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
+       cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
+
+
+
+# --- MakeMaker dist_ci section:
+
+ci :
+       $(PERLRUN) "-MExtUtils::Manifest=maniread" \
+         -e "@all = keys %{ maniread() };" \
+         -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
+         -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
+
+
+# --- MakeMaker distmeta section:
+distmeta : create_distdir metafile
+       $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \
+         -e '    or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' --
+
+
+
+# --- MakeMaker distsignature section:
+distsignature : create_distdir
+       $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \
+         -e '    or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' --
+       $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
+       cd $(DISTVNAME) && cpansign -s
+
+
+
+# --- MakeMaker install section:
+
+install :: pure_install doc_install
+       $(NOECHO) $(NOOP)
+
+install_perl :: pure_perl_install doc_perl_install
+       $(NOECHO) $(NOOP)
+
+install_site :: pure_site_install doc_site_install
+       $(NOECHO) $(NOOP)
+
+install_vendor :: pure_vendor_install doc_vendor_install
+       $(NOECHO) $(NOOP)
+
+pure_install :: pure_$(INSTALLDIRS)_install
+       $(NOECHO) $(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+       $(NOECHO) $(NOOP)
+
+pure__install : pure_site_install
+       $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+       $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install :: all
+       $(NOECHO) umask 022; $(MOD_INSTALL) \
+               $(INST_LIB) $(DESTINSTALLPRIVLIB) \
+               $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
+               $(INST_BIN) $(DESTINSTALLBIN) \
+               $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+               $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
+               $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
+       $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+               $(SITEARCHEXP)/auto/$(FULLEXT)
+
+
+pure_site_install :: all
+       $(NOECHO) umask 02; $(MOD_INSTALL) \
+               read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
+               write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
+               $(INST_LIB) $(DESTINSTALLSITELIB) \
+               $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
+               $(INST_BIN) $(DESTINSTALLSITEBIN) \
+               $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \
+               $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
+               $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
+       $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+               $(PERL_ARCHLIB)/auto/$(FULLEXT)
+
+pure_vendor_install :: all
+       $(NOECHO) umask 022; $(MOD_INSTALL) \
+               $(INST_LIB) $(DESTINSTALLVENDORLIB) \
+               $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
+               $(INST_BIN) $(DESTINSTALLVENDORBIN) \
+               $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \
+               $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
+               $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
+
+doc_perl_install :: all
+
+doc_site_install :: all
+       $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod
+       -$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH)
+       -$(NOECHO) umask 02; $(DOC_INSTALL) \
+               "Module" "$(NAME)" \
+               "installed into" "$(INSTALLSITELIB)" \
+               LINKTYPE "$(LINKTYPE)" \
+               VERSION "$(VERSION)" \
+               EXE_FILES "$(EXE_FILES)" \
+               >> $(DESTINSTALLSITEARCH)/perllocal.pod
+
+doc_vendor_install :: all
+
+
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+       $(NOECHO) $(NOOP)
+
+uninstall_from_perldirs ::
+
+uninstall_from_sitedirs ::
+       $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
+
+uninstall_from_vendordirs ::
+
+
+
+# --- MakeMaker force section:
+# Phony target to force checking subdirectories.
+FORCE :
+       $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker perldepend section:
+
+
+# --- MakeMaker makefile section:
+# We take a very conservative approach here, but it's worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
+       $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
+       $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
+       -$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
+       -$(NOECHO) $(MV)   $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
+       - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
+       $(PERLRUN) Makefile.PL "INSTALLDIRS=vendor"
+       $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
+       $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command.  <=="
+       $(FALSE)
+
+
+
+# --- MakeMaker staticmake section:
+
+# --- MakeMaker makeaperl section ---
+MAP_TARGET    = perl
+FULLPERL      = /usr/bin/perl
+
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+       $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
+       $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+       $(NOECHO) $(PERLRUNINST) \
+               Makefile.PL DIR= \
+               MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+               MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= \
+               INSTALLDIRS=vendor
+
+
+# --- MakeMaker test section:
+
+TEST_VERBOSE=0
+TEST_TYPE=test_$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES = 
+TESTDB_SW = -d
+
+testdb :: testdb_$(LINKTYPE)
+
+test :: $(TEST_TYPE) subdirs-test
+
+subdirs-test ::
+       $(NOECHO) $(NOOP)
+
+       $(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.'
+
+test_dynamic :: pure_all
+
+testdb_dynamic :: pure_all
+       PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
+
+test_ : test_dynamic
+
+test_static :: test_dynamic
+testdb_static :: testdb_dynamic
+
+
+# --- MakeMaker ppd section:
+# Creates a PPD (Perl Package Description) for a binary distribution.
+ppd :
+       $(NOECHO) $(ECHO) '<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.
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..7a00e0a
--- /dev/null
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+# $Id: Makefile.PL 35 2004-11-05 21:50:00Z don $
+
+use ExtUtils::MakeMaker;
+require './lib/Reference.pm';
+
+WriteMakefile(NAME      => 'Reference',
+             DISTNAME  => 'Reference',
+             VERSION   => $Reference::VERSION,
+             EXE_FILES => [qw(bin/get_reference)],
+            );
diff --git a/NOTES b/NOTES
new file mode 100644 (file)
index 0000000..aac6d98
--- /dev/null
+++ b/NOTES
@@ -0,0 +1,8 @@
+
+
+Z39.50 support
+ Zoom API -- http://zoom.z3950.org/
+ LOC Z39.50 -- http://lcweb.loc.gov/z3950/lcserver.html
+ Perl http://search.cpan.org/~mirk/Net-Z3950-0.41/Z3950.pm
+
+ Melvyl z39.50 melvyl.cdlib.org port 210
\ No newline at end of file
diff --git a/bin/get_reference b/bin/get_reference
new file mode 100755 (executable)
index 0000000..b042465
--- /dev/null
@@ -0,0 +1,111 @@
+#! /usr/bin/perl
+# This program is part of da_reference, and is released under the
+# terms of the GPL version 2, or any later version, at your
+# option. See the file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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);
+     }
+}
diff --git a/blib/arch/.exists b/blib/arch/.exists
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/blib/arch/auto/Reference/.exists b/blib/arch/auto/Reference/.exists
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/blib/bin/.exists b/blib/bin/.exists
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/blib/lib/.exists b/blib/lib/.exists
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/blib/lib/Reference.pm b/blib/lib/Reference.pm
new file mode 100644 (file)
index 0000000..a650f1d
--- /dev/null
@@ -0,0 +1,229 @@
+# This module is part of , and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Field/Author.pm b/blib/lib/Reference/Field/Author.pm
new file mode 100644 (file)
index 0000000..e0ff48c
--- /dev/null
@@ -0,0 +1,330 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+
+# Copyright 2003, 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Field/Date.pm b/blib/lib/Reference/Field/Date.pm
new file mode 100644 (file)
index 0000000..7768772
--- /dev/null
@@ -0,0 +1,178 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Field/Journal.pm b/blib/lib/Reference/Field/Journal.pm
new file mode 100644 (file)
index 0000000..ad5639a
--- /dev/null
@@ -0,0 +1,110 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Field/Pages.pm b/blib/lib/Reference/Field/Pages.pm
new file mode 100644 (file)
index 0000000..8e1c1c2
--- /dev/null
@@ -0,0 +1,109 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Output/Bibtex.pm b/blib/lib/Reference/Output/Bibtex.pm
new file mode 100644 (file)
index 0000000..06cd71d
--- /dev/null
@@ -0,0 +1,379 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Output/Filename.pm b/blib/lib/Reference/Output/Filename.pm
new file mode 100644 (file)
index 0000000..3fd2696
--- /dev/null
@@ -0,0 +1,92 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2009 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Retrieve/HTML/Miner.pm b/blib/lib/Reference/Retrieve/HTML/Miner.pm
new file mode 100644 (file)
index 0000000..3c934f4
--- /dev/null
@@ -0,0 +1,45 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Retrieve/PubMed.pm b/blib/lib/Reference/Retrieve/PubMed.pm
new file mode 100644 (file)
index 0000000..553245d
--- /dev/null
@@ -0,0 +1,580 @@
+# This module is part of Refence, and is released under the terms of
+# the GPL version 2, or any later version. See the file README and
+# COPYING for more information.
+# Copyright 2003 by Don Armstrong <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/\&gt;(\s|$)/>$1/gso;
+     #$response =~ s/(?:(\s)\&lt;|&lt;(\/))/$1<$2/gso;
+     $response =~ s/&quot;/"/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__
+
+
+
+
+
+
diff --git a/blib/lib/Reference/Type/Article.pm b/blib/lib/Reference/Type/Article.pm
new file mode 100644 (file)
index 0000000..b309071
--- /dev/null
@@ -0,0 +1,166 @@
+# This module is part of , and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/blib/lib/auto/Reference/.exists b/blib/lib/auto/Reference/.exists
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/blib/man1/.exists b/blib/man1/.exists
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/blib/man1/get_reference.1p b/blib/man1/get_reference.1p
new file mode 100644 (file)
index 0000000..130f6e8
--- /dev/null
@@ -0,0 +1,167 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "GET_REFERENCE 1p"
+.TH GET_REFERENCE 1p "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+get_reference \- Retrieve a reference from somewhere and output the
+formatted reference to STDOUT.
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+get_reference [options] referenceid [referenceid ...]
+.PP
+.Vb 6
+\& Options:
+\&  \-\-pmid,\-p referenceid is a pub med id. (Default)
+\&  \-\-bibtex,\-b ouput in bibtex format (Default)
+\&  \-\-debug, \-d debugging level (Default 0)
+\&  \-\-help,\-h display this help
+\&  \-\-man,\-m display manual
+.Ve
+.SH "OPTIONS"
+.IX Header "OPTIONS"
+.IP "\fB\-\-pmid, \-p\fR" 4
+.IX Item "--pmid, -p"
+The referenceid listed is a Pub Med \s-1ID\s0. (Default)
+.IP "\fB\-\-bibtex, \-b\fR" 4
+.IX Item "--bibtex, -b"
+Output the listed referenceid in BibTeX format. (Default)
+.IP "\fB\-\-help, \-h\fR" 4
+.IX Item "--help, -h"
+Display brief useage information.
+.IP "\fB\-\-man, \-m\fR" 4
+.IX Item "--man, -m"
+Display this manual.
+.SH "EXAMPLES"
+.IX Header "EXAMPLES"
+.Vb 1
+\&     get_reference \-p \-b \-d 1 123456;
+\&
+\&     get_reference 123456;
+.Ve
diff --git a/blib/man3/.exists b/blib/man3/.exists
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/blib/man3/Reference.3pm b/blib/man3/Reference.3pm
new file mode 100644 (file)
index 0000000..b0faef4
--- /dev/null
@@ -0,0 +1,197 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference 3pm"
+.TH Reference 3pm "2013-09-09" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+Reference \-\- Reference superclass
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
+.SS "new"
+.IX Subsection "new"
+.Vb 1
+\&     my $reference = new Reference;
+.Ve
+.PP
+Creates a new reference object
+.SS "ref_fields"
+.IX Subsection "ref_fields"
+.Vb 1
+\&     @$self\->{ref_fields}{$self\->ref_fields} = (1) x $self\->ref_fields;
+.Ve
+.PP
+Returns the fields that this reference knows how to deal with (or that
+should be dealt with using ref_fields).
+.PP
+This default implementation returns an empty list, and as such should
+be overriden by all Reference::Type subclasses.
+.SS "ref_field"
+.IX Subsection "ref_field"
+.Vb 1
+\&     $reference\->ref_field(\*(Aqauthor\*(Aq,[\*(AqJohn Q. Smith\*(Aq, \*(AqRandal P. Swag\*(Aq]);
+.Ve
+.PP
+Sets the reference field to the passed value (if any) and returns the
+new value. This function is called through \s-1AUTOLOAD\s0 using the
+\&\f(CW$reference\fR\->\fIfield()\fR syntax.
+.PP
+Returns the new setting of passed field.
+.PP
+Scalar fieldname, and an optional scalar, arrayref, or hashref to set
+reference field.
+.SS "\s-1AUTOLOAD\s0"
+.IX Subsection "AUTOLOAD"
+Dispatches calls to \f(CW$reference\fR\->fieldname to
+\&\f(CW$reference\fR\->ref_field('fieldname').
+.PP
+\&\s-1XXX\s0 I really wish there was a way to tell perl that we don't want to
+\&\s-1XXX\s0 handle a call to \s-1AUTOLOAD\s0.
+.SS "can"
+.IX Subsection "can"
+.Vb 2
+\&     $obj\->can(\*(AqMETHOD\*(Aq);
+\&     Class::Modular\->can(\*(AqMETHOD\*(Aq);
+.Ve
+.PP
+Replaces \s-1UNIVERSAL\s0's can method so that handled methods are reported
+correctly. Calls UNIVERSAL::can in the places where we don't know
+anything it doesn't.
+.PP
+Returns a coderef to the method if the method is supported, undef
+otherwise.
+.SS "_init"
+.IX Subsection "_init"
+.Vb 1
+\&     $self\->_init
+.Ve
diff --git a/blib/man3/Reference::Field::Author.3pm b/blib/man3/Reference::Field::Author.3pm
new file mode 100644 (file)
index 0000000..afdd1b4
--- /dev/null
@@ -0,0 +1,224 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Field::Author 3pm"
+.TH Reference::Field::Author 3pm "2009-03-23" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+Reference::Field::Author \-\-
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+.SH "TODO"
+.IX Header "TODO"
+\&\s-1XXX\s0 Allow the corresponding author to be set explicitely
+.PP
+\&\s-1XXX\s0 To do this, we need to break away from using the author field as
+an arrayref, and instead use a hashref with the author fields, and a
+specific corresponding author setting. [This should probaly be de
+riguer for other fields as well.]
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
+.SS "author"
+.IX Subsection "author"
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+\fIFunction\fR
+.IX Subsection "Function"
+.PP
+\fIReturns\fR
+.IX Subsection "Returns"
+.PP
+\fIArgs\fR
+.IX Subsection "Args"
+.SS "corresponding_author"
+.IX Subsection "corresponding_author"
+.Vb 1
+\&     my $corresponding_author = $ref\->corresponding_author;
+.Ve
+.PP
+Returns the corresponding author (the last author listed.)
+.SS "first_author"
+.IX Subsection "first_author"
+.Vb 1
+\&     my $first_author = $ref\->first_author;
+.Ve
+.PP
+Returns the first author (primary author.)
+.SS "_parse_author"
+.IX Subsection "_parse_author"
+.Vb 1
+\&     my $author_info = _parse_author($author);
+.Ve
+.PP
+Parses the author and returns an author record.
+.PP
+Author record
+.PP
+The author can be specified in a few different ways:
+.IP "\s-1SCALAR\s0 Author Name" 4
+.IX Item "SCALAR Author Name"
+.RS 4
+.PD 0
+.IP "\s-1SMITH\s0 John W." 4
+.IX Item "SMITH John W."
+.IP "Smith \s-1JW\s0" 4
+.IX Item "Smith JW"
+.IP "John W. Smith" 4
+.IX Item "John W. Smith"
+.IP "John Wilkenson Smith" 4
+.IX Item "John Wilkenson Smith"
+.IP "\s-1HASHREF\s0 Author structure" 4
+.IX Item "HASHREF Author structure"
+.IP "\s-1ARRAYREF\s0 Author Name" 4
+.IX Item "ARRAYREF Author Name"
+.RE
+.RS 4
+.PD
+.Sp
+In these cases, the author's name should be parsed appropriately. [\s-1XXX\s0
+Needs to be extended to handle Smith, John W. appropriately.]
+.RE
+.SS "_delete_author"
+.IX Subsection "_delete_author"
+\&\s-1XXX\s0 \s-1NOT\s0 \s-1IMPLEMENTED\s0
+.SS "_init"
+.IX Subsection "_init"
+Called by Reference's new function
+.PP
+Call superclass's _init function [\f(CW\*(C`$self\-\*(C'\fRNEXT::_init>], sets up the
+author list reference.
+.SH "POD ERRORS"
+.IX Header "POD ERRORS"
+Hey! \fBThe above document had some coding errors, which are explained below:\fR
+.IP "Around line 282:" 4
+.IX Item "Around line 282:"
+You forgot a '=back' before '=head2'
diff --git a/blib/man3/Reference::Field::Date.3pm b/blib/man3/Reference::Field::Date.3pm
new file mode 100644 (file)
index 0000000..b9ee4b7
--- /dev/null
@@ -0,0 +1,154 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Field::Date 3pm"
+.TH Reference::Field::Date 3pm "2009-03-23" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+.Vb 1
+\& \-\-
+.Ve
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
+.SS "date"
+.IX Subsection "date"
+\&\s-1XXX\s0 \s-1DOCUMENT\s0 \s-1ME\s0
+.SS "year"
+.IX Subsection "year"
+Returns the year associated with the date field
+.SS "day"
+.IX Subsection "day"
+Returns the day associated with the date field
+.SS "month"
+.IX Subsection "month"
+Returns the month associated with the date field
diff --git a/blib/man3/Reference::Field::Journal.3pm b/blib/man3/Reference::Field::Journal.3pm
new file mode 100644 (file)
index 0000000..fa8ceb4
--- /dev/null
@@ -0,0 +1,142 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Field::Journal 3pm"
+.TH Reference::Field::Journal 3pm "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+.Vb 1
+\& \-\-
+.Ve
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
diff --git a/blib/man3/Reference::Field::Pages.3pm b/blib/man3/Reference::Field::Pages.3pm
new file mode 100644 (file)
index 0000000..d8762ae
--- /dev/null
@@ -0,0 +1,142 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Field::Pages 3pm"
+.TH Reference::Field::Pages 3pm "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+.Vb 1
+\& \-\-
+.Ve
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
diff --git a/blib/man3/Reference::Output::Bibtex.3pm b/blib/man3/Reference::Output::Bibtex.3pm
new file mode 100644 (file)
index 0000000..4d28c5c
--- /dev/null
@@ -0,0 +1,231 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Output::Bibtex 3pm"
+.TH Reference::Output::Bibtex 3pm "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+Reference::Output::Bibtex \-\- Output references in BibTeX format
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.Vb 1
+\&     print bibtex($reference);
+.Ve
+.PP
+Returns a reference formatted in bibtex format.
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+Knows how to handle the reference\-> bibtex field mapping for many
+reference types, but overridden types may need to provide their own
+mapping.
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
+.SS "bibtex"
+.IX Subsection "bibtex"
+.Vb 3
+\&     print bibtex $reference;
+\&     %bibtex = bibtex $reference;
+\&     print bibtex($reference,mapping=>{...})
+.Ve
+.PP
+In scalar context, returns a formatted bibtex entry, suitable for
+printing. In list context, returns a hash of key, value pairs which
+can be used to print a formatted bibtex entry.
+.PP
+You can also pass an optional mapping to be used for making the bibtex
+entry. See \fBbibtex_mapping\fR for the details.
+.PP
+The mappings are obeyed in the following order, the first taking
+precedence over the last.
+.IP "Passed mapping" 4
+.IX Item "Passed mapping"
+.PD 0
+.IP "Object's bibtex_mapping" 4
+.IX Item "Object's bibtex_mapping"
+.IP "Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping)" 4
+.IX Item "Internal bibtex_mapping (%Reference::Output::Bibtex::bibtex_mapping)"
+.PD
+.PP
+Returns a \s-1SCALAR\s0 bibtex reference in scalar context, a \s-1HASH\s0 bibtex
+reference in list context
+.SS "bibtex_mapping"
+.IX Subsection "bibtex_mapping"
+.Vb 11
+\&      $Reference::Output::Bibtex::bibtex_mapping{Article} =
+\&        {mapping => {author   => {field  => \*(Aqauthor\*(Aq,
+\&                                  join   => \*(Aq and \*(Aq,
+\&                                  params => [],
+\&                                 },
+\&                     volume   => \*(Aqvolume\*(Aq,
+\&                     Articlce => \*(Aqname\*(Aq,
+\&                     foo      => \*(Aqbar\*(Aq,
+\&                    },
+\&         order => [qw(name author volume foo)],
+\&        };
+.Ve
+.PP
+This variable holds the mapping to bibtex output.
+.PP
+Each type of reference has its own keys. Currently the following types
+are supported by the Bibtex output method:
+.IP "article" 4
+.IX Item "article"
+.PD 0
+.IP "collection" 4
+.IX Item "collection"
+.IP "book" 4
+.IX Item "book"
+.PD
+.PP
+If you wish to add support for your own custom reference type, you
+merely need to add a bibtex_mapping element to your class's hashref,
+or add to this variable. [Preferbly the former, as the latter should
+only be used by the end user.]
+.PP
+The mapping key in the reference type hashref is a hashref containing
+key value pairs according to the following metric:
+.ie n .IP "If the mapping key value is not a reference, the value is used as the name function to call via ""$reference\-""field>. [In the example above, the volume mapping is built by a call to ""$reference\-""volume>]." 4
+.el .IP "If the mapping key value is not a reference, the value is used as the name function to call via \f(CW$reference\-\fRfield>. [In the example above, the volume mapping is built by a call to \f(CW$reference\-\fRvolume>]." 4
+.IX Item "If the mapping key value is not a reference, the value is used as the name function to call via $reference-field>. [In the example above, the volume mapping is built by a call to $reference-volume>]."
+.PD 0
+.ie n .IP "If the mapping key value is a hashref, the hashref contains two keys. The ""field"" key contains the name of the function to call. The ""params"" key contains the parameters" 4
+.el .IP "If the mapping key value is a hashref, the hashref contains two keys. The \f(CWfield\fR key contains the name of the function to call. The \f(CWparams\fR key contains the parameters" 4
+.IX Item "If the mapping key value is a hashref, the hashref contains two keys. The field key contains the name of the function to call. The params key contains the parameters"
+.PD
+.PP
+The order key in the reference type hashref is an arrayref which
+defines the order in which keys are listed in the BibTeX
+output. Values in the arrayref should be the keys of the mapping
+hashref. [The first value listed is the type of reference/reference
+name pair.]
+.SS "convert_to_utf8"
+.IX Subsection "convert_to_utf8"
+.Vb 1
+\&    $utf8 = convert_to_utf8("text","charset");
+.Ve
diff --git a/blib/man3/Reference::Output::Filename.3pm b/blib/man3/Reference::Output::Filename.3pm
new file mode 100644 (file)
index 0000000..138978a
--- /dev/null
@@ -0,0 +1,150 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Output::Filename 3pm"
+.TH Reference::Output::Filename 3pm "2009-03-23" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+Reference::Output::Filename \-\- Output a filename for the reference
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.Vb 1
+\&     print filename($reference);
+.Ve
+.PP
+Returns a filename for the reference
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
+.SS "filename"
+.IX Subsection "filename"
+.Vb 1
+\&     print filename($reference).\*(Aq.pdf\*(Aq;
+.Ve
+.PP
+Returns a filename for a reference
diff --git a/blib/man3/Reference::Retrieve::HTML::Miner.3pm b/blib/man3/Reference::Retrieve::HTML::Miner.3pm
new file mode 100644 (file)
index 0000000..d8d4f71
--- /dev/null
@@ -0,0 +1,142 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Retrieve::HTML::Miner 3pm"
+.TH Reference::Retrieve::HTML::Miner 3pm "2007-07-03" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+.Vb 1
+\& \-\-
+.Ve
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
diff --git a/blib/man3/Reference::Retrieve::PubMed.3pm b/blib/man3/Reference::Retrieve::PubMed.3pm
new file mode 100644 (file)
index 0000000..df3edb7
--- /dev/null
@@ -0,0 +1,247 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Retrieve::PubMed 3pm"
+.TH Reference::Retrieve::PubMed 3pm "2013-09-10" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+Reference::Retrieve::PubMed \-\- Reference Retrieval from PubMed
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.Vb 2
+\&     my $reference = Reference::Retrieve::PubMed::get_reference(\-pmid=>123456);
+\&     my @references = Reference::Retrieve::PubMed::get_reference(\-query=>\*(AqJohn Smith[AUTHOR] AND 230[Pages]\*(Aq,limit=>50);
+.Ve
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+Uh. Retreives references from pubmed. Yeah.
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
+.SS "get_reference"
+.IX Subsection "get_reference"
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+.Vb 3
+\&     my $reference = Reference::Retrieve::PubMed::get_reference(\-pmid=>123456);
+\&     my @references = Reference::Retrieve::PubMed::get_reference(\-query=>\*(AqJohn Smith[AUTHOR] AND 230[Pages]\*(Aq,\-limit=>50);
+\&     my @references = Reference::Retrieve::PubMed::get_reference(\-query=>{author=>\*(AqJohn Smith\*(Aq, pages=>\*(Aq230\*(Aq},\-limit=>50)
+.Ve
+.PP
+\fIFunction\fR
+.IX Subsection "Function"
+.PP
+Retrives a reference from pubmed
+.PP
+\fIReturns\fR
+.IX Subsection "Returns"
+.PP
+In scalar context, effectively assumes \-limit=>1 and returns the
+highest listed reference according to the order, etc. [Probably only
+usefull with \-pmid.] In list context, returns all results (or until it
+hits the \-limit.)
+.PP
+\fIArgs\fR
+.IX Subsection "Args"
+.PP
+list of arguments to select a reference or collection of references from.
+.SS "_fix_medline_journal"
+.IX Subsection "_fix_medline_journal"
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+.Vb 3
+\&     $reference\->journal(_fix_medline_journal($ref\->{MedlineCitation}\->{Article}\->{Journal},
+\&                                              $ref\->{MedlineCitation}\->{Article}\->{MedlineJournalInfo},
+\&                                              $ua,));
+.Ve
+.PP
+\fIFunction\fR
+.IX Subsection "Function"
+.PP
+From the medline citation informatino returns a properly formatted
+list of information for the journal reference listing.
+.PP
+\fIArgs\fR
+.IX Subsection "Args"
+.PP
+Journal information hashref
+.PP
+medline journal information hashref
+.PP
+user agent
+.SS ""
+.IX Subsection ""
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+.Vb 1
+\&     $reference\->date(_fix_medline_pubdate($ref\->{MedlineCitation}\->{Article}\->{Journal}\->{JournalIssue}\->{PubDate}));
+.Ve
+.PP
+\fIFunction\fR
+.IX Subsection "Function"
+.PP
+\fIReturns\fR
+.IX Subsection "Returns"
+.PP
+\fIArgs\fR
+.IX Subsection "Args"
+.SS "_fix_medline_pages"
+.IX Subsection "_fix_medline_pages"
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+.Vb 1
+\&     pages      => [_fix_medline_pages($ref\->{MedlineCitation}\->{Article}\->{Pagination}\->{MedlinePgn})],
+.Ve
+.PP
+\fIFunction\fR
+.IX Subsection "Function"
+.PP
+Returns output with a list of pages appropriate for an Article type of
+reference.
+.SS "_fix_ids"
+.IX Subsection "_fix_ids"
+.Vb 1
+\&     _fix_ids
+.Ve
+.SS "_find_links_from_url"
+.IX Subsection "_find_links_from_url"
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+\fIFunction\fR
+.IX Subsection "Function"
+.PP
+\fIReturns\fR
+.IX Subsection "Returns"
+.PP
+\fIArgs\fR
+.IX Subsection "Args"
diff --git a/blib/man3/Reference::Type::Article.3pm b/blib/man3/Reference::Type::Article.3pm
new file mode 100644 (file)
index 0000000..3ae18fd
--- /dev/null
@@ -0,0 +1,181 @@
+.\" Automatically generated by Pod::Man 2.25 (Pod::Simple 3.16)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Reference::Type::Article 3pm"
+.TH Reference::Type::Article 3pm "2007-07-03" "perl v5.14.2" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+Reference::Type::Article \-\- Article reference type
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+.SH "BUGS"
+.IX Header "BUGS"
+None known.
+.SS "name"
+.IX Subsection "name"
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+.Vb 2
+\&     $article\->name($article_name);
+\&     my $article_name = $article\->name;
+.Ve
+.PP
+\fIFunction\fR
+.IX Subsection "Function"
+.PP
+Returns the article name if it has been set, or builds an article name
+from the author, journal, volume, and page if none is set.
+.SS "ref_fields"
+.IX Subsection "ref_fields"
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+.Vb 1
+\&     my @ref_fields = $self\->ref_fields;
+.Ve
+.PP
+\fIReturns\fR
+.IX Subsection "Returns"
+.PP
+Returns the list of reference fields which this type of reference
+supports.
+.SS "_init"
+.IX Subsection "_init"
+\fIUsage\fR
+.IX Subsection "Usage"
+.PP
+Called by Reference's new function
+.PP
+\fIFunction\fR
+.IX Subsection "Function"
+.PP
+Call superclass's _init function [\f(CW\*(C`$self\-\*(C'\fRNEXT::_init>], set up the
+bibtex_mapping and bibtex_order.
diff --git a/blib/script/.exists b/blib/script/.exists
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/blib/script/get_reference b/blib/script/get_reference
new file mode 100755 (executable)
index 0000000..f71eb68
--- /dev/null
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+
+eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
+    if 0; # not running under some shell
+# This program is part of da_reference, and is released under the
+# terms of the GPL version 2, or any later version, at your
+# option. See the file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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);
+     }
+}
diff --git a/build-stamp b/build-stamp
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/install-stamp b/install-stamp
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/lib/Reference.pm b/lib/Reference.pm
new file mode 100644 (file)
index 0000000..a650f1d
--- /dev/null
@@ -0,0 +1,229 @@
+# This module is part of , and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/lib/Reference/Field/Author.pm b/lib/Reference/Field/Author.pm
new file mode 100644 (file)
index 0000000..e0ff48c
--- /dev/null
@@ -0,0 +1,330 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+
+# Copyright 2003, 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/lib/Reference/Field/Date.pm b/lib/Reference/Field/Date.pm
new file mode 100644 (file)
index 0000000..7768772
--- /dev/null
@@ -0,0 +1,178 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/lib/Reference/Field/Journal.pm b/lib/Reference/Field/Journal.pm
new file mode 100644 (file)
index 0000000..ad5639a
--- /dev/null
@@ -0,0 +1,110 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/lib/Reference/Field/Pages.pm b/lib/Reference/Field/Pages.pm
new file mode 100644 (file)
index 0000000..8e1c1c2
--- /dev/null
@@ -0,0 +1,109 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/lib/Reference/Output/Bibtex.pm b/lib/Reference/Output/Bibtex.pm
new file mode 100644 (file)
index 0000000..06cd71d
--- /dev/null
@@ -0,0 +1,379 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/lib/Reference/Output/Filename.pm b/lib/Reference/Output/Filename.pm
new file mode 100644 (file)
index 0000000..3fd2696
--- /dev/null
@@ -0,0 +1,92 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2009 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/lib/Reference/Retrieve/HTML/Miner.pm b/lib/Reference/Retrieve/HTML/Miner.pm
new file mode 100644 (file)
index 0000000..3c934f4
--- /dev/null
@@ -0,0 +1,45 @@
+# This module is part of da_reference, and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/lib/Reference/Retrieve/PubMed.pm b/lib/Reference/Retrieve/PubMed.pm
new file mode 100644 (file)
index 0000000..553245d
--- /dev/null
@@ -0,0 +1,580 @@
+# This module is part of Refence, and is released under the terms of
+# the GPL version 2, or any later version. See the file README and
+# COPYING for more information.
+# Copyright 2003 by Don Armstrong <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/\&gt;(\s|$)/>$1/gso;
+     #$response =~ s/(?:(\s)\&lt;|&lt;(\/))/$1<$2/gso;
+     $response =~ s/&quot;/"/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__
+
+
+
+
+
+
diff --git a/lib/Reference/Type/Article.pm b/lib/Reference/Type/Article.pm
new file mode 100644 (file)
index 0000000..b309071
--- /dev/null
@@ -0,0 +1,166 @@
+# This module is part of , and is released
+# under the terms of the GPL version 2, or any later version. See the
+# file README and COPYING for more information.
+# Copyright 2003 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/pm_to_blib b/pm_to_blib
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/templates/perl_module_header.pm b/templates/perl_module_header.pm
new file mode 100644 (file)
index 0000000..2279439
--- /dev/null
@@ -0,0 +1,45 @@
+# This module is part of da_reference, and is released under the terms
+# of the GPL version 2, or any later version, at your option. See the
+# file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__
+
+
+
+
+
+
diff --git a/templates/perl_program_header.pl b/templates/perl_program_header.pl
new file mode 100644 (file)
index 0000000..09e90e7
--- /dev/null
@@ -0,0 +1,70 @@
+#! /usr/bin/perl
+# This program is part of da_reference, and is released under the
+# terms of the GPL version 2, or any later version, at your
+# option. See the file README and COPYING for more information.
+# Copyright 2004 by Don Armstrong <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__