The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# this test is borrowed from Archive::Any to secure compatibility

use strict;
use warnings;
use Test::More 'no_plan';

use Archive::Any::Lite;
use File::Spec::Functions qw(updir);

my %tests = (
  't/lib.zip' => {
      impolite=> 0,
      naughty => 0,
      handler => 'Archive::Any::Lite::Zip',
      type    => 'zip',
      files   => [qw(
        lib/
        lib/Archive/
        lib/Archive/Any.pm
        lib/Archive/Any/
        lib/Archive/Any/Tar.pm
        lib/Archive/Any/Zip.pm
        lib/Archive/Any/Zip.pm~
        lib/Archive/Any/Tar.pm~
        lib/Archive/Any.pm~
        )],
  },
  't/lib.tgz' => {
      impolite  => 0,
      naughty   => 0,
      handler   => 'Archive::Any::Lite::Tar',
      type      => 'tar',
      files     => [qw( 
        lib/
        lib/Archive/
        lib/Archive/Any.pm
        lib/Archive/Any/
        lib/Archive/Any/Tar.pm
        lib/Archive/Any/Zip.pm
        lib/Archive/Any/Zip.pm~
        lib/Archive/Any/Tar.pm~
        lib/Archive/Any.pm~
                      )],
  },
  't/impolite.tar.gz' => {
      impolite  => 1,
      naughty   => 0,
      handler   => 'Archive::Any::Lite::Tar',
      type      => 'tar',
      files     => [qw(
        type.t
        Any.t
        00compile.t
        fail.t
    )],
  },
  't/naughty.tar' => {
      impolite  => 0,
      naughty   => 1,
      handler   => 'Archive::Any::Lite::Tar',
      type      => 'tar',
      files     => [qw(
        /tmp/lib/
        /tmp/lib/Archive/
        /tmp/lib/Archive/Any/
        /tmp/lib/Archive/Any/Tar.pm
        /tmp/lib/Archive/Any/Zip.pm
        /tmp/lib/Archive/Any.pm
        )],
  },
);


while( my($file, $expect) = each %tests ) {
    # Test it once with type auto-discover and once with the type
    # forced.  Forced typing was broken until 0.05.
    test_archive($file, $expect);
    test_archive($file, $expect, $expect->{type});
}

sub test_archive {
    my($file, $expect, $type) = @_;

    my $archive = Archive::Any::Lite->new($file, $type);

    # And now we chdir out from under it.  This causes serious problems
    # if we're not careful to use absolute paths internally.
    chdir('t');

    ok( defined $archive,               "new($file)" );
    ok( $archive->isa('Archive::Any::Lite'),  "  it's an object" );

    ok( eq_set([$archive->files], $expect->{files}),
                                     '  lists the right files' );
    ok( $archive->type(), "backwards compatibility" );

#    is( $archive->handler, $expect->{handler},    '  right handler' );

    is( $archive->is_impolite, $expect->{impolite},  "  impolite?" );
    is( $archive->is_naughty,  $expect->{naughty},   "  naughty?" );

    unless( $archive->is_impolite || $archive->is_naughty ) {
        ok($archive->extract(),   "extract($file)");
        foreach my $file (reverse $archive->files) {
            ok( -e $file, "  $file" );
            -d $file ? rmdir $file : unlink $file;
        }
    }

    chdir(updir);
}