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

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;

Related

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)],
);

Why doesn't a subclass inherit its parent's constants?

So I was going about my Moosey business and I thought hey might be nice to use a constant in these places where I'm using numbers, to make it clear what these numbers mean or in case they change later
So in the parent class I added the standard 'use constant'
package Parent;
use constant {
NO_LEVEL => 0,
MY_LEVEL => 1,
YOUR_LEVEL => 2,
};
package Child;
extends 'Parent';
#just to demonstrate that child can or cannot access the constant
sub printMyLevel{
print MY_LEVEL;
}
but the child class is not aware of the constants set in the parent! doh!
I'm guessing I have to do some Moose magic to get this to work right, or something else entirely. My searching on this issue didnt pull up any results =/
Constants are subroutines.
{
package Parent;
use Moose;
use namespace::autoclean;
use constant {
NO_LEVEL => 0,
MY_LEVEL => 1,
YOUR_LEVEL => 2,
};
__PACKAGE__->meta->make_immutable;
};
{
package Child;
use Moose;
use namespace::autoclean;
extends 'Parent';
sub printMyLevel {
my $self = shift;
my $class = ref $self;
print $class->MY_LEVEL;
}
__PACKAGE__->meta->make_immutable;
}
package main;
my $child = Child->new;
$child->printMyLevel;
Keep in mind that constants are subroutines with an empty prototype. perl takes advantage of this to inline them during compilation. However, method calls disregard prototypes, and therefore inheritable constants accessed this way would not be inlined.
This is actually mentioned in the documentation, if only in passing:
"Constants belong to the package they are defined in. To refer to a constant defined in another package, specify the full package name, as in Some::Package::CONSTANT. Constants may be exported by modules, and may also be called as either class or instance methods, that is, as Some::Package->CONSTANT or as $obj->CONSTANT where $obj is an instance of Some::Package. Subclasses may define their own constants to override those in their base class."
Since the constants are subroutines and you can get inheritance by calling them as methods bit has been covered to death already, here is a different spin on things.
If you know you are only working in a single file, you can use lexical constants to bridge packages:
package Parent;
our ($NO_LEVEL, $MY_LEVEL, $YOUR_LEVEL);
*NO_LEVEL = \0; # this split declaration installs aliases to numbers
*MY_LEVEL = \1; # into the lexicals. since numbers are constants
*YOUR_LEVEL = \2; # to perl, the aliased names are also constants
package Child;
# just to demonstrate that anything below can access the constants
sub printAll {
print "$NO_LEVEL $MY_LEVEL $YOUR_LEVEL\n";
}
Child->printAll; # 0 1 2
eval {$NO_LEVEL = 3} or print "error: $#\n";
# error: Modification of a read-only value attempted at ...
If you don't need perl to die when assigning to the constant, the our declaration gets a bit simpler (and could be a my):
our ($NO_LEVEL, $MY_LEVEL, $YOUR_LEVEL) = (0, 1, 2);
You can bring back the constant nature while still using the terse syntax with a little magic:
my $constant = sub {Internals::SvREADONLY($_[$_], 1) for 0 .. $#_};
package Parent;
$constant->(our ($NO_LEVEL, $MY_LEVEL, $YOUR_LEVEL) = (0, 1, 2));
package Child;
# just to demonstrate that anything below can access the constants
sub printAll {
print "$NO_LEVEL $MY_LEVEL $YOUR_LEVEL\n"; # interpolates :)
}
Child->printAll; # 0 1 2
eval {$NO_LEVEL = 3} or print "error: $#\n";
# error: Modification of a read-only value attempted at ...
You can of course omit the $constant coderef and inline the magic:
package Parent;
Internals::SvREADONLY($_, 1)
for our ($NO_LEVEL, $MY_LEVEL, $YOUR_LEVEL) = (0, 1, 2);
Call them as a method.
sub printMyLevel{
my ( $self, ) = $_;
print $self->MY_LEVEL;
}
Inheritance affects methods calls ($x->m), period.

How can I make all lazy Moose features be built?

I have a bunch of lazy features in a Moose object.
Some of the builders require some time to finish.
I would like to nvoke all the builders (the dump the "bomplete" object).
Can I make all the lazy features be built at once, or must I call each feature manually to cause it builder to run?
If you want to have "lazy" attributes with builders, but ensure that their values are constructed before new returns, the usual thing to do is to call the accessors in BUILD.
sub BUILD {
my ($self) = #_;
$self->foo;
$self->bar;
}
is enough to get the job done, but it's probably best to add a comment as well explaining this apparently useless code to someone who doesn't know the idiom.
Maybe you could use the meta class to get list of 'lazy' attributes. For example:
package Test;
use Moose;
has ['attr1', 'attr2'] => ( is => 'rw', lazy_build => 1);
has ['attr3', 'attr4'] => ( is => 'rw',);
sub BUILD {
my $self = shift;
my $meta = $self->meta;
foreach my $attribute_name ( sort $meta->get_attribute_list ) {
my $attribute = $meta->get_attribute($attribute_name);
if ( $attribute->has_builder ) {
my $code = $self->can($attribute_name);
$self->$code;
}
}
}
sub _build_attr1 { 1 }
sub _build_attr2 { 1 }
I've had this exact requirement several times in the past, and today I actually had to do it from the metaclass, which meant no BUILD tweaking allowed. Anyway I felt it would be good to share since it basically does exactly what ether mentioned:
'It would allow marking attributes "this is lazy, because it depends
on other attribute values to be built, but I want it to be poked
before construction finishes."'
However, derp derp I have no idea how to make a CPAN module so here's some codes:
https://gist.github.com/TiMBuS/5787018
Put the above into Late.pm and then you can use it like so:
package Thing;
use Moose;
use Late;
has 'foo' => (
is => 'ro',
default => sub {print "setting foo to 10\n"; 10},
);
has 'bar' => (
is => 'ro',
default => sub {print 'late bar being set to ', $_[0]->foo*2, "\n"; $_[0]->foo*2},
late => 1,
);
#If you want..
__PACKAGE__->meta->make_immutable;
1;
package main;
Thing->new();
#`bar` will be initialized to 20 right now, and always after `foo`.
#You can even set `foo` to 'lazy' or 'late' and it will still work.

OO-Perl Aliasing Class Attributes

I have a module that I'm working on. I am setting up a few attributes like this:
$self->{FOO};
$self->{BAR};
$self->{FOOBAR};
And, I want to use AUTOLOAD to help create methods for accessing these attributes. For example, $foo->Bar() returns the value of $self->{BAR}. No problem. Everything is standard.
Now, I want to create alias Methods. For example, if someone says $obj->Fu();, I'll return $self->{FOO}. What I'd like to do is create a $self->{FU} that points to the same memory location as $self->{FOO}. That way, when I set the value of $self->{FOO}, $self-{FU} is also set. This way, I don't have to make all sorts of changes in the way AUTOLOAD works or remember to set $self->{FU} whenever I set $self->{FOO}.
Any easy way of doing this?
Yes, use Moose, rather than attempting to make explicit mapping between hash
keys. Writing your own accessors, or using AUTOLOAD, is not necessary and has
a much higher chance of error:
package MyClass;
use Moose;
use MooseX::Aliases;
has foo => (
is => 'rw', isa => 'Str',
alias => 'fu',
);
has bar => (
is => 'rw', isa => 'Str',
);
__PACKAGE__->meta->make_immutable;
no Moose;
1;
package main;
use strict;
use warnings;
use MyClass;
my $obj = MyClass->new;
$obj->foo("value");
$obj->fu("a new value");
# prints "foo has the value 'a new value'"
print "foo has the value '", $obj->foo, "'\n";
I would recommend Moose over what you're doing, but the easiest way to accomplish what you're asking is probably this:
sub Fu { shift->Foo(#_) }
This way, it doesn't matter if Foo is autoloaded or not.
The non-Moose solution is to just create an alias in the symbol table. It's not a common thing to do, and I suspect that whatever you are trying to do has a better way, Moose or otherwise. Don't use any of this if you can avoid it with a better design or interface, which are often the superior solutions to things like this.
In this AUTOLOAD routine, I look at a %Aliases hash to figure out other methods else I have to define. When I have aliases, I make proper aliases in the symbol table. It's a bit ugly, but it avoids adding another actual method in the call stack:
#!perl
use 5.010;
{
package SomeClass;
use Carp;
use vars qw($AUTOLOAD);
sub new {
return bless {
map { $_, undef } qw(FOO BAR FOOBAR)
}, $_[0];
};
my %Aliases = (
FOO => [ qw(fu) ],
);
sub AUTOLOAD {
our $method = $AUTOLOAD;
$method =~ s/.*:://;
carp "Autoloading $method";
{
no strict 'refs';
*{"$method"} = sub {
#_ > 1
?
$_[0]->{"\U$method"} = $_[1]
:
$_[0]->{"\U$method"}
};
foreach my $alias ( #{ $Aliases{"\U$method"} } ) {
*{"$alias"} = *{"$method"};
}
goto &{"$method"};
}
}
sub DESTROY { 1 }
}
my $object = SomeClass->new;
$object->foo(5);
say "Foo is now ", $object->foo;
say "Foo is now ", $object->foo(9);
say "Fu is now ", $object->fu;
say "Fu is set to ", $object->fu(17);
say "Foo is now ", $object->foo;
Now foo and fu access the same thing:
Foo is now 5
Foo is now 9
Fu is now 9
Fu is set to 17
Foo is now 17

Perl: How to create objects on the fly?

My goal is to be able to use $obj like this:
print $obj->hello() . $obj->{foo};
And I would like to create an object inline, maybe using something like this:
my $obj = (
foo => 1,
hello => sub { return 'world' }
);
but when I try to use $obj as an object, I get an error saying that $obj has not been blessed. Is there some base class (like stdClass in PHP) I can use to bless the hash so that I can use it as an object?
For those that know JavaScript, I am trying to do the following, but in Perl:
# JS CODE BELOW
var obj = { foo: 1, hello: function () { return 'world' } };
echo obj.hello() + obj.foo;
Perl would require a little help to do this. Because it doesn't consider code references stored in hashes as "methods". Methods are implemented as entries into a package symbol table. Perl is more class-oriented than JavaScript, which proudly proclaims that it is more object-oriented (on individual objects).
In order to do that functionality, you would have to create a class that mapped references in this way. The way to get around methods in the symbol table is the AUTOLOAD method. If a package contains an AUTOLOAD subroutine, when a call is made to a blessed object that Perl cannot find in the inheritance chain, it will call AUTOLOAD and set the package-scoped (our) variable $AUTOLOAD will contain the full name of the function.
We get the name of the method called, by getting the last node (after the last '::') of the fully-qualified sub name. We look to see if there is a coderef at that location, and if there is, we can return it.
package AutoObject;
use strict;
use warnings;
use Carp;
use Params::Util qw<_CODE>;
our $AUTOLOAD;
sub AUTOLOAD {
my $method_name = substr( $AUTOLOAD, index( $AUTOLOAD, '::' ) + 2 );
my ( $self ) = #_;
my $meth = _CODE( $self->{$method_name} );
unless ( $meth ) {
Carp::croak( "object does not support method='$method_name'!" );
}
goto &$meth;
}
1;
Then you would bless the object into that class:
package main;
my $obj
= bless { foo => 1
, hello => sub { return 'world' }
}, 'AutoObject';
print $obj->hello();
Normally, in an AUTOLOAD sub I "cement" behavior. That is, I create entries into the package symbol table to avoid AUTOLOAD the next time. But that's usually for a reasonably defined class behavior.
I also designed a QuickClass which creates a package for each object declared, but that contains a lot of symbol table wrangling that now days is probably better done with Class::MOP.
Given the suggestion by Eric Strom, you could add the following code into the AutoObject package. The import sub would be called anytime somebody use-d AutoObject (with the parameter 'object').
# Definition:
sub object ($) { return bless $_[0], __PACKAGE__; };
sub import { # gets called when Perl reads 'use AutoObject;'
shift; # my name
return unless $_[0] eq 'object'; # object is it's only export
use Symbol;
*{ Symbol::qualify_to_reference( 'object', scalar caller()) }
= \&object
;
}
And then, when you wanted to create an "object literal", you could just do:
use AutoObject qw<object>;
And the expression would be:
object { foo => 1, hello => sub { return 'world' } };
You could even do:
object { name => 'World'
, hello => sub { return "Hello, $_[0]->{name}"; }
}->hello()
;
And you have an "object literal" expression. Perhaps the module would be better called Object::Literal.
A more Perlish approach is to create a separate namespace for your object's desired methods and to bless the object to make those methods available for your object. The code to do this can still be quite succint.
my $obj = bless { foo => 1 }, "bar";
sub bar::hello { return 'world' };
As gbacon suggests, if you're willing to write $obj->{hello}->() instead of $obj->hello(), you can skip the bless operation.
my $obj = { foo => 1, hello => sub { return 'world' } };
Try Hash::AsObject from CPAN.
In whatever function you're creating the object in, you need to call bless on your object in order to enable method calling.
For example:
package MyClass;
sub new
{
my $obj = {
foo => 1
};
return bless($obj, "MyClass");
}
sub hello
{
my $self = shift;
# Do stuff, including shifting off other arguments if needed
}
package main;
my $obj = MyClass::new();
print "Foo: " . $obj->{foo} . "\n";
$obj->hello();
EDIT: If you want to be able to use subroutine references to provide dynamic functionality for your objects...
First, you can create your code reference like so (within this hash constructor example):
my $obj = {
foo => 1,
hello => sub { print "Hello\n"; },
}
You can then invoke it like this:
my $obj = MyClass::new(); # or whatever
$obj->{hello}->(#myArguments);
A little cumbersome, but it works. (You might not even need the second arrow, but I'm not sure.)
$obj would be a scalar, so whatever you assign to it has to be a scalar as well. You could either say
my %obj = ( foo => 1, hello => sub { return 'world' });
or
my $obj = { foo => 1, hello => sub { return 'world' }};
The latter, with the curly braces, creates a hash reference (which is a scalar, so it can go into $obj). To get to the stuff inside a hash reference, though, you have to use the arrow operator. Something like $obj->{foo} or &{$obj->{hello}}.
Unless you need to have lists of hashes or something like that, it's generally better to use the first method.
Either way, you won't be able to say $obj->hello(). Perl uses that syntax for its own flavor of OOP, which would have the hello function in a separate package that your reference has been blessed into. Like:
package example;
sub new {} { my $result = {}; return bless $result, 'example' }
sub hello { return 'world' }
package main;
my $obj = example->new();
As you can see, the methods you can call are already defined, and it's not trivial to add more. There are magic methods you can use to do such a thing, but really, it's not worth it. &{$obj{hello}} (or &{$obj->{hello}} for a reference) is less effort than trying to make Perl work like Javascript.
It's spelled a little bit differently in Perl:
my $obj = { foo => 1, hello => sub { return "world" } };
print $obj->{hello}() . $obj->{foo};
But the code is awkward. The warning you saw about the reference not being blessed is telling you that your objects aren't implemented in the way Perl expects. The bless operator marks an object with the package in which to begin searching for its methods.
Tell us what you want to do in terms of your problem domain, and we can offer suggestions for a more natural approach in Perl.
Methods in Perl are not properties of the object like they are in Python. Methods are plain regular functions functions in a package associated with the object. Regular functions taking an extra argument for the self reference.
You cannot have dynamically created functions as methods.
Here is a quote from perldoc perlobj:
1. An object is simply a reference that happens to know which class it
belongs to.
2. A class is simply a package that happens to provide methods to deal
with object references.
3. A method is simply a subroutine that expects an object reference
(or a package name, for class methods) as the first argument.
Oh, and bless() is how you establish the connection between the reference and the package.
I recommend using Class::Struct as explained in perltoot man page.
Instead of paraphrasing the documentation, let me quote it as it explained well how this works:
"What it does is provide you a way to "declare" a class as having objects whose fields are of a specific type. The function that does this is called, not surprisingly enough, struct(). Because structures or records are not base types in Perl, each time you want to create a class to provide a record-like data object, you yourself have to define a new() method, plus separate data-access methods for each of that record's fields. You'll quickly become bored with this process. The Class::Struct::struct() function alleviates this tedium."
Still quoting from the doc is an example way on how to implement it:
use Class::Struct qw(struct);
use Jobbie; # user-defined; see below
struct 'Fred' => {
one => '$',
many => '#',
profession => 'Jobbie', # does not call Jobbie->new()
};
$ob = Fred->new(profession => Jobbie->new());
$ob->one("hmmmm");
$ob->many(0, "here");
$ob->many(1, "you");
$ob->many(2, "go");
print "Just set: ", $ob->many(2), "\n";
$ob->profession->salary(10_000);