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 }