summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm')
-rw-r--r--Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm214
1 files changed, 182 insertions, 32 deletions
diff --git a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm
index c358d245116..d7e84577e60 100644
--- a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm
+++ b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm
@@ -1,11 +1,14 @@
package BibTeX::Parser::Author;
{
- $BibTeX::Parser::Author::VERSION = '0.65';
+ $BibTeX::Parser::Author::VERSION = '0.66';
}
use warnings;
use strict;
+use BibTeX::Parser;
+
+
use overload
'""' => \&to_string;
@@ -52,42 +55,124 @@ sub jr {
}
+# Take a string and create an array [first, von, last, jr]
sub split {
- my ($self_or_class, $name) = @_;
+ my ($self_or_class, $name) = @_;
+
+ # remove whitespace at start and end of string
+ $name =~ s/^\s*(.*)\s*$/$1/s;
+
- # remove whitespace at start and end of string
- $name =~ s/^\s*(.*)\s*$/$1/s;
- if ( $name =~ /^\{\s*(.*)\s*\}$/ ) {
- return (undef, undef, $1, undef);
+ if (!length($name)) {
+ return (undef, undef, undef, undef);
+ }
+
+ my @comma_separated =
+ BibTeX::Parser::_split_braced_string($name,
+ '\s*,\s*');
+ if (scalar(@comma_separated) == 0) {
+ # Error?
+ return (undef, undef, undef, undef);
+ }
+
+ my $first=undef;
+ my $von=undef;
+ my $last=undef;
+ my $jr=undef;
+
+ if (scalar(@comma_separated) == 1) {
+ # First von Last form
+ my @tokens =
+ BibTeX::Parser::_split_braced_string($name, '\s+');
+ if (!scalar (@tokens)) {
+ return (undef, undef, undef, undef);
+ }
+ my ($start_von, $start_last) = _getStartVonLast (@tokens);
+ if ($start_von >0) {
+ $first = join(' ', splice(@tokens,0,$start_von));
}
+ if (($start_last-$start_von) >0) {
+ $von = join(' ', splice(@tokens,0,$start_last-$start_von));
+ }
+ $last = join(' ',@tokens);
+ return ($first, $von, $last, $jr);
+ }
+ # Now we work with von Last, [Jr,] First form
+ if (scalar @comma_separated == 2) { # no jr
+ my @tokens=
+ BibTeX::Parser::_split_braced_string($comma_separated[1], '\s+');
+ $first = join(' ', @tokens);
+ } else { # jr is present
+ my @tokens=
+ BibTeX::Parser::_split_braced_string($comma_separated[1], '\s+');
+ $jr = join(' ', @tokens);
+ @tokens=
+ BibTeX::Parser::_split_braced_string($comma_separated[2], '\s+');
+ $first = join(' ', @tokens);
+ }
+ my @tokens =
+ BibTeX::Parser::_split_braced_string($comma_separated[0], '\s+');
+ my $start_last = _getStartLast(@tokens);
+ if ($start_last > 0) {
+ $von=join(' ', splice(@tokens,0,$start_last));
+ }
+ $last = join(' ',@tokens);
+ return ($first, $von, $last, $jr);
- if ( $name =~ /\{/ ) {
- my @tokens;
- my $cur_token = '';
- while ( scalar( $name =~ /\G \s* ( [^,\{]*? ) ( \s* , \s* | \{ | \s* $ ) /xgc ) ) {
- $cur_token .= $1 if $1;
- if ( $2 =~ /\{/ ) {
- if ( scalar( $name =~ /\G([^\}]*)\}/gc ) ) {
- $cur_token .= "{$1}";
- } else {
- die "Unmatched brace in name '$name'";
- }
- } else {
- $cur_token =~ s/\s*$//;
- push @tokens, $cur_token if $cur_token;
- $cur_token = '';
- }
- }
- push @tokens, $cur_token if $cur_token;
- return _get_single_author_from_tokens( @tokens );
- } else {
- my @tokens = split /\s*,\s*/, $name;
+}
- return _get_single_author_from_tokens( @tokens );
- }
+# Return the index of the first von element and the first lastname
+# element. If no von element, von=last
+
+sub _getStartVonLast {
+ my $length=scalar(@_);
+ if ($length==1) {
+ return (0,0);
+ }
+ my $start_von=-1;
+ my $start_last=$length-1;
+ for (my $i=0; $i<$length; $i++) {
+ if (_is_von_token($_[$i])) {
+ $start_von=$i;
+ last;
+ }
+ }
+ if ($start_von== -1) { # no von part
+ return($length-1, $length-1);
+ }
+ if ($start_von== $length-1) { # all parts but last are upper case?
+ return($length-1, $length-1);
+ }
+ for (my $i=$start_von+1; $i<$length; $i++) {
+ if (!_is_von_token($_[$i])) {
+ $start_last=$i;
+ last;
+ }
+ }
+ return($start_von, $start_last);
+}
+
+
+# Return the index of the first lastname
+# element provided no first name elements are present
+
+sub _getStartLast {
+ my $length=scalar(@_);
+ if ($length==1) {
+ return 0;
+ }
+ my $start_last=$length-1;
+ for (my $i=0; $i<$length; $i++) {
+ if (!_is_von_token($_[$i])) {
+ $start_last=$i;
+ last;
+ }
+ }
+ return $start_last;
}
+
sub _split_name_parts {
my $name = shift;
@@ -172,6 +257,8 @@ sub _get_single_author_from_tokens {
}
+
+
sub to_string {
my $self = shift;
@@ -182,6 +269,39 @@ sub to_string {
}
}
+
+# Return 1 if the first letter on brace level 0 is lowercase
+sub _is_von_token {
+ my $string = shift;
+ while ($string =~
+ s/^(\\[[:alpha:]]+\{|\{|\\[[:^alpha:]]?|[[:^alpha:]])//) {
+ if ($1 eq '{' ) {
+ my $numbraces=1;
+ while ($numbraces !=0 && length($string)) {
+ my $symbol = substr($string, 0, 1);
+ if ($symbol eq '{') {
+ $numbraces ++;
+ } elsif ($symbol eq '}') {
+ $numbraces --;
+ }
+ $string = substr($string,1);
+ }
+ }
+ }
+
+ if (length $string ) {
+ my $symbol = substr($string, 0, 1);
+ if (lc($symbol) eq $symbol) {
+ return 1;
+ } else {
+ return 0;
+ }
+ } else {
+ return 1;
+ }
+
+}
+
1; # End of BibTeX::Entry
__END__
@@ -219,7 +339,7 @@ BibTeX::Author - Contains a single author for a BibTeX document.
=head1 VERSION
-version 0.65
+version 0.66
=head1 FUNCTIONS
@@ -252,13 +372,43 @@ with four strings, some of them possibly empty.
Return string representation of the name.
+=head1 NOTES
+
+BibTeX allows three representations of a person's name:
+
+=over 4
+
+=item 1.
+
+First von Last
+
+=item 2.
+
+von Last, First
+
+=item 3.
+
+von Last, Jr, First
+
+=back
+
+The module always converts the first form to the second of third one
+to allow simple string comparisons.
+
+The algorithm to determine the von part is the following: von part
+consists of tokens where the first letter at brace level 0 is in lower case.
+Anything in a "special characters" is on brace level 0. Thus the following
+tokens are considered von parts: C<von>, C<\NOOP{von}Von>, and
+the following token is not: C<{von}>
+
=head1 AUTHOR
-Gerhard Gossen <gerhard.gossen@googlemail.com>
+Gerhard Gossen <gerhard.gossen@googlemail.com> and
+Boris Veytsman <boris@varphi.com>
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2013 by Gerhard Gossen.
+This software is copyright (c) 2013--2015 by Gerhard Gossen and Boris Veytsman.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.