+++ /dev/null
-# This module is part of da_reference, and is released under the terms
-# of the GPL version 2, or any later version, at your option. See the
-# file README and COPYING for more information.
-
-# Copyright 2003, 2004 by Don Armstrong <don@donarmstrong.com>.
-# $Id: Author.pm 42 2009-03-20 06:29:46Z don $
-
-package Reference::Field::Author;
-
-=head1 NAME
-
-Reference::Field::Author --
-
-=head1 SYNOPSIS
-
-
-=head1 DESCRIPTION
-
-
-=head1 TODO
-
-XXX Allow the corresponding author to be set explicitely
-
-XXX To do this, we need to break away from using the author field as
-an arrayref, and instead use a hashref with the author fields, and a
-specific corresponding author setting. [This should probaly be de
-riguer for other fields as well.]
-
-=head1 BUGS
-
-None known.
-
-=cut
-
-
-use strict;
-use vars qw($REVISION $DEBUG);
-
-use NEXT;
-use Params::Validate qw(:types validate_with);
-
-BEGIN{
- ($REVISION) = q$LastChangedRevision: 42 $ =~ /\$LastChangedRevision:\s+([^\s+])/;
- $DEBUG = 0 unless defined $DEBUG;
-}
-
-
-=head2 author
-
-=head3 Usage
-
-
-
-=head3 Function
-
-=head3 Returns
-
-=head3 Args
-
-=cut
-
-sub author{
- my $self = shift;
- my %params;
- if (scalar(@_) == 1) {
- $params{author} = shift;
- $params{output} = 'scalar';
- $params{add_author} = 0;
- $params{del_author} = 0;
- }
- else {
- %params = validate_with(params => \@_,
- spec => {author => {type => ARRAYREF|SCALAR|HASHREF,
- optional => 1,
- },
- add_author => {type => BOOLEAN,
- default => 0,
- },
- del_author => {type => BOOLEAN,
- default => 0,
- },
- output => {default => 'scalar',
- type => SCALAR,
- },
- },
- );
- }
- # Update author according to the passed information
- if (defined $params{author}) {
- $self->{reference}->{author} = {authors => [],
- first_author => 0,
- corresponding_author => -1,
- } unless $params{add_author};
- # We can't handle things like Smith, Jones, Paul, Rue; for
- # obvious reasons. If you must do something so broken, you
- # have to go Smith, Jones; Paul, Rue; or Smith, Jones and
- # Paul, Rue.
- if (not ref($params{author}) and ($params{author} =~ /\sand\,?\s/ or $params{author} =~ /\w\;\s/)) {
- $params{author} = [grep /\w/, split (/\s*and,?\s*|\;\s*/,$params{author})];
- }
- $params{author} = [$params{author}] unless ref($params{author}) eq 'ARRAY';
- foreach my $author (@{$params{author}}) {
- my $author_info = _parse_author($author);
- if (not $params{del_author}) {
- push @{$self->{reference}{author}{authors}},$author_info;
- }
- else {
- _delete_author($author_info,$author->{reference}{author}{authors});
- }
- }
- }
-
- local $_ = $params{output};
- if (/bibtex/) {
- return join(' and ',map {$_->{full}} @{$self->{reference}{author}{authors}});
- }
- else {
- return join(', ',map {$_->{full}} @{$self->{reference}{author}{authors}});
- }
-
-}
-
-=head2 corresponding_author
-
- my $corresponding_author = $ref->corresponding_author;
-
-Returns the corresponding author (the last author listed.)
-
-=cut
-
-sub corresponding_author{
- my $self = shift;
-
- my %params = validate_with(params => \@_,
- spec => {output => {default => 'scalar',
- type => SCALAR,
- },
- },
- );
- local $_ = $params{output};
- if (/bibtex/) {
- return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full};
- }
- elsif (/last/) {
- return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{last};
- }
- else {
- return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full};
- }
-}
-
-=head2 first_author
-
- my $first_author = $ref->first_author;
-
-Returns the first author (primary author.)
-
-=cut
-
-sub first_author{
- my $self = shift;
- my %params = validate_with(params => \@_,
- spec => {output => {default => 'scalar',
- type => SCALAR,
- },
- },
- );
- local $_ = $params{output};
- if (/bibtex/) {
- return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || '';
- }
- elsif (/last/) {
- return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{last};
- }
- else {
- return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || '';
- }
-}
-
-
-=head2 _parse_author
-
- my $author_info = _parse_author($author);
-
-Parses the author and returns an author record.
-
-Author record
-
-The author can be specified in a few different ways:
-
-=over
-
-=item SCALAR Author Name
-
-=over
-
-=item SMITH John W.
-
-=item Smith JW
-
-=item John W. Smith
-
-=item John Wilkenson Smith
-
-=item HASHREF Author structure
-
-=item ARRAYREF Author Name
-
-=back
-
-In these cases, the author's name should be parsed appropriately. [XXX
-Needs to be extended to handle Smith, John W. appropriately.]
-
-
-=cut
-
-sub _parse_author($){
- my ($author) = @_;
-
- warn "Undefined author" and return undef if not defined $author;
-
- # the author information
- my %au = ();
- if (not ref($author)) {
- # UGH. Try to figure out the author.
- if ($author =~ /^\s*([A-Z]+)\s+([\w\s]+?)(?:\s*([A-Z])\.)?\s*$/) { # SMITH John W.
- $au{first} = ucfirst(lc($2)) || '';
- $au{last} = ucfirst(lc($1)) || '';
- $au{middle} = $3 || '';
- $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') .
- (($au{middle} ne '')?uc(substr($au{middle},0,1)):'');
- $au{full} = join(' ',grep /\w/,($au{first},$au{middle},$au{last}));
- }
- elsif ($author =~ /^\s*([A-Z][\w\s]*?)\s+([A-Z]+)\s*$/) { # Smith JW
- $au{first} = $2 || '';
- $au{middle} = '';
- if (length $au{first} > 1) {
- $au{middle} = substr($au{first},1);
- $au{first} = substr($au{first},0,1);
- }
- $au{last} = $1;
- $au{initials} = $2;
- $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last}))
- }
- elsif ($author =~ /^\s*([A-Z][\w]*?)\s+(?:([A-Z])\.|([A-Z][\w\s]*?)\s+)?\s*([A-Z][\w]*)\s*$/){ # John W. Smith or John Wilkinson Smith
- $au{first} = $1;
- $au{middle} = $2 || $3 || '';
- $au{last} = $4;
- $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last}));
- }
- # XXX Handle Smith, John Wilkinson; Smith, JW; and Smith, John W.
- else {
- warn "Couldn't handle author $author";
- $au{full} = $author;
- }
- }
- elsif (ref $author eq 'ARRAY') {
- warn "Author was empty" unless scalar @{$author};
- $au{full} = join(' ',grep /\w/, @{$author});
- $au{last} = $author->[-1];
- $au{first} = $author->[0] if scalar @{$author} > 1;
- $au{middle} = join(' ',grep /\w/,@{$author}[1..($#{$author}-1)]) if scalar @{$author} > 2;
- $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') .
- (($au{middle} ne '')?uc(substr($au{middle},0,1)):'');
- }
- elsif (ref $author eq 'HASH') {
- foreach my $key (qw(full last middle first initials)) {
- $au{$key} = '';
- $au{$key} = $author->{$key} if exists $author->{$key} and defined $author->{$key};
- }
- $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})) if $au{full} eq '';
- $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') .
- (($au{middle} ne '')?uc(substr($au{middle},0,1)):'') if $au{initials} eq '';
- }
- else {
- warn "Unknown reference: $author";
- return undef;
- }
- return \%au;
-}
-
-=head2 _delete_author
-
-
-
-
-XXX NOT IMPLEMENTED
-
-=cut
-
-sub _delete_author($$){
- my ($author_info,$author_list) = @_;
-
- die "NOT IMPLEMENTED";
-}
-
-
-=head2 _init
-
-Called by Reference's new function
-
-Call superclass's _init function [C<$self->NEXT::_init>], sets up the
-author list reference.
-
-=cut
-
-sub _init{
- my $self = shift;
-
- $self->{reference}->{author} = {authors => [],
- first_author => 0,
- corresponding_author => -1,
- };
-
- $self->NEXT::_init;
-
-}
-
-
-
-1;
-
-
-__END__
-
-
-
-
-
-
projects / reference.git / blobdiff