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
Related
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.
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'm writing a Perl script and I'm new to Perl -- I have a file that contains a list of files. For each item on the list I want to search a given directory and its sub-directories to find the file return the full path. I've been unsuccessful thus far trying to use File::Find. Here's what I got:
use strict;
use warnings;
use File::Find;
my $directory = '/home/directory/';
my $input_file = '/home/directory/file_list';
my #file_list;
find(\&wanted, $directory);
sub wanted {
open (FILE, $input_file);
foreach my $file (<FILE>) {
chomp($file);
push ( #file_list, $file );
}
close (FILE);
return #file_list;
}
I find File::Find::Rule a tad easier and more elegant to use.
use File::Find::Rule;
my $path = '/some/path';
# Find all directories under $path
my #paths = File::Find::Rule->directory->in( $path );
# Find all files in $path
my #files = File::Find::Rule->file->in( $path );
The arrays contain full paths to the objects File::Find::Rule finds.
File::Find is used to traverse a directory structure in the filesystem. Instead of doing what you're trying to do, namely, have the wanted subroutine read in the file, you should read in the file as follows:
use strict;
use warnings;
use vars qw/#file_list/;
my $directory = '/home/directory/';
my $input_file = '/home/directory/file_list';
open FILE, "$input_file" or die "$!\n";
foreach my $file (<FILE>) {
chomp($file);
push ( #file_list, $file );
}
# do what you need to here with the #file_list array
Okay, well re-read the doc and I misunderstood the wanted subroutine. The wanted is a subroutine that is called on every file and directory that is found. So here's my code to take that into account
use strict;
use warnings;
use File::Find;
my $directory = '/home/directory/';
my $input_file = '/home/directory/file_list';
my #file_list;
open (FILE, $input_file);
foreach my $file (<FILE>) {
chomp($file);
push ( #file_list, $file );
}
close (FILE);
find(\&wanted, $directory);
sub wanted {
if ( $_ ~~ #file_list ) {
print "$File::Find::name\n";
}
return;
}
I am a beginner PERL programmer and I have come across a snag that I can't get by. I have been reading and re-reading web posts and Simon Cozens book at perl.org all day, but can't seem to solve the problem.
My intention with the code below is to loop through files in a directory and when the file has a certain string a name to verify that the same file name doesn't exist with a different extension and if it doesn't, to print me the file name (later I will implement a delete of the file, but for now I want to ensure it will work.) Specifically, I am finding .mdb files and after checking there are no associated .ldb's files, deleting the .mdb file.
right now my code returns this:
RRED_Database_KHOVIS.ldb
RRED_Database_KHOVIS.mdb
I will kill RRED_Database_KHOVIS.mdb
RRED_Database_mkuttler.mdb
I will kill RRED_Database_mkuttler.mdb
RRED_Database_SBreslow.ldb
RRED_Database_SBreslow.mdb
I will kill RRED_Database_SBreslow.mdb
i want it to only return the "I will kill..." after a .mdb file with no associated .ldb file.
My current code is below. I appreciate any help offered...
use strict;
use warnings;
use File::Find;
use diagnostics;
my $dir = "//vfg1msfs01ab/vfgcfs01\$/Regulatory Reporting/Access Database/";
my $filename = "RRED_Database";
my $fullname, my $ext;
opendir DH, $dir or die "Couldn't open the directory: $!";
while ($_ = readdir(DH)) {
my $ext = ".mdb";
if ((/$filename/) && ($_ ne $filename . $ext)) {
print "$_ \n";
unless (-e $dir . s/.mdb/.ldb/) {
s/.ldb/.mdb/;
print "I will kill $_ \n\n" ;
#unlink $_ or print "oops, couldn't delete $_: $!\n";
}
s/.ldb/.mdb/;
}
}
When looping through files, I like to use 'next' statements repeatedly to assure that I'm only looking at exactly what I want. Try this:
use strict;
use warnings;
use File::Find;
use diagnostics;
my $dir = "//vfg1msfs01ab/vfgcfs01\$/Regulatory Reporting/Access Database/";
my $filename = "RRED_Database";
my $fullname, my $ext;
opendir DH, $dir or die "Couldn't open the directory: $!";
while ($_ = readdir(DH)) {
my $ext = ".mdb";
# Jump to next while() iteration unless the file begins
# with $filename and ends with $ext,
# and capture the basename in $1
next unless $_ =~ m|($filename.*)$ext|;
# Jump to next while() iteration if if the file basename.ldb is found
next if -f $1 . ".ldb";
# At this point, we have an mdb file with no matching ldb file
print "$_ \n";
print "I will kill $_ \n\n" ;
#unlink $_ or print "oops, couldn't delete $_: $!\n";
}
While stuart's anwser made it more lean... I was able to also get it to work with the code below... (i changed .mdb to .accdb because I am now dealing with different file type)
use strict;
use warnings;
use File::Spec;
use diagnostics;
my $dir = "//vfg1msfs01ab/vfgcfs01\$/Regulatory Reporting/Access Database/";
my $filename = "RRED_Database";
my $ext;
opendir DH, $dir or die "Couldn't open the directory: $!";
while ($_ = readdir(DH)) {
my $ext = ".accdb";
if ((/$filename/) && ($_ ne $filename . $ext) && ($_ !~ /.laccdb/)) {
# if file contains database name, is not the main database and is not a locked version of db
s/$ext/.laccdb/;
unless (-e File::Spec->join($dir,$_)) {
s/.laccdb/$ext/;
#print "I will kill $_ \n\n";
unlink $_ or print "oops, couldn't delete $_: $!\n";
}
s/.laccdb/$ext/;
}
}
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.