view release on metacpan or  search on metacpan

t/02_methods.t  view on Meta::CPAN

    my($expect_name, $expect_content) =
                        get_expect_name_and_contents( $from, \@EXPECT_NORMAL );

    like( $tar->get_content($to), $expect_content,
                                    "Original content of '$from' in '$to'" );
    ok( $tar->replace_content( $to, $from ),
                                    "   Set content for '$to' to '$from'" );
    is( $tar->get_content($to), $from,
                                    "   Content for '$to' is indeed '$from'" );
}

### remove tests ###
SKIP: {
    skip $ebcdic_skip_msg, 3 if ord "A" != 65;

    my $remove  = 'c';
    my $tar     = $Class->new;

    ok( $tar->read( $TAR_FILE ),    "Read in '$TAR_FILE'" );

    ### remove returns the files left, which should be equal to list_files
    is( scalar($tar->remove($remove)), scalar($tar->list_files),
                                    "   Removing file '$remove'" );

    ### so what's left should be all expected files minus 1
    is( scalar($tar->list_files), scalar(__PACKAGE__->get_expect) - 1,
                                    "   Proper files remaining" );
}

### write + read + extract tests ###
SKIP: {                             ### pesky warnings
    skip $ebcdic_skip_msg, 326 if ord "A" != 65;

    skip('no IO::String', 326) if   !$Archive::Tar::HAS_PERLIO &&
                                    !$Archive::Tar::HAS_PERLIO &&
                                    !$Archive::Tar::HAS_IO_STRING &&
                                    !$Archive::Tar::HAS_IO_STRING;

    my $tar = $Class->new;
    my $new = $Class->new;
    ok( $tar->read( $TAR_FILE ),    "Read in '$TAR_FILE'" );

    for my $aref (  [$tar,    \@EXPECT_NORMAL],
                    [$TARBIN, \@EXPECTBIN],
                    [$TARX,   \@EXPECTX]
    ) {
        my($obj,$struct) = @$aref;

        ### check if we stringify it ok
        {   my $string = $obj->write;
            ok( $string,           "    Stringified tar file has size" );
            cmp_ok( length($string) % BLOCK, '==', 0,
                                    "       Tar archive stringified" );
        }

        ### write tar tests
        {   my $out = $OUT_TAR_FILE;

            ### bug #41798: 'Nonempty $\ when writing a TAR file produces a
            ### corrupt TAR file' shows that setting $\ breaks writing tar files
            ### set it here purposely so we can verify NOTHING breaks
            local $\ = 'FOOBAR';

            {   ### write()
                ok( $obj->write($out),
                                    "       Wrote tarfile using 'write'" );
                check_tar_file( $out );
                check_tar_object( $obj, $struct );

                ### now read it in again
                ok( $new->read( $out ),
                                    "       Read '$out' in again" );

                check_tar_object( $new, $struct );

                ### now extract it again
                ok( $new->extract,  "       Extracted '$out' with 'extract'" );
                check_tar_extract( $new, $struct );

                rm( $out ) unless $NO_UNLINK;
            }


            {   ### create_archive()
                ok( $Class->create_archive( $out, 0, $COMPRESS_FILE ),
                                    "       Wrote tarfile using 'create_archive'" );
                check_tar_file( $out );

                ### now extract it again
                ok( $Class->extract_archive( $out ),
                                    "       Extracted file using 'extract_archive'");
                rm( $out ) unless $NO_UNLINK;
            }
        }

        ## write tgz tests
        {   my @out;
            push @out, [ $OUT_TGZ_FILE => 1             ] if $Class->has_zlib_support;
            push @out, [ $OUT_TBZ_FILE => COMPRESS_BZIP ] if $Class->has_bzip2_support;
            push @out, [ $OUT_TXZ_FILE => COMPRESS_XZ   ] if $Class->has_xz_support;

            for my $entry ( @out ) {

                my( $out, $compression ) = @$entry;

                {   ### write()
                    ok($obj->write($out, $compression),
                                    "       Writing compressed file '$out' using 'write'" );
                    check_compressed_file( $out );

                    check_tar_object( $obj, $struct );

                    ### now read it in again
                    ok( $new->read( $out ),
                                    "       Read '$out' in again" );
                    check_tar_object( $new, $struct );

                    ### now extract it again
                    ok( $new->extract,
                                    "       Extracted '$out' again" );
                    check_tar_extract( $new, $struct );