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