This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
82cf4448442ef9c5710b2c95c5bc68ace81e7235
[perl5.git] / cpan / Archive-Tar / t / 09_roundtrip.t
1 BEGIN { chdir 't' if -d 't' }
2
3 use Test::More;
4 use strict;
5 use lib '../lib';
6
7 use File::Spec ();
8 use File::Temp qw( tempfile );
9
10 use Archive::Tar;
11
12 # tarballs available for testing
13 my @archives = (
14   [qw( src short bar.tar )],
15   [qw( src long bar.tar )],
16   [qw( src linktest linktest_with_dir.tar )],
17 );
18 push @archives,
19   [qw( src short foo.tgz )],
20   [qw( src long foo.tgz )]
21   if Archive::Tar->has_zlib_support;
22 push @archives,
23   [qw( src short foo.tbz )],
24   [qw( src long foo.tbz )]
25   if Archive::Tar->has_bzip2_support;
26
27 @archives = map File::Spec->catfile(@$_), @archives;
28
29 plan tests => scalar @archives;
30
31 # roundtrip test
32 for my $archive (@archives) {
33
34       # create a new tarball with the same content as the old one
35       my $old = Archive::Tar->new($archive);
36       my $new = Archive::Tar->new();
37       $new->add_files( $old->get_files );
38
39       # save differently if compressed
40       my $ext = ( split /\./, $archive )[-1];
41       my @compress =
42           $ext =~ /t?gz$/       ? (COMPRESS_GZIP)
43         : $ext =~ /(tbz|bz2?)$/ ? (COMPRESS_BZIP)
44         : ();
45
46       my ( $fh, $filename ) = tempfile( UNLINK => 1 );
47       $new->write( $filename, @compress );
48
49       # read the archive again from disk
50       $new = Archive::Tar->new($filename);
51
52       TODO: {
53         local $TODO = 'Need to work out why no trailing slash';
54
55       # compare list of files
56       is_deeply(
57           [ $new->list_files ],
58           [ $old->list_files ],
59           "$archive roundtrip on file names"
60       );
61       };
62 }