1 # This module is part of da_reference, and is released under the terms
2 # of the GPL version 2, or any later version, at your option. See the
3 # file README and COPYING for more information.
5 # Copyright 2003, 2004 by Don Armstrong <don@donarmstrong.com>.
8 package Reference::Field::Author;
12 Reference::Field::Author --
22 XXX Allow the corresponding author to be set explicitely
24 XXX To do this, we need to break away from using the author field as
25 an arrayref, and instead use a hashref with the author fields, and a
26 specific corresponding author setting. [This should probaly be de
27 riguer for other fields as well.]
37 use vars qw($REVISION $DEBUG);
40 use Params::Validate qw(:types validate_with);
43 ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/;
44 $DEBUG = 0 unless defined $DEBUG;
65 if (scalar(@_) == 1) {
66 $params{author} = shift;
67 $params{output} = 'scalar';
68 $params{add_author} = 0;
69 $params{del_author} = 0;
72 %params = validate_with(params => \@_,
73 spec => {author => {type => ARRAYREF|SCALAR|HASHREF,
76 add_author => {type => BOOLEAN,
79 del_author => {type => BOOLEAN,
82 output => {default => 'scalar',
88 # Update author according to the passed information
89 if (defined $params{author}) {
90 $self->{reference}->{author} = {authors => [],
92 corresponding_author => -1,
93 } unless $params{add_author};
94 # We can't handle things like Smith, Jones, Paul, Rue; for
95 # obvious reasons. If you must do something so broken, you
96 # have to go Smith, Jones; Paul, Rue; or Smith, Jones and
98 if (not ref($params{author}) and ($params{author} =~ /\sand\,?\s/ or $params{author} =~ /\w\;\s/)) {
99 $params{author} = [grep /\w/, split (/\s*and,?\s*|\;\s*/,$params{author})];
101 $params{author} = [$params{author}] unless ref($params{author}) eq 'ARRAY';
102 foreach my $author (@{$params{author}}) {
103 my $author_info = _parse_author($author);
104 if (not $params{del_author}) {
105 push @{$self->{reference}{author}{authors}},$author_info;
108 _delete_author($author_info,$author->{reference}{author}{authors});
113 local $_ = $params{output};
115 return join(' and ',map {$_->{full}} @{$self->{reference}{author}{authors}});
118 return join(', ',map {$_->{full}} @{$self->{reference}{author}{authors}});
123 =head2 corresponding_author
125 my $corresponding_author = $ref->corresponding_author;
127 Returns the corresponding author (the last author listed.)
131 sub corresponding_author{
134 my %params = validate_with(params => \@_,
135 spec => {output => {default => 'scalar',
140 local $_ = $params{output};
142 return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full};
145 return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{last};
148 return $self->{reference}{author}{authors}[$self->{reference}{author}{corresponding_author}]{full};
154 my $first_author = $ref->first_author;
156 Returns the first author (primary author.)
162 my %params = validate_with(params => \@_,
163 spec => {output => {default => 'scalar',
168 local $_ = $params{output};
170 return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || '';
173 return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{last};
176 return $self->{reference}{author}{authors}[$self->{reference}{author}{first_author}]{full} || '';
183 my $author_info = _parse_author($author);
185 Parses the author and returns an author record.
189 The author can be specified in a few different ways:
193 =item SCALAR Author Name
203 =item John Wilkenson Smith
205 =item HASHREF Author structure
207 =item ARRAYREF Author Name
211 In these cases, the author's name should be parsed appropriately. [XXX
212 Needs to be extended to handle Smith, John W. appropriately.]
217 sub _parse_author($){
220 warn "Undefined author" and return undef if not defined $author;
222 # the author information
224 if (not ref($author)) {
225 # UGH. Try to figure out the author.
226 if ($author =~ /^\s*([A-Z]+)\s+([\w\s]+?)(?:\s*([A-Z])\.)?\s*$/) { # SMITH John W.
227 $au{first} = ucfirst(lc($2)) || '';
228 $au{last} = ucfirst(lc($1)) || '';
229 $au{middle} = $3 || '';
230 $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') .
231 (($au{middle} ne '')?uc(substr($au{middle},0,1)):'');
232 $au{full} = join(' ',grep /\w/,($au{first},$au{middle},$au{last}));
234 elsif ($author =~ /^\s*([A-Z][\w\s]*?)\s+([A-Z]+)\s*$/) { # Smith JW
235 $au{first} = $2 || '';
237 if (length $au{first} > 1) {
238 $au{middle} = substr($au{first},1);
239 $au{first} = substr($au{first},0,1);
243 $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last}))
245 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
247 $au{middle} = $2 || $3 || '';
249 $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last}));
251 # XXX Handle Smith, John Wilkinson; Smith, JW; and Smith, John W.
253 warn "Couldn't handle author $author";
257 elsif (ref $author eq 'ARRAY') {
258 warn "Author was empty" unless scalar @{$author};
259 $au{full} = join(' ',grep /\w/, @{$author});
260 $au{last} = $author->[-1];
261 $au{first} = $author->[0] if scalar @{$author} > 1;
262 $au{middle} = join(' ',grep /\w/,@{$author}[1..($#{$author}-1)]) if scalar @{$author} > 2;
263 $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') .
264 (($au{middle} ne '')?uc(substr($au{middle},0,1)):'');
266 elsif (ref $author eq 'HASH') {
267 foreach my $key (qw(full last middle first initials)) {
269 $au{$key} = $author->{$key} if exists $author->{$key} and defined $author->{$key};
271 $au{full} = join(' ',grep /\w/, ($au{first},$au{middle},$au{last})) if $au{full} eq '';
272 $au{initials} = (($au{first} ne '')?uc(substr($au{first},0,1)):'') .
273 (($au{middle} ne '')?uc(substr($au{middle},0,1)):'') if $au{initials} eq '';
276 warn "Unknown reference: $author";
282 =head2 _delete_author
291 sub _delete_author($$){
292 my ($author_info,$author_list) = @_;
294 die "NOT IMPLEMENTED";
300 Called by Reference's new function
302 Call superclass's _init function [C<$self->NEXT::_init>], sets up the
303 author list reference.
310 $self->{reference}->{author} = {authors => [],
312 corresponding_author => -1,