Everything inside the zip file has a Japanese name (e.g. the directories inside, pdfs inside etc.). When I tried using
Archive::Zip
or
Archive::Extract,
it fails at a single point (Input/Output error) while trying to create a directory with a apanese name.
Is there any way to deal with this without having to write my unzipping module?
use warnings;
use POSIX;
use File::Basename;
use File::Copy;
use Sys::Hostname;
use Archive::Extract;
use File::Path;
my $filename = '42108e01b86ed61ed18c29066254b5b9.zip';
my $dest_dir = "test_site/pk";
use Archive::Zip;
my $zip = Archive::Zip->new();
unless ( $zip->read( $filename ) == AZ_OK ) {
die "Error Reading Zip File !";
}
foreach my $m ( $zip->members() ) {
print "Member $m:\n ";
my $err = $zip->extractMemberWithoutPaths( $m, "$dest_dir/" . $m->fileName );
print "Error: $err" if $err;
print $/;
}
Error is:
Input/output error at Archive/Zip/Member.pm line 485.
Related
I am writing a perl script to get a filename present in a directory in a remote server , i couldn't find any WMIC command to traverse through directory ,is there any other command to access a remote server and traverse in a specific path to find a file and retrieve the file name.
use strict;
use warnings;
use File::Find::Rule;
use File::Basename qw(basename);
my $path = "\\\\vmw2160\\dir1";
my #full_pathes = File::Find::Rule->file->name('data.html')->in($path);print ".";
my #files = map { lc basename $_ } #full_pathes;
print foreach(#files);
my %file = map { $_ => 1 } #files;
print foreach(%file);
You would need to use File::Find::Rule module from CPAN with Number::Compare being a dependency. see comments next to some parts of the script.
use strict;
use warnings;
use File::Find::Rule;
use File::Basename qw(basename);
my $path = "\\\\devicename\\sharename"; #Enter your path here, i.e Network drive
my $report = 'notfound.txt'; #This is just a log to tell you which files you searched for does not exist on the drive
print 'Enter file that contains list of files to search: ';
my $expected = <STDIN>;
chomp $expected;
open(my $fh, '<', $expected) or die "Could not open '$expected' $!\n";
open(my $out, '>', $report) or die "Could not open '$report' $!\n";
my #full_pathes = File::Find::Rule->file->name('*')->in($path);
my #files = map { lc basename $_ } #full_pathes;
my %file = map { $_ => 1 } #files;
while (my $name = <$fh>) {
chomp $name;
if ($file{lc $name}) {
print "$name found\n";
} else {
print $out "$name\n";
}
}
close $out;
close $fh;
Then create a file with a list of files you want to search for. Let's call it myfiles.txt and enter the files in list form:
filename1.txt
filename2.pdf
filename3.bat
then Run the script and upon request, enter the filename myfiles.txt to the prompt and enter.
EDIT modified the code to take UNC paths.
I have been trying to zip files on remote windows server but not getting success by whatever i tried. Below is the small peice of code. Please tell me where m going wrong. This code is not producing any error but just not generating the zip file.
use strict;
use warnings;
# before running check perl module is installed in your PC.
use Archive::Zip;
use File::Basename 'basename';
my #files = ('D:\Scripts\Testing\abc.txt');
# if it is more than one file add it by using comma as separator
my $zip = Archive::Zip->new;
foreach my $file (#files) {
my $member = basename $file;
printf qq{Adding file "%s" as archive member "%s"\n}, $file, $member;
$zip->addFile( $file, $member );
printf "Member added\n";
}
printf "Writing to zip\n";
$zip->writeToFileNamed('zippedFolders.zip');
#zip file name change it as u want
Could you please:
use Cwd;
use strict;
use warnings;
# before running check perl module is installed in your PC.
use Archive::Zip;
use File::Basename;
my (#files,$dirname,$bsename) = "";
my $inFile = "D:\\Scripts\\Testing\\abc.txt"; # if it is more than one file add it by using comma as separator
my $curdir = getcwd();
#Need to open file here and to be read the file
open(IN, $inFile) || die "Cant \n";
while(<IN>) {
my $sngfile = $_;
chomp($sngfile);
push(#files, $sngfile);
}
my $zip = Archive::Zip->new();
foreach my $file (#files)
{
$dirname = dirname($file);
$bsename = basename($file);
#Check file exist here your code
if($dirname!~m/\.$/) {
print "$dirname\t$bsename\n";
#printf qq{Adding file "%s" as archive member "%s"\n}, $dirname, $bsename;
$zip->addFile("$dirname/$bsename"); }
}
printf "$curdir\\Writing to zip\n";
$zip->writeToFileNamed("$curdir/zippedFolders.zip"); #zip file name change it as u want
Hi I have a script that reads thru an email folder and if the subject line starts with 'test' it extracts the mail body to a txt file. I would like it to then move all 6 emails to another folder. but while the script extracts from all 6 emails in the folder, when i add the line ( $message->Move($tofolder); ) i can only get it to move 3 emails at once, not all of them!
I get warning: Use of uninitialized value in pattern match (m//) on ~ /^test /) ..... line
#!/usr/bin/perl
use strict;
use warnings;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Outlook';
my $filename = 'c:\\net.txt' ;
open(FH,"> $filename")
or die ("cannot open $filename");
my $outlook = Win32::OLE->new('Outlook.Application')
or die "Failed Opening Outlook.";
my $namespace = $outlook->GetNamespace("MAPI");
my $folder = $namespace->Folders("test")->Folders("test1");#->Folders; ("Junk Mail")->Folders("Bad");
my $tofolder = $namespace->Folders("test")->Folders("test1");#->Folders; ("Junk Mail")->Folders("Bad");
my $items = $folder->Items;
for my $itemIndex (1..$items->Count)
{
my $message = $items->item($itemIndex);
if ($message->{Subject} =~ /^test/){
print $message->{Subject}."\n";
print FH $message->{Body};
$message->Move($tofolder);
}
}
close(FH);
I'm afraid I'm not quite sure what's up - from the comments, an error on line 24 suggests that the thing you're accessing as a message doesn't have a 'Subject' field.
So it might actually not be a message at all.
I've tried something a bit like this (paraphrased a little) which seems to work:
#!/usr/bin/perl
use strict;
use warnings;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Outlook';
my $filename = 'c:\\net.txt';
open( my $output_fh, ">", $filename ) or die $!;
my $outlook = Win32::OLE->new('Outlook.Application')
or die "Failed Opening Outlook.";
my $namespace = $outlook->GetNamespace("MAPI");
my $archive = $namespace->GetDefaultFolder(6)->Folders('Archive');
my $deletedItems = $namespace->GetDefaultFolder(3);
my $items = $archive->Items;
foreach my $msg ( $items->in ) {
if ( $msg->{Subject} =~ m/^test/ ) {
print $msg ->{Subject}, "\n";
print {$output_fh} $msg->{Body};
$msg->Move($deletedItems);
}
}
close($output_fh);
This moves things from 'Archive' subfolder of 'Inbox' to Deleted Items. And extracts to a file as we go. Note that it just splurges 'body' to the output file, without any separators, so you probably want to do something more complicated. (I've taken to using $msg -> SaveAs so I can preserve the whole message object).
I tried to zip some CSV files which are about 5 MB with Perl. Below is my zip code.
The files are zipped but when I open them with the Windows unzip utility I found that the last lines of the CSV files are missing. What could be the problem here? I tried to change the chuncksize and the desiredCompressionLevel but this didn't help.
sub zip_util{
my $directory = shift;
$zip = Archive::Zip->new();
$zip->setChunkSize(65536);
# Add a file from disk
my $file1=File::Spec->catfile($directory, 'file.csv');
my $file2=File::Spec->catfile($directory, 'file2.csv');
my $file3=File::Spec->catfile($directory, 'fil3.csv');
$zip->addFile($file1,'file1.csv')->desiredCompressionLevel( 6 );
$zip->addFile($file2,'file2.csv')->desiredCompressionLevel( 6 );
$zip->addFile($fil3,'file3.csv')->desiredCompressionLevel( 6 );
# Save the Zip file
my $zipped_file=File::Spec->catfile($directory,'files.zip');
unless ( $zip->writeToFileNamed($zipped_file) == AZ_OK ) {
print LOG ": Zip Creation error\n";
}
I've checked it with warnings and strictures and I've found certain problems.
$zip doesn't use my (I don't know if it's intentional, but use strict really helps with globals like this).
You're running $zip->addFile($fil3,'file3.csv'). $fil3 variable definitely doesn't exist. If anything, this variable is $file3.
I guess it's issue during Copy and Paste, but subroutine doesn't have matching brace.
I've done quick script which I've used during testing.
use strict;
use warnings;
use Archive::Zip qw( :ERROR_CODES );
use File::Spec;
sub zip_util {
my ($directory) = #_;
my $zip = Archive::Zip->new();
$zip->setChunkSize(65536);
# Add a file from disk
my $file1 = File::Spec->catfile( $directory, 'file.csv' );
my $file2 = File::Spec->catfile( $directory, 'file2.csv' );
my $file3 = File::Spec->catfile( $directory, 'file3.csv' );
$zip->addFile( $file1, 'file1.csv' )->desiredCompressionLevel(6);
$zip->addFile( $file2, 'file2.csv' )->desiredCompressionLevel(6);
$zip->addFile( $file3, 'file3.csv' )->desiredCompressionLevel(6);
# Save the Zip file
my $zipped_file = File::Spec->catfile( $directory, 'files.zip' );
if ( $zip->writeToFileNamed($zipped_file) != AZ_OK ) {
print STDERR "Zip Creation error\n";
}
}
zip_util '.';
The problem is that it was working. So, I've done this script to make some sort of 5MB files:
use strict;
use warnings;
use 5.010;
for ( 1 .. 524_288 ) {
my $number = $_ % 10;
say "$number-------";
}
Both files in ZIP and original "CSV" had this same size and content. So, it's probably the second issue which I've mentioned - use of $fil3 variable or something with your files (which you sadly didn't uploaded, so I cannot look into those).
To my perl script, a file is passed as an arguement. The file can be a .txt file or a .zip file containing the .txt file.
I want to write code that looks something like this
if ($file is a zip) {
unzip $file
$file =~ s/zip$/txt/;
}
One way to check the extension is to do a split on . and then match the last result in the array (returned by split).
Is there some better way?
You can use File::Basename for this.
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
use File::Basename;
my #exts = qw(.txt .zip);
while (my $file = <DATA>) {
chomp $file;
my ($name, $dir, $ext) = fileparse($file, #exts);
given ($ext) {
when ('.txt') {
say "$file is a text file";
}
when ('.zip') {
say "$file is a zip file";
}
default {
say "$file is an unknown file type";
}
}
}
__DATA__
file.txt
file.zip
file.pl
Running this gives:
$ ./files
file.txt is a text file
file.zip is a zip file
file.pl is an unknown file type
Another solution is to make use of File::Type which determines the type of binary file.
use strict;
use warnings;
use File::Type;
my $file = '/path/to/file.ext';
my $ft = File::Type->new();
my $file_type = $ft->mime_type($file);
if ( $file_type eq 'application/octet-stream' ) {
# possibly a text file
}
elsif ( $file_type eq 'application/zip' ) {
# file is a zip archive
}
This way, you do not have to deal with missing/wrong extensions.
How about checking the end of the filename?
if ($file =~ /\.zip$/i) {
and then:
use strict;
use Archive::Extract;
if ($file =~ /\.zip$/i) {
my $ae = Archive::Extract->new(archive => $file);
my $ok = $ae->extract();
my $files = $ae->files();
}
more information here.
You can check the file extension using a regex match as:
if($file =~ /\.zip$/i) {
# $file is a zip file
}
I know this question is several years old, but for anyone that comes here in the future, an easy way to break apart a file path into its constituent path, filename, basename and extension is as follows.
use File::Basename;
my $filepath = '/foo/bar.txt';
my ($basename, $parentdir, $extension) = fileparse($filepath, qr/\.[^.]*$/);
my $filename = $basename . $extension;
You can test it's results with the following.
my #test_paths = (
'/foo/bar/fish.wibble',
'/foo/bar/fish.',
'/foo/bar/fish.asdf.d',
'/foo/bar/fish.wibble.',
'/fish.wibble',
'fish.wibble',
);
foreach my $this_path (#test_paths) {
print "Current path: $this_path\n";
my ($this_basename, $parentdir, $extension) = fileparse($this_path, qr/\.[^.]*$/);
my $this_filename = $this_basename . $extension;
foreach my $var (qw/$parentdir $this_filename $this_basename $extension/) {
print "$var = '" . eval($var) . "'\n";
}
print "\n\n";
}
Hope this helps.
Why rely on file extension? Just try to unzip and use appropriate exception handling:
eval {
# try to unzip the file
};
if ($#) {
# not a zip file
}
Maybe a little bit late but it could be used as an alternative reference:
sub unzip_all {
my $director = shift;
opendir my $DIRH, "$director" or die;
my #files = readdir $DIRH;
foreach my $file (#files){
my $type = `file $director/$file`;
if ($type =~ m/gzip compressed data/){
system "gunzip $director/$file";
}
}
close $DIRH;
return;
}
Here is possible to use linux file executing it from perl by the use of backticks(``). You area able to pass the path of your folder and evaluate if exists a file that is classified by file as gzip compressed.
If you do not mind using a perl module, you can use Module::Generic::File, such as:
use Module::Generic::File qw( file );
my $f = file( '/some/where/file.zip' );
if( $f->extension eq 'zip' )
{
# do something
}
Module::Generic::File has a lot of features to handle and manipulate a file.