bibtexperllibs (26dec15)

git-svn-id: svn://tug.org/texlive/trunk@39224 c570f23f-e606-0410-a88d-b1316a301751

3 files changed, 308 insertions, 106 deletions

diff --git a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser.pm b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser.pm
index 8f0ab3a4c49..c7d7a75fc35 100644
--- a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser.pm
+++ b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser.pm
@@ -1,6 +1,6 @@
 package BibTeX::Parser;
 {
-  $BibTeX::Parser::VERSION = '0.65';
+  $BibTeX::Parser::VERSION = '0.66';
 }
 # ABSTRACT: A pure perl BibTeX parser
 use warnings;
@@ -208,6 +208,53 @@ sub _extract_bracketed
 	}
 }
 
+# Split the $string using $pattern as a delimiter with
+# each part having balanced braces (so "{$pattern}"
+# does NOT split).
+# Return empty list if unmatched braces
+
+sub _split_braced_string {
+    my $string = shift;
+    my $pattern = shift;
+    my @tokens;
+    return () if  $string eq '';
+    my $buffer;
+    while (!defined pos $string || pos $string < length $string) {
+	if ( $string =~ /\G(.*?)(\{|$pattern)/cgi ) {
+	    my $match = $1;
+	    if ( $2 =~ /$pattern/i ) {
+		$buffer .= $match;
+		push @tokens, $buffer;
+		$buffer = "";
+	    } elsif ( $2 =~ /\{/ ) {
+		$buffer .= $match . "{";
+		my $numbraces=1;
+		while ($numbraces !=0 && pos $string < length $string) {
+		    my $symbol = substr($string, pos $string, 1);
+		    $buffer .= $symbol;
+		    if ($symbol eq '{') {
+			$numbraces ++;
+		    } elsif ($symbol eq '}') {
+			$numbraces --;
+		    }
+		    pos($string) ++;
+		}
+		if ($numbraces != 0) {
+		    return ();
+		}
+	    } else {
+		$buffer .= $match;
+	    }
+	} else {
+	    $buffer .= substr $string, (pos $string || 0);
+	    last;
+	}
+    }
+    push @tokens, $buffer if $buffer;
+    return @tokens;
+}
+
+
 1;    # End of BibTeX::Parser
 
 
@@ -220,7 +267,7 @@ BibTeX::Parser - A pure perl BibTeX parser
 
 =head1 VERSION
 
-version 0.65
+version 0.66
 
 =head1 SYNOPSIS
 
@@ -279,7 +326,13 @@ Parameters:
 
 Returns the next parsed entry or undef.
 
-=head2 SEE ALSO
+=head1 NOTES
+
+The fields C<author> and C<editor> are canonized, see
+L<BibTeX::Parser::Author>
+
+
+=head1 SEE ALSO
 
 =over 4
 
@@ -295,11 +348,12 @@ L<BibTeX::Parser::Author>
 
 =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.
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.
diff --git a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Entry.pm b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Entry.pm
index 6fb54a3972a..b10317c42b4 100644
--- a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Entry.pm
+++ b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Entry.pm
@@ -1,11 +1,12 @@
 package BibTeX::Parser::Entry;
 {
-  $BibTeX::Parser::Entry::VERSION = '0.65';
+  $BibTeX::Parser::Entry::VERSION = '0.66';
 }
 
 use warnings;
 use strict;
 
+use BibTeX::Parser;
 use BibTeX::Parser::Author;
 
 
@@ -122,76 +123,44 @@ sub _handle_cleaned_author_editor {
 no LaTeX::ToUnicode;
 
 sub _handle_author_editor {
-	my $type = shift;
-	my $self = shift;
-	if (@_) {
-		if (@_ == 1) { #single string
-			# my @names = split /\s+and\s+/i, $_[0];
-			my @names = _split_author_field( $_[0] );
-			$self->{"_$type"} = [map {new BibTeX::Parser::Author $_} @names];
-			$self->field($type, join " and ", @{$self->{"_$type"}});
-		} else {
-			$self->{"_$type"} = [];
-			foreach my $param (@_) {
-				if (ref $param eq "BibTeX::Author") {
-					push @{$self->{"_$type"}}, $param;
-				} else {
-					push @{$self->{"_$type"}}, new BibTeX::Parser::Author $param;
-				}
-
-				$self->field($type, join " and ", @{$self->{"_$type"}});
-			}
-		}
+    my $type = shift;
+    my $self = shift;
+    if (@_) {
+	if (@_ == 1) { #single string
+	    # my @names = split /\s+and\s+/i, $_[0];
+	    $_[0] =~ s/^\s*//; 
+	    $_[0] =~ s/\s*$//; 
+	    my @names = BibTeX::Parser::_split_braced_string($_[0], 
+							     '\s+and\s+');
+	    if (!scalar @names) {
+		$self->error('Bad names in author/editor field');
+		return;
+	    }
+	    $self->{"_$type"} = [map {new BibTeX::Parser::Author $_} @names];
+	    $self->field($type, join " and ", @{$self->{"_$type"}});
 	} else {
-		unless ( defined $self->{"_$type"} ) {
-			#my @names = split /\s+and\s+/i, $self->{$type} || "";
-			my @names = _split_author_field( $self->{$type} || "" );
-			$self->{"_$type"} = [map {new BibTeX::Parser::Author $_} @names];
-		}
-		return @{$self->{"_$type"}};
-	}
-}
-
-# _split_author_field($field)
-#
-# Split an author field into different author names.
-# Handles quoted names ({name}).
-sub _split_author_field {
-    my $field = shift;
-
-    return () if !defined $field || $field eq '';
-
-    my @names;
-
-    my $buffer;
-    while (!defined pos $field || pos $field < length $field) {
-	if ( $field =~ /\G ( .*? ) ( \{ | \s+ and \s+ )/xcgi ) {
-	    my $match = $1;
-	    if ( $2 =~ /and/i ) {
-		$buffer .= $match;
-		push @names, $buffer;
-		$buffer = "";
-	    } elsif ( $2 =~ /\{/ ) {
-		$buffer .= $match . "{";
-		if ( $field =~ /\G (.* \})/cgx ) {
-		    $buffer .= $1;
+	    $self->{"_$type"} = [];
+	    foreach my $param (@_) {
+		if (ref $param eq "BibTeX::Author") {
+		    push @{$self->{"_$type"}}, $param;
 		} else {
-		    die "Missing closing brace at " . substr( $field, pos $field, 10 );
+		    push @{$self->{"_$type"}}, new BibTeX::Parser::Author $param;
 		}
-	    } else {
-		$buffer .= $match;
+		
+		$self->field($type, join " and ", @{$self->{"_$type"}});
 	    }
-	} else {
-	   #print "# $field " . (pos ($field) || 0) . "\n";
-	   $buffer .= substr $field, (pos $field || 0);
-	   last;
 	}
+    } else {
+	unless ( defined $self->{"_$type"}) {
+	    my @names = BibTeX::Parser::_split_braced_string($self->{$type} || "", '\s+and\s+' );
+	    $self->{"_$type"} = [map {new BibTeX::Parser::Author $_} @names];
+	}
+	return @{$self->{"_$type"}};
     }
-    push @names, $buffer if $buffer;
-    return @names;
 }
 
 
+
 sub author {
 	_handle_author_editor('author', @_);
 }
@@ -235,6 +204,26 @@ sub raw_bibtex {
 	return $self->{_raw};
 }
 
+sub to_string {
+    my $self = shift;
+    my @fields = grep {!/^_/} keys %$self;	
+    my $result = '@'.$self->type."{".$self->key.",\n";
+    foreach my $field (@fields) {
+	my $value = $self->field($field);
+	if ($field eq 'author') {
+	    my @names = ($self->author);
+	    $value = join(' and ', @names);
+	}
+	if ($field eq 'editor') {
+	    my @names = ($self->editors);
+	    $value = join(' and ', @names);
+	}
+	$result .= "    $field = {"."$value"."},\n";
+    }
+    $result .= "}";
+    return $result;
+}
+
 1; # End of BibTeX::Entry
 
 __END__
@@ -246,7 +235,7 @@ BibTeX::Parser::Entry
 
 =head1 VERSION
 
-version 0.65
+version 0.66
 
 =head1 SYNOPSIS
 
@@ -265,15 +254,19 @@ by a BibTeX::Parser.
 	    my @editors = $entry->editor;
 
 	    ...
+
+	    print $entry->to_string;
     }
 
+   
+
 =head1 NAME
 
-BibTeX::Entry - Contains a single entry of a BibTeX document.
+BibTeX::Parser::Entry - Contains a single entry of a BibTeX document.
 
 =head1 VERSION
 
-version 0.65
+version 0.66
 
 =head1 FUNCTIONS
 
@@ -333,7 +326,7 @@ or strings.
 
 Note: You can also change the authors with $entry->field('editor', $editors_string)
 
-=head2 fieldlist()
+=head2 fieldlist ()
 
 Returns a list of all the fields used in this entry.
 
@@ -341,17 +334,22 @@ Returns a list of all the fields used in this entry.
 
 Returns a true value if this entry has a value for $fieldname.
 
-=head2 raw_bibtex
+=head2 raw_bibtex ()
 
 Return raw BibTeX entry (if available).
 
+=head2 to_string ()
+
+Returns a text of the BibTeX entry in BibTeX format
+
 =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.