1BEGIN { chdir 't' if -d 't' }
2
3use lib '../lib';
4
5use strict;
6use File::Spec;
7use File::Path;
8use Test::More;
9
10### developer tests mostly, so enable them with an extra argument
11plan skip_all => "Skipping tests on this platform" unless @ARGV;
12plan 'no_plan';
13
14my $Class   = 'Archive::Tar';
15my $Dir     = File::Spec->catdir( qw[src linktest] );
16my %Map     = (
17    File::Spec->catfile( $Dir, "linktest_with_dir.tar" ) => [
18        [ 0, qr/SECURE EXTRACT MODE/ ],
19        [ 1, qr/^$/ ]
20    ],
21    File::Spec->catfile( $Dir, "linktest_missing_dir.tar" ) => [
22        [ 0, qr/SECURE EXTRACT MODE/ ],
23        [ 0, qr/File exists/ ],
24    ],
25);
26
27use_ok( $Class );
28
29{   while( my($file, $aref) = each %Map ) {
30
31        for my $mode ( 0, 1 ) {
32            my $expect = $aref->[$mode]->[0];
33            my $regex  = $aref->[$mode]->[1];
34
35            my $tar  = $Class->new( $file );
36            ok( $tar,                   "Object created from $file" );
37
38            ### damn warnings
39            local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
40            local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
41
42            ok( 1,                  "   Extracting with insecure mode: $mode" );
43
44            my $warning;
45            local $SIG{__WARN__} = sub { $warning .= "@_"; warn @_; };
46
47            my $rv = eval { $tar->extract } || 0;
48            ok( !$@,                "       No fatal error" );
49            is( !!$rv, !!$expect,   "       RV as expected" );
50            like( $warning, $regex, "       Error matches $regex" );
51
52            rmtree( 'linktest' );
53        }
54    }
55}
56