diff options
Diffstat (limited to 'support/bibtexperllibs/BibTeX-Parser/lib/BibTeX')
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 - |