I am trying to traverse the directory tree upwards, searching for a given directory name, if the directory is found, I should chdir to it, otherwise give an error message. For example:
use warnings;
use strict;
use Cwd qw(getcwd);
die "Base directory not found!" if (!gotoDir());
sub gotoDir {
my $baseDir = '.test';
my $curdir = getcwd();
while (1) {
return 1 if (-d $baseDir);
if (! chdir("..")) {
chdir($curdir);
return 0;
}
}
}
The problem is that chdir does not fail when going beyond the root, so the above program enters an infinite loop if .test is not found.
Of course, I could just test for / since I am on Linux, but I would like to do this in a system independent manner.
As #Gnouc has answered, the File::Spec module has a portable representation of the root directory with its rootdir method.
This is how I would write your goto_dir subroutine. Note that capital letters are conventionally reserved for global identifiers like Package::Names.
I think it is best to pass the directory you are searching for as a parameter to the subroutine to make it more general. I have also written it so that the subroutine does a chdir to the .test directory if it is is found, which is what you say you want but not what your own solution tries to do.
Finally, since portability is important, I have used File::Spec->updir in place of a literal '..' to refer to the parent of the current directory.
#!/usr/bin/env perl
use strict;
use warnings;
use Cwd 'cwd';
use File::Spec;
goto_dir('.test') or die 'Base directory not found!';
sub goto_dir {
my ($base_dir) = #_;
my $original_dir = cwd;
while () {
if (-d $base_dir) {
chdir $base_dir;
return 1;
}
elsif (cwd eq File::Spec->rootdir) {
chdir $original_dir;
return 0;
}
else {
chdir File::Spec->updir;
}
}
}
You can use File::Spec to get the root directory:
$ perl -MFile::Spec -E 'say File::Spec->rootdir()'
/
File::Spec is great for obtaining what the root directory is, but for testing whether a given directory is or isn't that is not so easy. For that you likely want to use stat and compare if the dev and ino fields are equal:
use File::stat;
my $rootstat = stat(File::Spec->rootdir);
...
my $thisstat = stat($dir);
if( $thisstat->dev == $rootstat->dev and $thisstat->ino == $rootstat->ino ) {
say "This is the root directory";
}
This avoids problems of the string-formatted form of a path to the directory, as it may be that you have the path ../../../../../.. for example.
Related
I am taring the directory contents using Archive::Tar module.
My scripts is below:
#!/usr/bin/perl -w
use strict;
use warnings;
use Archive::Tar;
use File::Find;
use Data::Dumper;
my $home_dir = "C:/Users/Documents/Vinod/Perl_Scripts/test/";
my $src_location = $home_dir."LOG_DIR";
my $dst_location = $home_dir."file.tar.gz";
my #inventory = ();
find (sub { push #inventory, $File::Find::name }, $src_location);
print "Files:".Dumper(\#inventory);
my $tar = Archive::Tar->new();
$tar->add_files( #inventory );
$tar->write( $dst_location , 9 );
Script is able to create file.tar.gz file in location C:/Users/Documents/Vinod/Perl_Scripts/test/.
But when I extract the file.tar.gz manually it creates a whole path recursively once again. So LOG_DIR contents would be visible in the location C:/Users/Documents/Vinod/Perl_Scripts/test/file.tar/file/Users/Documents/Vinod/Perl_Scripts/test/LOG_DIR/
How can I have the contents which is inside C:/Users/Documents/Vinod/Perl_Scripts/test/LOG_DIR/ in C:/Users/Documents/Vinod/Perl_Scripts/test/file.tar/file/ while extracting it.
If you don't want to recreate the full path, chdir into the home directory, and make the source dir relative:
my $home_dir = "C:/Users/Documents/Vinod/Perl_Scripts/test/";
chdir $home_dir;
my $src_location = "LOG_DIR";
my $dst_location = $home_dir."file.tar.gz";
Since you use $File::Find::name for your list, you get the absolute path to each file. That's the name that you give Archive::Tar, so that's the name that it uses. You can see the files in a tarball:
$ tar -tzf archive.tgz
There are various ways to get relative paths instead. You might do that in the wanted function. Remove the part of the path that you do not want. That's typically not going to be the directory you used for find (src_location) because you want to keep that level of structure:
my #inventory;
find(
sub {
return if /\A\.\.?\z/;
push #inventory, abs2rel( $File::Find::name, $home_dir )
}, $src_location
);
Or do it after:
#inventory = map { abs2rel($_, $home_dir) } #inventory;
I'm writing Perl modules that allow users to create file and directory objects to manipulate the file system.
Example:
use File;
use Dir;
my $file = File->new("path");
my $dir = Dir ->new("path");
This works out nicely, but what I would really like to be able to create both file and directory objects without having to use two separate modules.
To do this I came up with the following solution...
IO.pm:
use File;
use Dir;
use Exporter qw(import);
our #EXPORT_OK = qw(file dir);
sub file {
my $path = shift;
return File->new($path);
}
sub dir {
my $path = shift;
return Dir->new($path);
}
1;
test.pl:
use IO qw(file dir);
my $file = file("path");
my $dir = dir ("path");
Now here's the problem, by doing this I eliminate the explicit call to new when the user creates a file or directory object. I'm sort of using the file and dir subroutines as constructors.
To me this code looks very clean, and is extremely simple to use, but I haven't seen many other people writing Perl code like this so I figured I should at least pose the question:
Is it okay to simply return an object from a subroutine like this, or does this scream bad practice?
That's perfectly fine.
For example, Path::Class's file and dir functions return Path::Class::File and Path::Class::Dir objects respectively.
If that was the only constructor the class provided, it would prevent (clean) subclassing, but that's not the case here.
There is, however, the question of whether replacing
open(my $fh, "path");
opendir(my $dh, "path);
with
my $fh = file("path");
my $dh = dir("path);
is advantageous or not (assuming the functions return IO::File and IO::Dir objects).
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/'
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.
I have a need to edit cue files in the first directory and not go recursively in the subdirectories.
find(\&read_cue, $dir_source);
sub read_cue {
/\.cue$/ or return;
my $fd = $File::Find::dir;
my $fn = $File::Find::name;
tie my #lines, 'Tie::File', $fn
or die "could not tie file: $!";
foreach (#lines) {
s/some substitution//;
}
untie #lines;
}
I've tried variations of
$File::Find::prune = 1;
return;
but with no success. Where should I place and define $File::Find::prune?
Thanks
If you don't want to recurse, you probably want to use glob:
for (glob("*.cue")) {
read_cue($_);
}
If you want to filter the subdirectories recursed into by File::Find, you should use the preprocess function (not the $File::Find::prune variable) as this gives you much more control. The idea is to provide a function which is called once per directory, and is passed a list of files and subdirectories; the return value is the filtered list to pass to the wanted function, and (for subdirectories) to recurse into.
As msw and Brian have commented, your example would probably be better served by a glob, but if you wanted to use File::Find, you might do something like the following. Here, the preprocess function calls -f on every file or directory it's given, returning a list of files. Then the wanted function is called only for those files, and File::Find does not recurse into any of the subdirectories:
use strict;
use File::Find;
# Function is called once per directory, with a list of files and
# subdirectories; the return value is the filtered list to pass to
# the wanted function.
sub preprocess { return grep { -f } #_; }
# Function is called once per file or subdirectory.
sub wanted { print "$File::Find::name\n" if /\.cue$/; }
# Find files in or below the current directory.
find { preprocess => \&preprocess, wanted => \&wanted }, '.';
This can be used to create much more sophisticated file finders. For example, I wanted to find all files in a Java project directory, without recursing into subdirectories starting with ".", such as ".idea" and ".svn", created by IntelliJ and Subversion. You can do this by modifying the preprocess function:
# Function is called once per directory, with a list of files and
# subdirectories; return value is the filtered list to pass to the
# wanted function.
sub preprocess { return grep { -f or (-d and /^[^.]/) } #_; }
If you only want the files in a directory without searching subdirectories, you don't want to use File::Find. A simple glob probably does the trick:
my #files = glob( "$dir_source/*.cue" );
You don't need that subroutine. In general, when you're doing a lot of work for a task that you think should be simple, you're probably doing it wrong. :)
Say you have a directory subtree with
/tmp/foo/file.cue
/tmp/foo/bar/file.cue
/tmp/foo/bar/baz/file.cue
Running
#! /usr/bin/perl
use warnings;
use strict;
use File::Find;
sub read_cue {
if (-f && /\.cue$/) {
print "found $File::Find::name\n";
}
}
#ARGV = (".") unless #ARGV;
find \&read_cue => #ARGV;
outputs
found /tmp/foo/file.cue
found /tmp/foo/bar/file.cue
found /tmp/foo/bar/baz/file.cue
But if you remember the directories in which you found cue files
#! /usr/bin/perl
use warnings;
use strict;
use File::Find;
my %seen_cue;
sub read_cue {
if (-f && /\.cue$/) {
print "found $File::Find::name\n";
++$seen_cue{$File::Find::dir};
}
elsif (-d && $seen_cue{$File::Find::dir}) {
$File::Find::prune = 1;
}
}
#ARGV = (".") unless #ARGV;
find \&read_cue => #ARGV;
you get only the toplevel cue file:
found /tmp/foo/file.cue
That's because $File::Find::prune emulates the -prune option of find that affects directory processing:
-prune
True; if the file is a directory, do not descend into it.