in reply to Re^3: Remove an existing, non-empty, directory re: Archive::Zip
in thread Remove an existing, non-empty, directory re: Archive::Zip

This is from the POD:

:
:
DESCRIPTION

The Archive::Zip module allows a Perl program to create, manipulate, read, and write Zip archive files.

Zip archives can be created, or you can read from existing zip files.

Once created, they can be written to files, streams, or strings. Members can be added, removed, extracted, replaced, rearranged, and enumerated. They can also be renamed or have their dates, comments, or other attributes queried or modified. Their data can be compressed or uncompressed as needed.
:
:
So the POD seems to indicate that removal and rename capabilities are provided.

All of the examples I have seen are for removing files, not directories. All of the examples I have seen for renaming are renaming while storing to a Zip file or retrieving from a Zip file. Both of which I am not doing. Considering the size of these files/directories (~0.6GB for the zip), I do not want to do it that way (i.e., unzip, rename, zip, etc.).

BTW - renaming is a fall back position, I would much rather remove the directory.

This is one of the many ways I've tried to remove a directory: 

# $NewMemberName looks like
#  'MyLabNotebook/Default/{A8C57B20-DFBD-492D-A4F7-B83D84D18CDA}'

if (!defined($zipA->removeMember($NewMemberName))) {
  die "**Fatal error, can't remove (ZipA; \"$NewMemberName\")";
  }

[download]
The variable $NewMemberName is generated by another Perl program and stored in a CSV file. I then read the CSV and use it here. This code does NOT, by-the-way, remove the member as it seems it should. And yes, I do validate the name to make sure it is truly in the Zip file.

The major complication is caused by the person who wrote the application that generates the Zip files. For whatever reason, they decided to name the folders with a very long string of arbitrary characters. So to know what order to process the data, the files in each folder have to the accessed and analyzed to decide the relationship among all the directories in the Zip file. Screwy, but I'm stuck with it.

Any help would be appreciated...

Thanks,
  EigenFunctions
  OpSys: Win7 Professional/Home Premium x64 Service Pack 1

Replies are listed 'Best First'.
Re^5: Remove an existing, non-empty, directory re: Archive::Zip
by EigenFunctions (Beadle) on Aug 16, 2016 at 18:59 UTC

    So I think I have it.

    • First, each and every file in the directory has to be removed (i.e, $zipA->removeMember($NewMemberName)).
    • After they are all removed, the directory entry seems to disappear from the Zip file.
    • After all removal is complete, the Zip file has to be updated (i.e., $Stat = $zipA->overwrite()).
    In my case, there are two Zip files, some folders are removed from one and some from the other. In any event, the scheme outlined above seems to work.

    A code snippet: 
    :
:
$csv     = Text::CSV->new();
$TodoCnt = -1;

PROC_TODO:
while(my $TODOrec = <TODO>) { # . . . . . . . . . . . . . . . . . . . 
+. . . . .
  $TodoCnt++;
  if ($TodoCnt == 0) {next PROC_TODO;}
  if ($TODOrec =~ /^FNX,/i) {last PROC_TODO;}
  $csv->parse($TODOrec);
  @Fields = $csv->fields();

  DELETE_EACH_FILE:
  foreach my $FileNameToDelete (@InDirFiles) { # . . . . . . . . . . .
+ . . . . .
    $NewMemberName = $Fields[FLD_LECROY] . "/" . $FileNameToDelete;
    print "DBG: Name- \"$NewMemberName\"\n";
    if (defined($zipB->memberNamed($NewMemberName))) {
        print "DBG: Member exists (ZipB) (\"$NewMemberName\")\n";
        }
      else {
        die "**Fatal error, can't find in zip (ZipB; \"".$NewMemberNam
+e."\")";
        }
    if (defined($zipA->memberNamed($NewMemberName))) {
        print "DBG: Member exists (ZipA) (\"$NewMemberName\")\n";
        }
      else {
        die "**Fatal error, can't find in zip (ZipA; \"".$NewMemberNam
+e."\")";
        }

    printf(LOGALL "%.4d  Folder: \"%s\"\n", $TodoCnt, $Fields[FLD_LECR
+OY]);
    printf(LOGALL "%.4s          \"%s\"\n", "    ",   $Fields[FLD_BY_T
+DS]);
    printf(LOGALL "%.4s          \"%s\"\n", "    ",   $FileNameToDelet
+e);
    if ($Fields[FLD_MOVE] =~ /^\s*$/) {
        print LOGALL "    skip folder from ZIP_A_New\n";
        print LOGALL "  delete folder from ZIP_B_Append\n";
        $DelBcnt++;
        if (!defined($zipB->removeMember($NewMemberName))) {
          die "**Fatal error, can't remove (ZipB; \"".$NewMemberName."
+\")";
          }
        }
      elsif ($Fields[FLD_MOVE] =~ /^move to B$/i) {
        print LOGALL "  delete folder from ZIP_A_New\n";
        print LOGALL "    SKIP folder from ZIP_B_Append\n";
        $DelAcnt++;
        if (!defined($zipA->removeMember($NewMemberName))) {
          die "**Fatal error, can't remove (ZipA; \"".$NewMemberName."
+\")";
          }
        }
      else {
        die "**Fatal error, Unknown \"move\" (\"".$Fields[FLD_MOVE]."\
+")";
        }
    } # . . . . . . . . . . . . . . . . . . . . . . . . . . end DELETE
+_EACH_FILE

  } # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .  end
+ PROC_TODO

if ($Stat = $zipA->overwrite() != AZ_OK) {
  printf("\n**Error, bad Zip A overwrite() (code: %d)\n\n", $Stat);
  }
if ($Stat = $zipB->overwrite() != AZ_OK) {
  printf("\n**Error, bad Zip B overwrite() (code: %d)\n\n", $Stat);
  }
:
:

    [download]

    Sorry for the screwy code, but I have been trying different approaches and, someday, I'll clean it up.

    I just hope it helps someone else...

    Thanks,
      EigenFunctions
      OpSys: Win7 x64 Service Pack 1 Professional/Home Premium Perl: Strawberry (v5.22.0)/ActiveState (v5.14.2)

[reply]
[d/l]
[select]

      I processed another Zip file last night and found that this technique sometimes (maybe) leaves behind null entries. That is, one directory member with no files and then the same directory with each file following. Unfortunately, I don't have the time to track down what's going on. Since I had to do some manual changes to the Zip file, that may have caused the phenomenon.

      I can ignore those null entries and so that's my solution.

      Note: One source of confusion in using Archive::Zip is that, I think there is no clear distinction in the POD between directories outside the Zip and directories inside the Zip file. If that distinction were more clearly presented, it may be easier to use. Just a thought.

      Thanks,
        EigenFunctions
        OpSys: Win7 x64 Service Pack 1 Professional/Home Premium Perl: Strawberry (v5.22.0)/ActiveState (v5.14.2)

[reply]

        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]
[reply]
[d/l]

In Section Seekers of Perl Wisdom