Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Archive::Zip - How to selectively copy files from one archive to another one?

by Gigabyte1907 (Initiate)
on Aug 04, 2012 at 17:18 UTC ( #985447=perlquestion: print w/ replies, xml ) Need Help??
Gigabyte1907 has asked for the wisdom of the Perl Monks concerning the following question:

Hello there!

I have a large Zip archive and I'm trying to extract files based on their names, and copy them into new Zip archives.

The method I'm using now is similar of what I would do using a simple batch file. First I'm extracting all the files using the ExtractTree command:

$zip->extractTree();

Then I use the "File::Find::Rule" module to add the files to new Zip archives using regular expression:

my $finder_type1 = File::Find::Rule->new()->name(qr/Type1_(.*?)\.xml$/ +i)->start("."); while( my $file1 = $finder_type1->match() ){ $type1->addFile($file1); } my $finder_type2 = File::Find::Rule->new()->name(qr/Type2_(.*?)\.xml$/ +i)->start("."); while( my $file2 = $finder_type2->match() ){ $type2->addFile($file2); } etc...

This is of course extremely inefficient. I tried to copy files from one Zip to another using $zip->extractMember($element) then write them to another Zip using $type1->addFile($element) but that didn't work, I got empty Zip archives as result.

I'm sure there's a way to selectively copy files from one Zip archive to another without extracting the whole thing and adding them again; is it?

Thanks in advance for help!

Comment on Archive::Zip - How to selectively copy files from one archive to another one?
Select or Download Code
Re: Archive::Zip - How to selectively copy files from one archive to another one?
by Mr. Muskrat (Abbot) on Aug 05, 2012 at 16:39 UTC

    We could better help you if you showed us the actual code you used with extractMember and addFile. When I use those, it works fine.

    #!perl use strict; use warnings; use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); # Include actual filenames in the next three lines my $oldfile = 'oldzip.zip'; my $newfile = 'newzip.zip'; my @wanted = ( 'perl.log', 'perld.log' ); my $oldzip = Archive::Zip->new(); $oldzip->read( $oldfile ) == AZ_OK or die 'read error'; my $newzip = Archive::Zip->new(); for my $file ( @wanted ) { $oldzip->extractMember( $file ); $newzip->addFile( $file ); } $newzip->writeToFileNamed( $newfile ) == AZ_OK or die 'error somewhere +';

      Hello Mr. Muskrat and thanks for your reply.

      I didn't have the code that I tried and I tried so many things that I decided to start from scratch... ;-)

      Anyway I have tried your answer and first of all, it doesn't really answer the question because I was asking about selectively extract from one Zip and copy the files into another Zip. Which mean that I do not know yet what the file list is.

      Based on your example and trying to remember what I did before, here is the code that I came up with:

      use strict; use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); my $oldfile = 'oldzip.zip'; my $newfile = 'newzip.zip'; my $oldzip = Archive::Zip->new(); $oldzip->read($oldfile) == AZ_OK or die 'read error'; my $newzip = Archive::Zip->new(); # Getting the list of selected files my @FileMembers123 = $oldzip->membersMatching("123.*\.xml"); foreach my $file (@FileMembers123) { $oldzip->extractMember($file); $newzip->addFile($file); } $newzip->writeToFileNamed( $newfile ) == AZ_OK or die 'error somewhere +';

      When I try to execute this code, I have this error message:

      Can't call method "desiredCompressionLevel" on an undefined value at c:/perl/lib/Archive/Zip/Archive.pm line 249

      When I try to print the content of the array @FileMembers123, this is what I get:

      Archive::Zip::ZipFileMember=HASH(0x2f122f4)
      Archive::Zip::ZipFileMember=HASH(0x2f124c4)
      Archive::Zip::ZipFileMember=HASH(0x2f12694)
      Archive::Zip::ZipFileMember=HASH(0x2f12864)
      Archive::Zip::ZipFileMember=HASH(0x2f25a2c)
      Archive::Zip::ZipFileMember=HASH(0x2f2a804)
      etc...

      It seems that I cannot get the file names using the command my @FileMembers123 = $oldzip->membersMatching("123.*\.xml");.

      If I could generate the list of the files (using a matching pattern) in my old Zip without unzipping it, it would probably work.

      Thanks again!

        It's all explained rather well in the docs. Archive::Zip

        addFile is expecting a filename not an Archive::Zip::ZipFileMember object. Try this instead:

        #!perl use strict; use warnings; use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); # Include actual filenames in the next two lines my $oldfile = 'oldzip.zip'; my $newfile = 'newzip.zip'; my $oldzip = Archive::Zip->new(); $oldzip->read( $oldfile ) == AZ_OK or die 'read error'; print "$oldfile contains the following files:\n"; print " $_\n" for $oldzip->memberNames(); print "\n"; my $newzip = Archive::Zip->new(); my @wanted = $oldzip->membersMatching( '123.*\.xml' ); for my $member ( @wanted ) { print "Extracting ", $member->fileName(), " from $oldfile and addi +ng to $newfile\n"; $oldzip->extractMember( $member ); $newzip->addMember( $member ); } print "\n"; $newzip->writeToFileNamed( $newfile ) == AZ_OK or die 'error somewhere +'; print "$newfile contains the following files:\n"; print " $_\n" for $newzip->memberNames(); __END__ # Sample output oldzip.zip contains the following files: 123a.xml 123b.xml 234c.xml Extracting 123a.xml from oldzip.zip and adding to newzip.zip Extracting 123b.xml from oldzip.zip and adding to newzip.zip newzip.zip contains the following files: 123a.xml 123b.xml

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://985447]
Approved by johngg
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (13)
As of 2015-07-06 20:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (83 votes), past polls