I am trying to design a class in perl. I am using Mooose. I am using an outside module (let's name it PITA::Parser.
has _parser => (
is => 'ro',
isa => 'object',
builder => _create_parser_object);
#other members here
sub _create_parser_object {
#simplified code
return PITA::Parser->new();
}
sub BUILD {
my $self = shift;
$self->_values($self->load_and_validate_data());
}
sub _load_and_validate_data {
my $values_href;
foreach $key (#key_names) {
$values_href->{$key} = $self->_parser->get_value();
#code to validate the values
return $values_href;
}
I want to mock out the PITA::Parser object. This object looks for a specific file (during new) that is not in my test folder, but rather in the environment where my code will be deployed. So, I am trying to mock it out as such:
my $mock_parser = Test::MockObject->new();
$mock_parser->mock('new', sub {});
$mock_parser->mock('get_value', sub {});
Then I want to create an object of my class
my $my_class_object(_parser => $mock_parser);
However, this does not work, I get an error that get_value can not be located by Test::MockObject.
You can use Test::MockObject to mock the parser object and pass it when creating your own object.
my $mock = Test::MockObject->new();
$mock->mock( 'frobnicate',
sub { return 'file that is not part of test environment' } );
my $obj = Your::Class->new(parser => $mock);
ok( $obj->load_and_validate_data );
It will create an object that has a method frobnicate. When called in your load_and_validate_data, it will return the controlled values you want it to return. There's a bunch of other stuff you can do with it. I suggest you take a look at the documentation.
Related
How could I get know which alias was used to call aliased subroutine? caller gives the original sub-name, but I'd like to see name used on calling.
Example:
use 5.010;
sub x_y_z {
return ( caller(0) )[3];
}
*foo_bar_baz = \&x_y_z;
say x_y_z(); # x_y_z
say foo_bar_baz(); # x_y_z, but need foo_bar_baz
Edit to address XY problem
I add another example to show my deeper intentsions. I want to create dispatch-table to route some tasks:
my $dispatch = {
x => {
y => {
z => sub {
&x_y_z;
},
}
},
a => {
b => {
c => {
d => sub {
&a_b_c_d;
},
}
}
}
}
sub foo {
my #arg = ( split '_', ( split( '::', ( caller(0) )[3] ) )[1] );
return #arg;
}
*x_y_z = \&foo;
*a_b_c_d = \&foo;
As you may imagine, this tree may grow pretty big. Now many leaves in dispatch-tree needs basically same sub, they differ just how they are called (named) and I'd like to have just one sub and alias it for specific task.
What you're trying to do is simply not possible within Perl's datamodel. An alias is just an alias, not an object with its own identity.
Note that it's possible to copy a subroutine and give it a new name, for example:
use Sub::Name;
*x_y_z = subname x_y_z => \&foo;
But you will have to do this manually.
It is not a good idea to depend on subnames for anything except for stack traces. Trying to build any logic on top of these names will likely end up in a hard to debug mess, not elegant software.
It might be better to pass the route name into the handler function as an explicit parameter, and to create a helper function to abstract over the necessary plumbing. For example:
my %routes;
sub route {
my ($name, $handler) = #_;
$routes{$name} = sub { $handler->($name => #_) };
return;
}
sub common_handler { ... }
route a_b_c => \&common_handler;
route x_y_z => \&common_handler;
route foo_bar => sub {
my ($route) = #_;
say "Custom handler invoked for route $route";
};
$routes{$name}->(#args);
If absolutely necessary you can of course implement such a route function so that it installs the handlers as a named subroutine. But at that point you are building some kind of framework like Moo(se), not an ordinary Perl module.
You can't. foo_bar_baz is an alias. caller reports the name of the subroutine as declared, not the name by which it was called. Note that not all subroutines have names and not all calls are by name. (Anonymous subs exist only as a CODE reference; they don't have an entry in the symbol table. Any sub—named or not—can be called via a reference.)
That said, you don't need aliasing here. What you really want is extra parameters for the database, table, etc., on which the sub should operate. The idiomatic way to do that is to wrap the generic sub and pass that information via the wrapper:
my %dispatch = (
a => { b => { c => sub { foo('a', 'b', 'c', #_) } } },
x => { y => { z => sub { foo('x', 'y', 'z', #_) } } },
);
$dispatch{a}{b}{c}->('foo');
$dispatch{x}{y}{z}->('bar');
sub foo {
my $db = shift;
my $table = shift;
my $task = shift;
my #params = #_;
say "$db $table $task: #params";
}
I have a class with an attribute set up as follows:
has _data => (
is => 'ro',
lazy => 1,
builder => '_load',
);
sub _load {
my $self = shift;
return retrieve $self->_file;
}
However I now want to call a method already defined on the class before returning the data.
In old-school Perl OO, I'd be doing something like this:
sub _load {
# Assuming laziness is implemented somewhere else.
my $self = shift;
$self->{_data} = retrieve $self->_file;
$self->refresh; # which does something with $self->{_data}
return $self->{_data};
}
But I can't figure out a 'clean' way to do this in Moose.
I've considered the following, but think they are quite ugly, and that there must be a better way of doing this.
If I make _data read-write, I could potentially write the data to the accessor, call the method then return the value from the accessor for Moose to write back to the accessor.
If I turn it into a plain old method then I'd have to define another attribute, say _raw_data, store the data in there, modify refresh() to use that attribute, and everything else uses _data().
Violate encapsulation and access the underlying $self->{_data} directly.
I tried an after '_load' => \&refresh;, but that just created an endless loop.
This would be a nice use of triggers:
has _data => (
is => 'ro',
lazy => 1,
builder => '_load',
trigger => sub { shift->refresh },
);
Except that triggers don't work on default/built values - only on values passed to the constructor explicitly, or passed to a writer/accessor method. Sad face. :-(
One solution would be to rewrite your refresh method so that instead of operating on $self->_data, it can accept a parameter (perhaps falling back to operating on $self->_data if no parameter is given.
sub _load {
my $self = shift;
my $tmp = retrieve $self->_file;
$self->refresh($tmp);
return $tmp;
}
sub refresh {
my $self = shift;
my $data = scalar(#_) ? $_[0] : $self->_data;
# do something with $data
}
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)],
);
I've written a simple Moose based class called Document. This class has two attributes: name and homepage.
The class also needs to provide a method called do_something() which retrieves and returns text from different sources (like a website or different databases) based on the homepage attribute.
Since there will be a lot of totally different implementations for do_something(), I'd like to have them in different packages/classes and each of these classes should know if it is responsible for the homepage attribute or if it isn't.
My approach so far involves two roles:
package Role::Fetcher;
use Moose::Role;
requires 'do_something';
has url => (
is => 'ro',
isa => 'Str'
);
package Role::Implementation;
use Moose::Role;
with 'Role::Fetcher';
requires 'responsible';
A class called Document::Fetcher which provides a default implmenentation for do_something() and commonly used methods (like a HTTP GET request):
package Document::Fetcher;
use Moose;
use LWP::UserAgent;
with 'Role::Fetcher';
has ua => (
is => 'ro',
isa => 'Object',
required => 1,
default => sub { LWP::UserAgent->new }
);
sub do_something {'called from default implementation'}
sub get {
my $r = shift->ua->get(shift);
return $r->content if $r->is_success;
# ...
}
And specific implementations which determine their responsibility via a method called responsible():
package Document::Fetcher::ImplA;
use Moose;
extends 'Document::Fetcher';
with 'Role::Implementation';
sub do_something {'called from implementation A'}
sub responsible { return 1 if shift->url =~ m#foo#; }
package Document::Fetcher::ImplB;
use Moose;
extends 'Document::Fetcher';
with 'Role::Implementation';
sub do_something {'called from implementation B'}
sub responsible { return 1 if shift->url =~ m#bar#; }
My Document class looks like this:
package Document;
use Moose;
has [qw/name homepage/] => (
is => 'rw',
isa => 'Str'
);
has fetcher => (
is => 'ro',
isa => 'Document::Fetcher',
required => 1,
lazy => 1,
builder => '_build_fetcher',
handles => [qw/do_something/]
);
sub _build_fetcher {
my $self = shift;
my #implementations = qw/ImplA ImplB/;
foreach my $i (#implementations) {
my $fetcher = "Document::Fetcher::$i"->new(url => $self->homepage);
return $fetcher if $fetcher->responsible();
}
return Document::Fetcher->new(url => $self->homepage);
}
Right now this works as it should. If I call the following code:
foreach my $i (qw/foo bar baz/) {
my $doc = Document->new(name => $i, homepage => "http://$i.tld/");
say $doc->name . ": " . $doc->do_something;
}
I get the expected output:
foo: called from implementation A
bar: called from implementation B
baz: called from default implementation
But there are at least two issues with this code:
I need to keep a list of all known implementations in _build_fetcher. I'd prefer a way where the code would automatically choose from every loaded module/class beneath the namespace Document::Fetcher::. Or maybe there's a better way to "register" these kind of plugins?
At the moment the whole code looks a bit too bloated. I am sure people have written this kind of plugin system before. Isn't there something in MooseX which provides the desired behaviour?
What you're looking for is a Factory, specifically an Abstract Factory. The constructor for your Factory class would determine which implementation to return based on its arguments.
# Returns Document::Fetcher::ImplA or Document::Fetcher::ImplB or ...
my $fetcher = Document::Fetcher::Factory->new( url => $url );
The logic in _build_fetcher would go into Document::Fetcher::Factory->new. This separates the Fetchers from your Documents. Instead of Document knowing how to figure out which Fetcher implementation it needs, Fetchers can do that themselves.
Your basic pattern of having the Fetcher role able to inform the Factory if its able to deal with it is good if your priority is to allow people to add new Fetchers without having to alter the Factory. On the down side, the Fetcher::Factory cannot know that multiple Fetchers might be valid for a given URL and that one might be better than the other.
To avoid having a big list of Fetcher implementations hard coded in your Fetcher::Factory, have each Fetcher role register itself with the Fetcher::Factory when its loaded.
my %Registered_Classes;
sub register_class {
my $class = shift;
my $registeree = shift;
$Registered_Classes{$registeree}++;
return;
}
sub registered_classes {
return \%Registered_Classes;
}
You can have something, probably Document, pre-load a bunch of common Fetchers if you want your cake and eat it too.
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;