view release on metacpan or  search on metacpan

t/01..bom.t  view on Meta::CPAN

our @encodings;
BEGIN {
    # encodings to use in unseekable test
    @encodings = qw( UTF-8 UTF-16LE UTF-16BE UTF-32LE UTF-32BE );

    plan tests => 11 + (@test_files * 14) + (@encodings * 4);

    use_ok("File::BOM", ':all');
}

# Ignore known harmless warning
local $SIG{__WARN__} = sub {
    my $warning = "@_";
    if ($warning !~ /^UTF-(?:16|32)LE:Partial character/) {
	warn $warning;
    }
};

for my $file (@test_files) {
    my $file_enc = $file2enc{$file};
    is(open_bom(FH, $file2path{$file}), $file2enc{$file}, "$file: open_bom returned encoding");
    my $expect = $filecontent{$file};

    my $line = <FH>;
    chomp $line;

    is($line, $expect, "$file: test content returned OK");

    close FH;

    {
	# test defuse
	open BOMB, '<', $file2path{$file}
	    or die "Couldn't read '$file2path{$file}': $!";

	my $enc = defuse BOMB;
	is($enc, $file_enc, "$file: defuse returns correct encoding ($enc)");
	$line = <BOMB>;
	chomp $line;
	is($line, $expect, "$file: defused version content OK");

	close BOMB;
    }

    open FH, '<', $file2path{$file};
    my $first_line;
    {
	local $/ = $fileeol{$file};
	$first_line = <FH>;
	chomp $first_line;
    }

    seek(FH, 0, SEEK_SET);

    is(get_encoding_from_filehandle(FH), $file_enc, "$file: get_encoding_from_filehandle returned correct encoding");

    my($enc, $offset) = get_encoding_from_bom($first_line);
    is($enc, $file_enc, "$file: get_encoding_from_bom also worked");

    {
	my $decoded = $enc ? decode($enc, substr($first_line, $offset))
			   : $first_line;

	is($decoded, $expect, "$file: .. and offset worked with substr()");
    }

    #
    # decode_from_bom()
    #
    my $result = decode_from_bom($first_line, 'UTF-8', FB_CROAK);
    is($result, $expect, "$file: decode_from_bom() scalar context");
    {
	# with default
	my $default = 'UTF-8';
	my $expect_enc = $file_enc || $default;

	my($decoded, $got_enc) = decode_from_bom($first_line, $default, FB_CROAK);

	is($decoded, $expect,      "$file: decode_from_bom() list context");
	is($got_enc, $expect_enc,  "$file: decode_from_bom() list context encoding");
    }
    {
	# without default
	my $expect_enc = $file_enc;
	my($decoded, $got_enc) = decode_from_bom($first_line, undef, FB_CROAK);

	is($decoded, $expect,      "$file: decode_from_bom() list context, no default");
	is($got_enc, $expect_enc,  "$file: decode_from_bom() list context encoding, no default");
    }

    seek(FH, 0, SEEK_SET);

    ($enc, my $spill) = get_encoding_from_stream(FH);

    $line = <FH>; chomp $line;

    is($enc, $file_enc, "$file: get_encoding_from_stream()");

    $line = $spill . $line;
    $line = decode($enc, $line) if $enc;

    is($line, $expect, "$file: read OK after get_encoding_from_stream");

    close FH;
}

# Test unseekable
SKIP: {
    my $tests = 4 * @encodings;
    skip "mkfifo not supported on this platform", $tests
	unless $fifo_supported;

    skip "mkfifo tests skipped on cygwin, set TEST_FIFO to enable them", $tests
        if $^O eq 'cygwin' && !$ENV{'TEST_FIFO'};

    for my $encoding (@encodings) {
	my($pid, $fifo, $enc, $spill, $result);

        # We need two copies of this as the encode below is destructive!
        my $expected = my $test = "Testing \x{2170}, \x{2171}, \x{2172}\n";

	my $bytes = $enc2bom{$encoding}
                  . encode($encoding, $test, FB_CROAK);

	($pid, $fifo) = write_fifo($bytes);
	($enc, $spill) = open_bom(my $fh, $fifo);
	$result = $spill . <$fh>;

	close $fh;
	waitpid($pid, 0);
	unlink $fifo;

	is($enc, $encoding,    "Read BOM correctly in unseekable $encoding file");
	is($result, $expected, "Read $encoding data from unseekable source");

	# Now test defuse too
	($pid, $fifo) = write_fifo($bytes);
	open($fh, '<:utf8', $fifo) or die "Couldn't read '$fifo': $!";
	($enc, $spill) = defuse $fh;
	$result = $spill . <$fh>;

	close $fh;
	waitpid($pid, 0);
	unlink $fifo;

	is($enc, $encoding, "defused fifo OK ($encoding)");
	is($result, $expected, "read defused fifo OK ($encoding)")