How can I separate a full path into directory and filename? - perl

$a = '/etc/init/tree/errrocodr/a.txt'
I want to extract /etc/init/tree/errrocodr/ to $dir and a.txt to $file. How can I do that?
(Editor's note: the original question presumed that you needed a regular expression for that.)

Just use Basename:
use File::Basename;
$fullspec = "/etc/init/tree/errrocodr/a.txt";
my($file, $dir, $ext) = fileparse($fullspec);
print "Directory: " . $dir . "\n";
print "File: " . $file . "\n";
print "Suffix: " . $ext . "\n\n";
my($file, $dir, $ext) = fileparse($fullspec, qr/\.[^.]*/);
print "Directory: " . $dir . "\n";
print "File: " . $file . "\n";
print "Suffix: " . $ext . "\n";
You can see this returning the results you requested but it's also capable of capturing the extensions as well (in the latter section above):
Directory: /etc/init/tree/errrocodr/
File: a.txt
Suffix:
Directory: /etc/init/tree/errrocodr/
File: a
Suffix: .txt

you don't need a regex for this, you can use dirname():
use File::Basename;
my $dir = dirname($a)
however this regex will work:
my $dir = $a
$dir =~ s/(.*)\/.*$/$1/

I think a regex solution is a perfectly legitimate need - since my googling for exactly that brought me here. I want to pull out a filename in a group that's part of a larger match expression - here's my attempt:
~> echo "/a/b/c/d" | perl -ne '/(?<dir>\/(\w+\/)*)(?<file>\w+)/ && print "dir $+{dir} file $+{file}\n";'
dir /a/b/c/ file d

Use #array = split("/", $a);
and then $array[-1] is your file name.

For example:
$a =~ m#^(.*?)([^/]*)$#;
($dir,$file) = ($1,$2);
But, as other said, it's better to just use Basename for this.
And, BTW, better avoid $a and $b as variable names, as they have a special meaning, for sort function.

try this; it works at least for the filename, but when you modify it, it also gives you the direction:
You can also modify it on UNIX-systems for the \ instead if / or to use them both with |
$filename =~ s/(^.*/)//g;
somehow the backslash before the 2nd / is not displayed...

Maybe this will work:
#^(.+/)/([^/]+)$#

Related

Perl FTP "GLOB" causes blank entries?

I have a perl script that is attempting to FTP files and it seems to be failing every other file.
I determined that for some reason the
$filename = glob $filename
is setting $filename to empty rather than the full filename.
I printed out the filename just before the glob line and it is correct and has no spaces in it.
I also tried just commenting out the glob line but then it returns "Not a GLOB reference" so apparently net ftp requires that.
Any idea what might cause glob to return empty? (and why it works on the first file and every 2nd file after that)
This is what I'm sending to the sub:
ftpToDevice($ftp,$device_dir,$config,$config,'put');
Here is the actual sub:
sub ftpToDevice {
my ($ftp,$fileDir,$fileName,$fileNameDest,$action) = #_;
print "ftp filename $fileName\n";
$fileName =~ s/\s+//g;
$fileNameDest =~ s/\s+//g;
$fileName = glob($fileName);
my $path = "cf3:\\";
chdir $fileDir if $action eq 'put';
print "file location: $fileDir/$fileName to $fileNameDest\n";
if($ftp->cwd("$path")){
if($action eq 'put'){
print "attempting FTP PUT $fileName $fileNameDest\n";
$ftp->put($fileName,$fileNameDest) or return "Error cannot put - " . $ftp->message;
#$ftp->rename($fileName,$fileNameDest) or return "Error cannot put - " . $ftp->message;
} else {
print "Attempting to delete $path $fileNameDest\n";
#$ftp->delete("$fileName") or return "Error cannot delete $fileName - " . $ftp->message;
$ftp->delete($fileNameDest) or return "Error cannot delete $fileName - " . $ftp->message;
print $ftp->message . "\n";
}
}
chdir $masterDir if $action eq 'put';
return 'success';
}
I found a solution but am not sure why it worked.
I commented out the line:
$fileName = glob($fileName);
I added this instead:
$fileName = "" . $fileName; #this converts it to a string I believe
This allowed all files to work (not just every second one) and did not give the GLOB error.
My theory is that somehow the list of files that is generated before the for each loop that uses the ftp sub is causing every second file to be a glob object (array or something?) rather than a plain text filename.

How to assemble a file full path when both the dir path and the file name are variables?

I have a perl script that get's 2 dir names, and go through all the files in the first dir, and find them at the second dir (and do some proccesing there).
the following:
opendir( SourceDir, $first_dir);
my #files = readdir(SourceDir);
foreach my $file (#files){
my $orig_file = $second_dir"/"$file;
print $orig_file . "\n";
}
`
but
my $orig_file = $second_dir"/"$file;
does not work,
how can I assem ble a full path presentation of my file in the second dir?
thanks
Shahar
You either need to do string interpolation or concatenation.
my $orig_file = "$second_dir/$file"; # Interpolated variables
my $orig_file = $second_dir . "/" . $file; # Concatenated variables
Note, be sure to include use strict; and use warnings in EVERY script. Additionally, be sure to include use autodie; anytime you're doing file or directory processing.
The following is a clean up of your script:
use strict;
use warnings;
use autodie;
my $first_dir = '....';
my $second_dir = '....';
open my $dh, $first_dir;
while (my $file = <$dh>) {
my $orig_file = "$second_dir/$file";
print $orig_file . "\n";
}
my $orig_file = $second_dir"/"$file; #<-- wrong
you should write:
my $orig_file = $second_dir . "/" . $file;
or this:
my $orig_file = "$second_dir/$file";

perl overload file name download

I need to be able to propose files to be downloaded but i have to read and print the file in my CGI. I tried to go for :
#!/usr/bin/perl -w
use strict;
push( #INC, $lib_directory );
require 'lib_utils.pl';
dl_file('/tmp/final.pdf');
as main page (dl.pl) and
sub dl_file {
my ($file) = #_;
if ( ! -e $file) {
print "file does not exist";
return 0;
}
my $content = read_file( $file, binmode => ':utf8' ) ;
$file =~ m#(.*)([^/]*)$#;
my $directory = $1;
my $filename = $2;
chdir $directory;
my $form = new CGI;
print $form->header(
-type => 'application/octet-stream',
-attachment => $filename,
-filename => $filename,
-Content-Disposition => "attachment; filename=$filename",
);
$form->print($content);
return 1;
}
for the called function. Funny thing is, this code workes just fine if i dont go for a sub and have all the code in dl.pl BUT as soon as i move the code in a sub, the downloaded file is called after the script (ie dl.pl)
How would you change it or how would you do ?
Thanks in advance for your help
Your line
$file =~ m#(.*)([^/]*)$#
will leave $1 containing the whole of $file and $2 empty. You need a slash in there somewhere, probably like this
$file =~ m#(.*)/([^/]*)$#
It would also make sense to make the directory optional, like so
$file =~ m#(?:(.*)/)?([^/]*)$#
my $directory = $1;
and you would have to write
chdir $directory if $directory
This is what's tripping you up:
$file =~ m#(.*)([^/]*)$#;
Looks like you're trying to split "/tmp/final.pdf" into directory and file. But you don't - that pattern splits you into:
print "F:",$filename,"\n";
print "D:",$directory,"\n";
this output:
F:
D:/tmp/final.pdf
This is why you have the problem - you don't have a filename, so it defaults to using the script name.
I would suggest instead you want:
my ( $directory, $filename ) = ( $file =~ m,(.*/)([\.\w]+)$, );
This gives:
F:final.pdf
D:/tmp/
As has been said, you're suffering from the greedy matching of .* which will eat up the entire string:
$file =~ m{(.*)([^/]*)$};
There are three easy solutions to this
1. Boundary Conditions
As has been stated, you can add a boundary condition that limits how much .* can match:
$file =~ m{(?:(.*)/)?([^/]*)$};
my $dir = $1 // '';
my $filename = $2;
Or this somewhat convoluted lookbehind assertion can also enforce a boundary:
$file =~ m{(.*)(?<![^/])([^/]*)$};
my $dir = $1;
my $filename = $2;
2. Non-greedy matching
However, the simplest regex solution is to use non-greedy matching .*?:
$file =~ m{(.*?)([^/]*)$};
my ($dir, $filename) = ($1, $2);
Basically, anytime you're about to put .* anywhere, check your assumptions. The majority of the time you'll actually want .*? instead.
3. Module for parsing file paths
The bonus option is just to use a module like File::Spec parsing file path information
use File::Spec;
my ($vol, $dirs, $filename) = File::Spec->splitpath( $file );

Using Perl to rename files in a directory

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

Rename a file with perl

I have a file in a different folder I want to rename in perl, I was looking at a solution earlier that showed something like this:
#rename
for (<C:\\backup\\backup.rar>) {
my $file = $_;
my $new = $file . 'backup' . $ts . '.rar';
rename $file, $new or die "Error, can not rename $file as $new: $!";
}
however backup.rar is in a different folder, I did try putting "C:\backup\backup.rar" in the <> above, however I got the same error.
C:\Program Files\WinRAR>perl backup.pl
String found where operator expected at backup.pl line 35, near "$_ 'backup'"
(Missing operator before 'backup'?)
syntax error at backup.pl line 35, near "$_ 'backup'"
Execution of backup.pl aborted due to compilation errors.
I was using
# Get time
my #test = POSIX::strftime("%m-%d-%Y--%H-%M-%S\n", localtime);
print #test;
To get the current time, however I couldn't seem to get it to rename correctly.
What can I do to fix this? Please note I am doing this on a windows box.
Pay attention to the actual error message. Look at the line:
my $new = $_ 'backup'. #test .'.rar';
If you want to interpolate the contents of $_ and the array #test into a string like that, you need to use:
my $new = "${_}backup#test.rar";
but I have a hard time making sense of that.
Now, strftime returns a scalar. Why not use:
my $ts = POSIX::strftime("%m-%d-%Y--%H-%M-%S", localtime);
my $new = sprintf '%s%s%s.rar', $_, backup => $ts;
Incidentally, you might end up making your life much simpler if you put the time stamp first and formatted it as YYYYMMDD-HHMMSS so that there is no confusion about to which date 04-05-2010 refers.
The line
my $new = $_ 'backup'. #test .'.rar';
probably should read
my $new = $file . 'backup' . #test . '.rar';
(You were missing a concatenation operator, and it is clearer to use the named variable from the line before than reusing $_ there...)
I think you missed the string concat symbol . (the period) :
my $new = $_ 'backup'. #test .'.rar';
should be
my $new = $_ . 'backup' . #test . '.rar';
A slight side issue but you don't need
for (<C:\\backup\\backup.rar>) {
my $file = $_;
.....
}
The < > construct would be useful if you were expanding a wildcard but you are not.
Be thoughtful of future readers of this code (you in a year!) and write
my $file = 'C:\backup\backup.rar' ;
Note the single quotes which doen't expand backslashes.