Hello EigenFunctions,
You can do this with the Archive::Zip->updateTree method, if you have a copy of the archive’s tree on disc, and you first delete the given directory from that copy:
$zip->updateTree
(
{
root => 'New_Tree', # On disk
zipName => 'Tree', # In the archive
mirror => 1, # Delete missing directories and fil
+es
}
) == AZ_OK or die 'update error';
But I guess that misses the point of your question, which is, I take it, to delete the given directory directly.
The POD for Archive::Zip says it can be done...
Where in the POD do you see that? (Not saying it isn’t there, only that I haven’t found it.)
| [reply] [d/l] [select] |
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\")";
}
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
| [reply] [d/l] |
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);
}
:
:
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] |