# 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__