How can I check the extension of a file using Perl? - perl

To my perl script, a file is passed as an arguement. The file can be a .txt file or a .zip file containing the .txt file.
I want to write code that looks something like this
if ($file is a zip) {
unzip $file
$file =~ s/zip$/txt/;
}
One way to check the extension is to do a split on . and then match the last result in the array (returned by split).
Is there some better way?

You can use File::Basename for this.
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
use File::Basename;
my #exts = qw(.txt .zip);
while (my $file = <DATA>) {
chomp $file;
my ($name, $dir, $ext) = fileparse($file, #exts);
given ($ext) {
when ('.txt') {
say "$file is a text file";
}
when ('.zip') {
say "$file is a zip file";
}
default {
say "$file is an unknown file type";
}
}
}
__DATA__
file.txt
file.zip
file.pl
Running this gives:
$ ./files
file.txt is a text file
file.zip is a zip file
file.pl is an unknown file type

Another solution is to make use of File::Type which determines the type of binary file.
use strict;
use warnings;
use File::Type;
my $file = '/path/to/file.ext';
my $ft = File::Type->new();
my $file_type = $ft->mime_type($file);
if ( $file_type eq 'application/octet-stream' ) {
# possibly a text file
}
elsif ( $file_type eq 'application/zip' ) {
# file is a zip archive
}
This way, you do not have to deal with missing/wrong extensions.

How about checking the end of the filename?
if ($file =~ /\.zip$/i) {
and then:
use strict;
use Archive::Extract;
if ($file =~ /\.zip$/i) {
my $ae = Archive::Extract->new(archive => $file);
my $ok = $ae->extract();
my $files = $ae->files();
}
more information here.

You can check the file extension using a regex match as:
if($file =~ /\.zip$/i) {
# $file is a zip file
}

I know this question is several years old, but for anyone that comes here in the future, an easy way to break apart a file path into its constituent path, filename, basename and extension is as follows.
use File::Basename;
my $filepath = '/foo/bar.txt';
my ($basename, $parentdir, $extension) = fileparse($filepath, qr/\.[^.]*$/);
my $filename = $basename . $extension;
You can test it's results with the following.
my #test_paths = (
'/foo/bar/fish.wibble',
'/foo/bar/fish.',
'/foo/bar/fish.asdf.d',
'/foo/bar/fish.wibble.',
'/fish.wibble',
'fish.wibble',
);
foreach my $this_path (#test_paths) {
print "Current path: $this_path\n";
my ($this_basename, $parentdir, $extension) = fileparse($this_path, qr/\.[^.]*$/);
my $this_filename = $this_basename . $extension;
foreach my $var (qw/$parentdir $this_filename $this_basename $extension/) {
print "$var = '" . eval($var) . "'\n";
}
print "\n\n";
}
Hope this helps.

Why rely on file extension? Just try to unzip and use appropriate exception handling:
eval {
# try to unzip the file
};
if ($#) {
# not a zip file
}

Maybe a little bit late but it could be used as an alternative reference:
sub unzip_all {
my $director = shift;
opendir my $DIRH, "$director" or die;
my #files = readdir $DIRH;
foreach my $file (#files){
my $type = `file $director/$file`;
if ($type =~ m/gzip compressed data/){
system "gunzip $director/$file";
}
}
close $DIRH;
return;
}
Here is possible to use linux file executing it from perl by the use of backticks(``). You area able to pass the path of your folder and evaluate if exists a file that is classified by file as gzip compressed.

If you do not mind using a perl module, you can use Module::Generic::File, such as:
use Module::Generic::File qw( file );
my $f = file( '/some/where/file.zip' );
if( $f->extension eq 'zip' )
{
# do something
}
Module::Generic::File has a lot of features to handle and manipulate a file.

Related

Find file that does not contain specific string

I want to find file that does not contain the specific string?
The listed file is like below
../../../experiment/fileA.txt (contain word 'Book')
../../../experiment/fileB.txt (contain word 'Book')
../../../experiment/fileC.txt (do not contain word 'Book')
../../../experiment/fileD.txt (contain word 'Book')
Here is my code
use strict;
use warning;
my $dirname = "../../../experiment/";
my $keyword = "Book";
my #result;
my $find_file = sub {
my $F = $File::Find::name;
if ($F =~ /txt$/) {
open my $in, "<", $F or die $!;
while(<$in>) {
if (/\Q$keyword\E/){
next;
}else{
push #result, $F;
return;
}
}
}
};
find ({ wanted => $find_file, no_chdir=>1}, $dirname );
foreach my $result (#result){
chomp $result;
$result =~ s{.*/}{};
print "$result\n";
}
But it seem does not work. It display all file whether it has the $keyword or not. I only want it to display only if the file does not have the $keyword
There's a simple logic error. The code goes through lines of each file
while (<$in>) {
if (/\Q$keyword\E/){
next;
} else {
push #result, $F;
return;
}
}
and as soon as any one line doesn't have $keyword it adds the file to #result.
You need to check all lines and if $keyword is never found only then add a file. The easiest way to do this is to return from the sub as soon as the thing is found
while (<$in>) {
return if /\Q$keyword/;
}
push #result, $F;
This doesn't address your code, but I'd like to point out that with the grep command on any Linux system you can do exactly what it looks like you're trying to do with this command:
grep -L Book -R ../../../experiment/
Path::Iterator::Rule makes tasks like this really simple. As a side note, I would recommend resolving the directory to an absolute path before iterating.
use strict;
use warnings;
use Cwd 'abs_path';
use File::Basename;
use Path::Iterator::Rule;
my $dirname = abs_path "../../../experiment/";
my $keyword = "Book";
my $rule = Path::Iterator::Rule->new->not_dir->name(qr/txt$/)->not_line_match(qr/\Q$keyword\E/);
my $next = $rule->iter($dirname);
while (defined(my $file = $next->())) {
print basename($file), "\n";
}

Zipping file in perl

I have been trying to zip files on remote windows server but not getting success by whatever i tried. Below is the small peice of code. Please tell me where m going wrong. This code is not producing any error but just not generating the zip file.
use strict;
use warnings;
# before running check perl module is installed in your PC.
use Archive::Zip;
use File::Basename 'basename';
my #files = ('D:\Scripts\Testing\abc.txt');
# if it is more than one file add it by using comma as separator
my $zip = Archive::Zip->new;
foreach my $file (#files) {
my $member = basename $file;
printf qq{Adding file "%s" as archive member "%s"\n}, $file, $member;
$zip->addFile( $file, $member );
printf "Member added\n";
}
printf "Writing to zip\n";
$zip->writeToFileNamed('zippedFolders.zip');
#zip file name change it as u want
Could you please:
use Cwd;
use strict;
use warnings;
# before running check perl module is installed in your PC.
use Archive::Zip;
use File::Basename;
my (#files,$dirname,$bsename) = "";
my $inFile = "D:\\Scripts\\Testing\\abc.txt"; # if it is more than one file add it by using comma as separator
my $curdir = getcwd();
#Need to open file here and to be read the file
open(IN, $inFile) || die "Cant \n";
while(<IN>) {
my $sngfile = $_;
chomp($sngfile);
push(#files, $sngfile);
}
my $zip = Archive::Zip->new();
foreach my $file (#files)
{
$dirname = dirname($file);
$bsename = basename($file);
#Check file exist here your code
if($dirname!~m/\.$/) {
print "$dirname\t$bsename\n";
#printf qq{Adding file "%s" as archive member "%s"\n}, $dirname, $bsename;
$zip->addFile("$dirname/$bsename"); }
}
printf "$curdir\\Writing to zip\n";
$zip->writeToFileNamed("$curdir/zippedFolders.zip"); #zip file name change it as u want

How to check if a file is within a directory

I have a text file with a list of individual mnemonics (1000+) in it and a directory that also has page files in it. I want to see how many pages a given mnemonic is on.
below is my code so far..
use strict;
use warnings;
use File::Find ();
my $mnemonics = "path\\path\\mnemonics.txt";
my $pages = "path\\path\\pages\\";
open (INPUT_FILE, $names) or die "Cannot open file $mnemonics\n";
my #mnemonic_list = <INPUT_FILE>;
close (INPUT_FILE);
opendir (DH, $pages);
my #pages_dir = readdir DH;
foreach my $mnemonic (#mnemonic_list) {
foreach my $page (#pages_dir) {
if (-e $mnemonic) {
print "$mnemonic is in the following page: $page";
} else {
print "File does not exist \n";
}
}
}
Basically, where I know that a name exists in a page, it isn't showing me the correct output. I'm getting a lot of "File does not exists" when I know it does.
Also, instead of (-e) I tried using:
if ($name =~ $page)
and that didn't work either..
Please help!
Assuming that you want to search a directory full of text files and print the names of files that contain words from the words in mnemonics.txt, try this:
use strict; use warnings;
my $mnemonics = "path/mnemonics.txt";
my $pages = "path/pages/";
open (INPUT_FILE, $mnemonics) or die "Cannot open file $mnemonics\n";
chomp(my #mnemonic_list = <INPUT_FILE>);
close (INPUT_FILE);
local($/, *FILE); # set "slurp" mode
for my $filename (<$pages*>) {
next if -d "$filename"; # ignore subdirectories
open FILE, "$filename";
binmode(FILE);
$filename =~ s/.+\///; # remove path from filename for output
my $contents = <FILE>; # "slurp" file contents
for my $mnemonic (#mnemonic_list) {
if ($contents =~ /$mnemonic/i) {
print "'$mnemonic' found in file $filename\n";
}
}
close FILE;
}

Using File::Temp module with System command in Perl

following is my Perl code:
use strict;
use File::Find;
use MIME::Base64;
use File::Temp qw(tempfile);
sub loadFiles(); #udf
sub mySub(); #udf
my #files = ();
my $dir = shift || die "Argument missing: directory name\n";
my $finalLoc;
my $filePath;
my $fileContents;
my $base64EncFile;
my $domain = "WTX";
my $devFilePath;
my $deviceDir;
my $position;
my $user = "admin";
my $encPwd = "YzNKcGNtRnRZVEF4";
my $decPwd;
my $response;
my $temp;
my $tempFilename;
loadFiles(); #call
foreach (#files) {
#take the file path into a variable
$filePath = $_;
#replace the '/' with '\' in the file path
$filePath =~ s/\//\\/g;
#take the file path into a variable
$devFilePath = $_;
#replace the '\' with '/' in the file path
$devFilePath =~ s/\\/\//g;
#perform string operation to derive a target file path
$position = index( $devFilePath, "RPDM" );
$deviceDir = "local:///" . substr( $devFilePath, $position );
#open handle on file to read the contents
open( FILE, "< $filePath" );
#read the entire file into a variable, 'fileContents'
$fileContents = do { local $/; <FILE> };
#base64 encode the file contents
$base64EncFile = encode_base64($fileContents);
#replace the <CR><LF> characters in the file and flatten the base64 string
$base64EncFile =~ s/[\x0A\x0D]//g;
#printing file path
print "FilePath=$filePath\n";
#creating a temp file with 9 random characters at the end, example 'tempUKv1vqBTp'
$temp = File::Temp->new(
TEMPLATE => "tempXXXXXXXXX",
UNLINK => 0
) or die "Could not make tempfile: $!";
$tempFilename = $temp->filename;
#Printing temp file name
print "TempFileName=$tempFilename\n";
#open the temp file for writing
open(TEMP, ">$tempFilename");
select(TEMP);
while($base64EncFile){
#??? HOW TO PRINT THE VARIABLE $base64EncFile CONTENTS INTO THE TEMP FILE ???
}
#creating a final request for sending to the web service
my $dpString = "<env:Envelope xmlns:env='http://schemas.xmlsoap.org/soap/envelope/' xmlns:dp='http://www.datapower.com/schemas/management'><env:Body><dp:request domain='$domain'><dp:set-file name='$deviceDir'>". $base64EncFile."</dp:set-file></dp:request></env:Body></env:Envelope>";
#decode the encoded password
$decPwd = decode_base64($encPwd);
system('C:\\apps\\curl-7.15.0\\curl.exe', '-#', '-k', '-u', "admin:$decPwd", '--data-binary', "$dpString", 'https://host/service/fileSet');
print "-----------------------------------------------------------\n";
close(TEMP);
close(FILE);
}
sub loadFiles() {
find( \&mySub, "$dir" ); #custom subroutine find, parse $dir
}
# following gets called recursively for each file in $dir, check $_ to see if you want the file!
sub mySub() {
push #files, $File::Find::name
if (/(\.xml|\.xsl|\.xslt|\.ffd|\.dpa|\.wsdl|\.xsd)$/i)
; # modify the regex as per your needs or pass it as another arg
}
Task I am trying to accomplish is, given a folder argument to the above perl program will make recursive calls to a given web service end point. Problem is - using the System command in Perl is unable to send files over 32 Kb. While trying to use File::Temp module in perl, I am not sure how to set the contents of a variable into a temp file (my first week using Perl).
Any help to achieve this will be helpful. Thanks!
Are you asking how to write a string to an open file?
print $fh $string;
should do the trick.
In your example, that would translate to replacing L62-65 with something like:
print TEMP $base64EncFile;

How do I search for .exe files

Do you guys have an idea on how to search or list down .exe files on the server
I am currently using (or maybe place it in an array)?
I will use this command in my Perl program. Assuming that my program is also located on the said server.
My OS is Linux - Ubuntu if that even matters, just in case. Working in CLI here. =)
As mentioned, It is not clear whether you want '*.exe' files, or executable files.
You can use File::Find::Rule to find all executable files.
my #exe= File::Find::Rule->executable->in( '/'); # all executable files
my #exe= File::Find::Rule->name( '*.exe')->in( '/'); # all .exe files
If you are looking for executable files, you (the user running the script) need to be able to execute the file, so you probably need to run the script as root.
It might take a long time to run to.
If you are looking for .exe files, chances are that your disk is already indexed by locate. So this would be much faster:
my #exe= `locate \.exe | grep '\.exe$'`
Perl to find every file under a specified directory that has a .exe suffix:
#!/usr/bin/perl
use strict;
use File::Spec;
use IO::Handle;
die "Usage: $0 startdir\n"
unless scalar #ARGV == 1;
my $startdir = shift #ARGV;
my #stack;
sub process_file($) {
my $file = shift;
print $file
if $file =~ /\.exe$/io;
}
sub process_dir($) {
my $dir = shift;
my $dh = new IO::Handle;
opendir $dh, $dir or
die "Cannot open $dir: $!\n";
while(defined(my $cont = readdir($dh))) {
next
if $cont eq '.' || $cont eq '..';
my $fullpath = File::Spec->catfile($dir, $cont);
if(-d $fullpath) {
push #stack, $fullpath
if -r $fullpath;
} elsif(-f $fullpath) {
process_file($fullpath);
}
}
closedir($dh);
}
if(-f $startdir) {
process_file($startdir);
} elsif(-d $startdir) {
#stack = ($startdir);
while(scalar(#stack)) {
process_dir(shift(#stack));
}
} else {
die "$startdir is not a file or directory\n";
}
Have a look at File::Find.
Alternatively, if you can come up with a command line to the *nix file command, you can use find2perl to convert that command line to a Perl snippet.
I'll probably be shot down for suggesting this, but you don't have to use modules for a simple task. For example:
#!/usr/bin/perl -w
#array = `find ~ -name '*.exe' -print`;
foreach (#array) {
print;
}
Of course, it will need to have some tweaking for your particular choice of starting directory (here, I used ~ for the home directory)
EDIT: Maybe I should have said until you get the modules installed
to get recursively use
use File::Find;
##cal the function by sending your search dir and type of the file
my #exe_files = &get_files("define root directory" , ".exe");
##now in #exe_files will have all .exe files
sub get_files() {
my ($location,$type) = #_;
my #file_list;
if (defined $type) {
find (sub { my $str = $File::Find::name;
if($str =~ m/$type/g ) {
push #file_list, $File::Find::name ;
}
}, $location);
} else {
find (sub {push #file_list, $File::Find::name }, $location);
}
return (#file_list);
}