<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package BibTeX::Parser;
{
  $BibTeX::Parser::VERSION = '1.05';
}
# ABSTRACT: A pure perl BibTeX parser
use warnings;
use strict;

use BibTeX::Parser::Entry;


my $re_namechar = qr/[a-zA-Z0-9\!\$\&amp;\*\+\-\.\/\:\;\&lt;\&gt;\?\[\]\^\_\`\|\']/o;
my $re_name     = qr/$re_namechar+/o;


sub new {
    my ( $class, $fh ) = @_;

    return bless {
        fh      =&gt; $fh,
        strings =&gt; {
            jan =&gt; "January",
            feb =&gt; "February",
            mar =&gt; "March",
            apr =&gt; "April",
            may =&gt; "May",
            jun =&gt; "June",
            jul =&gt; "July",
            aug =&gt; "August",
            sep =&gt; "September",
            oct =&gt; "October",
            nov =&gt; "November",
            dec =&gt; "December",

        },
        line   =&gt; -1,
        buffer =&gt; "",
    }, $class;
}

sub _slurp_close_bracket;

sub _parse_next {
    my $self = shift;

    while (1) {    # loop until regular entry is finished
        return 0 if $self-&gt;{fh}-&gt;eof;
        local $_ = $self-&gt;{buffer};

        until (/@/m) {
            my $line = $self-&gt;{fh}-&gt;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-&gt;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-&gt;{fh}-&gt;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-&gt;pre($pre);


            # Remember raw bibtex code
            my $raw = substr($_, $start_pos);
            $raw =~ s/^\s+//;
            $raw =~ s/\s+$//;
            $current_entry-&gt;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-&gt;{strings} );
                    if ( defined $self-&gt;{strings}-&gt;{$key} ) {
                        warn("Redefining string $key!");
                    }
                    $self-&gt;{strings}-&gt;{$key} = $value;
                    /\G[\s\n]*\}/cg;
                } else {
                    $current_entry-&gt;error("Malformed string!");
					return $current_entry;
                }
            } elsif ( $type eq "COMMENT" or $type eq "PREAMBLE" ) {
                /\G\{./cgo;
                _slurp_close_bracket;
            } else {    # normal entry
                $current_entry-&gt;parse_ok(1);

				# parse key
                if (/\G\s*\{(?:\s*($re_name)\s*,[\s\n]*|\s+\r?\s*)/cgo) {
                    $current_entry-&gt;key($1);

					# fields
                    while (/\G[\s\n]*($re_name)[\s\n]*=[\s\n]*/cgo) {
                        $current_entry-&gt;field(
                                      $1 =&gt; _parse_string( $self-&gt;{strings} ) );
                        my $idx = index( $_, ',', pos($_) );
                        pos($_) = $idx + 1 if $idx &gt; 0;
                    }

                    return $current_entry;

                } else {

                    $current_entry-&gt;error("Malformed entry (key contains illegal characters) at " . substr($_, pos($_) || 0, 20)  . ", ignoring");
                    _slurp_close_bracket;
					return $current_entry;
                }
            }

            $self-&gt;{buffer} = substr $_, pos($_);

        } else {
            $current_entry-&gt;error("Did not find type at " . substr($_, pos($_) || 0, 20)); 
			return $current_entry;
        }

    }
}


sub next {
    my $self = shift;

    return $self-&gt;_parse_next;
}

# slurp everything till the next closing brace. Handles
# nested brackets
sub _slurp_close_bracket {
    my $bracelevel = 0;
  BRACE: {
        /\G[^\}]*\{/cg &amp;&amp; do { $bracelevel++; redo BRACE };
        /\G[^\{]*\}/cg
          &amp;&amp; do {
            if ( $bracelevel &gt; 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-&gt;{$1};
            $value .= $strings_ref-&gt;{$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 &amp;&amp; next;
			/\G\{/cg &amp;&amp; (++$depth, next);
			/\G\}/cg &amp;&amp; (--$depth &gt; 0 ? next : last);
			/\G([^\\\{\}]+)/cg &amp;&amp; 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 &lt; 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 &amp;&amp; pos $string &lt; 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-&gt;new("filename");

    # Create parser object ...
    my $parser = BibTeX::Parser-&gt;new($fh);
    
    # ... and iterate over entries
    while (my $entry = $parser-&gt;next ) {
	    if ($entry-&gt;parse_ok) {
		    my $type    = $entry-&gt;type;
		    my $title   = $entry-&gt;field("title");

		    my @authors = $entry-&gt;author;
		    # or:
		    my @editors = $entry-&gt;editor;
		    
		    foreach my $author (@authors) {
			    print $author-&gt;first . " "
			    	. $author-&gt;von . " "
				. $author-&gt;last . ", "
				. $author-&gt;jr;
		    }
	    } else {
		    warn "Error parsing file: " . $entry-&gt;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&lt;author&gt; and C&lt;editor&gt; are canonicalized, see
L&lt;BibTeX::Parser::Author&gt;.


=head1 SEE ALSO

=over 4

=item

L&lt;BibTeX::Parser::Entry&gt;

=item

L&lt;BibTeX::Parser::Author&gt;

=back

=head1 VERSION

version 1.04


=head1 AUTHOR

Gerhard Gossen &lt;gerhard.gossen@googlemail.com&gt; and
Boris Veytsman &lt;boris@varphi.com&gt; and
Karl Berry &lt;karl@freefriends.org&gt;

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013-2024 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

</pre></body></html>