summaryrefslogtreecommitdiff
path: root/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX
diff options
context:
space:
mode:
Diffstat (limited to 'support/bibtexperllibs/BibTeX-Parser/lib/BibTeX')
-rw-r--r--support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser.pm366
-rw-r--r--support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser/Author.pm429
-rw-r--r--support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser/Entry.pm435
3 files changed, 0 insertions, 1230 deletions
diff --git a/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser.pm b/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser.pm
deleted file mode 100644
index 2897d8495d..0000000000
--- a/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser.pm
+++ /dev/null
@@ -1,366 +0,0 @@
-package BibTeX::Parser;
-{
- $BibTeX::Parser::VERSION = '1.04';
-}
-# ABSTRACT: A pure perl BibTeX parser
-use warnings;
-use strict;
-
-use BibTeX::Parser::Entry;
-
-
-my $re_namechar = qr/[a-zA-Z0-9\!\$\&\*\+\-\.\/\:\;\<\>\?\[\]\^\_\`\|\']/o;
-my $re_name = qr/$re_namechar+/o;
-
-
-sub new {
- my ( $class, $fh ) = @_;
-
- return bless {
- fh => $fh,
- strings => {
- jan => "January",
- feb => "February",
- mar => "March",
- apr => "April",
- may => "May",
- jun => "June",
- jul => "July",
- aug => "August",
- sep => "September",
- oct => "October",
- nov => "November",
- dec => "December",
-
- },
- line => -1,
- buffer => "",
- }, $class;
-}
-
-sub _slurp_close_bracket;
-
-sub _parse_next {
- my $self = shift;
-
- while (1) { # loop until regular entry is finished
- return 0 if $self->{fh}->eof;
- local $_ = $self->{buffer};
-
- until (/@/m) {
- my $line = $self->{fh}->getline;
- return 0 unless defined $line;
- $line =~ s/^%.*$//;
- $_ .= $line;
- }
-
- my $current_entry = new BibTeX::Parser::Entry;
- if (/@($re_name)/cgo) {
- my $type = uc $1;
- $current_entry->type( $type );
- my $start_pos = pos($_) - length($type) - 1;
-
- # read rest of entry (matches braces)
- my $bracelevel = 0;
- $bracelevel += tr/\{/\{/; #count braces
- $bracelevel -= tr/\}/\}/;
- while ( $bracelevel != 0 ) {
- my $position = pos($_);
- my $line = $self->{fh}->getline;
- last unless defined $line;
- $bracelevel =
- $bracelevel + ( $line =~ tr/\{/\{/ ) - ( $line =~ tr/\}/\}/ );
- $_ .= $line;
- pos($_) = $position;
- }
-
- # Remember text before the entry
- my $pre = substr($_, 0, $start_pos-1);
- if ($start_pos == 0) {
- $pre = '';
- }
- $current_entry->pre($pre);
-
-
- # Remember raw bibtex code
- my $raw = substr($_, $start_pos);
- $raw =~ s/^\s+//;
- $raw =~ s/\s+$//;
- $current_entry->raw_bibtex($raw);
-
- my $pos = pos $_;
- tr/\n/ /;
- pos($_) = $pos;
-
- if ( $type eq "STRING" ) {
- if (/\G\{\s*($re_name)\s*=\s*/cgo) {
- my $key = $1;
- my $value = _parse_string( $self->{strings} );
- if ( defined $self->{strings}->{$key} ) {
- warn("Redefining string $key!");
- }
- $self->{strings}->{$key} = $value;
- /\G[\s\n]*\}/cg;
- } else {
- $current_entry->error("Malformed string!");
- return $current_entry;
- }
- } elsif ( $type eq "COMMENT" or $type eq "PREAMBLE" ) {
- /\G\{./cgo;
- _slurp_close_bracket;
- } else { # normal entry
- $current_entry->parse_ok(1);
-
- # parse key
- if (/\G\s*\{(?:\s*($re_name)\s*,[\s\n]*|\s+\r?\s*)/cgo) {
- $current_entry->key($1);
-
- # fields
- while (/\G[\s\n]*($re_name)[\s\n]*=[\s\n]*/cgo) {
- $current_entry->field(
- $1 => _parse_string( $self->{strings} ) );
- my $idx = index( $_, ',', pos($_) );
- pos($_) = $idx + 1 if $idx > 0;
- }
-
- return $current_entry;
-
- } else {
-
- $current_entry->error("Malformed entry (key contains illegal characters) at " . substr($_, pos($_) || 0, 20) . ", ignoring");
- _slurp_close_bracket;
- return $current_entry;
- }
- }
-
- $self->{buffer} = substr $_, pos($_);
-
- } else {
- $current_entry->error("Did not find type at " . substr($_, pos($_) || 0, 20));
- return $current_entry;
- }
-
- }
-}
-
-
-sub next {
- my $self = shift;
-
- return $self->_parse_next;
-}
-
-# slurp everything till the next closing brace. Handles
-# nested brackets
-sub _slurp_close_bracket {
- my $bracelevel = 0;
- BRACE: {
- /\G[^\}]*\{/cg && do { $bracelevel++; redo BRACE };
- /\G[^\{]*\}/cg
- && do {
- if ( $bracelevel > 0 ) {
- $bracelevel--;
- redo BRACE;
- } else {
- return;
- }
- }
- }
-}
-
-# parse bibtex string in $_ and return. A BibTeX string is either enclosed
-# in double quotes '"' or matching braces '{}'. The braced form may contain
-# nested braces.
-sub _parse_string {
- my $strings_ref = shift;
-
- my $value = "";
-
- PART: {
- if (/\G(\d+)/cg) {
- $value .= $1;
- } elsif (/\G($re_name)/cgo) {
- warn("Using undefined string $1") unless defined $strings_ref->{$1};
- $value .= $strings_ref->{$1} || "";
- } elsif (/\G"(([^"\\]*(\\.)*[^\\"]*)*)"/cgs)
- { # quoted string with embeded escapes
- $value .= $1;
- } else {
- my $part = _extract_bracketed( $_ );
- $value .= substr $part, 1, length($part) - 2; # strip quotes
- }
-
- if (/\G\s*#\s*/cg) { # string concatenation by #
- redo PART;
- }
- }
- $value =~ s/[\s\n]+/ /g;
- return $value;
-}
-
-sub _extract_bracketed
-{
- for($_[0]) # alias to $_
- {
- /\G\s+/cg;
- my $start = pos($_);
- my $depth = 0;
- while(1)
- {
- /\G\\./cg && next;
- /\G\{/cg && (++$depth, next);
- /\G\}/cg && (--$depth > 0 ? next : last);
- /\G([^\\\{\}]+)/cg && next;
- last; # end of string
- }
- return substr($_, $start, pos($_)-$start);
- }
-}
-
-# 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
-
-
-__END__
-=pod
-
-=head1 NAME
-
-BibTeX::Parser - A pure perl BibTeX parser
-
-
-=head1 SYNOPSIS
-
-Parses BibTeX files.
-
- use BibTeX::Parser;
- use IO::File;
-
- my $fh = IO::File->new("filename");
-
- # Create parser object ...
- my $parser = BibTeX::Parser->new($fh);
-
- # ... and iterate over entries
- while (my $entry = $parser->next ) {
- if ($entry->parse_ok) {
- my $type = $entry->type;
- my $title = $entry->field("title");
-
- my @authors = $entry->author;
- # or:
- my @editors = $entry->editor;
-
- foreach my $author (@authors) {
- print $author->first . " "
- . $author->von . " "
- . $author->last . ", "
- . $author->jr;
- }
- } else {
- warn "Error parsing file: " . $entry->error;
- }
- }
-
-
-
-=head1 FUNCTIONS
-
-=head2 new
-
-Creates new parser object.
-
-Parameters:
-
- * fh: A filehandle
-
-=head2 next
-
-Returns the next parsed entry or undef.
-
-=head1 NOTES
-
-The fields C<author> and C<editor> are canonized, see
-L<BibTeX::Parser::Author>
-
-
-=head1 SEE ALSO
-
-=over 4
-
-=item
-
-L<BibTeX::Parser::Entry>
-
-=item
-
-L<BibTeX::Parser::Author>
-
-=back
-
-=head1 VERSION
-
-version 1.04
-
-
-=head1 AUTHOR
-
-Gerhard Gossen <gerhard.gossen@googlemail.com> and
-Boris Veytsman <boris@varphi.com> and
-Karl Berry <karl@freefriends.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-This software is copyright (c) 2013-2023 by Gerhard Gossen and Boris Veytsman and Karl Berry.
-
-This is free software; you can redistribute it and/or modify it under
-the same terms as the Perl 5 programming language system itself.
-
-=cut
-
diff --git a/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser/Author.pm b/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser/Author.pm
deleted file mode 100644
index a35e2073a6..0000000000
--- a/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser/Author.pm
+++ /dev/null
@@ -1,429 +0,0 @@
-package BibTeX::Parser::Author;
-{
- $BibTeX::Parser::Author::VERSION = '1.04';
-}
-
-use warnings;
-use strict;
-
-use BibTeX::Parser;
-
-
-use overload
- '""' => \&to_string;
-
-
-
-sub new {
- my $class = shift;
-
- if (@_) {
- my $self = [ $class->split(@_) ];
- return bless $self, $class;
- } else {
- return bless [], $class;
- }
-}
-
-sub _get_or_set_field {
- my ($self, $field, $value) = @_;
- if (defined $value) {
- $self->[$field] = $value;
- } else {
- return $self->[$field];
- }
-}
-
-
-sub first {
- shift->_get_or_set_field(0, @_);
-}
-
-
-sub von {
- shift->_get_or_set_field(1, @_);
-}
-
-
-sub last {
- shift->_get_or_set_field(2, @_);
-}
-
-
-sub jr {
- shift->_get_or_set_field(3, @_);
-}
-
-
-# Take a string and create an array [first, von, last, jr]
-sub split {
- my ($self_or_class, $name) = @_;
-
- # remove whitespace at start and end of string
- $name =~ s/^\s*(.*)\s*$/$1/s;
-
-
-
- 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);
-
-}
-
-# 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;
-
- if ( $name !~ /\{/ ) {
- return split /\s+/, $name;
- } else {
- my @parts;
- my $cur_token = '';
- while ( scalar( $name =~ /\G ( [^\s\{]* ) ( \s+ | \{ | \s* $ ) /xgc ) ) {
- $cur_token .= $1;
- if ( $2 =~ /\{/ ) {
- if ( scalar( $name =~ /\G([^\}]*)\}/gc ) ) {
- $cur_token .= "{$1}";
- } else {
- die "Unmatched brace in name '$name'";
- }
- } else {
- if ( $cur_token =~ /^{(.*)}$/ ) {
- $cur_token = $1;
- }
- push @parts, $cur_token;
- $cur_token = '';
- }
- }
- return @parts;
- }
-
-}
-
-
-sub _get_single_author_from_tokens {
- my (@tokens) = @_;
- if (@tokens == 0) {
- return (undef, undef, undef, undef);
- } elsif (@tokens == 1) { # name without comma
- if ( $tokens[0] =~ /(^|\s)[[:lower:]]/) { # name has von part or has only lowercase names
- my @name_parts = _split_name_parts $tokens[0];
-
- my $first;
- while (@name_parts && ucfirst($name_parts[0]) eq $name_parts[0] ) {
- $first .= $first ? ' ' . shift @name_parts : shift @name_parts;
- }
-
- my $von;
- # von part are lowercase words
- while ( @name_parts && lc($name_parts[0]) eq $name_parts[0] ) {
- $von .= $von ? ' ' . shift @name_parts : shift @name_parts;
- }
-
- if (@name_parts) {
- return ($first, $von, join(" ", @name_parts), undef);
- } else {
- return (undef, undef, $tokens[0], undef);
- }
- } else {
- if ( $tokens[0] !~ /\{/ && $tokens[0] =~ /^((.*)\s+)?\b(\S+)$/) {
- return ($2, undef, $3, undef);
- } else {
- my @name_parts = _split_name_parts $tokens[0];
- return ($name_parts[0], undef, $name_parts[1], undef);
- }
- }
-
- } elsif (@tokens == 2) {
- my @von_last_parts = _split_name_parts $tokens[0];
- my $von;
- # von part are lowercase words
- while ( @von_last_parts && lc($von_last_parts[0]) eq $von_last_parts[0] ) {
- $von .= $von ? ' ' . shift @von_last_parts : shift @von_last_parts;
- }
- return ($tokens[1], $von, join(" ", @von_last_parts), undef);
- } else {
- my @von_last_parts = _split_name_parts $tokens[0];
- my $von;
- # von part are lowercase words
- while ( @von_last_parts && lc($von_last_parts[0]) eq $von_last_parts[0] ) {
- $von .= $von ? ' ' . shift @von_last_parts : shift @von_last_parts;
- }
- return ($tokens[2], $von, join(" ", @von_last_parts), $tokens[1]);
- }
-
-}
-
-
-
-# The goal is to return a name in form
-# von Last, Jr, First
-# where any of the parts except Last may be empty.
-#
-sub to_string {
- my $self = shift;
-
- my $last = $self->last; # assume always present
- my $first = $self->first ? (", " . $self->first) : ''; # ", first"
- my $von = $self->von ? ($self->von . " ") : ''; # "von "
- my $jr = $self->jr ? (", " . $self->jr ) : ''; # ", jr"
- #
- my $ret = "${von}${last}${jr}${first}";
- #warn "returning name: $ret\n";
- return $ret;
-
-# original code, which introduced a spurious space with a von part.
-# https://github.com/borisveytsman/crossrefware/issues/11
-#
-# if ($self->jr) {
-# return () . " " . $self->last . ", " . $self->jr . ", " . $self->first;
-# } else {
-# return ($self->von ? $self->von . " " : '') . $self->last . ($self->first ? ", " . $self->first : '');
-# }
-#
-}
-
-
-# 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__
-=pod
-
-=head1 NAME
-
-BibTeX::Author - Contains a single author for a BibTeX document.
-
-=head1 SYNOPSIS
-
-This class ist a wrapper for a single BibTeX author. It is usually created
-by a BibTeX::Parser.
-
- use BibTeX::Parser::Author;
-
- my $entry = BibTeX::Parser::Author->new($full_name);
-
- my $firstname = $author->first;
- my $von = $author->von;
- my $last = $author->last;
- my $jr = $author->jr;
-
- # or ...
-
- my ($first, $von, $last, $jr) = BibTeX::Author->split($fullname);
-
-
-
-=head1 FUNCTIONS
-
-=head2 new
-
-Create new author object. Expects full name as parameter.
-
-=head2 first
-
-Set or get first name(s).
-
-=head2 von
-
-Set or get 'von' part of name.
-
-=head2 last
-
-Set or get last name(s).
-
-=head2 jr
-
-Set or get 'jr' part of name.
-
-=head2 split
-
-Split name into (firstname, von part, last name, jr part). Returns array
-with four strings, some of them possibly empty.
-
-=head2 to_string
-
-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 VERSION
-
-version 1.04
-
-
-=head1 AUTHOR
-
-Gerhard Gossen <gerhard.gossen@googlemail.com> and
-Boris Veytsman <boris@varphi.com> and
-Karl Berry <karl@freefriends.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-This software is copyright (c) 2013--2023 by Gerhard Gossen and Boris Veytsman and Karl Berry.
-
-This is free software; you can redistribute it and/or modify it under
-the same terms as the Perl 5 programming language system itself.
-
-=cut
-
diff --git a/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser/Entry.pm b/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser/Entry.pm
deleted file mode 100644
index d0bc9cc80b..0000000000
--- a/support/bibtexperllibs/BibTeX-Parser/lib/BibTeX/Parser/Entry.pm
+++ /dev/null
@@ -1,435 +0,0 @@
-package BibTeX::Parser::Entry;
-{
- $BibTeX::Parser::Entry::VERSION = '1.04';
-}
-
-use warnings;
-use strict;
-
-use BibTeX::Parser;
-use BibTeX::Parser::Author;
-
-
-
-sub new {
- my ($class, $type, $key, $parse_ok, $fieldsref) = @_;
-
- my %fields = defined $fieldsref ? %$fieldsref : ();
- my $i=0;
- foreach my $field (keys %fields) {
- if ($field !~ /^_/) {
- $fields{_fieldnums}->{$field}=$i;
- $i++;
- }
- }
- if (defined $type) {
- $fields{_type} = uc($type);
- }
- $fields{_key} = $key;
- $fields{_parse_ok} = $parse_ok;
- $fields{_raw} = '';
- return bless \%fields, $class;
-}
-
-
-
-sub parse_ok {
- my $self = shift;
- if (@_) {
- $self->{_parse_ok} = shift;
- }
- $self->{_parse_ok};
-}
-
-
-sub error {
- my $self = shift;
- if (@_) {
- $self->{_error} = shift;
- $self->parse_ok(0);
- }
- return $self->parse_ok ? undef : $self->{_error};
-}
-
-
-sub type {
- if (scalar @_ == 1) {
- # get
- my $self = shift;
- return $self->{_type};
- } else {
- # set
- my ($self, $newval) = @_;
- $self->{_type} = uc($newval);
- }
-}
-
-
-sub key {
- if (scalar @_ == 1) {
- # get
- my $self = shift;
- return $self->{_key};
- } else {
- # set
- my ($self, $newval) = @_;
- $self->{_key} = $newval;
- }
-
-}
-
-
-sub field {
- if (scalar @_ == 2) {
- # get
- my ($self, $field) = @_;
- return $self->{ lc( $field ) };
- } else {
- my ($self, $key, $value) = @_;
- my $field = lc ($key);
- $self->{$field} = $value; #_sanitize_field($value);
- if (!exists($self->{_fieldnums}->{$field})) {
- my $num = scalar keys %{$self->{_fieldnums}};
- $self->{_fieldnums}->{$field} = $num;
- }
- }
-
-}
-
-use LaTeX::ToUnicode qw( convert );
-
-
-sub cleaned_field {
- my ( $self, $field, @options ) = @_;
- if ( $field =~ /author|editor/i ) {
- return $self->field( $field );
- } else {
- return convert( $self->field( lc $field ), @options );
- }
-}
-
-
-sub cleaned_author {
- my $self = shift;
- $self->_handle_cleaned_author_editor( [ $self->author ], @_ );
-}
-
-
-sub cleaned_editor {
- my $self = shift;
- $self->_handle_cleaned_author_editor( [ $self->editor ], @_ );
-}
-
-sub _handle_cleaned_author_editor {
- my ( $self, $authors, @options ) = @_;
- map {
- my $author = $_;
- my $new_author = BibTeX::Parser::Author->new;
- map {
- $new_author->$_( convert( $author->$_, @options ) )
- } grep { defined $author->$_ } qw( first von last jr );
- $new_author;
- } @$authors;
-}
-
-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];
- $_[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 {
- $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"}});
- }
- }
- } 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"}};
- }
-}
-
-
-
-sub author {
- _handle_author_editor('author', @_);
-}
-
-
-sub editor {
- _handle_author_editor('editor', @_);
-}
-
-
-sub fieldlist {
- my $self = shift;
-
- return grep {!/^_/} keys %$self;
-}
-
-
-sub has {
- my ($self, $field) = @_;
-
- return defined $self->{$field};
-}
-
-sub _sanitize_field {
- my $value = shift;
- for ($value) {
- tr/\{\}//d;
- s/\\(?!=[ \\])//g;
- s/\\\\/\\/g;
- }
- return $value;
-}
-
-
-
-sub raw_bibtex {
- my $self = shift;
- if (@_) {
- $self->{_raw} = shift;
- }
- return $self->{_raw};
-}
-
-sub pre {
- my $self = shift;
- if (@_) {
- $self->{_pre} = shift;
- }
- return $self->{_pre};
-}
-
-
-sub to_string {
- my $self = shift;
- my %options=@_;
- if (!exists($options{canonize_names})) {
- $options{canonize_names}=1;
- }
- my @fields = grep {!/^_/} keys %$self;
- @fields = sort {
- $self->{_fieldnums}->{$a} <=>
- $self->{_fieldnums}->{$b}} @fields;
- my $result = '';
- if ($options{print_pre}) {
- $result .= $self->pre()."\n";
- }
- my $type = $self->type;
- if (exists($options{type_capitalization})) {
- if ($options{type_capitalization} eq 'Lowercase') {
- $type = lc $type;
- }
- if ($options{type_capitalization} eq 'Titlecase') {
- $type = ucfirst lc $type;
- }
- }
- print STDERR $self->key, "\n";
- $result .= '@'.$type."{".$self->key.",\n";
- foreach my $field (@fields) {
- my $value = $self->field($field);
- if ($field eq 'author' && $options{canonize_names}) {
- my @names = ($self->author);
- $value = join(' and ', @names);
- }
- if ($field eq 'editor' && $options{canonize_names}) {
- my @names = ($self->editor);
- $value = join(' and ', @names);
- }
- if (exists($options{field_capitalization})) {
- if ($options{field_capitalization} eq 'Uppercase') {
- $field = uc $field;
- }
- if ($options{field_capitalization} eq 'Titlecase') {
- $field = ucfirst $field;
- }
- }
- $result .= " $field = {"."$value"."},\n";
- }
- $result .= "}";
- return $result;
-}
-
-1; # End of BibTeX::Entry
-
-__END__
-=pod
-
-=head1 NAME
-
-BibTeX::Parser::Entry - Contains a single entry of a BibTeX document.
-
-=head1 SYNOPSIS
-
-This class ist a wrapper for a single BibTeX entry. It is usually created
-by a BibTeX::Parser.
-
- use BibTeX::Parser::Entry;
-
- my $entry = BibTeX::Parser::Entry->new($type, $key, $parse_ok, \%fields);
-
- if ($entry->parse_ok) {
- my $type = $entry->type;
- my $key = $enty->key;
- print $entry->field("title");
- my @authors = $entry->author;
- my @editors = $entry->editor;
-
- ...
-
- print $entry->to_string;
- }
-
-
-
-
-
-=head1 FUNCTIONS
-
-=head2 new
-
-Create new entry.
-
-=head2 parse_ok
-
-If the entry was correctly parsed, this method returns a true value, false otherwise.
-
-=head2 error
-
-Return the error message, if the entry could not be parsed or undef otherwise.
-
-=head2 type
-
-Get or set the type of the entry, eg. 'ARTICLE' or 'BOOK'. Return value is
-always uppercase.
-
-=head2 key
-
-Get or set the reference key of the entry.
-
-=head2 field($name [, $value])
-
-Get or set the contents of a field. The first parameter is the name of the
-field, the second (optional) value is the new value.
-
-=head2 cleaned_field($name)
-
-Retrieve the contents of a field in a format that is cleaned of TeX markup.
-
-=head2 cleaned_author
-
-Get an array of L<BibTeX::Parser::Author> objects for the authors of this
-entry. Each name has been cleaned of accents and braces.
-
-=head2 cleaned_editor
-
-Get an array of L<BibTeX::Parser::Author> objects for the editors of this
-entry. Each name has been cleaned of accents and braces.
-
-=head2 author([@authors])
-
-Get or set the authors. Returns an array of L<BibTeX::Author|BibTeX::Author>
-objects. The parameters can either be L<BibTeX::Author|BibTeX::Author> objects
-or strings.
-
-Note: You can also change the authors with $entry->field('author', $authors_string)
-
-=head2 editor([@editors])
-
-Get or set the editors. Returns an array of L<BibTeX::Author|BibTeX::Author>
-objects. The parameters can either be L<BibTeX::Author|BibTeX::Author> objects
-or strings.
-
-Note: You can also change the authors with $entry->field('editor', $editors_string)
-
-=head2 fieldlist ()
-
-Returns a list of all the fields used in this entry.
-
-=head2 has($fieldname)
-
-Returns a true value if this entry has a value for $fieldname.
-
-=head2 pre ()
-
-Return the text in BibTeX file before the entry
-
-=head2 raw_bibtex ()
-
-Return raw BibTeX entry (if available).
-
-=head2 to_string ([options])
-
-Returns a text of the BibTeX entry in BibTeX format. Options are
-a hash.
-
-=over 4
-
-=item C<canonize_names>
-
-If true (the default), authors' and editors'
-names are translated into canonical bibtex form. The command
-C<$entry-E<gt>to_string(canonize_names=E<gt>0)> overrides this behavior.
-
-=item C<field_capitalization>
-
-Capitalization of the field names.
-Can take values 'Uppercase', 'Lowercase' (the default) or 'Titlecase'
-
-=item C<print_pre>
-
-False by default. If true, the text in the Bib file before the
-entry is printed. Note that at present we assume the text
-before the entry NEVER has the @ symbol inside
-
-=item C<type_capitalization>
-
-Capitalization of the type names.
-Can take values 'Uppercase' (the default), 'Lowercase' or 'Titlecase'
-
-
-=back
-
-=head1 VERSION
-
-version 1.04
-
-=head1 AUTHOR
-
-Gerhard Gossen <gerhard.gossen@googlemail.com> and
-Boris Veytsman <boris@varphi.com> and
-Karl Berry <karl@freefriends.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-This software is copyright (c) 2013-2023 by Gerhard Gossen and Boris Veytsman and Karl Berry
-
-This is free software; you can redistribute it and/or modify it under
-the same terms as the Perl 5 programming language system itself.
-
-=cut
-