#!/usr/bin/perl

use strict;
$|++;

use lib('..');

use Data::HexDump;
use File::Path;

my $data = '.\data';

rmtree $data;    # remove old data if any
mkdir $data;

use Test::More tests => 28;

use File::AnyEncoding;    # under test

use_ok('File::AnyEncoding');

# test utf-16le encoding
{

    # create object and write test file with specified encoding

    my $encoding = 'UTF-16LE';
    my $fan1     = File::AnyEncoding->new($encoding);

    isa_ok( $fan1, 'File::AnyEncoding', '$fan1' );
    is( $fan1->get_encoding(), 'UTF-16LE', "specified encoding" );

    my $text1 = "Hello world \x{263A}\n\n";
    my $file1 = "$data\\$encoding.txt";

    $fan1->write_file( $file1, $text1 );

    my $expected1 = <<HERE;
00000000  FF FE 48 00 65 00 6C 00 - 6C 00 6F 00 20 00 77 00  ..H.e.l.l.o. .w.
00000010  6F 00 72 00 6C 00 64 00 - 20 00 3A 26 0D 00 0A 00  o.r.l.d. .:&....
00000020  0D 00 0A 00                                        ....
HERE

    is( my_hexdump($file1), $expected1, "write_file $file1" );

    # reset encoding - should be detected in read_file
    $fan1->set_encoding('NONE');
    is( $fan1->get_encoding(), 'NONE', "default encoding" );

    # read test file and remember encoding

    my $text2 = $fan1->read_file($file1);

    is( $fan1->get_encoding(), 'UTF-16LE', "detected encoding" );

    my $expected2 = 'Hello world \x{263a}\x{d}\x{a}\x{d}\x{a}';
    is( my_reasciify($text2), $expected2, "read_file $file1" );

    my @lines2 = $fan1->read_file($file1);
    is( scalar @lines2, 2, "read_file $file1" );
    my $join2 = join( '', @lines2 );
    is( my_reasciify($join2), $expected2, "read_file $file1" );

    # modify text and write second file using the remebered encoding

    $text2 =~ s/world/WORLD/;
    $text2 =~ s/\x{263A}/\x{20AC}/;

    ( my $file2 = $file1 ) =~ s/.txt/-2.txt/;

    $fan1->write_file( $file2, $text2 );    # writes file with remembered encoding

    my $expected3 = <<HERE;
00000000  FF FE 48 00 65 00 6C 00 - 6C 00 6F 00 20 00 57 00  ..H.e.l.l.o. .W.
00000010  4F 00 52 00 4C 00 44 00 - 20 00 AC 20 0D 00 0D 00  O.R.L.D. .. ....
00000020  0A 00 0D 00 0D 00 0A 00                            ........
HERE

    is( my_hexdump($file2), $expected3, "write_file $file1" );
}

# test utf-8 encoding
{

    # create object and write test file with specified encoding

    my $encoding = 'UTF-8';
    my $fan1     = File::AnyEncoding->new($encoding);

    isa_ok( $fan1, 'File::AnyEncoding', '$fan1' );
    is( $fan1->get_encoding(), 'UTF-8', "specified encoding" );

    my $text1 = "Hello world \x{263A}\n\n";
    my $file1 = "$data\\$encoding.txt";

    $fan1->write_file( $file1, $text1 );

    my $expected1 = <<HERE;
00000000  EF BB BF 48 65 6C 6C 6F - 20 77 6F 72 6C 64 20 E2  ...Hello world .
00000010  98 BA 0A 0A                                        ....
HERE

    is( my_hexdump($file1), $expected1, "write_file $file1" );

    # reset encoding - should be detected in read_file
    $fan1->set_encoding('NONE');
    is( $fan1->get_encoding(), 'NONE', "default encoding" );

    # read test file and remember encoding

    my $text2 = $fan1->read_file($file1);

    is( $fan1->get_encoding(), 'UTF-8', "detected encoding" );

    my $expected2 = 'Hello world \x{263a}\x{a}\x{a}';
    is( my_reasciify($text2), $expected2, "read_file $file1" );

    my @lines2 = $fan1->read_file($file1);
    is( scalar @lines2, 2, "read_file $file1" );
    my $join2 = join( '', @lines2 );
    is( my_reasciify($join2), $expected2, "read_file $file1" );

    # modify text and write second file using the remebered encoding

    $text2 =~ s/world/WORLD/;
    $text2 =~ s/\x{263A}/\x{20AC}/;

    ( my $file2 = $file1 ) =~ s/.txt/-2.txt/;

    $fan1->write_file( $file2, $text2 );    # writes file with remembered encoding

    my $expected3 = <<HERE;
00000000  EF BB BF 48 65 6C 6C 6F - 20 57 4F 52 4C 44 20 E2  ...Hello WORLD .
00000010  82 AC 0A 0A                                        ....
HERE

    is( my_hexdump($file2), $expected3, "write_file $file1" );
}

# test no encoding
{

    # create object and write test file with specified encoding

    my $encoding = 'NONE';
    my $fan1     = File::AnyEncoding->new($encoding);

    isa_ok( $fan1, 'File::AnyEncoding', '$fan1' );
    is( $fan1->get_encoding(), 'NONE', "specified encoding" );

    my $text1 = "Hello world \x{263A}\n\n";
    my $file1 = "$data\\$encoding.txt";

    $fan1->write_file( $file1, $text1 );

    my $expected1 = <<HERE;
00000000  48 65 6C 6C 6F 20 77 6F - 72 6C 64 20 E2 98 BA 0A  Hello world ....
00000010  0A                                                 .
HERE

    is( my_hexdump($file1), $expected1, "write_file $file1" );

    # reset encoding - should be detected in read_file
    $fan1->set_encoding('UTF-8');
    is( $fan1->get_encoding(), 'UTF-8', "default encoding" );

    # read test file and remember encoding

    my $text2 = $fan1->read_file($file1);

    is( $fan1->get_encoding(), 'NONE', "detected encoding" );

    my $expected2 = 'Hello world \x{e2}\x{98}\x{ba}\x{a}\x{a}';
    is( my_reasciify($text2), $expected2, "read_file $file1" );

    my @lines2 = $fan1->read_file($file1);
    is( scalar @lines2, 2, "read_file $file1" );
    my $join2 = join( '', @lines2 );
    is( my_reasciify($join2), $expected2, "read_file $file1" );

    # modify text and write second file using the remebered encoding

    $text2 =~ s/world/WORLD/;
    $text2 =~ s/\x{263A}/\x{20AC}/;

    ( my $file2 = $file1 ) =~ s/.txt/-2.txt/;

    $fan1->write_file( $file2, $text2 );    # writes file with remembered encoding

    my $expected3 = <<HERE;
00000000  48 65 6C 6C 6F 20 57 4F - 52 4C 44 20 E2 98 BA 0A  Hello WORLD ....
00000010  0A                                                 .
HERE

    is( my_hexdump($file2), $expected3, "write_file $file1" );

}

exit 0;

# returns hexdump of the $file
sub my_hexdump {
    my $file = shift;
    my $f    = new Data::HexDump;
    unless ( -f $file ) {
        warn "no such file $file";
        return '---';
    }
    $f->file($file);
    my $str = '';
    while ( local $_ = $f->dump ) {
        $str .= $_;
    }
    $str =~ s/.*00000000/00000000/s;
    return $str;
}

# returns sprintf of characters in $string,
# replacing those not printable as ascii by their hex code point numeric value
# similar to sub in File::BOM
sub my_reasciify {
    my $string = shift;
    $string = join "", map {
        my $ord = ord($_);

        #	($ord > 127 || ($ord < 32 && $ord != 10))
        ( $ord > 127 || $ord < 32 )
          ? sprintf '\x{%x}', $ord
          : $_
    } split //, $string;
}

__END__