### -*- Mode: perl -*-
##  Perl's and ReDIF-perl's unicode processing test script:
##

use vars qw( $test_no );

sub print_result {
    my $result = shift;
    $test_no ++;
    if ( not defined $result or not $result ) {
	print "not ok $test_no\n";
    } else {
	print "ok $test_no\n";
    }
}


BEGIN {print "1..9\n";}


eval " { use ReDIF::Unicode; } " ;
print_result( not $@ );   ###  test 1

eval " require 5.008_000; binmode STDOUT, ':utf8'; ";

# BEGIN { push @ARGV, '--spec' , './spec/'; } 

use ReDIF::Parser;

$redif_spec_filename = $ReDIF::CONFIG{spec_full_name}; 
print "redif.spec: $redif_spec_filename\n";

ReDIF::Parser::open_file( "t/unicode/DOMINIQUE_2.rdf" ); 
$result = &ReDIF::Parser::get_next_template();

if( $result ) {
    my $n = $result -> {'name-full'}[0];
    print "Name: $n\n";
    
#    use Data::Dumper;
#    print Dumper( $result );

#    print Dumper( $ReDIF::Parser::Core::Options->{'build_template_hash'} );

    die if $n !~ /DOMINIQUE/;
    { use bytes; $result = $n =~ m/L\xe9VY/; }
}

print_result ( $result );   ###  test 2


ReDIF::Parser::set_parser_options( utf8_output => 0 ) ;
ReDIF::Parser::open_file( "t/unicode/test_utf8_0.rdf" ); 

use pretty_print qw( &pretty_print );

$result = 0;
if( $t = &ReDIF::Parser::get_next_template_good_or_bad() ) {
#    pretty_print ( $t );
    my $n = $t->{author}[1]{name}[0];
    print "Name: $n\n";
    die if $n !~ /Tomas/;
    { 
	use bytes; 
#	$result = $n =~ m/Sj\xf6str\xf6m/; 
	$result = $n =~ m/str/; 
    }
}

print_result ( $result );   ###  test 4


ReDIF::Parser::set_parser_options( utf8_output => 1 ) ;

ReDIF::Parser::open_file( "t/unicode/test_utf8_0.rdf" ); 

$result = 0;
if( $t = &ReDIF::Parser::get_next_template_good_or_bad() ) {
    my $n = $t->{author}[1]{name}[0];
    print "Name: $n\n";
    die if $n !~ /Tomas/;
    { 
	use bytes; 
#	$result = $n =~ m/Tomas Sj\xf6str\xf6m/; 
#	$result =  index( $n, chr( 0xf6 ) )   + 1;
#	$result =  index( $n, chr( 0xc3 ) )   + 1;
	$result =  index( $n, chr( 0xb6 ) )   + 1;
    }
}

print_result ( $result );   ###  test 5


ReDIF::Parser::set_parser_options( utf8_output => 1 ) ;

ReDIF::Parser::open_file( "t/unicode/test_utf8_1.rdf" ); 

$t = &ReDIF::Parser::get_next_template_good_or_bad() ;

my $status = $t->{RESULT};
my $enc    = $t->{ENCODING};

print "STATUS: $status\n   ENC: $enc\n";

print_result( $status eq 'good' );      ###  test 6
print_result( $enc eq 'utf-8' );    ###  test 7

my $n1 = $t->{author}[0]{name}[0];
my $n2 = $t->{author}[1]{name}[0];
print "1st Name: $n1\n";
print "2nd Name: $n2\n";


ReDIF::Parser::set_parser_options( utf8_output => 0 ) ;

ReDIF::Parser::open_file( "t/unicode/test_utf8_1.rdf" ); 

$t = &ReDIF::Parser::get_next_template_good_or_bad() ;

$status = $t->{RESULT};
$enc    = $t->{ENCODING};

print "STATUS: $status\n   ENC: $enc\n";

print_result( $status eq 'bad' );      ###  test 8
print_result( $enc eq 'invalid' );      ###  test 9

$n1 = $t->{author}[0]{name}[0];
$n2 = $t->{author}[1]{name}[0];
print "1st Name: $n1\n";
print "2nd Name: $n2\n";


ReDIF::Parser::open_file( "t/unicode/test_utf8_1.rdf" ); 

$t = ReDIF::Parser::get_next_template() ;

print_result( not $t );      ###  test 10






__END__

open LAT1, "<t/DOMINIQUE_2.rdf"; 
$data_lat1 = join '', <LAT1>;
close LAT1;

eval ' 
    use utf8;

    $data_u = utf8_from_latin1( $data_lat1 );

    print "utf8 data: >>>$data_u<<<\n";
    if( $data_u =~ m/\n(handle:\s+.+)/i ) {
	my $handle_attribute = $1;
	my ( $h_value ) = 
	    $handle_attribute =~ 
		m/((?:RePEc|ReLIS|mapin):[a-zA-Z]{3}:\d{4}-[01]\d-[0-3]\d:[\w\-]+)$/;

	print "Dominique Handle: " , $h_value , "\n";
        my $h_v_lat = utf8_from_latin1( $h_value );
	print "Dominique Handle (latin1): " , $h_v_lat , "\n";

    }

    my $data_lat_back = latin1_from_utf8( $data_u );

';
print_result( not $@ );
    


__END__


###   additional BOM identification test(s)

undef $result;
{ 
    use utf8;
    if( $data_u8_bom =~ m/^\x{FEFF}/ ) { $result = 1; } 
    else { $result = 0; } 
} 
if( not defined $result or ($result == 0) ) {
    print "test 8 result : $result\n";
    print "not ";
}

print "ok 8\n";




undef $result;
eval ' { use utf8;
       if( $data_u8_bom =~ m/^\x{FEFF}/ ) { $result = 1; } 
       else { $result = 0; } } ';
if( $@ or not defined $result or ($result == 0) ) {
    print "test 8 result : $result\n";
    print "not ";
}

print "ok 8\n";


__END__



