What?

#!/usr/bin/perl --

use strict;
use warnings;
use autodie qw/ chdir /;
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
use Data::Dump qw/ dd /;;
use Path::Tiny qw/ path /;

my $thisdir = shift || path( __FILE__ )->parent;
chdir $thisdir;
#~ my $fyle = "".path( $thisdir, 'goner-goner-gone.zip' );
my $fyle = 'goner-goner-gone.zip';
FillZip( $fyle );
StatZip( $fyle );
TrimZip( $fyle );
StatZip( $fyle );
path( $fyle )->remove;
exit( 0 );

sub FillZip {
    my $outzip = shift;
    my $status;
    my $zip = Archive::Zip->new();
    $zip->addString('hi'x33, 'hi.txt');
    $zip->addString('hi'x33, 'ne/hi.txt');
    $zip->addString('hi'x33, 'wo/hi.txt');
    $zip->addString('hi'x33, 'one/hi.txt');
    $zip->addString('hi'x33, 'two/hi.txt');
    $zip->addDirectory('one/');
    $zip->addDirectory('two/');
    print "Trying to ->writeToFileNamed( $outzip )\n";
    $status = $zip->writeToFileNamed( "$outzip" );
    die "ERROR ->writeToFileNamed( $outzip ) , status == $status "
      if $status != AZ_OK;
}
sub TrimZip {
    my $outzip = shift;
    my $status;
    my $zip = Archive::Zip->new();
    print "Trying to ->read( $outzip )\n";
    $status = $zip->read( "$outzip" );
    die "ERROR ->read( $outzip ) , status == $status "
      if $status != AZ_OK;
    
    for my $goner ( qw{ one/ one/hi.txt } ){
        $zip->removeMember( $goner )
            or print "whoops removeMember( $goner )\n";
    }
    print "Trying to ->overwrite( $outzip )\n";    
    $status = $zip->overwrite( "$outzip" );  
    die "ERROR ->overwrite( $outzip ) , status == $status "
      if $status != AZ_OK;
}
sub StatZip {
    my( $file ) = @_;
    my $zip = Archive::Zip->new(  $file );
    print "\n## $file\n";
    print $_->fileName, " \t\t\t $_\n"
        for $zip->membersMatching( '.*' ) ;
#~         for $zip->membersMatching( '.*\..*' ) ;
    print "\n";
}


__END__
Trying to ->writeToFileNamed( goner-goner-gone.zip )

## goner-goner-gone.zip
hi.txt                   Archive::Zip::ZipFileMember=HASH(0x103074c)
ne/hi.txt                        Archive::Zip::ZipFileMember=HASH(0xb3
+d1d4)
wo/hi.txt                        Archive::Zip::ZipFileMember=HASH(0x10
+30a2c)
one/hi.txt                       Archive::Zip::ZipFileMember=HASH(0x10
+30c5c)
two/hi.txt                       Archive::Zip::ZipFileMember=HASH(0x10
+30cec)
one/                     Archive::Zip::DirectoryMember=HASH(0x1030ecc)
two/                     Archive::Zip::DirectoryMember=HASH(0x103040c)

Trying to ->read( goner-goner-gone.zip )
Trying to ->overwrite( goner-goner-gone.zip )

## goner-goner-gone.zip
hi.txt                   Archive::Zip::ZipFileMember=HASH(0x103070c)
ne/hi.txt                        Archive::Zip::ZipFileMember=HASH(0x10
+30e2c)
wo/hi.txt                        Archive::Zip::ZipFileMember=HASH(0x10
+3420c)
two/hi.txt                       Archive::Zip::ZipFileMember=HASH(0x10
+3395c)
two/                     Archive::Zip::DirectoryMember=HASH(0x1030ccc)
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.