Recursive descent in zip files? - perl

I am trying to recursively scan a bunch of zip files and I am using, of course, archive::zip. I would like to avoid expanding the archive's content in a temporary folder. I would like to be able to use something like (nearly-pseudo code):
sub CALLMYSELFAGAIN .....
my #members = $currentZipFile->members();
while(my $member = pop #members){
if ($member->isTextFile()){
push #content, $member->contents();
}elsif(isZipFile($member->fileName())){
CALLMYSELFAGAIN($member);
}
The problem is, $member->can("memberNames")) returns false, so $member is NOT an archive::zip in the sense that I could not open it again as a zip file. Or am I wrong?
Any hint?

You can do this:
elsif (isZipFile($member->filename)) {
my $contents = $currentZipFile->contents($member);
open my $fh, '<', \$contents; # In-memory filehandle
my $child_zip = Archive::Zip->new;
$child_zip->readFromFileHandle($fh);
CALLMYSELFAGAIN($child_zip);
}
but expect that to be very memory intensive, especially if you go more than one level deep.

Related

Creating two different objects through one Perl module

I'm writing Perl modules that allow users to create file and directory objects to manipulate the file system.
Example:
use File;
use Dir;
my $file = File->new("path");
my $dir = Dir ->new("path");
This works out nicely, but what I would really like to be able to create both file and directory objects without having to use two separate modules.
To do this I came up with the following solution...
IO.pm:
use File;
use Dir;
use Exporter qw(import);
our #EXPORT_OK = qw(file dir);
sub file {
my $path = shift;
return File->new($path);
}
sub dir {
my $path = shift;
return Dir->new($path);
}
1;
test.pl:
use IO qw(file dir);
my $file = file("path");
my $dir = dir ("path");
Now here's the problem, by doing this I eliminate the explicit call to new when the user creates a file or directory object. I'm sort of using the file and dir subroutines as constructors.
To me this code looks very clean, and is extremely simple to use, but I haven't seen many other people writing Perl code like this so I figured I should at least pose the question:
Is it okay to simply return an object from a subroutine like this, or does this scream bad practice?
That's perfectly fine.
For example, Path::Class's file and dir functions return Path::Class::File and Path::Class::Dir objects respectively.
If that was the only constructor the class provided, it would prevent (clean) subclassing, but that's not the case here.
There is, however, the question of whether replacing
open(my $fh, "path");
opendir(my $dh, "path);
with
my $fh = file("path");
my $dh = dir("path);
is advantageous or not (assuming the functions return IO::File and IO::Dir objects).

Find out in Perl and Windows if a file is writeable/ removable

I would like to build in Perl under Windows a Watch-Dog for a Hot-Folder (I might call it Folder-Watch or, hmm, probably much better: a Hot-Dog).
So far I succeeded in exactly doing that, with Win32::ChangeNotify (see sample below).
But as you might guess reading the source code I ran into a problem when the moving process wants to finish when the copying/creating process of the file in $watchdir has not finished (No such file or directory).
use Win32::ChangeNotifier;
use File::Copy qw(move);
my $notify = Win32::ChangeNotify->new($watchdir, 0, "FILE_NAME");
while (1) {
if ($notify->wait(1_000)) { # 1-second wait cycle
notify->reset;
#foundfiles = File::get_by_ext($watchdir, "csv"); # search and return files in $watchdir with extension "csv"
print "Something has happened! (del/ren/create)\n";
foreach (#foundfiles) {
move($watchdir.$_, $someotherdir.$_) or die "Fehler: $!";
}
#foundfiles = ();
}
}
Is there a way to automatically find out if the file is ready to go, i.e. has been finally created/copied?
I was thinking about something like
while (1) {
move $file if (-w $file) # writeable
wait(1)
}
but that does not seem to work under Windows. I need to solve this under Windows as well as Perl. Other than that I am open to suggestions.
Yes! I solved it (thanks to Сухой27)!
Inserting the following code right before moving the file:
while (1) {
last if writeable($path_in.$_);
print "-";
$| = 1;
sleep(1);
}
...whereas writeable refers to this little sub-marine:
sub writeable {
return open(my $file, ">>", shift);
}
Thanks, and have a nive day! :-)

perl script to parse log files from different test locations.which takes dynamic path of testcases

I want a perl script that will go in to every test folder and parse the log file in it.
Eg:
results/testcases/ **?** /test.log
The above path must be dynamically changing with different test folder names in the place of **?** mark.
I am using this results/testcases/#array/test.log
#array has test names
My suggestion would be:
my $path = "results/testcases";
opendir(TEMPDIR,$path) or die "err1";
my #dir = grep -d, readdir TEMPDIR;
foreach(#dir)
{
if( $_ !~ /\./ )
{
open( my $fileHandle , "results/testcases/".$_."/test.log" ) or die "err2";
# parsing log file
close $fileHandle or die "err2-2";
}
}
close TEMPDIR or die "err1-2";
First, you need to read the folder "results/testcases" for current correct folder names. Second, you need to open the files one by one, stead of putting #array in the middle of the path. Third, you should read basic perl, otherwise you won't be able to parse in a proper manner. Fourth, you really should read through HOW TO ASK, you should put in your code so that we could be more helpful and your questions shall help others, as well.
If your test folders relative paths are stored in #array. You can do the following:
my #testlogs = grep { -e $_ } map { "results/testcases/".$_."/test.log" } #array;
The new array #testlogs now contains the list of paths to existing 'test.log' files.
Then, you can parse each file like this:
map { ... parsing call ... } #testlogs;

How can I list the contents of a ZIP file using Perl?

What I am aiming to do is pretty much what it says in the title.
I have the following line of code which simply prints out [view archive] and when I click it the browser just downloads the zip file.
print "\<a href=\"http:\/\/intranet.domain.com\/~devcvs\/view-file.cgi?file=$reviewdata{'document'}&review_id=$reviewdata{'id'}\"\>[view archive]\<\/a\>\n";
What I would love to do is to list the files contained within this zip file anywhere on the page, e.g. just underneath or even a new page which this link links to and takes the filename as a parameter.
I believe once this is done the browser should take care of the rest in terms of just clicking these files and viewing them in the browser as they will be pdfs and html files which I don't foresee any problems with.
I am sure there is a module that does this but I am unsure of how to accomplish my goal using it.
Any help is much appreciated.
Have a look at Archive::Zip :
use strict;
use warnings;
use Archive::Zip qw/ :ERROR_CODES :CONSTANTS /;
my $zipFile = 'someZip.zip';
my $zip = Archive::Zip->new();
unless ( $zip->read( $zipFile ) == AZ_OK ) { # Make sure archive got read
die 'read error';
}
my #files = $zip->memberNames(); # Lists all members in archive
print $_, "\n" for #files;
Using Archive::Zip certainly makes the code easier, and you should probably install that module if you are going to work extensively on zip files.
However, for those who prefer not to install anything, there is a way to list the content of a zip file just using the core module IO::Uncompress::Unzip (already part of any standard Perl distribution).
use strict;
use warnings;
use IO::Uncompress::Unzip qw($UnzipError);
my $zipFile = '/path/to/zipfile.zip';
my $u = IO::Uncompress::Unzip->new($zipFile)
or die "Error: $UnzipError\n";
my $status;
for ($status = 1; $status > 0; $status = $u->nextStream()) {
my $header = $u->getHeaderInfo();
my $zippedFile = $header->{Name};
if ($zippedFile =~ /\/$/) {
last if $status < 0;
next;
}
print "$zippedFile\n";
}

Creating a file on the fly and return on the fly (Perl)

I have to create a file based on user inputs on the server. Return that file.
Now, I don't want the files once the file is returned to the user (otherwise they will fill up my disk space).
Is there a good way of doing this?
I have to do it in Perl.
Thank You.
If you're building a zip file and immediately sending it back to the client then you have lots of options.
You could use writeToFileHandle combined with IO::Scalar to write the zip file data straight to a string and send that back. This approach avoids the whole file issue completely.
You could also use writeToFileHandle combined with File::Temp to write to a temporary file and then stream that file back. The UNLINK option for File::Temp will help you automatically clean up the temp file as well.
This is what I created and works for me. When user opening some URL on my page I am creating ZIP archive on the fly and sending it to user.
If change "-" to "file.zip" it will save archive into your hosting/server (and don't need print "content type").
Tried with big size files (400-500Mb each file) - all ok.
use IO::Compress::Zip qw(:all);
my #files = ('example.gif', 'example1.png', 'example2.jpg', 'example3.avi', 'example4.mov');
my $path = "/home/********/**********";
print "Content-Type:application/zip\n";
print "Content-Disposition: attachment; filename=\"filename.zip\"\n\n";
my $z;
foreach my $file (#files) {
if ($z) {
$z->newStream(Name => $file, Method => ZIP_CM_STORE);
} else {
$z = new IO::Compress::Zip "-", Name => $file, Method => ZIP_CM_STORE;
}
open(FILE, "<", "$path/$file");
binmode FILE;
my ($buf, $data, $n);
while (($n = read FILE,$data, 1024) != 0) {
$z->print($data);
}
close(FILE);
}
$z->close;
exit;