i'm new in Perl and i'm trying to write a script which gets a path to a tar file, checking if there is txt file in it, and if yes extract the file to output folder. here is my code:
#!/usr/bin/perl
use strict;
use warnings;
use Archive::Tar;
use File::Spec::Functions qw(catdir);
#checking if tar file contain a txt file, if yes extract it to a folder
my $tarPath = 'path/to/tarArchive';
my $tar = Archive::Tar->new($tarPath);
my #files = $tar->list_files;
my $output_dir = 'C:/output/path';
foreach my $file (#files) {
if ( $file =~ /txt$/ ) {
my $extracted_file = catdir( $fileName, $file );
my $extracted_path = catdir( $output_dir, $file );
$tar->extract( $extracted_file, $output_dir );
print $extracted_file;
}
}
exit 0;
when i'm running this script i'm getting an error: no such file in archive.
could you please help me understand what am i doing wrong and what should be the correct command?
The Archive::Tar extract method does not allow you to specify an output directory; it only allows a list of input files. You need to use the extract_file method:
$tar->extract_file($extracted_file, $output_dir);
Related
This question already has answers here:
Using Perl to rename files in a directory
(4 answers)
Closed 7 years ago.
I'm trying following code to search for .txt files and rename them while copying it to different directory.
#!/bin/perl
use File::Basename;
#txtfiles = <*/*.txt>;
foreach my $file(#textfiles){
$dir = dirname($file);
$file = basename($file);
$file =~ s/(\d+)/$dir/; //renaming number with $dir
`mkdir -p summary` unless -d summary;
`cp $file summary`;
}
Above code gives error saying no such file to copy however print statement at each line shows correctly (renamed file names)
NOOOOO!
Don't use system commands -- especially since there are Perl commands that you can use.
`mkdir -p summary` unless -d summary;
`cp $file summary`;
Use the Perl commands!
use File::Copy; # Standard Perl Module. USE IT!
...
mkdir 'summary' unless -d 'summary'; # No need for `-p`
copy $file, 'summary';
Here's a revised script:
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
# use File::Basename; -- No need for this in this version
use File::Copy;
# What files do you want to find?
# Do you want to find the immediate files or the
# files in the subdirectories?
my #text_files = glob('*.txt'); # Immediate files only
mkdir 'summary' if not -d 'summary'; # Make this dir before the loop
for my $file ( #text_files ) {
next unless -f $file; # Make sure this is a file you want to copy!
#
# No need for 'dirname' and 'basename' with '*.txt' glob
#
if ( not copy $file, 'summary' ) { # Check the outcome of this command.
warn qq(Could not copy file "$file" to "summary".);
}
}
Let us know if you need to copy files in subdirectories rather than just in the immediate directory. Maybe you can use make_tree found in File::Path, or the Perl version of find from File::Find. These are standard Perl modules that all Perl installations have.
Addendum
I don't want current directory. The files are resides inside one directory i.e. foo/text_v0001.txt, foo/text_v0002.txt, foo_au/text_v0003.txt, foo_au/text_v0004.txt continues.... I want to replace the numbers with directory name e.g. foo/text_v0001.txt should renamed to text_foo.txt and foo/text_v0002.txt should renamed to text_foo.txt (since in same folder we can't have same name files, we can add part2 and the end of second file i.e. text_fooPart2.txt).
That last part is a doozy, and it's a new requirement too. I need to verify that a file doesn't already exist with the same name, and if it does, I need to make sure that I find the next available name.
If I find that a file already exist, I'll loop incrementing a duplicate file counter until I find a file name that doesn't already exist.
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
use File::Basename;
use File::Copy;
use File::Glob; # Improved Glob matching.
use constant {
DIRECTORY => 'summary',
};
# What files do you want to find?
# Do you want to find the immediate files or the
# files in the subdirectories?
#
# Let's do a more sophisticated pattern making sure we're catching
# the files we want.
#
my #text_files = glob('*/*.txt'); # Subdirectories only
mkdir DIRECTORY if not -d DIRECTORY; # Make this dir before the loop
for my $file ( #text_files ) {
my $dir_name = dirname $file;
my $file_name = basename $file;
say "DEBUG: On '$file'.";
#
# Let's make sure that the file name matches the expected
# pattern. If the substitution doesn't succeed, we assume
# this file shouldn't be copied, and skip it.
#
# I'm serching for a file that has the suffix '_vxxxx.txt' where
# 'xxxx' is some number. I remove the number and the letter `v`,
# and add in the directory name.
#
if ( not $file_name =~ s/_v(\d+)\.txt$/_$dir_name.txt/ ) {
warn qq("$dir_name/$file_name" has not been copied.");
next;
}
#
# If the name matches, make sure it's a file
#
if ( not -f $file ) {
warn qq("$file" is not a file and wasn't copied.");
next
}
#
# Now make sure file name is unique
#
if ( -f DIRECTORY . "/$file_name" ) { # File name already exists
say qq(DEBUG: Duplicate File '$file_name' detected!);
my $dup_file_counter = 2;
( my $file_no_suffix = $file_name ) =~ s/\.txt$//;
#
# Find a non-matching name
#
for (;;) {
my $new_file_name = $file_no_suffix . "_part_$dup_file_counter.txt";
say "DEBUG: New file name '$new_file_name'";
say qq(DEBUG: if ( not -e #{[DIRECTORY]} . "/$new_file_name" ) { );
if ( not -e DIRECTORY . "/$new_file_name" ) {
$file_name = $new_file_name;
last;
}
else {
$dup_file_counter += 1;
}
}
}
if ( not copy $file, DIRECTORY . "/$file_name" ) { # Check the outcome of this command.
warn qq(Could not copy file "$file" to directory ") . DIRECTORY . qq(".);
}
}
in the loop you are using #textfiles instead of #txtfiles. Use strict
#!/usr/local/bin/perl
use File::Basename;
use strict;
use warnings;
my #txtfiles = glob("*.txt");
foreach my $file(#txtfiles){
my $dir = dirname($file);
$file = basename($file);
$file =~ s/(\d+)/$dir/; # renaming number with $dir
`mkdir -p summary` unless -d "summary";
`cp $file summary`;
}
I want to run a perl script over all .dat files containing text "some_attr" in the specified directory and its sub directories. How can I do that?
I can list all .dat files containing "some_attr" using '***grep -nri some_attr * ./'*
and run perl script manually over greped files,but I want to automate this using perl
Assuming you have a Bash shell, you can use a simple for loop combined with grep:
for file in `grep -lr some_attr | uniq`
do
perl script_name.pl $file
done
You can use File::Find or File::Find::Rule:
use strict;
use warnings;
use autodie;
use File::Find::Rule;
# find all the .dat files in .
my #files = File::Find::Rule->file()
->name( '*.dat' )
->in( '.' );
for my ($file) {
my $data = do {
open my $fh, '<', $file;
local $/;
<$fh>;
};
next if $data !~ /some_attr/;
print $file, "\n";
}
I have a segment of code that is working that finds all of the .txt files in a given directory, but I can't get it to look in the subdirectories.
I need my script to do two things
scan through a folder and all of its subdirectories for a text file
print out just the last segments of its path
For example, I have a directory structed
C:\abc\def\ghi\jkl\mnop.txt
I script that points to the path C:\abc\def\. It then goes through each of the subfolders and finds mnop.txt and any other text file that is in that folder.
It then prints out ghi\jkl\mnop.txt
I am using this, but it really only prints out the file name and if the file is currently in that directory.
opendir(Dir, $location) or die "Failure Will Robertson!";
#reports = grep(/\.txt$/,readdir(Dir));
foreach $reports(#reports)
{
my $files = "$location/$reports";
open (res,$files) or die "could not open $files";
print "$files\n";
}
I do believe that this solution is more simple and easier to read. I hope it is helpful !
#!/usr/bin/perl
use File::Find::Rule;
my #files = File::Find::Rule->file()
->name( '*.txt' )
->in( '/path/to/my/folder/' );
for my $file (#files) {
print "file: $file\n";
}
What about using File::Find?
#!/usr/bin/env perl
use warnings;
use strict;
use File::Find;
# for example let location be tmp
my $location="tmp";
sub find_txt {
my $F = $File::Find::name;
if ($F =~ /txt$/ ) {
print "$F\n";
}
}
find({ wanted => \&find_txt, no_chdir=>1}, $location);
Much easier if you just use File::Find core module:
#!/usr/bin/perl
use strict;
use warnings FATAL => qw(all);
use File::Find;
my $Target = shift;
find(\&survey, #ARGV);
sub survey {
print "Found $File::Find::name\n" if ($_ eq $Target)
}
First argument: pathless name of file to search for. All subsequent arguments are directories to check. File::Find searches recursively, so you only need to name the top of a tree, all subdirectories will automatically be searched as well.
$File::Find::name is the full pathname of the file, so you could subtract your $location from that if you want a relative path.
I have files with random names and i want to rename all them together like Trace1, Trace2 and so on.... any idea?
Or in Perl:
#!/usr/bin/perl
use strict;
use warnings;
# use dirname() to keep the renamed files in the same directory
use File::Basename qw( dirname );
my $i = 1;
for my $file (#ARGV) {
rename $file, dirname($file) . "/Trace$i";
print "$file -> Trace$i\n";
} continue { $i++ }
If you are new to Linux, you need to also remember to make the script executable (assuming the script was saved in the file named random-renamer):
chmod 755 random-renamer
And then to run it (rename all the files in the random-files directory):
./random-renamer random-files/*
You can just use a shell command:
i=1;
for f in *
do
mv $f "Trace$i"
i=$(($i+1))
done
This checks if there are any existing files named Trace# and avoids clobbering them.
use Path::Class qw( dir );
use List::Util qw( max );
my $dir = dir(...);
my #files =
map $_->basename(),
grep !$_->is_dir(),
$dir->children();
my $last =
max 0,
map /^Trace([0-9]+)\z/,
#files;
my $errors;
for (#files) {
my $old = $dir->file($_);
my $new = $dir->file("Trace" . ++$last);
if (!rename($new, $old)) {
warn("Can't rename \"$old\" to \"$new\": $!\n");
++$errors;
}
}
exit($errors ? 1 : 0);
The problem for which the perl code is to be developed is as follow:
There is a root directory that contains several directory in it. Each subdirectory has in turn a text file in it.
We need to go into each directory of the root directory and first rename the file inside that directory. Then we will need to get back, or one directory up, and replace the directory name with the same name as the text file it contains.
Steps:
open each directory
rename the text file in the directory opened
go up one level and rename the directory itself with the same name as the text file it contains
move to the next directory in the root directory
You can use the File::Find module, it traverses the directory tree recursively.The finddepth() function in the module can be used for this purpose, it does postorder traversal working from the bottom of the directory tree up.
use File::Find;
my $DirName = 'path_of_dir' ;
sub rename_subdir
{
#The path of the file/dir being visited.
my $orignm = $File::Find::name;
my $newnm = $orignm . '_rename';
print "Renaming $orignm to $newnm\n";
rename ($orignm, $newnm);
}
#For each file and sub directory in $Dirname, 'finddepth' calls
#the 'rename_subdir' subroutine recursively.
finddepth (\&rename_subdir, $DirName);
You have not mentioned how you store the file names that will be used for renaming, so I'll assume it's a generic type of change, e.g. "file_x" -> "file_x_foo". You'll have to define that yourself.
This script will try to rename all the files in the directory, assuming the only regular file in the directory is the target file. If you have more files in the directory, you will need to supply a means of identifying that file.
The script takes an optional argument which is the root dir.
This is sample code, untested, but it should work.
use strict;
use warnings;
use autodie;
use File::Copy;
my $rootdir = shift || "/rootdir";
opendir my $dh, $rootdir;
chdir $rootdir;
my #dirlist = grep -d, readdir $dh;
for my $dir (#dirlist) {
next if $dir =~ /^\.\.?$/;
chdir $dir;
for my $org (grep -f, glob "*.txt") { # identify target file
my $new = $org;
$new .= "_foo"; # change file name, edit here!
move $org, $new;
}
chdir "..";
move $dir, $new;
}
Hi i am trying an overview of your idea
#!/usr/bin/perl
use strict;
use File::Find;
use Data::Dumper;
use File::Basename;
my $path = 'your root directory';
my #instance_list;
find (sub { my $str = $_;
if($str =~ m/.txt$/g) {
push #instance_list, $File::Find::name if (-e $File::Find::name);
}
}, $path);
print Dumper(#instance_list);
for my $instance (#instance_list) {
my $newname = 'newEntry';
my $filename = basename( $instance );
#rename the file 1st,
my $newFileName = dirname( $instance ) .'/'. $filename.$newname.'.txt'
;
rename($instance, $newFileName) or die $!;
#rename the directory
my $newDirName = dirname(dirname( $instance ) ).'/'. $newname;
rename(dirname($instance), $newDirName) or die $!;
}