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

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.

Related

Perl , How to read subfolder Output

I am writing a script to read the content of multiple sub folder in a directory.
And recently i need to read the content of folder inside multiple sub-folder.
Want to ask how can i write the code to read those folder inside multiple sub-folder.
This is the new conditions
Multiple Sub-folder -> Local folder -> fileAAA.csv
how do i read this fileAAA in Local folder of Multiple Sub-folder?
Currently the code i am writing was in this condition and it works well.
Multiple Sub-folder -> fileAAA.csv
Able to read fileAAA from multiple Sub-folder
Below is the code i use to read
Multiple Sub-folder -> fileAAA.csv
my ( $par_dir, $sub_dir );
opendir( $par_dir, "$parent" );
while ( my $sub_folders = readdir($par_dir) ) {
next if ( $sub_folders =~ /^..?$/ ); # skip . and ..
my $path = $parent . '/' . $sub_folders;
next unless ( -d $path ); # skip anything that isn't a directory
opendir( $sub_dir, $path );
while ( my $file = readdir($sub_dir) ) {
next unless $file =~ /\.csv?$/i;
my $full_path = $path . '/' . $file;
print_file_names($full_path);
}
closedir($sub_dir);
$flag = 0;
}
closedir($par_dir);
......
Updated
You should look at the File::Find module which has everything already in place to do searches like this, and has taken account of all corner cases for you
I wrote that on my tablet and at the time I couldn't offer sample code to support it. I believe this will do what you're asking for, which is simply to find all CSV files at any level beneath a parent directory
use strict;
use warnings;
use File::Find qw/ find /;
STDOUT->autoflush;
my $parent = '/Multiple Sub-folder';
find(sub {
return unless -f and /\.csv$/i;
print_file_names($File::Find::name);
}, $parent);
sub print_file_names {
my ($fn) = #_;
print $fn, "\n";
}
Without using moudle try this
Instead of opendir can you try glob for subdirectory search.
In below script i make a subroutine for continuous search.
When elsif condition is satisfied the path of the directory is will go to the find subroutine then it'll seach and so on.
my $v = "/Multiple Sub-folder";
find($v);
sub find{
my ($s) = #_;
foreach my $ma (glob "$s/*")
{
if(-f $ma)
{
if($ma =~m/.csv$/) # Here search for csv files.
{
print "$ma\n";
}
}
elsif(-d $ma)
{
find("$ma")
}
}
}
But can you use File::Find module for search the files in the directory as the answer of Borodin Which is the best approach.

perl script to parse log files from different test locations.which takes dynamic path of testcases

I want a perl script that will go in to every test folder and parse the log file in it.
Eg:
results/testcases/ **?** /test.log
The above path must be dynamically changing with different test folder names in the place of **?** mark.
I am using this results/testcases/#array/test.log
#array has test names
My suggestion would be:
my $path = "results/testcases";
opendir(TEMPDIR,$path) or die "err1";
my #dir = grep -d, readdir TEMPDIR;
foreach(#dir)
{
if( $_ !~ /\./ )
{
open( my $fileHandle , "results/testcases/".$_."/test.log" ) or die "err2";
# parsing log file
close $fileHandle or die "err2-2";
}
}
close TEMPDIR or die "err1-2";
First, you need to read the folder "results/testcases" for current correct folder names. Second, you need to open the files one by one, stead of putting #array in the middle of the path. Third, you should read basic perl, otherwise you won't be able to parse in a proper manner. Fourth, you really should read through HOW TO ASK, you should put in your code so that we could be more helpful and your questions shall help others, as well.
If your test folders relative paths are stored in #array. You can do the following:
my #testlogs = grep { -e $_ } map { "results/testcases/".$_."/test.log" } #array;
The new array #testlogs now contains the list of paths to existing 'test.log' files.
Then, you can parse each file like this:
map { ... parsing call ... } #testlogs;

How can I list the contents of a ZIP file using Perl?

What I am aiming to do is pretty much what it says in the title.
I have the following line of code which simply prints out [view archive] and when I click it the browser just downloads the zip file.
print "\<a href=\"http:\/\/intranet.domain.com\/~devcvs\/view-file.cgi?file=$reviewdata{'document'}&review_id=$reviewdata{'id'}\"\>[view archive]\<\/a\>\n";
What I would love to do is to list the files contained within this zip file anywhere on the page, e.g. just underneath or even a new page which this link links to and takes the filename as a parameter.
I believe once this is done the browser should take care of the rest in terms of just clicking these files and viewing them in the browser as they will be pdfs and html files which I don't foresee any problems with.
I am sure there is a module that does this but I am unsure of how to accomplish my goal using it.
Any help is much appreciated.
Have a look at Archive::Zip :
use strict;
use warnings;
use Archive::Zip qw/ :ERROR_CODES :CONSTANTS /;
my $zipFile = 'someZip.zip';
my $zip = Archive::Zip->new();
unless ( $zip->read( $zipFile ) == AZ_OK ) { # Make sure archive got read
die 'read error';
}
my #files = $zip->memberNames(); # Lists all members in archive
print $_, "\n" for #files;
Using Archive::Zip certainly makes the code easier, and you should probably install that module if you are going to work extensively on zip files.
However, for those who prefer not to install anything, there is a way to list the content of a zip file just using the core module IO::Uncompress::Unzip (already part of any standard Perl distribution).
use strict;
use warnings;
use IO::Uncompress::Unzip qw($UnzipError);
my $zipFile = '/path/to/zipfile.zip';
my $u = IO::Uncompress::Unzip->new($zipFile)
or die "Error: $UnzipError\n";
my $status;
for ($status = 1; $status > 0; $status = $u->nextStream()) {
my $header = $u->getHeaderInfo();
my $zippedFile = $header->{Name};
if ($zippedFile =~ /\/$/) {
last if $status < 0;
next;
}
print "$zippedFile\n";
}

How to get properties of a directory using perl script?

I want to get the details of a directory as like number of files and subdirectories in it and permissions for those.
Yes! it's easy to do it on linux machines using back ticks to execute a command.But is there a way to make the script platform independent.
thanks :)
You can use directory handles (opendir and readdir) to get the contents of directories and File::stat to get the permissions
You might want to consider using Path::Class. This both gives you an easy interface and also handles all the cross platform things (including the difference between "\" and "/" on your platform) for you.
use Path::Class qw(file dir);
my $dir = dir("/etc");
my $dir_count = 0;
my $file_count = 0;
while (my $file = $dir->next) {
# $file is a Path::Class::File or Path::Class::Dir object
if ($file->is_dir) {
$dir_count++;
} else {
$file_count++;
}
my $mode = $file->stat->mode;
$mode = sprintf '%o', $mode; # convert to octal "0755" form
print "Found $file, with mode $mode\n";
}
print "Found $dir_count dirs and $file_count files\n";

Archive tar files to a different location in Perl

I am reading a directory having some archive files and uncompressing the archive files one by one.
Everything seems well however the files are getting uncompressed in the folder which has the main perl code module which is running the sub modules.
I want the archive to be generated in the folder I specify.
This is my code:
sub ExtractFile
{
#Read the folder which was copied in the output path recursively and extract if any file is compressed
my $dirpath = $_[0];
opendir(D, "$dirpath") || die "Can't open dir $dirpath: $!\n";
my #list = readdir(D);
closedir(D);
foreach my $f (#list)
{
print " \$f = $f";
if(-f $dirpath."/$f")
{
#print " File in directory $dirpath \n ";#is \$f = $f\n";
my($file_name, $file_dirname,$filetype)= fileparse($f,qr{\..*});
#print " \nThe file extension is $filetype";
#print " \nThe file name is is $file_name";
# If compressed file then extract the file
if($filetype eq ".tar" or $filetype eq ".tzr.gz")
{
my $arch_file = $dirpath."/$f";
print "\n file to be extracted is $arch_file";
my $tar = Archive::Tar->new($arch_file);
#$tar->extract() or die ("Cannot extract file $arch_file");
#mkdir($dirpath."/$file_name");
$tar->extract_file($arch_file,$dirpath."/$file_name" ) or die ("Cannot extract file $arch_file");
}
}
if(-d $dirpath."/$f")
{
if($f eq "." or $f eq "..")
{ next; }
print " Directory\n";# is $f";
ExtractFile($dirpath."/$f");
}
}
}
The method ExtractFile is called recursively to loop all the archives.
When using $tar->extract() it uncompresses in the folder which calls this method.
When I use $tar->extract_file($arch_file,$dirpath."/$file_name") I get an error :
No such file in archive: '/home/fsang/dante/workspace/output/s.tar' at /home/fsang/dante/lib/Extraction.pm line 80
Please help I have checked that path and input output there is no issue with it.
Seems some usage problem I am not aware of for $tar->extract_file().
Many thanks for anyone resolving this issue.
Regards,
Sakshi
You've misunderstood extract_file. The first parameter is the name of a file inside the archive to extract. You're passing in the path of the archive itself. You passed that to new; you don't need to pass it in again. As the error message explains, s.tar does not contain a file named /home/fsang/dante/workspace/output/s.tar, so extract_file fails.
You can get a list of files in the archive by using $tar->list_files.
A simpler solution may be to temporarily chdir to the directory you want to extract the archive into. File::pushd provides an easy way to do that.
a typo?
$tar->extract_file($arch_file,$dirpath."/$file_name" )
should probably be
$tar->extract_file($arch_file,$dirpath."/".$file_name)
$tarFile = "test.tar.gz";
$myTar = Archive::Tar->new($tarFile);
foreach my $member ($myTar->list_files())
{
my $res = $myTar->extract_file( $member , 'C:/temp/'.$member );
print "Exract error!\n" unless ($res);
}
I see a gun being brought to a Swiss Army knife fight.
Here's a *nix one-liner that does what you want:
find /source/dir -name "*.tar" -exec tar -C /target/dir -xvzf '{}' \; -print
Is there a need to write a script for this?
You aren't necessarily doing anything special other than debug lines.