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).
Related
BACKGROUND
I am using File::Tail to tail a log file symbolic link. The symbolic link gets updated after midnight to include a new date stamp, which unfortunately my script does not tail the new file after the symbolic link is updated. Otherwise, my script works as intended.
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Data::Dumper;
use charnames':full';
use Cwd 'abs_path';
use File::Tail;
my $symlink = sub {
my($log) = '/home/user/log';
};
my $file=File::Tail->new(
name=>&$symlink,
ignore_nonexistant=>1,
tail=>0,
interval=>0,
maxinterval=>1,
name_changes=>\&$symlink
) || warn $!;
print Dumper $file;
while (defined($_=$file->read)) {
# do a bunch of stuff;
}
QUESTION
How do I get perl to follow the updated symbolic link?
From the File::Tail documentation:
name_changes
Some logging systems change the name of the file they are writing to, sometimes to include a date, sometimes a sequence number,
sometimes other, even more bizarre changes.
Instead of trying to implement various clever detection methods, File::Tail will call the code reference defined in name_changes. The
code reference should return the string which is the new name of the
file to try opening.
Note that if the file does not exist, File::Tail will report a fatal error (unless ignore_nonexistant has also been specified).
So your code reference should return the name of the new file, which according to your question has a datestring in it. Perhaps something like this would work:
use Path::Tiny; # file system agnostic path utilty
use Time::Piece; # data utilties
my $symlink = sub {
my $time = localtime; # a Time::Piece object
return path(
'/home/user/log',
join('', $time->year, $time->mon, $time->mday),
)->canonpath;
};
For today this sub would return: /home/user/log20151112
I was missing a return from the sub
my $symlink = sub {
my($log) = '/home/user/log';
return $log;
};
Works perfectly now!
I am trying to recursively scan a bunch of zip files and I am using, of course, archive::zip. I would like to avoid expanding the archive's content in a temporary folder. I would like to be able to use something like (nearly-pseudo code):
sub CALLMYSELFAGAIN .....
my #members = $currentZipFile->members();
while(my $member = pop #members){
if ($member->isTextFile()){
push #content, $member->contents();
}elsif(isZipFile($member->fileName())){
CALLMYSELFAGAIN($member);
}
The problem is, $member->can("memberNames")) returns false, so $member is NOT an archive::zip in the sense that I could not open it again as a zip file. Or am I wrong?
Any hint?
You can do this:
elsif (isZipFile($member->filename)) {
my $contents = $currentZipFile->contents($member);
open my $fh, '<', \$contents; # In-memory filehandle
my $child_zip = Archive::Zip->new;
$child_zip->readFromFileHandle($fh);
CALLMYSELFAGAIN($child_zip);
}
but expect that to be very memory intensive, especially if you go more than one level deep.
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.
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";