I am writing a script that will create a new tar file containing only those files that were created after the previous tar.gz file was created.
my $path_to_logs = "/home/myscripts/";
my $FNAME= `ls -t *.tar.gz | head -n1`;
my $FILENAME = $path_to_logs.$FNAME;
chomp ($FILENAME);
if (-e $FILENAME){
my $changed= `find . -name '*.log' -newer $FILENAME`;
chomp $changed;
$command = "tar -cvzT ". $changed." -f deleteme-$(date +%Y-%m-%d-%H-%M-%S).tar.gz";
chomp $command;
print $command;
}
However, the outout for $command shows that each of the find results are on a new line, so I dont get on concatenated command for tar. Any idea why?
Thanks.
How about this to solve your immediate problem:
my $find_cmd = "find . -name '*.log' -newer $filename";
open my $in, '-|', $find_cmd or die "Couldn't run command. $!\n";
while(<$in>) {
chomp;
print "Do something with file: $_\n";
}
If you need the files in a single line you can create a variable and concatenate them or whatever, I just wanted to show you a better way to call a system command (it would be even better if you could call the command directly without the shell expansion but you are relying on the shell expansion there).
In the long run you might want to learn how to use perl's own find/wanted routine and how to do dir globbing instead of having to rely so much on the system.
Just transform the output from find into a single line:
my $changed= `find . -name '*.log' -newer $FILENAME`;
chomp $changed;
$changed =~ s/\n/ /g;
$command = "tar -cvzT -f deleteme-$(date +%Y-%m-%d-%H-%M-%S).tar.gz " . $changed;
Btw, in general, it's often better to reduce one's dependency on OS specific features. You can duplicate all of the commands that you're shelling to the OS in perl using not too much effort:
use strict;
use warnings;
use autodie;
use File::Find::Rule;
use File::stat;
use Time::Piece;
my $path_to_logs = "/home/myscripts/";
my ($FILENAME) = sort {
stat($a)->mtime <=> stat($b)->mtime
} glob('/home/myscripts/*.tar.gz');
if (-e $FILENAME){
my $modified = stat($FILENAME)->mtime;
my #files = File::Find::Rule->file()
->name('*.log')
->modified(">$modified")
->in('.');
my $datenow = localtime->strftime('%Y-%m-%d-%H-%M-%S');
my $command = "tar -cvzT -f deleteme-${datenow}.tar.gz ". join(' ', #files);
You could even use Archive::Tar instead of /bin/tar, but that would potentially have a performance hit.
However, regardless, these simple changes make your script much more portable, and didn't require that much additional code.
It doesn't make much sense to do this in Perl anyway. Regardless of the wrapper language, it would be simpler and more robust to pipe the find output straight to tar, which knows how to handle it.
Anyway, your use of tar's -T option is wrong. It expects a file name containing file names, one per line, not a list of file names.
Also, your FNAME contains the newest file in the current directory, where apparently the intent is to find the newest file in /home/myscripts.
Finally, the $(date ...) interpolation will not be interpolated by Perl, but trivially works if you convert this (back?) to a shell script.
#!/bin/sh
path_to_logs = "/home/myscripts/"
FNAME=$(cd "$path_to_logs"; ls -t *.tar.gz | head -n1)
FILENAME = "$path_to_logs/$FNAME"
if [ -e "$FILENAME" ]; then
find . -name '*.log' -newer "$FILENAME" |
tar -c -v -z -T - -f deleteme-$(date +%Y-%m-%d-%H-%M-%S).tar.gz
fi
Related
I want to make the same calculations in two similar files, but I do not want to double the code for each file nor to create two scripts for this.
my $file = "file1.txt";
my $tempfile = "file1_temp.txt";
if (not defined $file) {
die "Input file not found";
}
open(my $inputFileHandler, '<:encoding(UTF-8)', $file)
or die "Could not open file '$file' $!";
open(my $outs, '>', $tempfile) or die $!;
/*Calculations made*/
close($outs);
copy($tempfile,$file) or die "Copy failed: $!";
unlink($tempfile) or die "Could not delete the file!\n";
close($inputFileHandler);
So i want to do the exact calculations for file2.txt_temp and copy it in file2.txt is there a way to do it without writing the code again for file2?
Thank you very much.
Write your code as a Unix filter. Read the data from STDIN and write it to STDOUT. Your code will be simpler and your program will be more flexible.
#!/usr/bin/perl
use strict;
use warnings;
while (<STDIN>) {
# do a calculation using the data that is in $_
print $output_data
}
The cleverness is in how you call the program:
$ ./my_clever_filter < file1.txt > file1_out.txt
$ ./my_clever_filter < file2.txt > file2_out.txt
See The Unix Filter Model: What, Why and How? for far more information.
Assuming your code is well written (not manipulating any globals, ...) you could use a for-loop
foreach my $prefix ('file1', 'file2') {
my $file = $prefix . ".txt";
my $tempfile = $prefix . "_temp.txt";
...
}
There is a certain Perl feature that is designed especially for cases like this, and that is this:
$ perl -pi -e'/*Calculations made*/' file1.txt file2.txt ... fileN.txt
Loosely referred to as "in-place edit", which basically does what your code does: It writes to a temp file and then overwrites the original.
Which will apply your calculations to the files named as arguments. If you have complex calculations you can put them in a file and skip the -e'....' part
$ perl -pi foo.pl file1.txt ...
Say for example that your "calculations" consist of incrementing each pair of numbers by 1:
s/(\d+) (\d+)/($1 + 1) . ($2 + 1)/ge
You would do either
$ perl -pi -e's/(\d+) (\d+)/($1 + 1) . ($2 + 1)/ge' file1.txt file2.txt
$ perl -pi foo.pl file1.txt file2.txt
Where foo.pl contains the code.
Be aware that the -i switch is destructive, so make backups before running the command. You can supply a backup extension to save a backup, but that backup is overwritten if you run the command again. E.g. -i.bak.
-p places a while (<>) loop around your code, followed by a print of each line,
-i.bak does the editing of the original file, and saves a backup with the extension, if it is supplied.
I have a folder which has over 1500 files scattered around in different sub-folders with extension .fna. I was wondering if there is a simple way in Perl to extract all these files and store them in a different location?
As File::Find is recommended everywhere, let me add that there are other, sometimes nicer, options, like https://metacpan.org/pod/Path::Iterator::Rule or Path::Class traverse function.
Which OS are you using? If it's Windows, I think a simple xcopy command would be a lot easier. Open a console window and type "xcopy /?" to get the info on this command. It should be something simple like:
xcopy directory1/*.fna directory2 /s
use File::Find;
my #files;
find(\&search, '/some/path/*.fna');
doSomethingWith(#files);
exit;
sub search {
push #files, $File::Find::name;
return;
}
Without much more information to go on, you don't need a perl script to do something as easy as this.
Here's a *nix one-liner
find /source/dir -name "*.fna" -exec mv -t /target/dir '{}' \+ -print
sorry for the late response. I was away for a conference. Here is my code which seem to work fine so far.
use strict;
use warnings;
use Cwd;
use FileHandle;
open my $out, ">>results7.txt" or die;
my $parent = "/home/denis/Denis_data/Ordered species";
my ($par_dir, $sub_dir);
opendir($par_dir, $parent);
while (my $sub_folders = readdir($par_dir)) {
next if ($sub_folders =~ /^..?$/); # skip . and ..
my $path = $parent . '/' . $sub_folders;
#my $path = $sub_folders;
next unless (-d $path); # skip anything that isn't a directory
chdir($path) or die;
system 'perl batch_hmm.pl';
print $out $path."\n";
#chdir('..') or die;
#closedir($sub_dir);
}
closedir($par_dir);
I will also try the File::Finder option. The above one looks quite messy.
HI all,
i need to have this command line command executed from a Perl file:
for file in *.jpg ; do mv $file `echo $file | sed 's/\(.*\.\)jpg/\1jp4/'` ; done
So I added the folders and tried:
system "bash -c 'for file in $mov0to/*.jp4 ; do mv $file `echo $basedir/internal/0/$file | sed 's/\(.*\.\)jp4/\1jpg/'` ; done'";
But all I get is:
sh: Syntax error: "(" unexpected
No file specified
I am on Kubuntu 10.4
Thanks,
Jan
I can think of many better ways of doing this, but ideally you want pure Perl:
use File::Copy qw( move );
opendir DIR, $mov0to or die "Unable to open $mov0to: $!";
foreach my $file ( readdir DIR ) {
my $out = $file;
next unless $out =~ s/\.jp4$/.jpg/;
move "$mov0to/$file", "$basedir/internal/0/$out" or die "Unable to move $mov0to/$file->$basedir/internal/0/$out: $!";
}
closedir DIR;
If you insist on doing the lifting in Bash, you should be doing:
system qq(bash -c 'for file in $mov0to/*.jp4 ; do mv \$file $basedir/internal/0/\${file\/%.jp4\/.jpg} ; done');
All of the variables inside the double quotes will get interpolated, the $file that you're using in the bash for loop in particular. We don't have enough context to know where the other variables ($mov0to and $basedir) come from or what they contain so they might be having the same problems. The double quotes are also eating your backslashes in the sed part.
Andy White is right, you'd have less of a mess if the bash commands were in a separate script.
It's most likely a problem with nested quotes. I would recommend either moving that bash command into its own (bash) script file, or writing the loop/logic directly in Perl code, making simpler system calls if you need to.
I have a directory hierarchy with a bunch of files. Some of the directories start with a ..
I want to copy the hierarchy somewhere else, leaving out all files and dirs that start with a .
How can one do that?
I think what you want is File::Copy::Recursive's rcopy_glob():
rcopy_glob()
This function lets you specify a
pattern suitable for perl's glob() as
the first argument. Subsequently each
path returned by perl's glob() gets
rcopy()ied.
It returns and array whose items are
array refs that contain the return
value of each rcopy() call.
It forces behavior as if
$File::Copy::Recursive::CPRFComp is
true.
If you're able to solve this problem without Perl, you should check out rsync. It's available on Unix-like systems, on Windows via cygwin, and perhaps as a stand-alone tool on Windows. It will do what you need and a whole lot more.
rsync -a -v --exclude='.*' foo/ bar/
If you aren't the owner of all of the files, use -rOlt instead of -a.
Glob ignores dot files by default.
perl -lwe'rename($_, "foo/$_") or warn "failure renaming $_: $!" for glob("*")'
The code below does the job in a simple way but doesn't handle symlinks, for example.
#! /usr/bin/perl
use warnings;
use strict;
use File::Basename;
use File::Copy;
use File::Find;
use File::Spec::Functions qw/ abs2rel catfile file_name_is_absolute rel2abs /;
die "Usage: $0 src dst\n" unless #ARGV == 2;
my($src,$dst) = #ARGV;
$dst = rel2abs $dst unless file_name_is_absolute $dst;
$dst = catfile $dst, basename $src if -d $dst;
sub copy_nodots {
if (/^\.\z|^[^.]/) {
my $image = catfile $dst, abs2rel($File::Find::name, $src);
if (-d $_) {
mkdir $image
or die "$0: mkdir $image: $!";
}
else {
copy $_ => $image
or die "$0: copy $File::Find::name => $image: $!\n";
}
}
}
find \©_nodots => $src;
cp -r .??*
almost perfect, because it misses files beginning with . and followed by a single sign. like - .d or .e
echo .[!.] .??*
this is even better
or:
shopt -s dotglob ; cp -a * destination; shopt -u dotglob
I found File::Copy::Recursive's rcopy_glob().
The following is what is showed in the docs but is deceptive.
use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
it does not import rcopy_glob() and the only way I found to use it was to be explict as follows:
use File::Copy::Recursive;
File::Copy::Recursive::rcopy_glob("glob/like/path","dest/path");
How do I copy a directory including sub directories excluding files or directories that match a certain regex on a Windows system?
I'd do something like this:
use File::Copy;
sub copy_recursively {
my ($from_dir, $to_dir, $regex) = #_;
opendir my($dh), $from_dir or die "Could not open dir '$from_dir': $!";
for my $entry (readdir $dh) {
next if $entry =~ /$regex/;
my $source = "$from_dir/$entry";
my $destination = "$to_dir/$entry";
if (-d $source) {
mkdir $destination or die "mkdir '$destination' failed: $!" if not -e $destination;
copy_recursively($source, $destination, $regex);
} else {
copy($source, $destination) or die "copy failed: $!";
}
}
closedir $dh;
return;
}
Another option is File::Xcopy. As the name says, it more-or-less emulates the windows xcopy command, including its filtering and recursive options.
From the documentation:
use File::Xcopy;
my $fx = new File::Xcopy;
$fx->from_dir("/from/dir");
$fx->to_dir("/to/dir");
$fx->fn_pat('(\.pl|\.txt)$'); # files with pl & txt extensions
$fx->param('s',1); # search recursively to sub dirs
$fx->param('verbose',1); # search recursively to sub dirs
$fx->param('log_file','/my/log/file.log');
my ($sr, $rr) = $fx->get_stat;
$fx->xcopy; # or
$fx->execute('copy');
# the same with short name
$fx->xcp("from_dir", "to_dir", "file_name_pattern");
If you happen to be on a Unix-like OS and have access to rsync (1), you should use that (for example through system()).
Perl's File::Copy is a bit broken (it doesn't copy permissions on Unix systems, for example), so if you don't want to use your system tools, look at CPAN. Maybe File::Copy::Recursive could be of use, but I don't see any exclude options. I hope somebody else has a better idea.
I don't know how to do an exclusion with a copy, but you could work something up along the lines of:
ls -R1 | grep -v <regex to exclude> | awk '{printf("cp %s /destination/path",$1)}' | /bin/sh
A classic answer would use 'cpio -p':
(cd $SOURCE_DIR; find . -type f -print) |
perl -ne 'print unless m/<regex-goes-here>/' |
cpio -pd $TARGET_DIR
The 'cpio' command deals with the actual copying, including permission preservation. The trick of 'cd $SOURCE_DIR; find . ...' deals with removing the leading part of the source path from the names. The only problem with that invocation of 'find' is that it won't follow symlinks; you need to add '-follow' if that's what you want.