File: 004Utf8.t

package info (click to toggle)
libarchive-tar-wrapper-perl 0.42-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 372 kB
  • sloc: perl: 782; makefile: 2
file content (41 lines) | stat: -rw-r--r-- 1,080 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
use warnings;
use strict;
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init($ERROR);

use File::Temp qw(tempfile);

my $TARDIR = "data";
$TARDIR = "t/$TARDIR" unless -d $TARDIR;

use Test::More tests => 6;
BEGIN { use_ok('Archive::Tar::Wrapper') }

SKIP: {
    if ( $] < 5.008 ) {
        skip "Unicode tests skipped with perl < 5.8", 5;
    }
    umask(0);
    my $arch = Archive::Tar::Wrapper->new();

    ok( $arch->read("$TARDIR/foo.tgz"), "opening compressed tarfile" );

    # Add data
    my $data = "this is data \x{00fc}";
    ok( $arch->add( "foo/bar/string", \$data, { binmode => ":utf8" } ),
        "adding data" );

    # Make a tarball
    my ( $fh, $filename ) = tempfile( UNLINK => 1 );
    ok( $arch->write($filename), "Tarring up" );

    # List
    my $a2 = Archive::Tar::Wrapper->new();
    ok( $a2->read($filename), "Reading in new tarball" );

    my $f1 = $a2->locate("foo/bar/string");
    open FILE, "<:utf8", $f1 or die "Cannot open $f1";
    my $got_data = join '', <FILE>;
    close FILE;
    is( $got_data, $data, "comparing file utf8 data" );
}