$dir =~ s/\$\&/\$src/g;
$pattern =~ s/\$\&/\$src/g;
$dir1 = eval( $dir );
$file = eval( $pattern );
Question about the above, $dir is a directory and $pattern is the pattern of a certain filename. What does eval accomplish? seems like it's replacing $& in the string with the variable &src as a string literal but how does eval on a directory path or filename work?
The fact that these strings happen to contain path-like information is irrelevant to what it's doing.
The 1st 2 lines replace '$&' with '$src'.
The 2nd 2 lines (the evals) force a re-interpolation on the strings, replacing '$src' with the contents of $src. (plus, of course, expanding out any other variables that are named in the strings).
Unless your leaving out something important, these could both be done in a single step by removing the backslash from the substitutions' replacement string, like ($dir1 = $dir) =~ s/\$\&/$src/g
Related
I don't use perl a whole bunch. I have a list of image files that I need to be renamed with an incrementing counter.
images folder
image_1_0.jpg
image_1_1.jpg
image_2_0.jpg
image_2_1.jpg
image_3_0.jpg
image_3_1.jpg
image_3_2.jpg
image_4_0.jpg
image_5_0.jpg
image_5_1.jpg
image_5_2.jpg
image_5_3.jpg
image_5_4.jpg
image_5_5.jpg
output would be
1.jpg
2.jpg
3.jpg
4.jpg
5.jpg
6.jpg
7.jpg
8.jpg
9.jpg
10.jpg
11.jpg
12.jpg
13.jpg
14.jpg
15.jpg
What I currently have
my $dir = usr/local/bin/images
my counter = 0;
opendir (IMGDIR, "$dir") or die "Cannot open directory: $!";
my #files = readdir(IMGDIR);
foreach my $oldfile(#files){
(my $oldfileb = $oldfile =~ s/\.[^.]+$//; #get file without extention
my $newfile = $dir/"$counter".jpg;
rename ("$dir/$oldfileb", "dir/$newfile");counter++;
}
Trying to use it more Perl more, but could use some help with this. Error is giving at the counter portion of code
Start the script with
#! /usr/bin/perl
use warnings;
use strict;
See strict and warnings. Perl will protect you from the most common errors.
Strings must be enclosed in quotes and every statement should end with a semicolon if another statement follows it:
my $dir = 'usr/local/bin/images';
Variables must start with a sigil:
my $counter = 0;
Parentheses must be closed:
(my $oldfileb = $oldfile) =~ s/\.[^.]+$//;
Since Perl 5.14, you can also use the more readable /r modifier:
my $oldfileb = $oldfile =~ s/\.[^.]+$//r;
Note that you should skip files that don't look like image names (readdir will return . and .. on *nix, for example). You also might want to sort the files.
/ outside of quotes is division, . is concatenation.
my $newfile = "$dir/$counter.jpg";
You already included $dir in $newfile:
rename "$dir/$oldfileb", $newfile;
Check the return value of rename for errors.
rename "$dir/$oldfileb", $newfile or warn "Can't rename $oldfile: $!";
I am unable to extract the last digits in the filename and rename the file placing the digits at the beginning of the file.
Like suppose my file name is "Gen_TCC_TIF_2110_413010_L3TL_Ae6TL707285_371925.out"
I want to rename the file as "371925_Gen_TCC_TIF_2110_413010_L3TL_Ae6TL707285.out"
my $newFileName ='Gen_TCC_TIF_2110_413010_L3TL_Ae6TL707285_371925.out';
my ($digits) = $newFileName =~ /(\d+)/g;
my $newFileName_2="${digits}_Gen_TCC_TIF_2110_413010_L3TL_Ae6TL707285_371925.out"
try:
$newFileName =~ /(\d+)\.out/;
my $digits = $1;
my $newFileName_2=$digits."_Gen_TCC_TIF_2110_413010_L3TL_Ae6TL707285_371925.out";
(\d+)\.out/ should give you all Digits before .out
Try this:
$newFileName =~ s/(.*?)_(\d+)\.out/$2_$1\.out/;
Or
$newFileName =~ s/(.*?)_(\d+)(\.\w+)/$2_$1$3/;
You can do it with a single regex:
my $newFileName = 'Gen_TCC_TIF_2110_413010_L3TL_Ae6TL707285_371925.out';
my $newFileName_2 = $filename =~ s/(.*)_(\d+)(?=\.out)/$2_$1/r;
# or, for older Perl, use this instead:
(my $newFileName_2 = $filename) =~ s/(.*)_(\d+)(?=\.out)/$2_$1/;
# or, to modify directly the variable $newFileName:
$newFileName =~ s/(.*)_(\d+)(?=\.out)/$2_$1/;
Or if you want to get the digits (because you need them for something else), then you can do:
my ($digits) = $newFileName =~ /_(\d+)\.out/;
You were using /g modifier, which made your regex match all blocks of digits, which isn't what you wanted. (even worst, it was returning an array, but you were only keeping the first element (2110) in the scalar $digit )
I am trying to zip files from a directory. It works well except when the file name has spaces.
Since glob splits its parameter on spaces, I also tried bsd_glob but it did not work.
How do I handle spaces in the file names? I am seeking to retrieve all files.
#Directory of focus
my $log = 'C:/Users/me/Desktop/log';
my #files = bsd_glob( $log.'/*.*' );
#Copy contents to new directory to be zipped
foreach my $file (#files) {
copy($file, $logout) or die
"Failed to copy $file: $!\n";
}
Fail to copy
# Create Child tmp
my $out = 'C:/Users/me/Desktop/out';
mkdir $out;
# Directory of focus
my $log = 'C:/Users/me/Desktop/log';
opendir (DIR, $log) or die $!;
while ( my $file = readdir(DIR) ) {
next if $file =~ /^\./;
#print "$file\n";
copy($file, $out) or die "Failed to copy $file: $!\n";
}
closedir (DIR);
There isn't any conflict in your code, as spaces won't matter in the files that glob finds, only in the pattern that you pass to it as a parameter. I notice that you write in a comment on Matt Jacob's post
I'm sorry, the process works. Thank you! Apparently the file is opened elsewhere
so I imagine that that was the problem all along. But I thought it would be useful if I explained how to get glob to cope with a pattern that contains spaces
Behaviour of glob with spaces
I would write
my #files = glob "$log/*.*"
because I think it is clearer, but the string you're passing to glob is C:/Users/me/Desktop/log/*.* which has no spaces, so glob is fine
If you had a space in the path somewhere then you're right - glob would split at those spaces and treat each part as a separate parameter. Say you had
my #files = glob "C:/Program Files/*"
then you would get the list ('C:/Program') because glob checks whether a file exists only if there is a wildcard in the pattern. So we get back the first part C:/Program which doesn't have a wildcard, but the second part contributes nothing more because there are no files matching Files/*
Solution using quotes
The solution in this case is to wrap patterns that contain spaces in a pair of quotation marks - either single or double. So either of
my #files = glob "'C:/Program Files/*'"
or
my #files = glob '"C:/Program Files/*"'
will work fine. But if you want to interpolate a path like your C:/Users/me/Desktop/out then the outermost quotes must be double quotes. In your case that would look like
my $log = 'C:/Users/me/Desktop/log';
my #files = glob "'$log/*.*'";
but I prefer to use the alternative qq operator like this
my $log = 'C:/Users/me/Desktop/log';
my #files = glob qq{"$log/*.*"};
Solution using bsd_glob
The alternative, as you point out in your question, is to add
use File::Glob 'bsd_glob'
to the top of your code and use the bsd_glob function instead, which treats spaces in the pattern the same as any other character and doesn't split on them.
Or if you have
use File::Glob ':bsd_glob'
(note the additional colon) then the standard glob call will behave the same way as bsd_glob, which allows you to use the angle bracket form of glob like this
my #files = <C:/Program Files/*>
without any problems
Don't use glob. Use readdir instead (or File::Find if you need recursion).
opendir (my $dh, $log) or die $!;
while (my $file = readdir($dh)) {
next if $file =~ /^\./;
copy("$log/$file", $out) or die "Failed to copy $file: $!\n";
}
closedir($dh);
What Perl script should I be using to only change the first 8 characters in a file name to all caps instead of the script changing the entire file name to all caps?
Here is how I am setting it up:
#!/usr/bin/perl
chdir "directory path";
##files = `ls *mw`;
#files = `ls | grep mw`;
chomp #files;
foreach $oldname (#files) {
$newname = $oldname;
$newname =~ s/mw//;
print "$oldname -> $newname\n";
rename("$oldname","$newname");
}
You can use this regex:
my $str = 'Hello World!';
$str =~ s/^(.{8})/uc($1)/se; # $str now contains 'HELLO WOrld!'
The substitution
s/^(.{1,8})/\U$1/
will set the first eight characters of a string to upper case. The complete program looks like this
use strict;
use warnings;
chdir "directory path" or die "Unable to change current directory: $!";
opendir my $dh, '.' or die $!;
my #files = grep -f && /mw/, readdir $dh;
foreach my $file (#files) {
(my $new = $file) =~ s/mw//;
$new =~ s/^(.{1,8})/\U$1/s;
print "$file -> $new\n";
rename $file, $new;
}
How about:
#!/usr/bin/perl
use strict;
use warnings;
use File::Copy;
chdir'/path/to/directory';
# Find all files that contain 'mw'
my #files = glob("*mw*");
foreach my $file(#files) {
# skip directories
next if -d $file;
# remve 'mw' from the filename
(my $FILE = $file) =~ s/mw//;
# Change filename to uppercase even if the length is <= 8 char
$FILE =~ s/^(.{1,8})/uc $1/se;
move($file, $FILE);
}
As said in the doc for rename, you'd better use File::Copy to be platform independent.
Always check return values of system calls!
When you make any call to OS services, you should always check the return value. For example, the Perl documentation for chdir is (with added emphasis)
chdir EXPR
chdir FILEHANDLE
chdir DIRHANDLE
chdir
Changes the working directory to EXPR, if possible. If EXPR is omitted, changes to the directory specified by $ENV{HOME}, if set; if not, changes to the directory specified by $ENV{LOGDIR}. (Under VMS, the variable $ENV{SYS$LOGIN} is also checked, and used if it is set.) If neither is set, chdir does nothing. It returns true on success, false otherwise. See the example under die.
On systems that support fchdir(2), you may pass a filehandle or directory handle as the argument. On systems that don't support fchdir(2), passing handles raises an exception.
As written in your question, your code discards important information: whether system calls chdir and rename succeeded or failed.
Providing useful error messages
An example of a common idiom for checking return values in Perl is
chdir $path or die "$0: chdir $path: $!";
The error message contains three important bits of information:
the program emitting the error, $0
what it was trying to do, chdir in this case
why it failed, $!
Also note that die also the name of the file and line number where program control was if your error message does not end with newline. When the chdir fails, the standard error will resemble
./myprogram: chdir: No such file or directory at ./myprogram line 3.
Logical or is true when at least one of its arguments is true. The “do something or die” idiom works because if chdir above fails, it returns a false value and requires or to evaluate the right-hand side and terminates execution with die. In the happy case where chdir succeeds and returns a true value, there is no need to evaluate the right-hand side because we already have one true argument to logical or.
Suggested improvements to your code
For what you’re doing, I recommend using readdir to avoid problems in case one of the filenames contains whitespace. Note the defined test in the code below that’s there to stop a file named 0 (i.e., a single zero character) terminating your loop.
#! /usr/bin/env perl
chdir "directory path" or die "$0: chdir: $!";
opendir $dh, "." or die "$0: opendir: $!";
while (defined($oldname = readdir $dh)) {
next unless ($newname = $oldname) =~ s/mw//;
$newname =~ s/^(.{1,8})/\U$1/;
rename $oldname, $newname or die "$0: rename $oldname, $newname: $!";
}
For the rename to have any hope, you have to preserve the value of $oldname, so right away, the code above copies it to $newname and starts changing the copy rather than the original. You will see
($new = $old) =~ s/.../.../; # or /.../
in Perl code, so it is also an important idiom to understand.
The perlop documentation defines handy escape sequences for use in strings and regex substitutions:
\l lowercase next character only
\u titlecase (not uppercase!) next character only
\L lowercase all characters till \E seen
\U uppercase all characters till \E seen
\Q quote non-word characters till \E
\E end either case modification or quoted section (whichever was last seen)
The code above grabs the first eight characters (or fewer if $newname is shorter in length) and replaces them with their upcased counterparts.
Example output
See the code in action:
$ ls directory\ path/
defmwghijk mwabc nochange qrstuvwxyzmw
$ ./prog
$ ls directory\ path/
ABC DEFGHIJK QRSTUVWXyz nochange
I figure there's more to your requirements than you're telling us, such as not uppercasing parts of the file extension. Instead of matching the first eight characters, I'll match the first eight letters:
use v5.14;
use utf8;
chdir "/Users/brian/test/";
my #files = glob( 'mw*' );
foreach my $old (#files) {
my $new = $old =~ s/\Amw(\pL{1,8})/\U$1/ir;
print "$old → $new\n";
}
Some other notes:
You can do the glob directly in Perl. You don't need ls.
It looks like you were stripping off mv, so I did that. If that's not what you want, it's easy to change.
In lieu of a regular expression to up-case the first eight characters you could use the 4-argument form of substr. This offers in situ replacement.
my $old = q(abcdefghij);
my $new = $old;
substr( $new, 0, 8, substr( uc($old), 0, 8 ) );
print "$old\n$new\n";
abcdefghij
ABCDEFGHij
Use rename or File::Copy::move (as M42 showed) to perform the actual rename.
I'd like to take a directory and for all email (*.msg) files, remove the 'RE ' at the beginning. I have the following code but the rename fails.
opendir(DIR, 'emails') or die "Cannot open directory";
#files = readdir(DIR);
closedir(DIR);
for (#files){
next if $_ !~ m/^RE .+msg$/;
$old = $_;
s/RE //;
rename($old, $_) or print "Error renaming: $old\n";
}
If your ./emails directory contains these files:
1.msg
2.msg
3.msg
then your #files will look something like ('.', '..', '1.msg', '2.msg', '3.msg') but your rename wants names like 'emails/1.msg', 'emails/2.msg', etc. So you can chdir before renaming:
chdir('emails');
for (#files) {
#...
}
You'd probably want to check the chdir return value too.
Or add the directory names yourself:
rename('emails/' . $old, 'emails/' . $_) or print "Error renaming $old: $!\n";
# or rename("emails/$old", "emails/$_") if you like string interpolation
# or you could use map if you like map
You might want to combine your directory reading and filtering using grep:
my #files = grep { /^RE .+msg$/ } readdir(DIR);
or even this:
opendir(DIR, 'emails') or die "Cannot open directory";
for (grep { /^RE .+msg$/ } readdir(DIR)) {
(my $new = $_) =~ s/^RE //;
rename("emails/$_", "emails/$new") or print "Error renaming $_ to $new: $!\n";
}
closedir(DIR);
You seem to be assuming glob-like behavior rather than than readdir-like behavior.
The underlying readdir system call returns just the filenames within the directory, and will include two entries . and ... This carries through to the readdir function in Perl, just to give a bit more detail on mu's answer.
Alternately, there's not much point to using readdir if you're collecting all the results in an array anyways.
#files = glob('emails/*');
As already mentioned, your script fails because of the path you expect and the script uses are not the same.
I would suggest a more transparent usage. Hardcoding a directory is not a good idea, IMO. As I learned one day when I made a script to alter some original files, with the hardcoded path, and a colleague of mine thought this would be a nice script to borrow to alter his copies. Ooops!
Usage:
perl script.pl "^RE " *.msg
i.e. regex, then a file glob list, where the path is denoted in relation to the script, e.g. *.msg, emails/*.msg or even /home/pat/emails/*.msg /home/foo/*.msg. (multiple globs possible)
Using the absolute paths will leave the user with no doubt as to which files he'll be affecting, and it will also make the script reusable.
Code:
use strict;
use warnings;
use v5.10;
use File::Copy qw(move);
my $rx = shift; # e.g. "^RE "
if ($ENV{OS} =~ /^Windows/) { # Patch for Windows' lack of shell globbing
#ARGV = map glob, #ARGV;
}
for (#ARGV) {
if (/$rx/) {
my $new = s/$rx//r; # Using non-destructive substitution
say "Moving $_ to $new ...";
move($_, $new) or die $!;
}
}
I don't know if the regex fits the specifig name of the files, but in one line this could be done with:
perl -E'for (</path/to/emails*.*>){ ($new = $_) =~ s/(^RE)(.*$)/$2/; say $_." -> ".$new}
(say ... is nice for testing, just replace it with rename $_,$new or rename($_,$new) )
<*.*> read every file in the current directory
($new = $_) =~ saves the following substitution in $new and leaves $_ as intact
(^RE) save this match in $1 (optional) and just match files with "RE" at the beginning
(.*$) save everything until and including the end ($) of the line -> into $2
substitute the match with the string in$2