I'm fairly new to Moose and OO programming. Looking for some guidance. I've got the following Dir Moose class that builds a listing of File objects:
#!usr/bin/perl
package Dir;
use Moose;
use Modern::Perl;
has 'files' => (is => 'rw', isa => 'HashRef[File]' );
<..>
sub BUILD {
my $self = shift;
<..>
map { $files{$_} = File->new ( path => $path . '/' . $_ ) } #file_names;
$self->files ( \%files );
<..>
}
I'm trying to write a new class called MyDir that extends the Dir class above. However, instead of creating File class objects, I want to use specialized objects that extends File objects:
#!usr/bin/perl
package MyDir;
use Moose;
use Modern::Perl;
has 'type' => (is => 'ro', isa => 'Str', default => '');
has 'files' => (is => 'rw', isa => 'HashRef[MyFile]' );
I'm thinking Moose probably has way to do this without rewriting the BUILD subroutine but I'm unsure of how to implement this.
I found a good solution by adding a new attribute:
has 'file_class' => (is => 'ro', isa => 'ClassName', default => 'File');
And now my code that sets the files attribute is this:
map { $files{$_} = $self->file_class->new ( path => $path . '/' . $_ ) } #file_names;
Related
I would like to be able to declare one of a set of mutually dependent attributes required.
Let's assume a simple example of Number 'nr_two' being 'nr_one' + 1, and 'nr_one' being 'nr_two' -1, with one of either having to be passed in upon initialization.
So far, I have seen this problem solved for example through BUILDARGS checks and a lazy builder on each:
has 'nr_one' => (
is => 'ro',
isa => 'Num',
lazy => 1,
builder => '_build_nr_one',
);
sub _build_nr_one { shift->nr_two - 1; }
has 'nr_two' => (
is => 'ro',
isa => 'Num',
lazy => 1,
builder => '_build_nr_two',
);
sub _build_nr_two { shift->nr_one + 1; }
around 'BUILDARGS' => sub {
my $orig = shift;
my $self = shift;
my $args = is_hashref($_[0])? $_[0] : { #_ };
die "Either nr_one or nr_two is required!" unless defined $args{nr_one} || defined $args{nr_two};
return $self->$orig($args);
};
Or, avoiding the around:
has 'nr_one' => (
is => 'ro',
isa => 'Num',
predicate => 'has_nr_one',
lazy => 1,
builder => '_build_nr_one',
);
sub _build_nr_one { shift->nr_two - 1; }
has 'nr_two' => (
is => 'ro',
isa => 'Num',
predicate => 'has_nr_two',
lazy => 1,
builder => '_build_nr_two',
);
sub _build_nr_two { shift->nr_one + 1; }
sub BUILD {
my $self = shift;
die "Either nr_one or nr_two is required!" unless $self->has_nr_one || $self->has_nr_two;
}
However, I am looking for something that can be declared on the attributes,
for example a grouping of some sort that can then be introspected and, for example, triggered in BUILD.
Ideally, I'd like to ship this into a generic role or Meta class to make it available
with some sort of nicer syntax, to avoid having to check for BUILD(ARGS) checks
or rely on the pod to declare things accurately.
Is there cpan module that could help with this, or a pattern someone is aware of to achieve this?
Any hints / partial solutions are appreciated, if not :)
An example of what I would imagine would look something like this:
has 'nr_one' => (
is => 'ro',
isa => 'Num',
lazy => 1,
builder => '_build_nr_one',
required_grouping => 'NumberGroup',
);
sub _build_nr_one { shift->nr_two - 1; }
has 'nr_two' => (
is => 'ro',
isa => 'Num',
lazy => 1,
builder => '_build_nr_two',
required_grouping => 'NumberGroup',
);
sub _build_nr_two { shift->nr_one + 1; }
# when initialized without any attributes, error thrown:
# "One of 'nr_one', 'nr_two' is required"
# or, probably easier: "NumberGroup required!"
I did not find a way to make a custom MooseX::Type or attribute trait automatically add a method modifier to BUILDARGS() that would validate the attributes. But it is simple to do that with a Moose::Role like this:
#! /usr/bin/env perl
package NumberGroup;
use Moose::Role;
around 'BUILDARGS' => sub {
my $orig = shift;
my $self = shift;
my $args = (ref $_[0]) eq "HASH" ? $_[0] : { #_ };
die "Either nr_one or nr_two is required!" unless defined $args->{nr_one} || defined $args->{nr_two};
return $self->$orig($args);
};
package Main;
use Moose;
with 'NumberGroup';
has 'nr_one' => (
is => 'ro',
isa => 'Num',
);
has 'nr_two' => (
is => 'ro',
isa => 'Num',
);
package main;
use strict;
use warnings;
Main->new();
Output:
Either nr_one or nr_two is required! at ./p.pl line 8.
Initially topic was started here, but I need a working code example how to properly delegate attributes with Moo or Moose.
Based on documentation I wrote this code to check:
package Cat;
use Moo;
has 'token' => ( is => 'rw', default => '12345' );
has 'tiger' => ( is => 'rw', default => sub { my $self = shift; Cat::Tiger->new(token => $self->token) }, handles => [ qw(token) ] );
package Cat::Tiger;
use Moo;
extends 'Cat';
# + some additional methods
package main;
use Data::Dumper;
my $cat = Cat->new(token=>'54321');
warn $cat->token;
warn $cat->tiger->token;
But this code produce an error:
You cannot overwrite a locally defined method (token) with a
delegation at 3.pl line 5
If I remove handles => [ qw(token) ] at line 5 code will return another error:
Deep recursion on subroutine "Tiger::new" at 3.pl line 5.
So how to do?
I need to set token of Cat::Tiger object ($cat->tiger->token) same as in Cat object ($cat-token) and synс them everytime when token of Cat object changed.
Well, problem solved with moving token to separate class and using MooX::Singleton for this class:
package Credentials;
use Moo;
with 'MooX::Singleton';
has 'token' => ( is => 'rw', default => '12345' );
package Cat;
use Moo;
has 'credentials' => ( is => 'rw', default => sub { Credentials->instance }, handles => [qw(token)] );
has 'tiger' => ( is => 'rw', default => sub { Cat::Tiger->new(token => shift->token) } );
package Cat::Tiger;
use Moo;
has 'credentials' => ( is => 'rw', default => sub { Credentials->instance }, handles => [qw(token)] );
package main;
use Data::Dumper;
my $cat = Cat->new;
warn $cat->token;
warn $cat->tiger->token;
$cat->token('54321');
warn $cat->token;
warn $cat->tiger->token; # will be also 54321
If someone knows better solution you are welcome to suggest it :)
I have WrapperClass object that has an InnerClass object as an attribute. The InnerClass object has a weight attribute. My WrapperClass object also has a weight attribute and I want its default value to be whatever the value of the InnerClass object's weight attribute is.
#!/usr/bin/perl
package InnerClass;
use Moose;
has 'weight' => (
is => 'rw',
);
package WrapperClass;
use Moose;
has 'wrapped' => (
is => 'rw',
lazy => 1,
default => sub {InnerClass->new(weight => 1)},
);
has 'weight' => (
is => 'rw',
default => sub {
my $self = shift;
$self->wrapped->weight()
},
lazy => 1,
);
The code above works, but in reality InnerClass has many attributes which WrapperClass needs to do the same thing for. Ideally I would do something like this when I'm writing WrapperClass:
use Moose;
has 'wrapped' => (
is => 'rw',
);
my #getDefaultsFromWrappers
= qw(weight height mass x y z label); # etc ...
foreach my $attr (#getDefaultsFromWrappers) {
has $attr => (
is => 'rw',
default => sub {
# Somehow tell the default which attribute
# it needs to call from wrapped object?
my $self = shift;
$self->wrapped->???()
},
lazy => 1,
);
}
However, there is no way of passing an argument to a default or builder to tell it which attribute it is building. I've considered using caller but this seems like a hack.
Does anyone know how I could accomplish this style of attribute declaration or is it a case of declaring each attribute and its default separately?
You can use $attr where your question marks are because it is still in scope when you declare the attributes.
foreach my $attr (#getDefaultsFromWrappers) {
has $attr => (
is => 'rw',
default => sub { shift->wrapped->$attr() },
lazy => 1,
);
}
The following is a possible alternative, which you might want to use if your attribute declarations are not uniform:
has weight => (
is => 'rw',
isa => 'Num',
default => _build_default_sub('weight'),
lazy => 1,
);
has label => (
is => 'rw',
isa => 'Str',
default => _build_default_sub('label'),
lazy => 1,
);
sub _build_default_sub {
my ($attr) = #_;
return sub { shift->wrapped->$attr };
}
This may be better handled by method delegation and default values in the inner object.
With these, the example you gave can be better written as:
#!/usr/bin/perl
use strict;
use warnings;
package InnerClass;
use Moose;
has weight => (
is => 'rw',
default => 1,
);
package WrapperClass;
use Moose;
has wrapped => (
is => 'rw',
isa => 'InnerClass',
lazy => 1,
default => sub { InnerClass->new },
handles => [ 'weight' ],
);
package main;
my $foo = WrapperClass->new;
print $foo->weight;
Any additional defaults would be added as default on the InnerClass, and within the WrapperClass, add to wrapped 'handles' array ref to indicate that it should be delegated to that object.
If don't want the defaults to be applied to all instances of InnerClass, then you can remove the default from there, specify all attributes required (to give better error detection), and specify all attributes in the default constructor.
In my previous question Moose - Loading values from conf files... Jack Maney was kind enough to provide an example of how to do so using Moose.
In order to make the configuration object even more general I decided to use Config::Auto.
The problem is that I still am very green as to how Moose works. For instance, Jack's example is:
package My::Module;
use Moose;
has 'config'=>(isa=>'HashRef[Str]',is=>'rw',required=>1);
around BUILDARGS=>sub
{
my $orig=shift;
my $class=shift;
my $args=shift; #other arguments passed in (if any).
my %config_hash=();
open(my $read,"<","config_file") or confess $!;
while(<$read>)
{
chomp;
my #array=split /:/;
$config_hash{$array[0]}=$array[1];
}
close($read);
$args->{config}=\%config_hash;
return $class->$orig($args);
};
no Moose;
1;
I had modified it to this:
#!/usr/local/bin/perl
package DART::Setup;
use namespace::autoclean;
use Moose;
use Config::Auto;
our $VERSION = '0.0.1';
has 'EMPTY' => ( isa => 'Str', is => 'ro', default => q{} );
has 'PPLTESTEXECUTIONID' => ( isa => 'Int', is => 'ro', default => 0 );
has 'SARQTESTEXECUTIONID' => ( isa => 'Int', is => 'ro', default => 0 );
has 'ISPROXY' => ( isa => 'Int', is => 'ro', default => 0 );
has 'LOCALHOST' => ( isa => 'Str', is => 'ro', default => '127.0.0.1' );
has 'config'=>(isa=>'HashRef[Str]',is=>'rw',required=>1);
has 'SSO' => ( isa => 'Str', is => 'rw', default => q{} );
has 'cookieFile' => ( isa => 'Str', is => 'rw', default => q{} );
around BUILDARGS=>sub
{
my $orig=shift;
my $class=shift;
my $args=shift;
my $cfg = Config::Auto::parse($args);
my %config_hash = %{$cfg};
$args->{config}=\%config_hash;
return $class->$orig($args);
};
return 1;
But to be honest I'm not sure what I'm doing here. First off, how many arguments do I need to provide when I'm creating a new Setup object? Do I just pass it the path to my configuration file, something like:
my $newConfig = DART::Setup->new('/home/y/conf/MyApp/MyApp.cfg');
Or do I need to provide arguments for $orig and $class?
Finally, how do I now access my newly loaded configurations? Can I do something like:
my %configHash = %{$newConfig->config()};
foreach my $key (keys %configHash) {
print "the key is, $key, and the value is: $configHash{$key}\n";
}
Am I understanding this correctly?
Okay, inside of BUILDARGS, you want to read in the config file and pass the key-value pairs into the config attribute. Here's a modified version with another attribute for the config file.
package My::Module;
use Moose;
use Config::Auto;
has 'config'=>(isa=>'HashRef[Str]',is=>'rw',required=>1);
has 'config_file'=>(isa=>'Str',is=>'ro');
around BUILDARGS=>sub
{
my $orig=shift;
my $class=shift;
my $args=shift; #currently {config_file=>'/path/to/file/config_file.conf'} (or whatever)
#make sure we've been passed a config file
confess "No config file found in BUILDARGS" unless defined $args->{config_file};
#Now, we open the user-specified config file via Config::Any
my $ca=Config::Auto->new(source=>$args->{config_file},format=>"colon");
my $parsed=$ca->parse; #hash reference containing the parsed data.
#Now, we add this to our arguments that will become our attributes:
$args->{config}=$parsed;
return $class->$orig($args);
}
no Moose;
1;
The main thing to realize about BUILDARGS is that it takes the following arguments: the names of the class and original constructor (which are passed to Moose::Object) and then any other arguments passed to the constructor. So, if you call
my $mm=My::Module->new({config_file=>"/path/to/file/file.conf"});
Then, in BUILDARGS, we initially have
$args=={config_file=>"/path/to/file/file.conf"}
But after parsing the file and adding the $parsed hash reference, it turns into
$args=={config_file=>"/path/to/file/file.conf",config=>{server=>"mozilla.org",protocol=>"HTTP",...}}
etc, etc.
By writing my $cfg = Config::Auto::parse($args); inside of BUILDARGS, you're trying to pass a config_file argument to the parser in Config::Auto, and it'll have no idea what to do with it.
BUILDARGS is just a way to hook into the constructor at the beginning of construction. For your reference, the construction section of the manual might help in your understanding on that.
Jack Maney's answer is perfectly fine. Building on his suggestion to use a config_file attribute, here's an alternative that uses a lazy builder. Personally, I prefer these to BUILDARGS because the code is slightly simpler. Builders are used to set the default value of an attribute. You need to make it lazy because building the attribute depends on another attribute (in this case config_file) to ensure that construction of the object has completed and the attribute has been set.
package DART::Setup;
use namespace::autoclean;
use Moose;
use MooseX::FileAttribute;
use Config::Auto;
# use MooseX::FileAttribute (optional) to enforce that the file actually exists
# - just a shortcut to remove some boilerplate code if you want
has_file 'config_file' => (
is => 'ro',
must_exist => 1,
required => 1,
);
has 'config' => (
isa => 'HashRef[Str]',
is => 'ro',
# disallow this attribute to be set by the constructor
init_arg => undef,
# cause this attribute to be set up after construction
lazy => 1,
builder => '_build_config',
# or alternatively, use 'default' instead of 'builder'
# (but it still needs to be lazy)
#default => sub { Config::Auto::parse( shift->config_file ) },
);
sub _build_config {
my ( $self ) = #_;
my $config = Config::Auto::parse( $self->config_file );
return $config;
}
Since Perl/Moose always calls the base class' BUILD function before it calls the subclass BUILD function, there is a new instance of the base class everytime you instantiate a subclass.
How do I go about creating a static variable that can be used by all the subclasses, or alternatively how can I create a static base or abstract class? (does that approach even make sense?)
I'm trying to create a variable that dynamically enables or disables certain features of a function defined at run-time in the base class but accessible from the sub classes.
So if I do something like
my obj = My::childObject_1->new( 'use_my_var' => 1 );
it will also be true for
my obj2 = My::childObject_2->new();
my obj3 = My::childObject_3->new();
without having to specifically define that variable. Unless
my obj4 = My::childObject_2->new( use_my_var' => 0 );
in which case it would from that point be false for all subclasses because they all
extends My::BaseObject
Additionally, is there a design pattern that describes this behavior?
(Note: I'm on a shared system so I can't install MooseX -- or at least I haven't been able to figure out how to setup local PERL5LIB installs of modules in my user directory =/ so Moose-only solution helps for now!)
UPDATE
Now there is a much better way to do this, use MooseX::ClassAttribute
Then just use class_has rather than has for the methods you want shared with all instances.
package My::Class;
use Moose;
use MooseX::ClassAttribute;
class_has 'Cache' =>
( is => 'rw',
isa => 'HashRef',
default => sub { {} },
);
__PACKAGE__->meta()->make_immutable();
OLD
Additionally, is there a design pattern that describes this behavior?
Yes. It's called a Singleton. A Singleton is a pattern whereby multiple initiations (calls to ->new) will return the same object. You can either do it like this, or store the variable outside of a class. Moose provides a layer that will permit you to create Singletons easily (thought it isn't particularly hard either way): the module MooseX::Singleton. Moose also permits you to delegate to another object by using an accessor.
Here we use MooseX::Singleton, and delgation to a hidden attribute to achive the desired effect.
package MySingleton;
use MooseX::Singleton;
has 'foo' => ( is => 'rw', isa => 'Bool', default => 0 );
package ClassA;
use Moose;
has '_my_singleton' => (
isa => 'MySingleton'
, is => 'ro'
, default => sub { MySingleton->new }
, handles => [qw( foo )]
);
package ClassB;
use Moose;
has '_my_singleton' => (
isa => 'MySingleton'
, is => 'ro'
, default => sub { MySingleton->new }
, handles => [qw( foo )]
);
package main;
use Test::More tests => 5;
my $class_a = ClassA->new;
my $class_b = ClassA->new;
is( $class_a->foo(0), 0, 'Set A to false' );
is( $class_a->foo, 0, 'A Is false' );
is( $class_b->foo, 0, 'B Is false' );
is( $class_b->foo(1), 1, 'Set B to true' );
is( $class_a->foo, 1, 'A is true' );
Or, without MooseX
Please don't do this unless required. The MooseX method is much nicer:
package Underclass;
use Moose;
has 'foo' => ( is => 'rw', isa => 'Bool', default => 0 );
package SingletonWrapper;
my $obj;
sub new {
if ( $obj ) { return $obj; }
else { $obj = Underclass->new }
}
package ClassA;
use Moose;
has '_my_singleton' => (
isa => 'Underclass'
, is => 'ro'
, default => sub { SingletonWrapper->new }
, handles => [qw( foo )]
);
package ClassB;
use Moose;
has '_my_singleton' => (
isa => 'Underclass'
, is => 'ro'
, default => sub { SingletonWrapper->new }
, handles => [qw( foo )]
);