view release on metacpan or  search on metacpan

t/85_util.t  view on Meta::CPAN

my $fnm = "_85hdr.csv"; END { unlink $fnm; }

my $a_ring = chr (utf8::unicode_to_native (0xe5));
foreach my $irs ("\n", chr (utf8::unicode_to_native (0xaa))) {
    local $/ = $irs;
    foreach my $eol ("\n", "\r\n", "\r") {
	my $str = join $eol =>
	    qq{zoo,b${a_ring}r},
	    qq{1,"1 \x{20ac} each"},
	    "";
	for (   [ "none"       => ""			],
		[ "utf-8"      => "\xef\xbb\xbf"	],
		[ "utf-16be"   => "\xfe\xff"		],
		[ "utf-16le"   => "\xff\xfe"		],
		[ "utf-32be"   => "\x00\x00\xfe\xff"	],
		[ "utf-32le"   => "\xff\xfe\x00\x00"	],
		# Below 5 not (yet) supported by Encode
		[ "utf-1"      => "\xf7\x64\x4c"	],
		[ "utf-ebcdic" => "\xdd\x73\x66\x73"	],
		[ "scsu"       => "\x0e\xfe\xff"	],
		[ "bocu-1"     => "\xfb\xee\x28"	],
		[ "gb-18030"   => "\x84\x31\x95"	],
		#
		[ "UTF-8"      => "\x{feff}"		],
		) {
	    my ($enc, $bom) = @$_;
	    my ($enx, $box, $has_enc) = ($enc, $bom, 0);
	    $enc eq "UTF-8" || $enc eq "none" or
		$box = eval { Encode::encode ($enc, chr (0xfeff)) };
	    $enc eq "none" and $enx = "utf-8";

	    # On os390, Encode only supports the following EBCDIC
	    #  cp37, cp500, cp875, cp1026, cp1047, and posix-bc
	    # utf-ebcdic is not in the list
	    eval {
		no warnings "utf8";
		open my $fh, ">", $fnm;
		binmode $fh;
		if (defined $box) {
		    print $fh byte_utf8a_to_utf8n ($box);
		    print $fh Encode::encode ($enx, $str);
		    $has_enc = 1;
		    }
		else {
		    print $fh Encode::encode ("utf-8", $str);
		    }

		close $fh;
		};
	    #$ebcdic and $has_enc = 0; # TODO

	    $csv = Text::CSV->new ({ binary => 1, auto_diag => 9 });

	    SKIP: {
		$has_enc or skip "Encoding $enc not supported", $enc =~ m/^utf/ ? 10 : 9;
		$csv->column_names (undef);
		open my $fh, "<", $fnm;
		binmode $fh;
		ok (1, "$fnm opened for enc $enc");
		ok ($csv->header ($fh), "headers with BOM for $enc");
		$enc =~ m/^utf/ and is ($csv->{ENCODING}, uc $enc, "Encoding inquirable");

		is (($csv->column_names)[1], "b${a_ring}r", "column name was decoded");
		ok (my $row = $csv->getline_hr ($fh), "getline_hr");
		is ($row->{"b${a_ring}r"}, "1 \x{20ac} each", "Returned in Unicode");
		close $fh;

		my $aoh;
		ok ($aoh = csv (in => $fnm, bom => 1), "csv (bom => 1)");
		is_deeply ($aoh,
		    [{ zoo => 1, "b${a_ring}r" => "1 \x{20ac} each" }], "Returned data bom = 1");

		ok ($aoh = csv (in => $fnm, encoding => "auto"), "csv (encoding => auto)");
		is_deeply ($aoh,
		    [{ zoo => 1, "b${a_ring}r" => "1 \x{20ac} each" }], "Returned data auto");
		}

	    SKIP: {
		$has_enc or skip "Encoding $enc not supported", 7;
		$csv->column_names (undef);
		open my $fh, "<", $fnm;
		$enc eq "none" or binmode $fh, ":encoding($enc)";
		ok (1, "$fnm opened for enc $enc");
		ok ($csv->header ($fh), "headers with BOM for $enc");
		is (($csv->column_names)[1], "b${a_ring}r", "column name was decoded");
		ok (my $row = $csv->getline_hr ($fh), "getline_hr");
		is ($row->{"b${a_ring}r"}, "1 \x{20ac} each", "Returned in Unicode");
		close $fh;

		ok (my $aoh = csv (in => $fnm, bom => 1), "csv (bom => 1)");
		is_deeply ($aoh,
		    [{ zoo => 1, "b${a_ring}r" => "1 \x{20ac} each" }], "Returned data");
		}

	    unlink $fnm;
	    }
	}
    }

{   # Header after first line with sep=
    open my $fh, ">", $fnm or die "$fnm: $!";
    print $fh "sep=;\n";
    print $fh "a;b 1;c\n";
    print $fh "1;2;3\n";
    close $fh;
    ok (my $aoh = csv (in => $fnm, munge => "db"), "Read header with sep=;");
    is_deeply ($aoh, [{ a => 1, "b_1" => 2, c => 3 }], "Munged to db with sep");
    }