It is possible to use an after modifier in a Role for a required attribute that is populated in the consuming class via a builder method?
package A::Role;
use Moose::Role;
use IO::File;
use Carp;
requires 'properties_file';
after 'properties_file' => sub {
my $self = shift;
$self->_check_prop_file();
$self->_read_file();
};
Consuming class:
package A::B::C;
use Moose;
use Carp;
use Moose;
use Carp;
use HA::Connection::SSH;
use constant {
...
};
has 'properties_file' => ( is => 'ro',
isa => 'Str',
builder => '_build_current_data');
with 'A::Role';
sub _build_current_data { ... }
To answer your question: Yes you can. You've already done the crucial part which was to consume the role after declaring the attribute so that the accessor method is generated.
So the code that you supplied would execute in the sequence that you would expect:-
my $c = A::B::C->new;
# 'properties_file' is built by _build_current_data()
my $filename = $c->properties_file;
# _check_prop_file() and _read_file() are executed (but before $filename is assigned)
However, it does seem strange that you invoke the checking and reading of the properties file by getting properties_file. If you just want the properties file to be checked and read automatically after construction, the role could supply a BUILD method to be consumed into the class. (BUILD is executed after construction, so properties_file will be initialised already.)
sub BUILD {
my $self = shift;
$self->_check_prop_file();
$self->_read_file();
return;
}
Related
Can anyone provide a code example how do you set watchers on variable change inside of class ? I tried to do it several ways using different features (Scalar::Watcher, trigger attribute of Moo) and OOP frameworks (Moo, Mojo::Base) and but all failed.
Below is my failed code for better understanding of my task. In this example i need to update attr2 everytime when attr1 changed.
Using Mojo::Base and Scalar::Watcher:
package Cat;
use Mojo::Base -base;
use Scalar::Watcher qw(when_modified);
use feature 'say';
has 'attr1' => 1;
has 'attr2' => 2;
has 'test' => sub { # "fake" attribute for getting access to $self
my $self = shift;
when_modified $self->attr1, sub { $self->attr2(3); say "meow" };
};
package main;
use Data::Dumper;
my $me = Cat->new;
$me->attr1;
warn Dumper $me;
say $me->attr1(3)->attr2; # attr2 is still 2, but must be 3
Using Moo and trigger:
package Cat;
use Moo;
use Scalar::Watcher qw(when_modified);
use feature 'say';
has 'attr1' => ( is => 'rw', default => 1, trigger => &update() );
has 'attr2' => ( is => 'rw', default => 1);
sub update {
my $self = shift;
when_modified $self->attr1, sub { $self->attr2(3); say "meow" }; # got error here: Can't call method "attr1" on an undefined value
};
package main;
use Data::Dumper;
my $me = Cat->new;
$me->attr1;
warn Dumper $me;
say $me->attr1(3)->attr2;
Any suggestion is much appreciated.
The Moo part
got error here: Can't call method "attr1" on an undefined value
This is because Moo expects a code reference as a trigger for has. You are passing the result of a call to update. The & here doesn't give you a reference, but instead tells Perl to ignore the prototypes of the update function. You don't want that.
Instead, create a reference with \&foo and do not add parenthesis (). You don't want to call the function, you want to reference it.
has 'attr1' => ( is => 'rw', default => 1, trigger => \&update );
Now once you've done that, you don't need the Scalar::Watcher any more. The trigger already does that. It gets called every time attr1 gets changed.
sub update {
my $self = shift;
$self->attr2(3);
say "meow";
};
If you run the whole thing now, it will work a little bit, but crash with this error:
Can't locate object method "attr2" via package "3" (perhaps you forgot to load "3"?) at
That's because attr1 returns the new value, and not a reference to $self. All Moo/Moose accessors work like that. And 3 is not an object, so it doesn't have a method attr2
# this returns 1
# |
# V
say $me->attr1(3)->attr2;
Instead, do this as two calls.
$me->attr1(3);
say $me->attr2;
Here's a complete example.
package Cat;
use Moo;
use feature 'say';
has 'attr1' => ( is => 'rw', default => 1, trigger => \&update );
has 'attr2' => ( is => 'rw', default => 1 );
sub update {
my $self = shift;
$self->attr2(3);
say "meow";
}
package main;
my $me = Cat->new;
say $me->attr2;
$me->attr1(3);
say $me->attr2;
And the output:
1
meow
3
Why Scalar::Watcher does not work with Mojo
First of, Mojo::Base does not provide a trigger mechanism. But the way you implemented Scalar::Watcher could not work, because the test method was never called. I tried hooking around new in the Mojo::Base based class to do the when_modified call in a place where it would always be called.
Everything from here is on is mere speculation.
The following snippet is what I tried, but it does not work. I'll explain why further below.
package Cat;
use Mojo::Base -base;
use Scalar::Watcher qw(when_modified);
use feature 'say';
has 'attr1' => '1';
has 'attr2' => 'original';
sub new {
my $class = shift;
my $self = $class->SUPER::new(#_);
when_modified $self->{attr1}, sub { $self->attr2('updated'); say "meow" };
return $self;
}
As you can see, this is now part of the new call. The code does get executed. But it doesn't help.
The documentation of Scalar::Watcher states that the watcher should be there until the variable goes out of scope.
If when_modified is invoked at void context, the watcher will be
active until the end of $variable's life; otherwise, it'll return a
reference to a canceller, to cancel this watcher when the canceller is
garbage collected.
But we don't actually have a scalar variable. If we try to do
when_modified $self->foo
then Perl does a method call of foo on $self and when_modified will get that call's return value. I also tried reaching into the internals of the object above, but that didn't work either.
My XS is not strong enough to understand what is going on here, but I think it is having some trouble attaching that magic. It can't work with hash ref values. Probably that's why it's called Scalar::Watch.
I have a module that refuses to load unless a compile-time sanity check is met. Something like this:
package TopSecret;
use Moose;
die "Only Joe can use this!" unless $ENV{USER} eq 'joe';
1;
Now I would like to apply a similar sanity check to multiple modules, so my thought is to put it in a role. The consuming module would provide some information to customize the check a bit. So it might look something like:
package TopSecret;
use Moose;
with 'ForAuthorizedUser';
sub authorized_user { 'joe' }
1;
The problem is: how can I exercise TopSecret::authorized_user() from within ForAuthorizedUser, at compile time? Something like 'requires "authorized_user"' - except it would have to verify not just that the method exists, but execute it and check the return value.
I think that attribute overriding would be appropriate here. You declare the attribute in your Role and mark it as required, but don't provide a definition. Then the module that consumes the Role can supply the value for that attribute. Note that validation is typically done in the BUILD() subroutine.
package ForAuthorizedUser;
use Moose::Role;
use Carp qw(croak); # so you can see the line it fails on
has 'authorized_user' => (
is => 'ro',
required => 1,
);
sub BUILD {
my ($self) = #_;
croak "Only Joe can use this!"
unless $self->authorized_user eq 'joe';
}
1;
Now in your module that consumes ForAuthorizedUser, you supply the definition for the attribute:
package TopSecret;
use Moose;
with qw(ForAuthorizedUser);
has '+authorized_user' => (
default => 'joe',
);
__PACKAGE__->meta->make_immutable;
In a separate module you do the same thing, but with a different name (mine):
package TopSecret2;
use Moose;
with qw(ForAuthorizedUser);
has '+authorized_user' => (
default => 'hunter',
);
__PACKAGE__->meta->make_immutable;
Then you could test this like so:
use TopSecret;
use TopSecret2;
TopSecret->new; # lives
TopSecret2->new # croaks Only Joe can use this! at constructor TopSecret2::new (defined at Test.pm line 35) line 36.
I'm trying to create child classes in Perl that inherit class functions from a single parent. I got it to partially work, using the object method syntax Child->inheritedMethod() to call inherited functions outside the child, and my $class=shift; $class->inheritedMethod(); inside the child class, as described here.
However, for inherited methods, it seems control is passed to parent class, and the method is run in the parent scope with the parent variables. For example, this is in the Parent class:
our $VERSION = 0.11;
our $NICKNAME = "Parent Base";
sub version{ $VERSION }
sub whoami{ $NICKNAME }
sub whereami{
my $class = shift;
print "should be printing whereami right now...\n";
print "## In ",(caller(1))[3]," of ",$class->whoami," ",$class->version," in ",__PACKAGE__,"\n";
}
Each child class declares its own $VERSION and $NICKNAME, which I hoped would be accessed in place of the parent variables. But when I call whereami from the child, it gives
## Child::Method of Parent Base 0.11 in Parent.
Questions:
Is there a way around this? Some other module I should use like Moo(se)? Export all the methods instead of inheritance, which I hear shouldn't be done (polluting the namespace, not a problem here)?
Would this still be an issue using objects and object
attributes/variables? I'm trying to avoid it due to my team's
aversion to object-oriented.
Is this how inheritance usually works,
or just Perl? I thought the method would be called within the scope
of the child class, not passed to the parent.
The problem is that the method accesses the variable from the lexical scope where it was declared, i.e. the parent class. Class variables are therefore not the same thing as class attributes.
You can access the correct variable by fully qualifying its name (not possible under strict refs:
#!/usr/bin/perl
use warnings;
use strict;
{ package Parent;
our $package = 'Parent';
sub get_package {
my $class = shift;
{ no strict 'refs';
return (caller(0))[3], $class, ${"$class\::package"}
}
}
}
{ package Son;
use parent 'Parent';
our $package = 'Son';
}
print join ' ', 'Son'->get_package, "\n";
print join ' ', 'Parent'->get_package, "\n";
In Moo*, you can use Moo*X::ClassAttribute:
#!/usr/bin/perl
use warnings;
use strict;
{ package Parent;
use Moo;
use MooX::ClassAttribute;
class_has package => (is => 'ro',
default => 'Parent');
sub get_package {
my $class = shift;
return $class->package;
}
}
{ package Son;
use Moo;
use MooX::ClassAttribute;
extends 'Parent';
class_has package => (is => 'ro',
default => 'Son');
}
print 'Parent'->get_package, "\n";
print 'Son'->get_package, "\n";
Note that MooX::ClassAttribute says
Overriding class attributes and their accessors in subclasses is not yet supported.
Unlike in Moose, you can't use the class_has '+package' => (default => 'Son'); syntax for overriding.
I have a Moose class that needs to send requests of type Foo::Request. I need to make this dependency accessible from the outside, so that I can easily exchange the request implementation in tests. I came up with the following attribute:
has request_builder => (
is => 'rw',
isa => 'CodeRef',
default => sub {
sub { Foo::Request->new(#_) }
}
);
And then in code:
my $self = shift;
my $request = $self->request_builder->(path => …);
And in tests:
my $tested_class = …;
my $request = Test::MockObject->new;
$request->mock(…);
$tested_class->request_builder(sub { $request });
Is there a more simple / more idiomatic solution?
How about applying a role dynamically in your tests with Moose::Util::apply_all_roles? I have been wanting to use this for a while, but haven't had an excuse yet. Here is how I think it would work.
First, modify your original attribute slightly:
package MyClientThing;
has request => (
is => 'rw',
isa => 'Foo::Request',
builder => '_build_request',
);
sub _build_request { Foo::Request->new };
....
Then create a Test::RequestBuilder role:
package Test::RequestBuilder;
use Moose::Role;
use Test::Foo::Request; # this module could inherit from Foo::Request I guess?
sub _build_request { return Test::Foo::Request->new };
Meanwhile in 't/my_client_thing.t' you would write something like this:
use MyClientThing;
use Moose::Util qw( apply_all_roles );
use Test::More;
my $client = MyClientThing->new;
apply_all_roles( $client, 'Test::RequestBuilder' );
isa_ok $client->request, 'Test::Foo::Request';
See Moose::Manual::Roles for more info.
My suggestion, following the model in chromatic's article (comment above by Mike), is this:
In your class:
has request => (
is => 'ro',
isa => 'CodeRef',
default => sub {
Foo::Request->new(#_)
}
);
In your test:
my $request = Test::MockObject->new;
$request->mock(…);
my $tested_class = MyClass->new(request => $request, ...);
Does exactly what your code does, with the following refinements:
make the attribute read-only and set it in the constructor, if possible, for better encapsulation.
your request attribute is a ready-to-use object; no need to dereference the sub ref
Consider this approach:
In your Moose class define an 'abstract' method called make_request. Then define two roles which implement make_request - one which calls Foo::Request->new and another one which calls Test::MockObject->new.
Example:
Your main class and the two roles:
package MainMooseClass;
use Moose;
...
# Note: this class requires a role that
# provides an implementation of 'make_request'
package MakeRequestWithFoo;
use Moose::Role;
use Foo::Request; # or require it
sub make_request { Foo::Request->new(...) }
package MakeRequestWithMock;
use Moose::Role;
use Test::MockRequest; # or require it
sub make_request { Test::MockRequest->new(...) }
If you want to test your main class, mix it with the 'MakeRequestWithMock' role:
package TestVersionOfMainMooseClass;
use Moose;
extends 'MainMooseClass';
with 'MakeRequestWithMock';
package main;
my $test_object = TestVersionOfMainMooseClass->new(...);
If you want to use it with the Foo implementation of 'make_request', mix it in with the 'MakeRequestWithFoo' role.
Some advantages:
You will only load in modules that you need. For instance, the class TestVersionOfMainMooseClass will not load the module Foo::Request.
You can add data that is relevant/required by your implementation of make_request as instance members of your new class. For example, your original approach of using a CODEREF can be implemented with this role:
package MakeRequestWithCodeRef;
use Moose::Role;
has request_builder => (
is => 'rw',
isa => 'CodeRef',
required => 1,
);
sub make_request { my $self = shift; $self->request_builder->(#_) };
To use this class you need to supply an initializer for request_builder, e.g.:
package Example;
use Moose;
extends 'MainMooseClass';
with 'MakeRequestWithCodeRef';
package main;
my $object = Example->new(request_builder => sub { ... });
As a final consideration, the roles you write might be usable with other classes.
I know this post is a little old, but for anyone referring to this question now the requester could use a framework like Bread::Board.
I would like some attributes (perhaps this is the wrong term in this context) to be private, that is, only internal for the object use - can't be read or written from the outside.
For example, think of some internal variable that counts the number of times any of a set of methods was called.
Where and how should I define such a variable?
The Moose::Manual::Attributes shows the following way to create private attributes:
has '_genetic_code' => (
is => 'ro',
lazy => 1,
builder => '_build_genetic_code',
init_arg => undef,
);
Setting init_arg means this attribute cannot be set at the constructor. Make it a rw or add writer if you need to update it.
/I3az/
You can try something like this:
has 'call_counter' => (
is => 'ro',
writer => '_set_call_counter',
);
is => 'ro' makes the attribute read only. Moose generates a getter. Your methods will use the getter for incrementing the value, like so:
sub called {
my $self = shift;
$self->_set_call_counter( $self->call_counter + 1 );
...
}
writer => '_set_call_counter' generates a setter named _set_call_counter. Moose does not support true private attributes. Outside code can, technically, call _set_call_counter. By convention, though, applications do not call methods beginning with an underscore.
I think you want MooseX::Privacy.
The perldoc tells you all you should need - it adds a new trait to your attributes allowing you to declare them as private or protected:
has config => (
is => 'rw',
isa => 'Some::Config',
traits => [qw/Private/],
);
I haven't been able to figure out a way to make Moose attributes completely private. Whenever I use has 'name' => (...); to create an attribute, it is always exposed to reading at a minimum. For items I want to be truly private, I'm using standard "my" variables inside the Moose package. For a quick example, take the following module "CountingObject.pm".
package CountingObject;
use Moose;
my $cntr = 0;
sub add_one { $cntr++; }
sub get_count { return $cntr; }
1;
Scripts that use that module have no direct access to the $cntr variable. They must use the "add_one" and "get_count" methods which act as an interface to the outside world. For example:
#!/usr/bin/perl
### Call and create
use CountingObject;
my $co = CountingObject->new();
### This works: prints 0
printf( "%s\n", $co->get_count() );
### This works to update $cntr through the method
for (1..10) { $co->add_one(); }
### This works: prints 10
printf( "%s\n", $co->get_count() );
### Direct access won't work. These would fail:
# say $cntr;
# say $co->cntr;
I'm new to Moose, but as far as I can tell, this approach provides completely private variables.
Alan W. Smith provided a private class variable with a lexical variable, but it is shared by all objects in the class. Try adding a new object to the end of the example script:
my $c1 = CountingObject->new();
printf( "%s\n", $c1->get_count() );
# also shows a count of 10, same as $co
Using MooseX:Privacy is a good answer, though if you can't, you can borrow a trick from the inside-out object camp:
package CountingObject;
use Moose;
my %cntr;
sub BUILD { my $self = shift; $cntr{$self} = 0 }
sub add_one { my $self = shift; $cntr{$self}++; }
sub get_count { my $self = shift; return $cntr{$self}; }
1;
With that, each object's counter is stored as an entry in a lexical hash. The above can be implemented a little more tersely thus:
package CountingObject;
use Moose;
my %cntr;
sub add_one { $cntr{$_[0]}++ }
sub get_count { return $cntr{$_[0]}||0 }
1;