# BibParser.pm - bib file parsing routines
# (c) Martin Matousek, 2003-02-11

use strict;
use warnings;

package BibParser;
use FileParser;
use TeX;
use Opts;

use base 'FileParser';

# 'diag' => 0/1/2
# 'longstrings' => 0/1
sub parse
{
    my ( $this, $File, $Bib, $Opts ) = @_[0..3];
    $Opts = new Opts( $Opts, 'diag' => 0, 'maxlen' => 20 );
    $this->{ 'opts' } = $Opts;

    my $Object = 0;
    $this->open( $File, ":encoding(iso8859-2)" );
#    $Opts->{'diag'} = 1;

    while( 1 )
    {
        $_= $this->row( \&SpSkip ) or do {
            $this->close();
            return $Bib;
        };
    
        /^\s*\@(\w+)\s*/ or $this->die( 'Entry begin expected' );
        $Object = { '-type' => lc($1) };
        my $t = lc($1); # bug
        
        $Opts->{ 'diag' } && print STDERR "BEGIN $1 - '$Object->{'-type'}':";

        $_= $this->row( \&SpSkip, $' );  #';
        
        /^\s*\{\s*/ or $this->die( "'{' expected\n" ); 
        $_= $this->row( \&SpSkip, $' );  #';

        if( $Object->{'-type'} eq 'string' )
        {
            if( $Object->{ '-key' } = $this->getKey() )
            {
                $Object->{ 'fl' } = $this->fl();
                $Object->{ '-val' } = $this->getVal( $Object->{ '-key' } );
                $Opts->{ 'diag' } > 1 && 
                    print STDERR "$Object->{ '-key' }:$Object->{'-val'}\n";
            }
            else { $this->die( 'Key name expected' ); }
            
            if( defined( $Bib->{ $Object->{ '-key' } } ) )
            {
                if( $Bib->{ $Object->{ '-key' } }{ '-type' } eq 'string' ) 
                {
                    $this->warn( "Duplicate string $Object->{ '-key' }" );
                }
                else
                {
                    $this->die( "Duplicate bibkey $Object->{ '-key' }" );
                }
            }

            $_ = $this->row( \&SpSkip );
            /^\s*\}\s*/ or $this->die( "Missing '}'" );
            $this->{'row'} = $';  #';
            $Opts->{ 'diag' } && print STDERR "END\n";
        }
        else
        {
            /^\s*([^\s,]+)\s*/ or $this->die( 'Bibkey expected' );
            $Object->{ '-key' } = $1;
            $Object->{ 'fl' }{ '-key' } = $this->fl();
            defined( $Bib->{ $1} ) and $this->die( "Duplicate bibkey $1" );

            $Opts->{ 'diag' } && print STDERR "$1\n";
            $_ = $this->row( \&SpSkip, $' );  #';

            my $key = '-key';

            while( 1 )
            {
                $_ = $this->row( \&SpSkip );

                while( /^\s*,\s*/ )        # skipping commas
                {
                    if( defined( $key ) ) { undef( $key ); }
                    else { $this->warn( 'Ambiguous comma' ); }
                    $_ = $this->row( \&SpSkip, $' );  #';
                }

                /^\s*\}\s*/ and do {       # end of entry
                    $this->{ 'row' } = $';   #';
                    last; 
                }; 
                
                defined( $key ) and 
                    $this->die( "Missing comma or '}'.\nLast field '$key' at " .
                                ($Object->{'fl'}{$key} =~ /:/, 
                                 "$` line $'" ) . 
                                " in entry $Object->{ '-key' } " .
                                "($Object->{'-type'})" );
                
                if( $key = lc( $this->getKey() ) )
                {
                    $Object->{ 'fl' }{$key} = $this->fl();
                    $Object->{$key} = $this->getVal( $key );
                    $Opts->{ 'diag' } > 1 && print STDERR 
                        "$key:$Object->{$key}\n";
                }
                else { $this->die( "Field name or '\}' expected" ); }
            }
            $Opts->{ 'diag' } && print STDERR "END\n";
        }
        
        $Bib->{ $Object->{ '-key' } } = $Object;
        push @{$Bib->{ '-keys' }}, $Object->{ '-key' };
    }
}


sub getKey
{
    my $this = shift;
    my $Val = '';
    my $fl;
    my $line;


    $this->row( \&SpSkip ) =~ /^\s*(\w+)\s*/ and do
    {
        my $key = $1;
        $this->row( \&SpSkip, $' ) =~ /^\s*\=\s*/ or
            $this->die( "'=' expected" );
        $this->{ 'row' } = $';
        return $key;
    };

    return undef;
    
}

sub getVal
{
    my $this = shift;
    my $key = shift;
    my $Val = '';
    
    my $vline = $this->{'line'}; 
    $_ = $this->row( \&SpSkip );
    
    if( /^\s*\"/ )                         # quotes
    {
        $_ = $';
        if( $this->{ 'opts' }{ 'longstrings' } )  # multiline strings
        {
            while( /^(([^\"\\]|\\.)*)$/ )
            {
                $Val .= $_;
# ch               $_ = $this->row( \&SpSkip, '' );
                $_ = $this->row( undef, '' );
            }
        }
        /^(([^\"\\]|\\.)*)\"\s*/ or $this->die( "closing '\"' expected" );
        $Val .= $1;
        $this->{ 'row' } = $';
    } 
    elsif ( /^\s*\{/ )                     # curly braces
    {
        $_ = $';
        my $cnt = 1;
        while( $cnt )
        {
# ch            $_ = $this->row( \&SpSkip, $_ ) or
#                $this->die( "closing '}' expected" );
            $_ = $this->row( undef, $_ ) or
                $this->die( "closing '}' expected" );

            /^([^\\\{\}]|\\.)*(\{)?/ && do {
                $Val .= $&;
                $_ = $';
                $2 and $cnt ++;
            };

            /^\}\s*/ && do {
                $cnt --;
                $cnt and $Val .= $&;
                $_ = $';
            };
        }
        $this->{ 'row' } = $_;
    }
    elsif( /^\s*(\w+)\s*/ )                     # word
    {
        $Val = $1;
        $this->{ 'row' } = $';
        $this->{'opts'}{ 'wchar' } and $Val = TeX::TeX2wchar( $Val );
        $this->{'opts'}{ 'utf8' } and $Val = TeX::TeX2utf8( $Val );
#                print  STDERR "$Val\n";
        return $Val;
    }
    else
    {
        $this->die( 'value expected' );
    }
    $vline = $this->{'line'} - $vline + 1;
    $vline <= $this->{'opts'}{ 'maxlen' } or 
        $this->warn( "Value of \'$key\' too long ($vline lines)\n" );
    $this->{'opts'}{ 'wchar' } and $Val = TeX::TeX2wchar( $Val );
    $this->{'opts'}{ 'utf8' } and $Val = TeX::TeX2utf8( $Val );
#                print  STDERR "$Val\n";
    return $Val;
}

sub SpSkip
{
    $_ = shift;
    s/^\s*//;                   # skip leading wspaces
    s/^\%.*$//s;                 # skip comment 
    return $_;
}

1;
