package BibExport::Db;

use Bib::Write;
use warnings;
use strict;

# ------------------------------------------------------------------------------
our $level = 0;
our @stack = ();

sub _start {
    print _al() . "START:$_[0]\n";
    push @stack, $_[0];
    $level ++;
}

sub _end {
    $level --;
    print _al() . "END:" . ( pop @stack ) . "\n";
    $level or print "\n";
}

sub _al {
    return ( "  " x $level );
}
# ------------------------------------------------------------------------------
sub _textparse {
    local $_ = $_[0];
    
    s/[ \t\r]*\n[ \t\f]*\n\s*/\\par /g;
    s/\s+/ /g;
    s/\\par\s*/\n\n/;
    $_;
}

sub _encode
{
    my $Text = $_[ 0 ];
    
    $Text =~ s/([\n\r%])/sprintf( "%%%.2x", ord( $1 ) )/ge;
    return $Text;
}

sub _id {
    print _al() . "ID:" . _encode( ref( $_[0] ) ? $_[0]->{'-key'} : $_[0] )."\n";
}

sub _pages {
    defined( $_[0]->{'pages'} ) and do {
        my $p = $_[0]->{'pages'};
        $p =~ s/--/-/;
        print '' . ("  " x $level ).
            "PAGES" . ($_[1] || '' ) . ":" . _encode( $p ) . "\n";
        delete( $_[0]->{'pages'} );
    };
}

sub _list {
    my ( $obj, $key ) = @_;
    my $i = 1;
    foreach my $a ( @{$obj->{lc($key)}} ) {
        print _al() . uc( $key ) . "($i):" . _encode( $a ) . "\n";
        $i ++;
    }
    delete( $obj->{lc($key)} );
}

sub _keyvals {
    my $obj = shift;
    my ($K, $k);
    foreach my $l ( @_ ) {
        ($K, $k) = ref( $l ) ? @{$l} : ( uc( $l ), lc( $l ) );
        defined( $obj->{ $k } ) and do {
            print '' . ("  " x $level ).
                "$K:" . _encode( _textparse( $obj->{ $k } ) ) . "\n";
        };
        delete( $obj->{ lc( $k ) } );
    }
}

sub _ymd_from_to {
    my ($obj) = @_;
    my ($from, $to);

    $obj->{'year'} and $obj->{'month'} and $obj->{'day'} and do {
        $obj->{'month'} = bib_month( $obj->{'month'} );
        if( $obj->{'day'} =~ /^(\d+)[-]+(\d+)$/ ) {
            $from = sprintf( "%.4i-%.2i-%.2i", @{$obj}{'year','month'}, $1);
            $to = sprintf( "%.4i-%.2i-%.2i", @{$obj}{'year','month'}, $2);
        } else {
            $from = $to = sprintf( "%.4i-%.2i-%.2i",
                                   @{$obj}{'year','month','day'} );
        }
    };
    return ($from, $to);
}

# ==============================================================================

sub new {
    my $class = shift;
    $class = ref( $class ) || $class;

    return bless( { 'proc' => {} }, $class );
}

sub done {
    my ($this) = @_;

    foreach my $k ( keys( %{$this->{'proc'}} ) ) {
        _proceedings( $k, $this->{'proc'}{$k} );
    }
}

sub proceedings
{
    my $this = shift;
    my $obj = { %{$_[0]} };
    
    my $id = $obj->{'-key'};

    if( $obj->{'volume'} ) {
        $id =~ /[a-z]$/ or die;
        my $procid = $`;
        defined( $this->{'proc'}{$procid} ) or $this->{'proc'}{$procid} = {};
        defined( $this->{'proc'}{$procid}{$id} ) and die "duplicity ($id)";
        $this->{'proc'}{$procid}{$id} = $obj;
    } else {
        defined( $this->{'proc'}{$id} ) and die "duplicity ($id)";
        $this->{'proc'}{$id} = $obj;
    }
}

sub _test_eq {
    my ($obj, $_obj, $type) = @_;
    if( defined( $_obj->{$type} ) ) {
        defined( $obj->{$type} ) and $obj->{$type} eq $_obj->{$type} or
            delete( $_obj->{$type} );
    }
}

sub _cln_eq {
    my ($obj, $_obj, $type) = @_;
    defined( $_obj->{$type} ) and delete( $obj->{$type} );
}

sub _proceedings
{
    my $id = shift;
    my $obj = { %{$_[0]} };
    my $_obj = $obj;

    _start( 'proceedings' );
    _id( $id );

    if( defined( $obj->{ "${id}a" } ) ) {
        $_obj = { %{$obj->{ "${id}a" }} };

        foreach my $k ( keys( %{$obj} ) ) {
            _test_eq( $obj->{$k}, $_obj, 'checked' );
            _test_eq( $obj->{$k}, $_obj, 'isbn' );
        }
        foreach my $k ( keys( %{$obj} ) ) {
            _cln_eq( $obj->{$k}, $_obj, 'checked' );
            _cln_eq( $obj->{$k}, $_obj, 'isbn' );
            delete( @{$obj->{$k}}{ qw(title booktitle abbrevtitle 
                                      month day address
                                      editor issn publisher venue year
                                      series url note mnote organization)} );
        }
    }

    _keyvals( $_obj, 'TITLE' );
    _keyvals( $_obj, [ 'TITLE_SHORT', 'booktitle' ] );
    _keyvals( $_obj, [ 'TITLE_ABBREV', 'abbrevtitle' ] );
    _keyvals( $_obj, 'TITLE' );
    _list( $_obj, 'EDITORS' );

    my $i = 1;
    foreach my $a ( @{$_obj->{'editor'}} ) {
        print _al() . "EDITORS($i):\n";
        _authorship( _encode( $a ), $i ++ );
    }
    delete( $_obj->{'editor'} );

    my ($venue_from, $venue_to) = _ymd_from_to( $_obj );
    _keyvals( $_obj, 'YEAR' );
    $venue_from and do {
        print _al() . "VENUE_FROM:" . _encode( $venue_from ) . "\n";
        print _al() . "VENUE_TO:" . _encode( $venue_to ) . "\n";
    };
    
    delete( @{$_obj}{ qw(month day address)} );
    _keyvals($_obj, qw(VENUE PUBLISHER ISBN ISSN SERIES URL NOTE MNOTE
                       ORGANIZATION));
    if( defined( $obj->{ "${id}a" } ) ) {
        my $i = 1;
        foreach my $k ( sort(  keys( %{$obj} ) ) ) {
            print _al() . "PROCVOLS($i):\n";
            $level ++;
            _procvolume( $obj->{$k}, $i ++ );
            $level --;
            main::_warn_untreated( $obj->{$k}, $id);
        }
    } else {
        print _al() . "PROCVOLS(1):\n";
        $level ++;
        _procvolume( $_obj, 1 );
        $level --;
        main::_warn_untreated( $_obj, $id );
    }
    _end();
}

sub _annote {
    my ($annote) = @_;

    _start( 'annote' );
    print _al() . "ANNOTE:" . _encode( $annote ) . "\n";
    _end();
}

sub _rnote {
    my ($rnote) = @_;

    _start( 'rnote' );
    print _al() . "RNOTE:" . _encode( $rnote ) . "\n";
    _end();
}

sub _authorship {
    my ($name, $ord) = @_;

    _start( 'authorship' );
    print _al() . "ORD:$ord\n";
    print _al() . "NAME:" . _encode( $name ) . "\n";
    _end();
}

sub _procvolume {
    my ($obj, $ord) = @_;

    _start( 'procvolume' );
    _id( $obj );
    print _al() . "ORD:$ord\n";
    _pages( $obj );
    _keyvals($obj, qw(ISBN NUMBER VOLUME HARDCOPY));
    _end();
}

sub _paper
{
    my ($obj) = @_;
 
    _id( $obj );
    _keyvals( $obj, 'CHECKED', 'TITLE' );


    my $i = 1;
    foreach my $a ( @{$obj->{'author'}} ) {
        print _al() . "AUTHORS($i):\n";
        _authorship( _encode( $a ), $i ++ );
    }
    delete( $obj->{'author'} );

    _pages( $obj );
    if( defined( $obj->{'read'} ) ) {
        $obj->{'rnote'} = $obj->{'rnote'} ? $obj->{'rnote'} . "," : '';
        $obj->{'rnote'} .= "R:$obj->{'read'}";
        delete( $obj->{'read'} );
    }

    if( defined( $obj->{'source'} ) ) {
        $obj->{'hardcopy'} = $obj->{'hardcopy'} ? $obj->{'hardcopy'} . "," : '';
        $obj->{'hardcopy'} .= $obj->{'source'};
        delete( $obj->{'source'} );
    }

    $obj->{'refs'} = $obj->{'references'};
    delete( $obj->{'references'} );


    if( defined( $obj->{'annote'} ) ) {
        print _al() . "ANNOTES(1):\n";
        _annote( $obj->{'annote'} );
    }

    if( defined( $obj->{'rnote'} ) ) {
        print _al() . "RNOTES(1):\n";
        _rnote( $obj->{'rnote'} );
    }

    _keyvals($obj, qw(NOTE HARDCOPY MNOTE LANGUAGE
                      KEYWORDS URL REFS ABSTRACT) );
}

sub inproceedings
{
    my ($this, $obj ) = @_;

   _start( 'inproceedings' );
   _paper( $obj );
   $obj->{'procvolume'} = $obj->{'crossref'};
   delete $obj->{'crossref'};
  _keyvals( $obj, 'PROCVOLUME');
   main::_warn_untreated( $obj, $obj->{'-key'} );
   _end();
}

sub article {
    my ($this, $obj) = @_;

   _start( 'article' );
   _paper( $obj );
   _keyvals( $obj, qw(JOURNAL YEAR VOLUME NUMBER MONTH) );
   main::_warn_untreated( $obj, $obj->{'-key'} );
   _end();
}

sub techreport
{
    my ($this, $obj) = @_;

   _start( 'techreport' );
   _paper( $obj );
   _keyvals( $obj, qw( YEAR MONTH INSTITUTION ADDRESS TYPE NUMBER) );
   main::_warn_untreated( $obj, $obj->{'-key'} );
   _end();
}

1;
