Implement linux command 'rename' using Perl - linux

Mac Os X does not have the useful linux command rename, which has the following format:
rename 'perl-regex' list-of-files
So here's what I have put together but it does not rename any files ($new is always the same as $file):
#!/usr/bin/env perl -w
use strict;
use File::Copy 'move';
my $regex=shift;
my #files=#ARGV;
for my $file (#files)
{
my $new=$file;
$new =~ "$regex"; # this is were the problem is !!!
if ($new ne $file)
{
print STDOUT "$file --> $new \n";
move $file, ${new} or warn "Could not rename $file to $new";
}
}
It is as if I am not passing the regexp and if I hard code it to
$new =~ s/TMP/tmp;
it will work just fine...
Any thoughts?

$operator = 's/TMP/tmp/';
print $operator;
doesn't magically evaluate the operator, so it should be no surprise that
$operator = 's/TMP/tmp/';
$x =~ $operator;
doesn't either. If you want to evaluate Perl code, you're going to have to pass it to the Perl interpreter. You can access it using eval EXPR.
$operator = 's/TMP/tmp/';
eval('$x =~ '.$operator.'; 1')
or die $#;

You cannot put the whole sentence s/TMP/tmp; in a variable. You can, though, do something like
$new =~ s/$find/$replace;
$find being your regex and $replace what you want to replace the matches with.
If you still want to pass the whole sentence, you might want to take a look at eval().

There are two ways this can be solved elegantly
Require two seperate command line arguments: One for the regex, and one for the replacement. This is inelegant and restrictive.
my ($search, $replace, #files) = #ARGV;
...;
my $new = $file;
$new =~ s/$search/$replace/e; # the /e evals the replacement,
# allowing us to interpolate vars
Invoked like my-rename '(.*)\.txt' '#{[our $i++]}-$1.foo' *.txt. This allows to execute almost any code⁽¹⁾ via string variable interpolation.
(1): no nested regexes in older perls
Just allow arbitrary Perl code, similar to perl -ne'...'. The semantics of the -n switch are that the current line is passed as $_. It would make sense to pass filenames as $_, and use the value of the last statement as the new filename. This would lead to something like
# somewhat tested
my ($eval_content, #files) = #ARGV;
my $code = eval q' sub {
no strict; # could be helpful ;-)
my #_out_;
FILENAME:
for (#_) {
my $_orig_ = $_;
push #_out_, [ $_orig_ => do { ' . $eval_content . q' } ];
# or
# do { " . $eval_content . " };
# push #_out_, [ $_orig_, $_ ];
# if you want to use $_ as out-argument (like -p).
# Can lead to more concise code.
}
return #_out_;
} ';
die "Eval error: $#" if $#;
for my $rename ($code->(#files)) {
my ($from, $to) = #$rename;
...
}
This could be invoked like my-rename 'next FILENAME if /^\./; our $i++; s/(.*)\.txt/$i-$1.foo/; $_' *.txt. That skips all files starting with a dot, registeres a global variable $i, and puts a number counting upwards from one in front of each filename, and changes the extension. Then we return $_ in the last statement.
The loop builds pairs of the original and the new filename, which can be processed in the second loop.
This is probably quite flexible, and not overly inefficient.

Well, it is already a Perl utility, and it's on CPAN: http://cpan.me/rename. You can use the module which comes with that utility, File::Rename, in a direct way:
#!/usr/bin/env perl
use File::Rename qw(rename);
rename #ARGV, sub { s/TMP/tmp/ }, 'verbose';
Other possibility is to concatenate the module and the script from that distribution and put the resulting file somewhere into your $PATH.

Better download the real script with no dependencies:
wget https://raw.githubusercontent.com/sputnick-dev/perl-rename/master/rename
#!/usr/bin/perl -w
#
# This script was developed by Robin Barker (Robin.Barker#npl.co.uk),
# from Larry Wall's original script eg/rename from the perl source.
#
# This script is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# Larry(?)'s RCS header:
# RCSfile: rename,v Revision: 4.1 Date: 92/08/07 17:20:30
#
# $RCSfile: rename,v $$Revision: 1.5 $$Date: 1998/12/18 16:16:31 $
#
# $Log: rename,v $
# Revision 1.5 1998/12/18 16:16:31 rmb1
# moved to perl/source
# changed man documentation to POD
#
# Revision 1.4 1997/02/27 17:19:26 rmb1
# corrected usage string
#
# Revision 1.3 1997/02/27 16:39:07 rmb1
# added -v
#
# Revision 1.2 1997/02/27 16:15:40 rmb1
# *** empty log message ***
#
# Revision 1.1 1997/02/27 15:48:51 rmb1
# Initial revision
#
use strict;
use Getopt::Long;
Getopt::Long::Configure('bundling');
my ($verbose, $no_act, $force, $op);
die "Usage: rename [-v] [-n] [-f] perlexpr [filenames]\n"
unless GetOptions(
'v|verbose' => \$verbose,
'n|no-act' => \$no_act,
'f|force' => \$force,
) and $op = shift;
$verbose++ if $no_act;
if (!#ARGV) {
print "reading filenames from STDIN\n" if $verbose;
#ARGV = <STDIN>;
chop(#ARGV);
}
for (#ARGV) {
my $was = $_;
eval $op;
die $# if $#;
next if $was eq $_; # ignore quietly
if (-e $_ and !$force)
{
warn "$was not renamed: $_ already exists\n";
}
elsif ($no_act or rename $was, $_)
{
print "$was renamed as $_\n" if $verbose;
}
else
{
warn "Can't rename $was $_: $!\n";
}
}
__END__
=head1 NAME
rename - renames multiple files
=head1 SYNOPSIS
B<rename> S<[ B<-v> ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr> S<[ I<files> ]>
=head1 DESCRIPTION
C<rename>
renames the filenames supplied according to the rule specified as the
first argument.
The I<perlexpr>
argument is a Perl expression which is expected to modify the C<$_>
string in Perl for at least some of the filenames specified.
If a given filename is not modified by the expression, it will not be
renamed.
If no filenames are given on the command line, filenames will be read
via standard input.
For example, to rename all files matching C<*.bak> to strip the extension,
you might say
rename 's/\.bak$//' *.bak
To translate uppercase names to lower, you'd use
rename 'y/A-Z/a-z/' *
=head1 OPTIONS
=over 8
=item B<-v>, B<--verbose>
Verbose: print names of files successfully renamed.
=item B<-n>, B<--no-act>
No Action: show what files would have been renamed.
=item B<-f>, B<--force>
Force: overwrite existing files.
=back
=head1 ENVIRONMENT
No environment variables are used.
=head1 AUTHOR
Larry Wall
=head1 SEE ALSO
mv(1), perl(1)
=head1 DIAGNOSTICS
If you give an invalid Perl expression you'll get a syntax error.
=head1 BUGS
The original C<rename> did not check for the existence of target filenames,
so had to be used with care. I hope I've fixed that (Robin Barker).
=cut

Related

Perl script to search a word inside the directory

I'am looking for a perl script to grep for a string in all files inside a directory .
bash command .
Code:
grep -r 'word' /path/to/dir
This is a fairly canonical task while I couldn't find straight answers with a possibly easiest and simples tool for the job, the handy Path::Tiny
use warnings;
use strict;
use feature 'say';
use Data::Dump; # dd
use Path::Tiny; # path
my $dir = shift // '.';
my $pattern = qr/word/;
my $ret = path($dir)->visit(
sub {
my ($entry, $state) = #_;
return if not -f;
for ($entry->lines) {
if (/$pattern/) {
print "$entry: $_";
push #{$state->{$entry}}, $_;
}
}
},
{ recurse => 1 }
);
dd $ret; # print the returned complex data structure
The way a file is read here, using lines, is just one way to do that. It may not be suitable for extremely large files as it reads all lines at once, where one better read line by line.
The visit method is based on iterator, which accomplishes this task cleanly as well
my $iter = path($dir)->iterator({ recurse => 1 });
my $info;
while (my $e = $iter->()) {
next if not -f $e;
# process the file $e as needed
#/$pattern/ and push #{$info->{$e}}, $_ and print "$e: $_"
# for $e->lines
}
Here we have to provide a data structure to accumulate information but we get more flexibility.
The -f filetest used above, of a "plain" file, is still somewhat permissive; it allows for swap files, for example, which some editors keep during a session (vim for instance). Those will result in all kinds of matches. To stay with purely ASCII or UTF-8 files use -T test.
Otherwise, there are libraries for recursive traversal and searching, for example File::Find (or File::Find::Rule) or Path::Iterator::Rule.
For completeness, here is a take with the core File::Find
use warnings;
use strict;
use feature 'say';
use File::Find;
my #dirs = #ARGV ? #ARGV : '.';
my $pattern = qr/word/;
my %res;
find( sub {
return if not -T; # ASCII or UTF-8 only
open my $fh, '<', $_ or do {
warn "Error opening $File::Find::name: $!";
return;
};
while (<$fh>) {
if (/$pattern/) {
chomp;
push #{$res{$File::Find::name}}, $_
}
}
}, #dirs
);
for my $k (keys %res) {
say "In file $k:";
say "\t$_" for #{$res{$k}};
}

finding a file in directory using perl script

I'm trying to develop a perl script that looks through all of the user's directories for a particular file name without the user having to specify the entire pathname to the file.
For example, let's say the file of interest was data.list. It's located in /home/path/directory/project/userabc/data.list. At the command line, normally the user would have to specify the pathname to the file like in order to access it, like so:
cd /home/path/directory/project/userabc/data.list
Instead, I want the user just to have to enter script.pl ABC in the command line, then the Perl script will automatically run and retrieve the information in the data.list. which in my case, is count the number of lines and upload it using curl. the rest is done, just the part where it can automatically locate the file
Even though very feasible in Perl, this looks more appropriate in Bash:
#!/bin/bash
filename=$(find ~ -name "$1" )
wc -l "$filename"
curl .......
The main issue would of course be if you have multiple files data1, say for example /home/user/dir1/data1 and /home/user/dir2/data1. You will need a way to handle that. And how you handle it would depend on your specific situation.
In Perl that would be much more complicated:
#! /usr/bin/perl -w
eval 'exec /usr/bin/perl -S $0 ${1+"$#"}'
if 0; #$running_under_some_shell
use strict;
# Import the module File::Find, which will do all the real work
use File::Find ();
# Set the variable $File::Find::dont_use_nlink if you're using AFS,
# since AFS cheats.
# for the convenience of &wanted calls, including -eval statements:
# Here, we "import" specific variables from the File::Find module
# The purpose is to be able to just type '$name' instead of the
# complete '$File::Find::name'.
use vars qw/*name *dir *prune/;
*name = *File::Find::name;
*dir = *File::Find::dir;
*prune = *File::Find::prune;
# We declare the sub here; the content of the sub will be created later.
sub wanted;
# This is a simple way to get the first argument. There is no
# checking on validity.
our $filename=$ARGV[0];
# Traverse desired filesystem. /home is the top-directory where we
# start our seach. The sub wanted will be executed for every file
# we find
File::Find::find({wanted => \&wanted}, '/home');
exit;
sub wanted {
# Check if the file is our desired filename
if ( /^$filename\z/) {
# Open the file, read it and count its lines
my $lines=0;
open(my $F,'<',$name) or die "Cannot open $name";
while (<$F>){ $lines++; }
print("$name: $lines\n");
# Your curl command here
}
}
You will need to look at the argument-parsing, for which I simply used $ARGV[0] and I do dont know what your curl looks like.
A more simple (though not recommended) way would be to abuse Perl as a sort of shell:
#!/usr/bin/perl
#
my $fn=`find /home -name '$ARGV[0]'`;
chomp $fn;
my $wc=`wc -l '$fn'`;
print "$wc\n";
system ("your curl command");
Following code snippet demonstrates one of many ways to achieve desired result.
The code takes one parameter, a word to look for in all subdirectories inside file(s) data.list. And prints out a list of found files in a terminal.
The code utilizes subroutine lookup($dir,$filename,$search) which calls itself recursively once it come across a subdirectory.
The search starts from current working directory (in question was not specified a directory as start point).
use strict;
use warnings;
use feature 'say';
my $search = shift || die "Specify what look for";
my $fname = 'data.list';
my $found = lookup('.',$fname,$search);
if( #$found ) {
say for #$found;
} else {
say 'Not found';
}
exit 0;
sub lookup {
my $dir = shift;
my $fname = shift;
my $search = shift;
my $files;
my #items = glob("$dir/*");
for my $item (#items) {
if( -f $item && $item =~ /\b$fname\b/ ) {
my $found;
open my $fh, '<', $item or die $!;
while( my $line = <$fh> ) {
$found = 1 if $line =~ /\b$search\b/;
if( $found ) {
push #{$files}, $item;
last;
}
}
close $fh;
}
if( -d $item ) {
my $ret = lookup($item,$fname,$search);
push #{$files}, $_ for #$ret;
}
}
return $files;
}
Run as script.pl search_word
Output sample
./capacitor/data.list
./examples/data.list
./examples/test/data.list
Reference:
glob,
Perl file test operators

How to use `diff` on files whose paths contain whitespace

I am trying to find the differences between files, but the filename and directory name contain white space. I am trying to execute the command in a Perl script.
diff /home/users/feroz/logs/back_up20161112/Security File/General Security.csv /home/users/feroz/logs/back_up20161113/Security File/General Security.csv
Perl
open( my $FH, '>', $logfile ) or die "Cannot open the file '$logfile' $!";
foreach $filename ( keys %filenames ) {
$old_file = $parent_directory . $previous_date . $search_directory . "$filenames{$filename}";
$new_file = $parent_directory . $current_date . $search_directory . "$filenames{$filename}";
if ( !-e $old_file ) {
#print ("\nFile does not exist in previos date backup");
print $FH "\nERROR:'$old_file' ---- does not exist in the backup directory ";
}
elsif ( !-e $new_file ) {
#print ("\n The file does not exist in current directory");
print $FH "\nERROR:'$new_file' --- does not exist in the present directory ";
}
else {
# print $FH "\nDifference between the files $filenames{$filename} of $previous_date and $current_date ";
my $cmd = 'diff $old_file $new_file| xargs -0';
open( my $OH, '|-', $cmd ) or die "Failed to read the output";
while ( <OH> ) {
print $FH "$_";
}
close $OH;
}
}
To be absolutly safe, use ShellQuote
use String::ShellQuote;
my $old_file2 = shell_quote($old_file);
my $new_file2 = shell_quote($new_file);
`diff $old_file2 $new_file2`;
Thank you for showing your Perl code
Single quotes don't interpolate, so that will pass the strings $old_file and $new_file to the command instead of those variables' contents. The shell will then try to interpret them as shell variables
I suggest that you write this instead
my $cmd = qq{diff '$old_file' '$new_file' | xargs -0};
open( my $OH, '-|', $cmd ) or die "Failed to read the output";
That will use double quotes (qq{...}) around the command string so that the variables are interpolated. The file paths have single quotes around them to indicate that the shell should treat them as individual strings
This won't work if there's a chance that your file paths could contain a single quote, but that's highly unusual
Pass arguments out-of-band to avoid the need to shell-quote them, rather than interpolating them into a string which is parsed by a shell as a script. Substituting filenames as literal text into a script generates exposure to shell injection attacks -- the shell-scripting equivalent to the family of database security bugs known as SQL injection.
Without Any Shell At All
The pipe to xargs -0 appears to be serving no purpose here. Eliminating it allows this to be run without any shell involved at all:
open(my $fh, "-|", "diff", $old_file, $new_file)
With Shell Arguments Passed Out-Of-Band From Script Text
If you really do want the shell to be invoked, the safe thing to do is to keep the script text an audited constant, and have it retrieve arguments from either the argv list passed to the shell or the environment.
# Putting $1 and $2 in double quotes ensures that the shell treats contents as literal
# the "_" is used for $0 in the shell.
$shell_script='diff "$1" "$2" | xargs -0'
open(my $fh, "-|",
"sh", "-c", $shell_script,
"_", $old_file, $new_file);
You can either
Put the whitespace path segment inside quotes
diff /home/users/feroz/logs/back_up20161112/"Security File"/General Security.csv /home/users/feroz/logs/back_up20161113/"Security File"/General Security.csv
or escape the whitespace
diff /home/users/feroz/logs/back_up20161112/Security\ File/General Security.csv /home/users/feroz/logs/back_up20161113/Security\ File/General Security.csv`

How to rename multiple files in terminal (LINUX)?

I have bunch of files with no pattern in their name at all in a directory. all I know is that they are all Jpg files. How do I rename them, so that they will have some sort of sequence in their name.
I know in Windows all you do is select all the files and rename them all to a same name and Windows OS automatically adds sequence numbers to compensate for the same file name.
I want to be able to do that in Linux Fedora but I you can only do that in Terminal. Please, help. I am lost.
What is the command for doing this?
The best way to do this is to run a loop in the terminal going from picture to picture and renaming them with a number that gets bigger by one with every loop.
You can do this with:
n=1
for i in *.jpg; do
p=$(printf "%04d.jpg" ${n})
mv ${i} ${p}
let n=n+1
done
Just enter it into the terminal line by line.
If you want to put a custom name in front of the numbers, you can put it before the percent sign in the third line.
If you want to change the number of digits in the names' number, just replace the '4' in the third line (don't change the '0', though).
I will assume that:
There are no spaces or other weird control characters in the file names
All of the files in a given directory are jpeg files
That in mind, to rename all of the files to 1.jpg, 2.jpg, and so on:
N=1
for a in ./* ; do
mv $a ${N}.jpg
N=$(( $N + 1 ))
done
If there are spaces in the file names:
find . -type f | awk 'BEGIN{N=1}
{print "mv \"" $0 "\" " N ".jpg"
N++}' | sh
Should be able to rename them.
The point being, Linux/UNIX does have a lot of tools which can automate a task like this, but they have a bit of a learning curve to them
Create a script containing:
#!/bin/sh
filePrefix="$1"
sequence=1
for file in $(ls -tr *.jpg) ; do
renamedFile="$filePrefix$sequence.jpg"
echo $renamedFile
currentFile="$(echo $file)"
echo "renaming \"$currentFile\" to $renamedFile"
mv "$currentFile" "$renamedFile"
sequence=$(($sequence+1))
done
exit 0
If you named the script, say, RenameSequentially then you could issue the command:
./RenameSequentially Images-
This would rename all *.jpg files in the directory to Image-1.jpg, Image-2.jpg, etc... in order of oldest to newest... tested in OS X command shell.
I wrote a perl script a long time ago to do pretty much what you want:
#
# reseq.pl renames files to a new named sequence of filesnames
#
# Usage: reseq.pl newname [-n seq] [-p pad] fileglob
#
use strict;
my $newname = $ARGV[0];
my $seqstr = "01";
my $seq = 1;
my $pad = 2;
shift #ARGV;
if ($ARGV[0] eq "-n") {
$seqstr = $ARGV[1];
$seq = int $seqstr;
shift #ARGV;
shift #ARGV;
}
if ($ARGV[0] eq "-p") {
$pad = $ARGV[1];
shift #ARGV;
shift #ARGV;
}
my $filename;
my $suffix;
for (#ARGV) {
$filename = sprintf("${newname}_%0${pad}d", $seq);
if (($suffix) = m/.*\.(.*)/) {
$filename = "$filename.$suffix";
}
print "$_ -> $filename\n";
rename ($_, $filename);
$seq++;
}
You specify a common prefix for the files, a beginning sequence number and a padding factor.
For exmaple:
# reseq.pl abc 1 2 *.jpg
Will rename all matching files to abc_01.jpg, abc_02.jpg, abc_03.jpg...

How to find/cut for only the filename from an output of ls -lrt in Perl

I want the file name from the output of ls -lrt, but I am unable to find a file name. I used the command below, but it doesn't work.
$cmd=' -rw-r--r-- 1 admin u19530 3506 Aug 7 03:34 sla.20120807033424.log';
my $result=`cut -d, -f9 $cmd`;
print "The file name is $result\n";
The result is blank. I need the file name as sla.20120807033424.log
So far, I have tried the below code, and it works for the filename.
Code
#!/usr/bin/perl
my $dir = <dir path>;
opendir (my $DH, $dir) or die "Error opening $dir: $!";
my %files = map { $_ => (stat("$dir/$_"))[9] } grep(! /^\.\.?$/, readdir($DH));
closedir($DH);
my #sorted_files = sort { $files{$b} <=> $files{$a} } (keys %files);
print "the file is $sorted_files[0] \n";
use File::Find::Rule qw( );
use File::stat qw( stat );
use List::Util qw( reduce );
my ($oldest) =
map $_ ? $_->[0] : undef, # 4. Get rid of stat data.
reduce { $a->[1]->mtime < $b->[1]->mtime ? $a : $b } # 3. Find one with oldest mtime.
map [ $_, scalar(stat($_)) ], # 2. stat each file.
File::Find::Rule # 1. Find relevant files.
->maxdepth(1) # Don't recurse.
->file # Just plain files.
->in('.'); # In whatever dir.
File::Find::Rule
File::stat
List::Util
You're making it harder for yourself by using -l. This will do what you want
print((`ls -brt`)[0]);
But it is generally better to avoid shelling out unless Perl can't provide what you need, and this can be done easily
print "$_\n" for (sort { -M $a <=> -M $b } glob "*")[0];
if the name of log file is under your control, ie., free of space or other special characters, perhaps a quick & dirty job will do:
my $cmd=' -rw-r--r-- 1 admin u19530 3506 Aug 7 03:34 sla.20120807033424.log more more';
my #items = split ' ', $cmd;
print "log filename is : #items[8..$#items]";
print "\n";
It's not possible to do it reliably with -lrt - if you were willing to choose other options you could do it.
BTW you can still sort by reverse time with -rt even without the -l.
Also if you must use ls, you should probably use -b.
my $cmd = ' -rw-r--r-- 1 admin u19530 3506 Aug 7 03:34 sla.20120807033424.log';
$cmd =~ / ( \S+) $/x or die "can't find filename in string " ;
my $filename = $1 ;
print $filename ;
Disclaimer - this won't work if filename has spaces and probably under other circumstances. The OP will know the naming conventions of the files concerned. I agree there are more robust ways not using ls -lrt.
Maybe as this:
ls -lrt *.log | perl -lane 'print $F[-1]'

Resources