Watch change of attribute inside Perl class - perl

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.

Related

Why declare a subroutine that returns a subroutine reference in Moose?

im new to Moose in perl, and i have been reading its documentation when i encountered this one which i dont quite understand:
If you want to use a reference of any sort as the default value, you must return it from a subroutine. OK i get this statement, and the next example
has 'mapping' => (
is => 'ro',
default => sub { {} },
);
This is necessary because otherwise Perl would instantiate the reference exactly once, and it would be shared by all objects: This one i dont understand, what does it mean that it would instantiate the reference exactly once and will be shared by all objects? How?
has 'mapping' => (
is => 'ro',
default => {}, # wrong!
);
Moose will throw an error if you pass a bare non-subroutine reference as the default.
If Moose allowed this then the default mapping attribute could easily end up shared across many objects. Instead, wrap it in a subroutine reference as we saw above. Dont get this again
Because it creates action at a distance, which is bad. Illustration of the problem:
package Wrong;
my $default = {};
sub new {
my ($class) = #_;
return bless $default => $class;
}
package main;
use 5.010;
my #wobj;
push #wobj, Wrong->new for 0..2;
$wobj[0]->{some_new_attr} = 'foobar';
use Data::Dumper qw(Dumper);
print Dumper $wobj[1]; # huh????!
print Dumper $wobj[2]; # that one, too?! why?
say for #wobj; # ah, it's the same shared address
package Correct;
my $default = sub { return {} };
sub new {
my ($class) = #_;
return bless $default->() => $class;
}
package main;
my #cobj;
push #cobj, Correct->new for 0..2;
$cobj[0]->{some_new_attr} = 'foobar';
print Dumper $cobj[$_] for 0..2; # instances 1 and 2 are unaffected
say for #cobj; # all different addresses

Can you call Moose::before in an imported function with local context

I'm writing a client for a REST server using Moose and trying to map the calls into objects. Since many of the calls are simple and will use a boilerplate function to pre-fetch it, I'm trying to use export a function that creates the actual before functions within each class.
package R::A;
use Moose;
use R::Util qw(make_befores);
has 'var' => (is => 'rw', isa => 'Str');
make_befores('/servercall/' => ['var']);
1;
package R::Util;
use Moose; use Moose::Exporter;
sub make_befores {
while (my ($c, $vs) = each(#_)){
before $vs => sub {
# make call and set object values
};
}
}
Moose::Exporter->setup_import_methods(
as_is => [ 'make_befores', ],
);
1;
That's probably incomplete and definitely untested but I think it relays the point. When calling make_befores, it calls it in context of R::Util and breaks since it doesn't call it as R::A with all its variables and such. If make_befores is simply copy-and-pasted into R::A, it works. This will be used in multiple classes, though, so I want it to be an import-able function.
Or am I going about this all wrong?
UPDATED:
Fuji Goro's solution worked great, but was hard to figure out for a Moose newbie like myself, so here's what it ended up looking like:
sub make_befores {
my $meta = shift;
while (my ($c, $vs) = each(#_)){
my $sub = sub { ... };
Moose::Util::add_method_modifier($meta, before => [$vs => $sub]);
}
}
before is just a syntactic sugar to the MOP. See Moose.pm. Use MOP directly, or you can use Moose::Util::add_method_modifier() and with_meta for this case.
use Moose::Util;
use Moose::Exporter;
sub make_before {
my($meta, #methods) = #_;
Moose::Util::add_method_modifier($meta, before => \#methods);
}
Moose::Exporter->setup_import_methods(
with_meta => [qw(make_before)],
);

Using a Moose alias with MooseX::Constructor::AllErrors

I'm trying to use an alias with MooseX::Aliases and MooseX::Constructor::AllErrors
However, the two don't seem to play nicely together. Consider the following example:
package Alias
{
use Moose;
use MooseX::Aliases;
use MooseX::Constructor::AllErrors;
has foo => (
is => 'rw', isa => 'Str', required => 1, alias => 'bar'
);
}
use strict;
use warnings;
use Alias;
my $obj;
eval {
$obj = Alias->new( bar => 'alias_value' );
};
if ($#)
{
foreach my $error ( $#->errors )
{
print $error ."\n";
print $error->message ."\n";
}
exit 1;
}
print $obj->bar ."\n";
$obj->foo( 'new_alias_value' );
print $obj->foo."\n";
1;
This should allow me to create an Alias object using the 'bar' alias... shouldn't it? Does anyone know if MooseX::Constructor::AllErrors is supposed to support aliased attributes?
It's a bug, in that it violates expectations, but it's not easily resolvable -- the problem is that MooseX::Aliases modifies what arguments are allowed/accepted in the constructor, but MooseX::Constructor::AllErrors is not aware of this, so when it looks at the passed values at construction time, it errors out when there is no 'agency' field.
This gets around the situation by manually moving the aliased field before MooseX::Constructor::AllErrors sees it:
around BUILDARGS => sub {
my $orig = shift;
my $self = shift;
my %args = #_;
$args{agency} //= delete $args{company};
$self->$orig(%args);
};
The good news is that this has hope of working better in the future, because
there are plans for MooseX::Aliases to be cored, which would force all other
extensions (e.g. MXCAE) to support the alias feature properly.

Moose and Roles method modifers

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;
}

How can I create internal (private) Moose object variables (attributes)?

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;