### -*- Mode: perl -*-

# This script tests ReDIF::Parser::Input internals: low-level
# (lexical) ReDIF data parse: lines, encodings


eval " use ReDIF::Parser::Input; ";

test( not( $@ ), $@ );

use ReDIF::Parser::Input;

my $r = ReDIF::Parser::Input::start_file( "t/1995.rdf" );

test( $r );
test( defined $ReDIF::Parser::Input::SOURCE_ENCODING );
test( $ReDIF::Parser::Input::SOURCE_ENCODING eq 'latin1' );
test( $ReDIF::Parser::Input::CURRENT_BUFFER_POSITION ==0 );

my $EOL = unpack ( "H2", &ReDIF::Parser::Input::get_line_ending() );

print "line ending: $EOL\n" ;

test( $EOL eq '0a' );

$r = ReDIF::Parser::Input::extract_next_line( 0 );

test ( $r );

my $line = ReDIF::Parser::Input::get_the_line( );

print "LINE: [$line]\n";

test( ( defined $line and $line eq "" ), unpack('H10', $line) );

$r = ReDIF::Parser::Input::extract_next_line( 0 );

test ( $r );

$line = ReDIF::Parser::Input::get_the_line( );

test( defined $line and ($line =~ /^template-type: /i ) );

print "LINE: $line\n";

$r = ReDIF::Parser::Input::extract_next_line( 0 );

test ( $r );

$line = ReDIF::Parser::Input::get_the_line( );

print "LINE: $line\n";

test( defined $line and ($line =~ /^author-name: /i ) );


$r = ReDIF::Parser::Input::extract_next_line( 0 );
$r = ReDIF::Parser::Input::extract_next_line( 0 );
$r = ReDIF::Parser::Input::extract_next_line( 0 );
$r = ReDIF::Parser::Input::extract_next_line( 0 );
$r = ReDIF::Parser::Input::extract_next_line( 0 );

$n = test( ($r), &ReDIF::Parser::Input::get_the_line() ) ;
print " $n should fail\n";

$line = ReDIF::Parser::Input::get_the_line( );

test( defined $line and ($line =~ /^author-workplace-name: /i ) );
test( defined $line and ($line =~ /rio$/ ) );


$r = ReDIF::Parser::Input::extract_next_line( 0 );
$r = ReDIF::Parser::Input::extract_next_line( 0 );
$r = ReDIF::Parser::Input::extract_next_line( 0 );

$line = ReDIF::Parser::Input::get_the_line( );

test( (defined $line and 
       ($line =~ /^ fertility dynamics using an econometric/ ) )?1:0, $line );
test( defined $line and ($line =~ /several$/ ) );

while( $r ) {
    $r = ReDIF::Parser::Input::extract_next_line( 0 );
}

test( not $r ) ;

$r = ReDIF::Parser::Input::extract_next_line( 0 );


my @res = ReDIF::Parser::Input::process_file( 't/ctlseri.rdf', 0 );

test( ( @res ? 1: 0 ), join( ':', @res ) );

my $eof_reached   = $res[0];
my $lines_array   = $res[1];

$n = test( $eof_reached );

my $i= 0; 
foreach my $l ( @$lines_array ) {

    my $n   = sprintf "%02i", $i; 
    my $p   = sprintf "%03i", $l->{pos}; 
    my $t   = $l->{text}; 
    print "[$n:$p] $t";
    $i ++;
}

test( (scalar @$lines_array > 10) );


$r = ReDIF::Parser::Input::start_file( 't/ctlseri.rdf', 0 );
test($r);

while( $r ) {
    $r = ReDIF::Parser::Input::extract_next_line();
    if( $r ) {
	$line = ReDIF::Parser::Input::get_the_line( );

	chomp ($line) ;
	print "L[]: '$line'\n";
    }
}


{ 
    package TEST;
    use strict;
    use vars qw( @EVENTS );
    
    sub the_attribute {
	my $self = shift;
	my @args = @_;
	my $event = [ 'the_attribute', @args ];
	push @EVENTS, $event;
    }


    sub close_current_template {
        my $self = shift;
	my @args = @_;
	my $event = [ 'close_current_template', @args ];
	push @EVENTS, $event;
    }

}


ReDIF::Parser::Input::init( { attribute_output => 'TEST' } );

$r = ReDIF::Parser::Input::start_file( 't/input.data', 0 );
while( defined $r ) {
    $r = ReDIF::Parser::Input::extract_next_attribute();
#    if ( defined $r ) {	
#	print "A: '$r->{attribute}' V: '$r->{value}' P: $r->{file_position} ",
#	"LN: $r->{line_number}\n";
#    }
# print ".";
}

my $result_events = \@TEST::EVENTS;
my $c = 0;
foreach my $ev ( @$result_events ) {
    print "event $c: >>>", join ( ', ', @$ev ), "<<<\n"; 
}



###############################################################
#############     TESTING   FRAMEWORK     #####################
###############################################################

sub test {
    push @TESTS, shift;
    push @MESSAGES, shift;
}

sub ok { 
    push @TESTS, 1; 
    push @MESSAGES, shift;
}
sub nok { 
    push @TESTS, 0; 
    push @MESSAGES, shift;
}



END { 

    my $tests = scalar @TESTS;

    if( not $tests ) {
	print "1..1\nnot ok 1\n";
	exit;
    }

    print "1..$tests\n";

    my $counter = 1;
    while ( 1 ) {
	my $t = shift @TESTS;
	my $m = shift @MESSAGES;
	if( not $t ) {
	    print "not ";
	}
	print "ok $counter\n";

	if( $m ) { 
	    print "[$counter] $m\n";
	}
	last if not scalar @TESTS;
	$counter ++;
    }
}
