diff options
Diffstat (limited to 'Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm')
-rw-r--r-- | Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm | 214 |
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. |