I've building a script that recursively builds the names of a directory's subdirectories/files and the names of the files in those subdirectories as objects:
package Dir;
use Moose;
use Modern::Perl;
use File;
use strict;
use warnings;
has 'path' => (is => 'ro', isa => 'Str', required => 1);
has 'name' => (is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; my ($name) = $self->path =~ /\/([^\/]*)$/; return $name; } );
has 'subdirs' => (is => 'rw', isa => 'ArrayRef[Dir]' );
has 'files' => (is => 'rw', isa => 'ArrayRef[File]' );
has 'num_dirs' => (is => 'ro', isa => 'Int', lazy => 1, default => sub { my $self = shift; scalar #{$self->subdirs}; } );
sub BUILD {
my $self = shift;
my $path = $self->path;
# run some tests
logf('Path to the directory does not exist.') if (!-e $path);
logf('The path should point to a directory, not a file.') if (!-d $path);
# populate subdirs attribute with Dir objects
opendir my $dh, $path or die "Can't opendir '$path': $!";
# Get files and dirs and separate them out into categories
my #dirs_and_files = grep { ! m{^\.$|^\.\.$} } readdir $dh;
closedir $dh or die "Can't closedir '$path': $!";
my #subdir_names = grep { -d "$path/$_" } grep { !m{^\.} } #dirs_and_files;
my #file_names = grep { -f "$path/$_" } grep { !m{^\.} } #dirs_and_files;
# Create objects
my #dir_objects = map { Dir->new ( path => $path . '/' . $_ ) } #subdir_names;
my #file_objects = map { File->new ( path => $path . '/' . $_ ) } #file_names;
# Populate this with file and directory objects
$self->subdirs ( \#dir_objects );
$self->files ( \#file_objects );
}
1;
Notice the code has a files attribute which holds an array of File objects. A File has the following attributes:
has 'path' => (is => 'ro', isa => 'Str', required => 1);
has 'name' => (is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; my ($name) = $self->path =~ /\/([^\/]*)$/; return $name; } );
The problem is that the name attribute never gets set when a File object is created. I'm not sure why.
EDIT 1: Solution (sort of)
So, I slapped this into the File object to see if it triggered the creation of the attribute:
sub BUILD {
my $self = shift;
}
This did not solve the problem. However, this did:
sub BUILD {
my $self = shift;
$self->name;
}
The question I have, though, is why did I need to do this?
The problem is your pattern is failing if there's a trailing slash.
my ($name) = $self->path =~ /\/([^\/]*)$/;
If $self->path is /some/thing it works. If it's /some/thing/ it "works" but [^\/]* happily matches an empty string. So you get no warning.
You can put in an optional slash, and change it to match ONE or more non-slashes. Also by using alternative delimiters we can clean up all those leaning toothpicks.
my ($name) = $self->path =~ m{/ ([^/]+) /? $}x;
But really one shouldn't be parsing paths with regular expressions. Use one of the many built in modules like File::Basename or File::Spec
return basename($self->path);
Some side notes.
Moose is very slow to start up and is best suited for long running processes like web servers. For something as generic as a File and Dir class, consider using Moo. It's mostly compatible with Moose, much faster, and when used in conjunction with Types::Standard, does types better. It would be good, for example, to make a StrNotEmpty type to avoid this sort of problem.
Unless this is an exercise, Perl already has a great module to do this sort of thing. Look into Path::Tiny.
Attributes with lazy => 1 are only created when their accessor is called, not after construction.
Just a side note:
You incorrectly claim a path doesn't exist if you have no permission to its parent dir. Also, you incorrectly claim a path to a directory isn't one if you have no permission to its parent dir.
You also needlessly stat the file twice. In fact, you needn't stat the file at all since opendir is already making the checks you are making.
Simply replace
logf('Path to the directory does not exist.') if (!-e $path);
logf('The path should point to a directory, not a file.') if (!-d $path);
opendir my $dh, $path or die "Can't opendir '$path': $!";
with
opendir(my $dh, $path)
or do {
logf("Can't open directory \"$path\": $!");
die("Can't open directory \"$path\": $!");
};
This also avoids the race condition in your code, the possibility that the state of things might change between the checks and the opendir.
Related
I'm new to MOOSE and Perl OOP, and I'm struggling understanding the execution order of the code.
I want to create a class reading files, so an attribute of the object should be the filehandle and another the filename to be read.
My problem is that the attribute 'filehandle' has a builder that requires $self->filename, but sometimes at runtime 'filename' is not (yet) available when the builder is called.
Thanks for you help
My ideal object creation:
my $file = FASTQ::Reader->new(
filename => "$Bin/test.fastq",
);
Perl module:
has filename => (
is => 'ro', isa => 'Str', required => 1,
);
has fh => (
is => 'ro', isa => 'FileHandle', builder => '_build_file_handler',
);
sub _build_file_handler {
my ($self) = #_;
say Dumper $self;
open(my $fh, "<", $self->filename) or die ("cant open " . $self->filename . "\n");
return $fh;
}
See: https://gist.github.com/telatin/a81a4097913af55c5b86f9e01a2d89ae
If a value of one attribute depends on another attribute, make it lazy.
#!/usr/bin/perl
use warnings;
use strict;
{ package My::Class;
use Moose;
has filename => (is => 'ro', isa => 'Str', required => 1);
has fh => (is => 'rw', isa => 'FileHandle', lazy => 1, builder => '_build_fh');
# ~~~~~~~~~
sub _build_fh {
my ($self) = #_;
open my $fh, '<', $self->filename or die $!;
return $fh
}
}
my $o = 'My::Class'->new(filename => __FILE__);
print while readline $o->fh;
See Laziness in Moose::Manual::Attributes:
if the default value for this attribute depends on some other attributes, then the attribute must be lazy.
I'm writing a script to help me get proficient in Moose. I've got the following bit of code:
package Dir;
use Moose;
use Modern::Perl;
use File;
has 'dirs' => (is => 'ro', isa => 'HashRef[Dir]' );
has 'files' => (is => 'ro', isa => 'HashRef[File]');
has 'dir_class' => (is => 'ro', isa => 'ClassName', default => 'Dir');
has 'file_class' => (is => 'ro', isa => 'ClassName', default => 'File');
sub BUILD {
my $self = shift;
my $path = $self->path;
my $name = $self->name;
my (%dirs, %files);
# populate dirs attribute with LaborData::Data::Dir objects
opendir my $dh, $path or die "Can't opendir '$path': $!";
# Get files and dirs and separate them out
my #dirs_and_files = grep { ! m{^\.$|^\.\.$} } readdir $dh;
closedir $dh or die "Can't closedir '$path': $!";
my #dir_names = grep { -d "$path/$_" } grep { !m{^\.} } #dirs_and_files;
my #file_names = grep { -f "$path/$_" } grep { !m{^\.} } #dirs_and_files;
# Create objects
map { $dirs{$_} = $self->dir_class->new ( path => $path . '/' . $_ ) } #dir_names;
map { $files{$_} = $self->file_class->new ( path => $path . '/' . $_ ) } #file_names;
# Set attributes
$self->dirs ( \%dirs );
$self->files ( \%files );
}
The code results in the following error: died: Moose::Exception::CannotAssignValueToReadOnlyAccessor (Cannot assign a value to a read-only accessor at reader Dir::dirs
To get around this error, I could either make the attributes rw or use builder methods for the dirs and files attributes. The former solution is undesirable and the latter solution will require duplication of code (for example, the directory will need to be opened twice) and so is also undesirable.
What is the best solution to this problem?
You can assign a writer to your read-only attribute and use that internally from your BUILD. Name it with an _ to indicate it's internal.
package Foo;
use Moose;
has bar => ( is => 'ro', writer => '_set_bar' );
sub BUILD {
my $self = shift;
$self->_set_bar('foobar');
}
package main;
Foo->new;
This will not throw an exception.
It's essentially the same as making it rw, but now the writer is not the same accessor as the reader. The _ indicates that it's internal, so it's less undesirable than just using rw. Remember that you cannot really protect anything in Perl anyway. If your user wants to get to the internals they will.
I found one possible solution, though it's frowned upon:
# Set attributes
$self->{dirs} = \%dirs;
$self->{files} = \%files;
I am trying to make an extensible system whereby I can code up a new module to be a handler. I want the program to automatically load any new .pm file that is put into the Handlers directory and conforms to a Moose::Role interface.
I'm wondering whether there is a Perl module or a more Moose sanctioned way to do this automatically? Here is what I have built so far, but it seems a little verbose and there has got to be a simpler way to do it.
handler.pl contains:
#!/usr/bin/perl
use Handler;
use Data::Dumper;
my $base_handler = Handler->new();
$base_handler->load_modules('SysG/Handler');
print Dumper($base_handler);
Handler.pm contains:
package Handler;
use Moose;
has 'handlers' => ( traits => ['Array'], handles => { add_handler => 'push' } );
sub load_modules {
my ($self,$dir) = #_;
push(#INC, $dir);
my #modules = find_modules_to_load($dir);
eval {
# Note that this sort is important. The processing order will be critically important.
# The sort implies the sort order
foreach my $module ( sort #modules) {
(my $file = $module) =~ s|::|/|g;
print "About to load $file.pm for module $module\n" ;
require $file . '.pm';
$module->import();
my $obj = $module->new();
$self->add_handler($obj);
1;
}
} or do {
my $error = $#;
print "Error loading modules: $error" if $error;
};
}
sub find_modules_to_load {
my ($dir) = #_;
my #files = glob("$dir/*.pm");
my $namespace = $dir;
$namespace =~ s/\//::/g;
# Get the leaf name and add the System::Module namespace to it
my #modules = map { s/.*\/(.*).pm//g; "${namespace}::$1"; } #files;
die "ERROR: No classifier modules found in $dir\n" unless #modules;
return #modules;
}
1;
Then I have made a directory called SysG/Handler and added two .pm files which ordinarily will conform to a Moose::Role (as if to define an interface that must be adhered too).
The SysG::Handler::0001_HandleX.pm stub contains:
package SysG::Handler::0001_HandleX;
use Moose;
1;
The SysG::Handler::0002_HandleX.pm stub contains:
package SysG::Handler::0002_HandleY;
use Moose;
1;
Put all this together and the Data::Dumper result is:
$VAR1 = bless( {
'handlers' => [
bless( {}, 'SysG::Handler::0001_HandleX' ),
bless( {}, 'SysG::Handler::0002_HandleY' )
]
}, 'Handler' );
So, now I repeat my original question: There must be a simpler way, or a module or a Moose way to automatically load any modules in a specific directory.
Any Moose experts able to help out here?
MooseX::Object::Pluggable
I need some help regarding the arrays in Perl
This is the constructor I have.
BuildPacket.pm
sub new {
my $class = shift;
my $Packet = {
_PacketName => shift,
_Platform => shift,
_Version => shift,
_IncludePath => [#_],
};
bless $Packet, $class;
return $Packet;
}
sub SetPacketName {
my ( $Packet, $PacketName ) = #_;
$Packet->{_PacketName} = $PacketName if defined($PacketName);
return $Packet->{_PacketName};
}
sub SetIncludePath {
my ( $Packet, #IncludePath ) = #_;
$Packet->{_IncludePath} = \#IncludePath;
}
sub GetPacketName {
my( $Packet ) = #_;
return $Packet->{_PacketName};
}
sub GetIncludePath {
my( $Packet ) = #_;
#{ $Packet->{_IncludePath} };
}
(The code has been modified according to the suggestions from 'gbacon', thank you)
I am pushing the relative paths into 'includeobjects' array in a dynamic way. The includepaths are being read from an xml file and are pushed into this array.
# PacketInput.pm
if($element eq 'Include')
{
while( my( $key, $value ) = each( %attrs ))
{
if($key eq 'Path')
push(#includeobjects, $value);
}
}
So, the includeobject will be this way:
#includeobjects = (
"./input/myMockPacketName",
"./input/myPacket/my3/*.txt",
"./input/myPacket/in.html",
);
I am using this line for set include path
$newPacket->SetIncludePath(#includeobjects);
Also in PacketInput.pm, I have
sub CreateStringPath
{
my $packet = shift;
print "printing packet in CreateStringPath".$packet."\n";
my $append = "";
my #arr = #{$packet->GetIncludePath()};
foreach my $inc (#arr)
{
$append = $append + $inc;
print "print append :".$append."\n";
}
}
I have many packets, so I am looping through each packet
# PacketCreation.pl
my #packets = PacketInput::GetPackets();
foreach my $packet (PacketInput::GetPackets())
{
print "printing packet in loop packet".$packet."\n";
PacketInput::CreateStringPath($packet);
$packet->CreateTar($platform, $input);
$packet->GetValidateOutputFile($platform);
}
The get and set methods work fine for PacketName. But since IncludePath is an array, I could not get it to work, I mean the relative paths are not being printed.
If you enable the strict pragma, the code doesn't even compile:
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 15.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 29.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 30.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 40.
Don't use # unquoted in your keys because it will confuse the parser. I recommend removing them entirely to avoid confusing human readers of your code.
You seem to want to pull all the attribute values from the arguments to the constructor, so continue peeling off the scalar values with shift, and then everything left must be the include path.
I assume that the components of the include path will be simple scalars and not references; if the latter is the case, then you'll want to make deep copies for safety.
sub new {
my $class = shift;
my $Packet = {
_PacketName => shift,
_Platform => shift,
_Version => shift,
_IncludePath => [ #_ ],
};
bless $Packet, $class;
}
Note that there's no need to store the blessed object in a temporary variable and then immediately return it because of the semantics of Perl subs:
If no return is found and if the last statement is an expression, its value is returned.
The methods below will also make use of this feature.
Given the constructor above, GetIncludePath becomes
sub GetIncludePath {
my( $Packet ) = #_;
my #path = #{ $Packet->{_IncludePath} };
wantarray ? #path : \#path;
}
There are a couple of things going on here. First, note that we're careful to return a copy of the include path rather than a direct reference to the internal array. This way, the user can modify the value returned from GetIncludePath without having to worry about mucking up the packet's state.
The wantarray operator allows a sub to determine the context of its call and respond accordingly. In list context, GetIncludePath will return the list of values in the array. Otherwise, it returns a reference to a copy of the array. This way, client code can call it either as in
foreach my $path (#{ $packet->GetIncludePath }) { ... }
or
foreach my $path ($packet->GetIncludePath) { ... }
SetIncludePath is then
sub SetIncludePath {
my ( $Packet, #IncludePath ) = #_;
$Packet->{_IncludePath} = \#IncludePath;
}
Note that you could have used similar code in the constructor rather than removing one parameter at a time with shift.
You might use the class defined above as in
#! /usr/bin/perl
use strict;
use warnings;
use Packet;
sub print_packet {
my($p) = #_;
print $p->GetPacketName, "\n",
map(" - [$_]\n", $p->GetIncludePath),
"\n";
}
my $p = Packet->new("MyName", "platform", "v1.0", qw/ foo bar baz /);
print_packet $p;
my #includeobjects = (
"./input/myMockPacketName",
"./input/myPacket/my3/*.txt",
"./input/myPacket/in.html",
);
$p->SetIncludePath(#includeobjects);
print_packet $p;
print "In scalar context:\n";
foreach my $path (#{ $p->GetIncludePath }) {
print $path, "\n";
}
Output:
MyName
- [foo]
- [bar]
- [baz]
MyName
- [./input/myMockPacketName]
- [./input/myPacket/my3/*.txt]
- [./input/myPacket/in.html]
In scalar context:
./input/myMockPacketName
./input/myPacket/my3/*.txt
./input/myPacket/in.html
Another way to reduce typing is to use Moose.
package Packet;
use Moose::Policy 'Moose::Policy::JavaAccessors';
use Moose;
has 'PacketName' => (
is => 'rw',
isa => 'Str',
required => 1,
);
has 'Platform' => (
is => 'rw',
isa => 'Str',
required => 1,
);
has 'Version' => (
is => 'rw',
isa => 'Int',
required => 1,
);
has 'IncludePath' => (
is => 'ro',
isa => 'ArrayRef[Str]',
default => sub {[]},
traits => [ 'Array' ],
handles => {
getIncludePath => 'elements',
getIncludePathMember => 'get',
setIncludePathMember => 'set',
},
);
__PACKAGE__->meta->make_immutable;
no Moose;
1;
Check out Moose::Manual::Unsweetened for another example of how Moose saves time.
If you are adamant in your desire to learn classical Perl OOP, read the following perldoc articles: perlboot, perltoot, perlfreftut and perldsc.
A great book about classical Perl OO is Damian Conway's Object Oriented Perl. It will give you a sense of the possibilities in Perl's object.
Once you understand #gbacon's answer, you can save some typing by using Class::Accessor::Fast:
#!/usr/bin/perl
package My::Class;
use strict; use warnings;
use base 'Class::Accessor::Fast';
__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_accessors( qw(
IncludePath
PacketName
Platform
Version
));
use overload '""' => 'to_string';
sub to_string {
my $self = shift;
sprintf(
"%s [ %s:%s ]: %s",
$self->get_PacketName,
$self->get_Platform,
$self->get_Version,
join(':', #{ $self->get_IncludePath })
);
}
my $obj = My::Class->new({
PacketName => 'dummy', Platform => 'Linux'
});
$obj->set_IncludePath([ qw( /home/include /opt/include )]);
$obj->set_Version( '1.05b' );
print "$obj\n";
I'm having difficulty using MooseX::Declare properly when calling BUILDARGS.
I'm trying to create an object as an interface for a file. (Specifically, I want an interface to a binary file that lets me peek at the next few bytes in the file then chomp them off for further processing.)
I want to be able to create one of these objects like this
my $f = binary_file_buffer->new( $file_name );
and then use it like this
while( my $block_id = $f->peek( $id_offset, $id_length ) ) {
$block_id = unpack_block_id( $block_id );
$munge_block{ $block_id }->(
$f->pop( $block_size[ $block_id ] )
);
}
My of binary_file_buffer class definition/declaration looks like this
use MooseX::Declare;
class binary_file_buffer {
use FileHandle;
use Carp;
has _file => ( is => 'ro', isa => 'FileHandle' );
has _file_name => ( is => 'ro', isa => 'Str' );
has _buff => ( is => 'rw', isa => 'Str', default => '' );
method BUILDARGS ( Str $file_name ) {
my $file = FileHandle->new( $file_name );
carp "unable to open $file_name : $!" unless defined $file;
$file->binmode;
return (
_file_name => $file_name,
_file => $file,
);
}
# get the next n bytes from the buffer.
method pop ( Int $len ) {
# ... Make sure there is data in _buff
return substr( $self->{_buff}, 0, $len, '' );
}
# Look around inside the buffer without changing the location for pop
method peek ( Int $offset, Int $len ) {
# ... Make sure there is data in _buff
return substr( $self->{_buff}, $offset, $len );
}
}
(There is buffer loading and managing code that I didn't include here. It is fairly straight forward.)
The problem is, I use the keyword method in the BUILDARGS declaration. So, MooseX::Declare expects a binary_file_buffer object as the first argument to BUILDARGS. But BUILDARGS gets the arguments passed to new, so the first argument is the string a 'binary_file_buffer', the name of the package. As a result it fails the type checking and dies when creating an object using new, like I did in the first code snippet. (At least that's my understanding of what is happening.)
The error message I get is:
Validation failed for 'MooseX::Types::Structured::Tuple[MooseX::Types::Structured::Tuple[Object,Str,Bool],MooseX::Types::Structured::Dict[]]' failed with value [ [ "binary_file_buffer", "drap_iono_t1.log", 0 ], { } ], Internal Validation Error is: Validation failed for 'MooseX::Types::Structured::Tuple[Object,Str,Bool]' failed with value [ "binary_file_buffer", "drap_iono_t1.log", 0 ] at C:/bin/perl/site/lib/MooseX/Method/Signatures/Meta/Method.pm line 445
MooseX::Method::Signatures::Meta::Method::validate('MooseX::Method::Signatures::Meta::Method=HASH(0x2a623b4)', 'ARRAY(0x2a62764)') called at C:/bin/perl/site/lib/MooseX/Method/Signatures/Meta/Method.pm line 145
binary_file_buffer::BUILDARGS('binary_file_buffer', 'drap_iono_t1.log') called at generated method (unknown origin) line 5
binary_file_buffer::new('binary_file_buffer', 'drap_iono_t1.log') called at logshred.pl line 13
I like the type checking sugar the method keyword supplies for $file_name, but I don't know how to get it since BUILDARGS isn't technically a method.
Does MooseX::Declare have a way to skip the $self creation, or something like that?
Am I doing this the proper MooseX::Declare way? Or am I missing something?
I think you want something like method BUILDARGS (ClassName $class: Str $filename) { ... } in which you explicitly define the invocant as ClassName $class.
I think you want:
#!/use/bin/perl
use strict;
use warnings;
use MooseX::Declare;
class BinaryFile::Buffer {
use FileHandle;
use Carp;
has file => ( is => 'ro', isa => 'FileHandle');
has file_name => ( is => 'ro', isa => 'Str');
has _buff => (
is => 'rw',
isa => 'Str',
default => '',
init_arg => undef
);
sub BUILDARGS {
my ($class, $file_name) = #_;
my $file = FileHandle->new( $file_name ) or do {
carp "unable to open ", $file_name, " : $!";
return;
};
$file->binmode;
return $class->SUPER::BUILDARGS(
file_name => $file_name,
file => $file
);
}
# get the next n bytes from the buffer.
method pop(Int $len) {
# ... Make sure there is data in _buff
return substr( $self->buff, 0, $len, '' );
}
# Look around inside the buffer without changing the location for pop
method peek(Int $offset, Int $len) {
# ... Make sure there is data in _buff
return substr( $self->buff, $offset, $len );
}
}
my $f = BinaryFile::Buffer->new($0);
print $f->file_name, "\n";
also a really neat way of doing it (just an expansion of the answer before me):
use MooseX::MultiMethods;
multi method BUILDARGS (ClassName $class: Str $filename) {
#do whatever you want to do if only a strg is passed
}
that way, MooseX::MultiMethods will take care that if you do NOT call
FileHandle->new( $file_name ),
but
FileHandle->new(
_filename => $file_name
);
(which is the normal syntax),
it would still work!
Also, you could ( which is not so useful for filenames but in other cases )
add a
multi method ( ClassName $class, Int $some_number ){}
that way, new could now handle hashrefs, integers and strings...
oh the possibilities... ;)