summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/bibtexperllibs
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2015-12-29 00:16:03 +0000
committerKarl Berry <karl@freefriends.org>2015-12-29 00:16:03 +0000
commitd3c8410c4bf38ea695fb6580785720e426a71a87 (patch)
tree62d8ec81a9b6ca9fc63d53121d29249e9f56d01b /Master/texmf-dist/scripts/bibtexperllibs
parentbac237f29f6ca325050af70f4720d1af61c45bbe (diff)
bibtexperllibs (26dec15)
git-svn-id: svn://tug.org/texlive/trunk@39224 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/bibtexperllibs')
-rw-r--r--Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser.pm64
-rw-r--r--Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm214
-rw-r--r--Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Entry.pm136
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.