I am reading a directory having some archive files and uncompressing the archive files one by one.
Everything seems well however the files are getting uncompressed in the folder which has the main perl code module which is running the sub modules.
I want the archive to be generated in the folder I specify.
This is my code:
sub ExtractFile
{
#Read the folder which was copied in the output path recursively and extract if any file is compressed
my $dirpath = $_[0];
opendir(D, "$dirpath") || die "Can't open dir $dirpath: $!\n";
my #list = readdir(D);
closedir(D);
foreach my $f (#list)
{
print " \$f = $f";
if(-f $dirpath."/$f")
{
#print " File in directory $dirpath \n ";#is \$f = $f\n";
my($file_name, $file_dirname,$filetype)= fileparse($f,qr{\..*});
#print " \nThe file extension is $filetype";
#print " \nThe file name is is $file_name";
# If compressed file then extract the file
if($filetype eq ".tar" or $filetype eq ".tzr.gz")
{
my $arch_file = $dirpath."/$f";
print "\n file to be extracted is $arch_file";
my $tar = Archive::Tar->new($arch_file);
#$tar->extract() or die ("Cannot extract file $arch_file");
#mkdir($dirpath."/$file_name");
$tar->extract_file($arch_file,$dirpath."/$file_name" ) or die ("Cannot extract file $arch_file");
}
}
if(-d $dirpath."/$f")
{
if($f eq "." or $f eq "..")
{ next; }
print " Directory\n";# is $f";
ExtractFile($dirpath."/$f");
}
}
}
The method ExtractFile is called recursively to loop all the archives.
When using $tar->extract() it uncompresses in the folder which calls this method.
When I use $tar->extract_file($arch_file,$dirpath."/$file_name") I get an error :
No such file in archive: '/home/fsang/dante/workspace/output/s.tar' at /home/fsang/dante/lib/Extraction.pm line 80
Please help I have checked that path and input output there is no issue with it.
Seems some usage problem I am not aware of for $tar->extract_file().
Many thanks for anyone resolving this issue.
Regards,
Sakshi
You've misunderstood extract_file. The first parameter is the name of a file inside the archive to extract. You're passing in the path of the archive itself. You passed that to new; you don't need to pass it in again. As the error message explains, s.tar does not contain a file named /home/fsang/dante/workspace/output/s.tar, so extract_file fails.
You can get a list of files in the archive by using $tar->list_files.
A simpler solution may be to temporarily chdir to the directory you want to extract the archive into. File::pushd provides an easy way to do that.
a typo?
$tar->extract_file($arch_file,$dirpath."/$file_name" )
should probably be
$tar->extract_file($arch_file,$dirpath."/".$file_name)
$tarFile = "test.tar.gz";
$myTar = Archive::Tar->new($tarFile);
foreach my $member ($myTar->list_files())
{
my $res = $myTar->extract_file( $member , 'C:/temp/'.$member );
print "Exract error!\n" unless ($res);
}
I see a gun being brought to a Swiss Army knife fight.
Here's a *nix one-liner that does what you want:
find /source/dir -name "*.tar" -exec tar -C /target/dir -xvzf '{}' \; -print
Is there a need to write a script for this?
You aren't necessarily doing anything special other than debug lines.
Related
I am looking a small script which will tell me whether a file is an empty file or not, but I am unable to display this.
I have used the below code:
opendir DIR,$directory ;
while (my $dir =readdir DIR) {
if (-s "$dir") {
print "This is an empty file";
}
}
Here I am unable to print "This is an empty file" and my code does not went inside the if loop. Can anyone tell me what is the wrong in the above code?
The relevant file test operators are:
-z: check if the file is empty.
-s: check if the file has nonzero size (returns size in bytes).
You are checking if $dir is non-empty, so opposite of what you are trying to achieve. Use -z (or !-s) instead.
Also, each $dir is just the filename without the path, so you need to include it yourself if you aren't processing the current directory.
if (-z "$directory/$dir") {
print "This is an empty file";
}
Your main problem is that readdir() doesn't return what you think it does. It returns the names of the files in the directory. But the names you get back don't have the directory path attached. And the -s operator needs the full path to the file in order to find it.
So you need to attach the directory name yourself. Something like this will work:
opendir DIR, $directory ;
while (my $dir = readdir DIR) {
# Note: Full path here.
if (-s "$directory/$dir") {
print "This is an empty file";
}
}
But there are a couple of other things I'll fix. Firstly -s returns the size of the file. So that's true for a non-empty file. Which means that your logic is reversed. It actually needs to be this:
if (-s "$directory/$dir") {
print "This is a non-empty file";
} else {
print "This is an empty file";
}
It's also worth noting that using bareword directory handles isn't a very good idea. It's far better to use lexical variables as handles. I'd write your code like this:
opendir my $dir_h, $directory ;
while (my $file = readdir $dir_h) {
# Note: Full path here.
if (-s "$directory/$file") {
print "This is a non-empty file";
} else {
print "This is an empty file";
}
}
Oh, I also sneakily changed a variable name. $file seems a far better name thant $dir :-)
Okay I'm at a total loss.
I am trying to extract all the XMLs and PDFs from a 7zip file.
There is more stuff inside said file, so I just want to extract from the PDF folder and the XML folder. Leaving the file structure behind and not searching in any other folders.
I am using the 7Zip command line to do this.
I have two sub routines that I execute which are almost identical.
sub Extract_pdfs_from_this
{
my ($file, $destination) = #_;
my $sevenzip_executable = '\\\\server\7-Zip\7z.exe';
my $extract_pdfs = "$sevenzip_executable e -y -o$destination $file output\\JETPDF\\DISB\\*.pdf ";
print STDOUT "\n\nExtracting PDFs From $file \n>>$extract_pdfs \n";
eval{system($extract_pdfs)};
print STDOUT "Finished Extracting PDFs \n";
return;
}
..
sub Extract_xmls_from_this
{
my ($file, $destination) = #_;
my $sevenzip_executable = '\\\\server\7-Zip\7z.exe';
my $extract_xmls = "$sevenzip_executable e -y -o$destination $file staging\\DISB\\OnBase\\*.xml ";
print STDOUT "\n\nExtracting XMLs From $file \n>>$extract_xmls \n";
eval{system($extract_xmls)};
print STDOUT "Finished Extracting XMLs \n";
return;
}
and I use it like so...
my $in_extraction_directory = dirname(__FILE__);
my $input_subdirectory = "$directory\\$subdirectory";
my #in_seven_zip_files = Get_all_sevenzips_in($input_subdirectory);
foreach my $sevenzip_file (#in_seven_zip_files)
{
$sevenzip_file = "$input_subdirectory\\$sevenzip_file";
Extract_pdfs_from_this($sevenzip_file, $in_extraction_directory);
Extract_xmls_from_this($sevenzip_file, $in_extraction_directory);
}
When executed the PDFs get extracted but not the XMLs.
I get an error, there are no files to process.
I feel like 7zip is hung up on the file from the previous call. Is there a way to close it or release the file?
Any help appreciated, much time wasted on this.
Thanks!
Check exit status $?, if you feel it's hung.
Also you can try first extracting xmls then pdfs to really make sure, if extracting pdfs command is making issue.
share console output, Which can show much details.
User error... Works just how it should.
I had a condition:
unless ($number_of_pdfs == $number_of_xmls)
{
print STDOUT "The number of PDFs and XMLs did not match!\n\n";
print STDOUT "PDFs: $number_of_pdfs \nXMLs: $number_of_xmls\nFile: $sevenzip_file \nExtraction Directory: $output_directory\n\n";
die;
}
and in the first file I was extracting, the XML was not in the correct path... Someone didn't follow pattern. Very embarrassing thanks for the response.
I have a directory, /home/textfile/.
I want to use a Perl script to check to see if *.txt file exist in this directory or not. If they do, I want to have it say "Text files exist". Otherwise, if there are no text files in the directory I want it to say "No text files exist".
The text files could have any name. I just want to check if there is a text file in that directory, /home/textfile.
Below is the script I am trying to use:
$filedir = "/home/textfile/";
chdir($filedir);
if (-e "`ls *.txt`")
{
print STDOUT "Text file exist"
}
else
{
print STDOUT "No text file exist"
}
How can I fix this script so it will do what I am looking for it to do?
It's simplest to use glob to get a list of all files ending with .txt in that directory. It avoids shelling out to use ls
Like this
use strict;
use warnings;
my $dir = '/home/textfile';
my #files = glob "$dir/*.txt";
print "No " unless #files;
print "Text file exist\n";
From perldoc about the -X file test operators:
A file test, where X is one of the letters listed below. This unary
operator takes one argument, either a filename, a filehandle, or a
dirhandle, and tests the associated file to see if something is true
about it.
In wrapping the ls command in double quotes, you are hoping to test the filenames that are returned by ls, but in reality you are testing for the existence of a file named 'ls *.txt'.
There are a couple of options. You could use ls in a separate step to get all of the text file names and then test for the existence of a single one.
my #text_files = `ls *.txt`;
chomp(#text_files);
if ( -e $text_files[0] ) {
...
}
else {
...
}
But since ls will only return existing files, the -e check here is not needed at all. You can simply say:
my #text_files = `ls *.txt`;
if ( #text_files ) {
print "Text file exist"
}
else {
print "No Text file exist"
}
I should also note that, since you don't use $dir in your ls command, you are not actually looking in the $dir directory but the current working directory. You would need to add $dir to the ls command:
my #text_files = `ls $dir/*.txt`;
if ( #text_files ) {
print "Text file exist"
}
else {
print "No Text file exist"
}
Alternatively, you can use the glob builtin instead of shelling out to ls and let Perl manage how to actually read the files. This is generally the more robust and maintainable solution:
my #text_files = glob("$dir/*.txt");
if ( #text_files ) {
print "Text file exist"
}
else {
print "No Text file exist"
}
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;
I have a Perl script that reads in a list of files from a file, accessFiles.txt, and copies them to another location.
open my $accessFiles, "$scriptDir\\accessFiles.txt" or die "Could not open access file list $!";
while (my $accessFile = <$accessFiles>) {
my($file, $dir, $ext) = fileparse($accessFile, qr/\.[^.]*/);
my $accessDir = "$localDir\\AccessFiles\\$file";
my $accessCopy = "$accessDir\\$file$ext";
system("rmdir","/S", "/Q",$accessDir);
system("mkdir",$accessDir);
system("copy", $accessFile, $accessCopy);
}
The output of the copy command says it copied one file for each file in accessFiles.txt, but only the last file gets copied.
I've added input statements before and after the copy, and I cannot see any of the other files in the copied directory at any time.
Now, if I change the script to read from an array of files, then it works perfectly.
my #files = ('\\\\sourceshare\acc1.accdb', '\\\\sourceshare\acc2.accdb');
foreach my $accessFile (#files) {
my($file, $dir, $ext) = fileparse($accessFile, qr/\.[^.]*/);
my $accessDir = "$localDir\\AccessFiles\\$file";
my $accessCopy = "$accessDir\\$file$ext";
system("rmdir","/S", "/Q",$accessDir);
system("mkdir",$accessDir);
system("copy", $accessFile, $accessCopy);
}
Thanks in advance.
You didn't remove the trailing newline. Add
chomp($accessFile);