Why doesn't Perl recognize the file name? - perl

I'm trying to do a match file name with a document with an if condition, but Perl doesn't seems to catch it. I defined my document as:
my $file = $filename
Which $filename is equals to "/Desktop/src/file_top.sv". I'm running a program that reads the $filename and if the file is not named "file_top.sv", then the program doesn't create the other file (name is not relevant). I'm trying to do it with an if condition like this:
if($filename =~ /^file\_top.*\.sv$/){
#do something....
}
But, it doesn't seem to work. Am I doing something wrong? Do you know any other alternatives? Should I use the whole path?

It does not match because ^ means "start of the string", which in your case is the / character before Desktop. Here is an approach to match just the file name without the directory path:
use warnings;
use strict;
use File::Basename qw(basename);
my $filename = "/Desktop/src/file_top.sv";
if (basename($filename) =~ /^file_top.*\.sv$/){
print "do something....\n";
}
else {
print "do something else....\n";
}
This will match filenames like file_top.sv and file_top123.sv, but it will not match abc_file_top.sv.

Related

Checking to see if any .txt files exist in a directory using a Perl script

I have a directory, /home/textfile/.
I want to use a Perl script to check to see if *.txt file exist in this directory or not. If they do, I want to have it say "Text files exist". Otherwise, if there are no text files in the directory I want it to say "No text files exist".
The text files could have any name. I just want to check if there is a text file in that directory, /home/textfile.
Below is the script I am trying to use:
$filedir = "/home/textfile/";
chdir($filedir);
if (-e "`ls *.txt`")
{
print STDOUT "Text file exist"
}
else
{
print STDOUT "No text file exist"
}
How can I fix this script so it will do what I am looking for it to do?
It's simplest to use glob to get a list of all files ending with .txt in that directory. It avoids shelling out to use ls
Like this
use strict;
use warnings;
my $dir = '/home/textfile';
my #files = glob "$dir/*.txt";
print "No " unless #files;
print "Text file exist\n";
From perldoc about the -X file test operators:
A file test, where X is one of the letters listed below. This unary
operator takes one argument, either a filename, a filehandle, or a
dirhandle, and tests the associated file to see if something is true
about it.
In wrapping the ls command in double quotes, you are hoping to test the filenames that are returned by ls, but in reality you are testing for the existence of a file named 'ls *.txt'.
There are a couple of options. You could use ls in a separate step to get all of the text file names and then test for the existence of a single one.
my #text_files = `ls *.txt`;
chomp(#text_files);
if ( -e $text_files[0] ) {
...
}
else {
...
}
But since ls will only return existing files, the -e check here is not needed at all. You can simply say:
my #text_files = `ls *.txt`;
if ( #text_files ) {
print "Text file exist"
}
else {
print "No Text file exist"
}
I should also note that, since you don't use $dir in your ls command, you are not actually looking in the $dir directory but the current working directory. You would need to add $dir to the ls command:
my #text_files = `ls $dir/*.txt`;
if ( #text_files ) {
print "Text file exist"
}
else {
print "No Text file exist"
}
Alternatively, you can use the glob builtin instead of shelling out to ls and let Perl manage how to actually read the files. This is generally the more robust and maintainable solution:
my #text_files = glob("$dir/*.txt");
if ( #text_files ) {
print "Text file exist"
}
else {
print "No Text file exist"
}

Archive::Zip membersMatching can't locate method in Perl?

I have a script that uses Archive::Zip, and I want to use the method membersMatching, but I can't figure out what I'm missing.
I called the module at the beginning of the script:
use Archive::Zip qw( :ERROR_CODES :CONSTANTS :MISC_CONSTANTS );
and this is the block of code where the module is used:
while (my $file = readdir(TRIMMED_CELL_DIR)) {
#Only if file ends in _1.fastqc.zip (only 1 instance per "trimmed" subdirectory.)
if($file =~ /.*\_1\_fastqc\.zip/){
#Extract the file summary.txt and assign it to filehandle SUMMARY_R1.
$file = "${trimmedDirectory}/${file}";
print "Loading ZIP file: $file. \n";
my $zip = Archive::Zip->new($file);
my #txtFileMembers = $zip->membersMatching( '.*\.txt' );
foreach my $txtFile (#txtFileMembers){
extractMember($txtFile);
open(SUMMARY_R1,"< $txtFile");
}
}
I keep getting the error Can't locate object method "membersMatching". ... and I know it has something to do with this membersMatching method not being exported, but I don't know how to call it in the script. Te CPAN page for Archive::Zip doesn't say anything except to use it like so:
membersMatching( $regex )
membersMatching( { regex => $regex } )
Return array of members whose filenames match given regular expression in list context. Returns number of matching members in
scalar context.
my #textFileMembers = $zip->membersMatching( '.*\.txt' );
# or
my $numberOfTextFiles = $zip->membersMatching( '.*\.txt' );
The ZIP file loading with the Archive::Zip->new($file) function works, so the module is being exported, just not the method memebersMatching...
Check the path of your zip file ($file). I think it's failing there. Update your code to the below:
my $zip = Archive::Zip->new();
unless ( $zip->read( 'someZip.zip' ) == AZ_OK ) {
die 'read error';
}
print "zip contains the following files:\n";
print "$_\n" for $zip->memberNames();

Trouble storing files with Archive::Zip: I get empty zip files without error code

When I try to create zip archives via Archive::Zip there are no errors thrown, but the resulting zip file is broken.
use Archive::Zip;
my $zip = Archive::Zip->new();
my $file = "/a/very/long/path/with/191/characters/file.txt";
if(-f $file)
{
$zip->addFile("$file", "destinationname.txt");
print "$file added\n";
}
unless ($zip->writeToFileNamed("out.zip") == "AZ_OK") { die "error";};
Now my out.zip file is just 22B and is empty:
$> > unzip -l out.zip
Archive: out.zip
warning [out.zip]: zipfile is empty
What goes wrong?
First Update: Everything works fine when I use files with a shorter path name. Any idea for a workaround? Symlinking does not work.
Second update: This works as a workaround:
use File::Slurp;
[...]
my $text = read_file($file);
$zip->addString($text, "destinationfile.txt");
[..]
Change it to: $zip->addFile($plmxmlFile);.
$zip is already reference to your target file and by adding name of file you'd use for output, you're making Archive::Zip try read and write from same file on assembling attempt, creating a mess (and just generally doing not what your really wanted).
I cannot see why your program creates an empty zip file, but you are misusing quotation marks in several places.
In particular the value AZ_OK is a symbol for a numeric value that you can import by request.
The writeToFileNamed method will never return the string "AZ_OK" and also you should compare strings using eq instead of ==.
Fortunately (or not, depending on your point of view) these two errors together with your failure to import the value of AZ_OK and your omission of use warnings will compare the return value of writeToFileNamed with zero (the proper value of AZ_OK) and should give you the correct results.
Try this program instead.
use strict;
use warnings;
use Archive::Zip qw( :ERROR_CODES );
my $zip = Archive::Zip->new;
my $file = 'a/very/long/path/with/191/characters/file.txt';
if (-f $file) {
$zip->addFile($file, 'destinationname.txt');
print "$file added\n";
}
my $status = $zip->writeToFileNamed('out.zip');
$status == AZ_OK or die "error $status";
Update
The length of the path is unlikely to make any difference unless it is hundreds of characters long.
Try this version and tell us what you get.
use strict;
use warnings;
use Archive::Zip qw( :ERROR_CODES );
my $zip = Archive::Zip->new;
my $file = 'a/very/long/path/with/191/characters/file.txt';
unlink 'out.zip';
die qq(File "$file" not found) unless -f $file;
$zip->addFile($file, 'destinationname.txt');
print "$file added\n";
my $status = $zip->writeToFileNamed('out.zip');
$status == AZ_OK or die "error $status";
maybe i have understood what is the problem :
you use the full root a/very/long/path/with/191/characters/file.txt
so you compress all directories in you zip, your file is empty because your are note able to see the path.
use chdir
chdir 'a/very/long/path/with/191/characters/'

Perl: How to detect which file exists among foo.(txt|abc)

My perl script needs to detect the extension of an existing file and print out the filename. The input that specifies the filename with a vague extension would be in this format:
foo.(txt|abc)
and the script would print "foo.txt" if it exists. If foo.txt does not exist and foo.abc exists, then it would print "foo.abc."
How can I do this detection and printing of the correct existing file in a neat and clean way?
Thanks!
Actually, you've almost got the regular expression right there: the only thing you need to do is escape the . with a backslash (since . means "any character except the newline character" in regular expressions), and it would also help to put a ?: inside of the parentheses (since you don't need to capture the file extension). Also, ^ and $ denote markers for the beginning and the end of the string (so we're matching the entire string, not just part of a string...that way we don't get a match for the file name "thisisnotfoo.txt")
Something like this should work:
use strict;
use warnings;
my $file1="foo.txt";
my $file2="foo.abc";
my $file3="some_other_file";
foreach ($file1,$file2,$file3)
{
if(/^foo\.(?:txt|abc)$/)
{
print "$_\n";
}
}
When the above code is run, the output is:
foo.txt
foo.abc
Take a look at perldoc perlretut for more stuff about regular expressions.
You may want to look at glob, but you'd have to use a different syntax. The equivalent would be:
foo.{txt,abc}
See File::Glob for more information. Also note that this will return a list of all of the matches, so you'll have to do your own rules if it should prefer one when multiple exist.
sub text_to_glob {
my ($s) = #_;
$s =~ s/([\\\[\]{}*?~\s])/\\$1/g;
return $s;
}
my $pat = 'foo.(txt|abc)';
my #possibilities;
if (my ($base, $alt) = $pat =~ /^(.*\.)\(([^()]*)\)\z/s) {
#possibilities = glob(
text_to_glob($base) .
'{' . join(',', split(/\|/, $alt)) . '}'
);
} else {
#possibilities = $pat;
}
for my $possibility (#possibilities) {
say "$possibility: ", -e $possibility ? "exists" : "doesn't exist";
}
glob, but also see File::Glob
-e
use strict;
use warnings;
FILE:
for (glob "file.{txt,abc}") {
if (-f $_) {
print $_, "\n";
last FILE;
}
}

Cleaning up a directory name (Removing ".." and "." from directory name)

I am writing an SFTP module using a Java class (Yes. I know it's stupid. Yes, I know about Net::SFTP. It's political why we have to do it this way).
The underlying Java program has basically a few classes to get, put, list, and remove the file from the server. In these calls, you have to give it a directory and file. There is no way to move outside of your original directory. You're stuck doing the tracking yourself.
I decided it would be nice if I kept track of your remote directory, and created a Chdir Method that tracks the directory you're in from the root of the FTP. All I do is store the directory inside an attribute and use it in the other commands. Very simple and it works.
The problem is that the stored directory name gets longer and longer. For example, if the directory is foo/bar/barfoo, and you do $ftp->Chdir("../.."), your new directory would be foo/bar/barfoo/../.. and not foo. Both are technically correct, but the first is cleaner and easier to understand.
I would like some code that will allow me to simplify the directory name. I thought about using File::Spec::canonpath, but that specifically says it does not do this. It refered me to Cwd, but that depends upon direct access to the machine, and I'm connecting via FTP.
I've come up with the following code snippet, but it really lacks elegance. It should be simpler to do, and more obvious what it is doing:
use strict;
use warnings;
my $directory = "../foo/./bar/./bar/../foo/barbar/foo/barfoo/../../fubar/barfoo/..";
print "Directory = $directory\n";
$directory =~ s{(^|[^.])\.\/}{$1}g;
print "Directory = $directory\n";
while ($directory =~ s{[^/]+/\.\.(/|$)}{}) {
print "Directory = $directory\n";
}
$directory =~ s{/$}{};
print "Directory = $directory\n";
Any idea? I'd like to avoid having to install CPAN modules. They can be extremely difficult to install on our server.
If I were writing this, I would split the directory string on / and iterate over each piece. Maintaining a stack of pieces, a .. entry means "pop", . means do nothing, and anything else means push that string onto the stack. When you are done, just join the stack with / as the delimiter.
my #parts = ();
foreach my $part (File::Spec->splitdir($directory)) {
if ($part eq '..') {
# Note that if there are no directory parts, this will effectively
# swallow any excess ".." components.
pop(#parts);
} elsif ($part ne '.') {
push(#parts, $part);
}
}
my $simplifiedDirectory = (#parts == 0) ? '.' : File::Spec->catdir(#parts);
If you want to keep leading .. entries, you will have to do something like this instead:
my #parts = ();
my #leadingdots = ();
foreach my $part (File::Spec->splitdir($directory)) {
if ($part eq '..') {
if (#parts == 0) {
push(#leadingdots, '..');
} else {
pop(#parts);
}
} elsif ($part ne '.') {
push(#parts, $part);
}
}
my $simplifiedDirectory = File::Spec->catdir((#leadingdots, #parts));
I have a pure Perl module on CPAN for trimming paths: Path::Trim. Download, copy and use it from your working directory. Should be easy.
I am not sure if you can access that directory.
If you can, you can go to that directory and do a getcwd there:
my $temp = getcwd; # save the current directory
system ("cd $directory"); # change to $directory
$directory = getcwd;
system ("cd $temp"); # switch back to the original directory
The SFTP protocol supports the realpath command that does just what you want.