I'm trying to figure out how to get a method code reference using Moose.
Below is an example of what I'm trying to do:
use Modern::Perl;
package Storage;
use Moose;
sub batch_store {
my ($self, $data) = #_;
... store $data ...
}
package Parser;
use Moose;
has 'generic_batch_store' => ( isa => 'CodeRef' );
sub parse {
my $self = shift;
my #buf;
... incredibly complex parsing code ...
$self->generic_batch_store(\#buf);
}
package main;
$s = Storage->new;
$p = Parser->new;
$p->generic_batch_store(\&{$s->batch_store});
$p->parse;
exit;
The question I linked to above goes into detail about the various options when encapsulating a method call in a code ref. In your case, I would write the main package as:
my $storage = Storage->new;
my $parser = Parser->new;
$parser->generic_batch_store(sub {$storage->batch_store(#_)});
$parser->parse;
$storage is changed to a lexical so that the code reference sub {$storage->batch_store(#_)} can close over it. The (#_) added to the end allows arguments to be passed to the method.
I am not a Moose expert, but I believe that you will need to call the code with an additional dereferencing arrow:
$self->generic_batch_store->(\#buf);
which is just shorthand for:
($self->generic_batch_store())->(\#buf);
Related
How can I catch access to member variables?
$Class1->{Class2}
If the Class2 field doesn't exist, is is possible to catch this from an internal function?
You can, but you probably shouldn't. The problem here is - if you access a variable within a class directly... then you just can. You can prevent this with a couple of workarounds - and this is where things like Moose come in.
And there's a couple of slightly hacky tricks like inside-out objects (which I think aren't common practice any more - Perl Best Practice advocated them some years back) or using anonymous hashes to hold state.
But failing that - why not use an accessor, and auto-generate one using 'AUTOLOAD'.
#!/usr/bin/env perl
package MyClass;
use strict;
use warnings;
use vars '$AUTOLOAD';
sub AUTOLOAD {
my ( $self ) = #_;
my $subname = $AUTOLOAD =~ s/.*:://r;
if ( $self -> {$subname} ) {
return $self -> {$subname};
}
warn "Sub called $subname was called\n";
return "$subname";
}
sub new {
my ( $class ) = #_;
my $self = {};
bless $self, $class;
}
package main;
use strict;
use warnings;
my $object = MyClass -> new;
$object -> {var} = "fleeg";
print "Undef fiddle was: ", $object -> fiddle,"\n";
print "But 'var' was: ", $object -> var,"\n";
This has the same problem, in that changing method names might cause things to break. However it has the advantage that you can handle 'invalid' method calls however you like.
But really - explicit 'get' and 'set' methods are better choices for most use-cases.
You do this by providing proper getter/setter methods that wrap around your class/instance variables. The internals should never be accessed directly, particularly from outside of the class itself (it's wise to not do so within the class either, except for the actual method that maintains that specific attribute. Here's a very basic example:
use warnings;
use strict;
package A;
sub new {
my ($class, %args) = #_;
my $self = bless {}, $class;
$self->x($args{x});
$self->y($args{y});
return $self;
}
sub x {
my ($self, $x) = #_;
$self->{x} = $x if defined $x;
return $self->{x} // 1;
}
sub y {
my ($self, $y) = #_;
$self->{y} = $y if defined $y;
return $self->{y} // 2;
}
package main;
my $obj = A->new(x => 5, y => 3);
print $obj->x ."\n";
print $obj->y ."\n";
Now, you could just as easily do print $obj->{x}, but that's where your problem is. What happens when the code is much more complicated than this, and for some reason you want to change the x attribute name to foo, but retain the x() method? $obj->{x} will now be undef as its never set.
Always use the provided methods for accessing attributes of a class/object. Encapsulation such as this is a staple of OO programming.
I'm just trying to do this: http://modernperlbooks.com/mt/2011/08/youre-already-using-dependency-injection.html. Really not deviating too much at all from that example code.
Here's what I've got:
package M;
use Moose;
use Exporter;
use Data::Dumper;
sub new {
print "M::new!\n";
my $class = shift;
return bless {}, $class;
}
sub x {
my ($self, $stuff) = #_;
print Dumper($stuff);
}
#################################
package Foo;
use Moose;
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = ();
has 'mS', is => 'ro', default => sub { M->new };
sub new {
my $class = shift;
return bless {}, $class;
}
sub bar {
my ($self, $data) = #_;
# do stuff here...
# ...
my $foo = $self->mS;
# this...
$foo->x($data);
# ...causes "Can't call method "x" on an undefined value at Foo.pm line 45."
}
1;
It's worth noting that the M::new! message never appears, so I'm guessing that it's never reached. What's going on?
With Moose, you shouldn't write sub new. Moose provides the constructor for you.
Also, using Exporter makes no sense with object-oriented modules. The following program works for me:
#!/usr/bin/perl
{ package M;
use Moose;
use Data::Dumper;
sub x {
my ($self, $stuff) = #_;
print Dumper($stuff);
}
}
{ package Foo;
use Moose;
has mS => ( is => 'ro', default => sub { 'M'->new } );
sub bar {
my ($self, $data) = #_;
my $foo = $self->mS;
$foo->x($data);
}
}
my $foo = 'Foo'->new;
$foo->bar('test');
You have a solution - don't write your own new() method when you're using Moose. But there's one other little point that might be worth making.
The constructor that Moose will give you for your Foo class will work pretty well as a drop-in replacement for your new() method. But the one that Moose gives you for your M class will be missing a feature - it won't print your "M::new!\n" message. How do we get round that?
In Moose, you can define a BUILD() method which will be called immediately after new() has returned a new object. That's a good place to put any extra initialisation that your new object needs. It would also be be a good place for your print() call (although it happens after object construction, not before - so it's not an exact replacement).
I am trying to call subroutines from one controller file to another when I am writing the following code:
Abc.pm This is the file I have the code that I need to call a subroutine to another controller file. The following subroutine I need to call.
package MyApp::Controller::Abc;
use Moose;
use IO::File;
use Data::Dumper;
use MyApp::MyConfig;
use MyApp::DateUtils;
use MyApp::Arrs::API;
use MyApp::Constants;
use namespace::autoclean;
sub get_token_id :Private
{
my $self = shift;
my $c = $self->context;
my $myDBI = $c->model('MyDBI')->new;
return $myDBI->get_token_id;
}
The above code I need to call to Def.pm file. Now I am calling as following:
package MyApp::Controller::Def;
use Moose;
use namespace::autoclean;
use MyApp::Utils;
BEGIN { extends 'Catalyst::Controller'; }
my($self, $c) = #_;
my ($State, $Zip, $Country) = #_;
my $tokenid = $self->get_token_id;
I am getting the following error:
Can't call method "get_token_id" on an undefined value
But I need to call as following only:
When I am using the following code:
package MyApp::Controller::Def;
use Moose;
use namespace::autoclean;
use MyApp::Utils;
BEGIN { extends 'Catalyst::Controller'; }
my $self = shift;
my $c = $self->context;
my ($State, $Zip, $Country) = #_;
my $coid = $self->get_token_id;
I am getting this error:
Can't call method "context" on an undefined value
Can any one help me why I am getting this error.
Thanks in advance...
The root cause here appears to be that you're not instantiating your objects properly.
Using:
$self = shift;
is an object oriented notation, and it makes no sense if you're doing it outside a subroutine - which is what appears to be happening here. And more specifically - a subroutine that's called as a method, using $object -> subname($some_parameter);. If you do this, then perl passes a reference to the object as the first argument to the subroutine - which is where things like:
sub my_method {
my $self = shift;
$self -> {some_attribute} = 1;
$self -> some_other_method(#args);
}
or
sub some_other_method {
my ( $self, #args ) = #_;
foreach ( #args ) {
print;
}
}
type notation kicks in.
You're not doing this - you're 'shifting' in the body of a module, which will have no #_ it's undefined, and then you're trying to call a context method within an undefined object. Hence the error. get_token_id has the same root cause.
I can't easily offer advice on how to fix it, because it's hard to be sure what you're actually trying to do. I would suggest reviewing how OO perl works though, as a refresher might be beneficial.
I have a class called Question, and a bunch of sub-classes depending on the type of question. I can create objects against the sub-classes, but I shouldn't be able to create an object of class Question itself:
#! /usr/bin/env perl
use strict;
use warnings;
#
# LOAD IN YOUR QUESTIONS HERE
#
my #list_of_questions;
for my $question_type qw(Science Math English Dumb) {
my $class = "Question::$question_type";
my $question = $class->new;
push #list_of_questions, $question;
}
package Question;
use Carp;
sub new {
my $class = shift;
my $self = {};
if ( $class = eq "Question" ) {
carp qq(Need to make object a sub-class of "Question");
return;
}
bless $self, $class;
return $self;
}
yadda, yadda, yadda...
package Question::Math;
use parent qw(Question);
yadda, yadda, yadda...
package Question::Science;
use parent qw(Question);
yadda, yadda, yadda...
package Question::English;
use parent qw(Question);
yadda, yadda, yadda...
Notice these are not modules, but merely classes I've defined to be used in my program. Thus, I can't test module loading at runtime.
When I run the above, I get:
Can't locate object method "new" via package "Question::Dumb" (perhaps you forgot to load "Question::Dumb"?)
Is there any way to catch for this particular error, so I can handle it myself? I know I could create an array of valid types, but I was hoping someway of being able to add new question type without having to remember to update my array.
AFAICT what you want to do is check the symbol table to see if your "class" (aka "package") has been defined or not. Doing it manually is no hardship, but Class::Load provides slightly more readable sugar and applies "heuristics" - whatever that means. If you don't want to use this module then the source code for is_class_loaded will lead you to whatever answer you're actually seeking.
use Class::Load qw(is_class_loaded);
for my $question_type (qw(Math English Science Dumb)) {
my $class = "Question::$question_type";
if(!is_class_loaded($class)) {
# construct your new package at runtime, then
}
new_question($class);
}
Your variable name ("class_type") was weird, so I fixed it. I also don't know whether Module::Load is better, but we use Class::Load for this at work.
Edit: bare qw()s are deprecated in one of the newer Perls (5.14?). It's a stupid deprecation, but it's there, so we all have to learn to wrap our qw() foreachs in parens now.
You can't have an expression like Invalid::Class->new() not throw an exception in the calling code, but you can wrap it in exception handling and wrap that inside a method. The standard pattern is to supply a 'type' argument describing the subclass you which to create to a factory method. A common anti-pattern is to put that factory method on the base class, creating a circular dependency and having to do more work than should be required.
It is usual to have the factory method on the interface class and to have it construct sub-classes of an unrelated, dedicated base class, possibly warning or throwing when it fails. In code, that looks pretty much like so:
package Question;
use Try::Tiny;
use Carp qw/carp/;
sub new {
my ($class, $type, #args) = #_;
# could do some munging on $type to make it a class name here
my $real_class = "Question::$type";
return try {
$real_class->new(#args);
} catch {
# could differentiate exception types here
carp qq(Invalid Question type "$type");
};
}
package Question::Base;
sub new {
my ($class) = #_;
return bless {} => $class;
}
package Question::Math;
use base 'Question::Base'; # `use parent` expects to load a module
package main;
use Test::More tests => 2;
use Test::Warn;
isa_ok(Question->new('Math'), 'Question::Math');
warning_like(
sub { Question->new('Dumb') }, # I hear there's no such thing
qr/^Invalid Question/
);
Here's what I finally did:
package Question;
use Carp;
sub new {
my $class = shift;
my %params = #_;
#
# Standardize the Parameters
# Remove the dash, double-dash in front of the parameter and
# lowercase the name. Thus, -Question, --question, and question
# are all the same parameter.
#
my %option_hash;
my $question_type;
for my $key (keys %params) {
my $value = $params{$key};
$key =~ s/^-*//; #Remove leading dashes
$key = ucfirst ( lc $key ); #Make Key look like Method Name
if ( $key eq "Type" ) {
$question_type = ucfirst (lc $value);
}
else {
$option_hash{$key} = $value;
}
}
if ( not defined $question_type ) {
carp qq(Parameter "type" required for creating a new question.);
return;
}
#
# The real "class" of this question includes the question type
#
my $self = {};
$class .= "::$question_type";
bless $self, $class;
#
# All _real does is return a _true_ value. This method is in this
# class, so all sub-classes automatically inherit it. If the eval
# fails, this isn't a subclass, or someone wrote their own `_real_
# method in their sub-class.
#
eval { $self->_real; };
if ( $# ) {
carp qq(Invalid question type of $question_type);
return;
}
#
# Everything looks good! Let's fill up our question object
#
for my $method ( keys %option_hash ) {
my $method_set;
eval { $method_set = $self->$method( $option_hash{$method} ) };
if ( $# or not $method_set ) {
carp qq(Can't set "$method" for question type "$question_type");
return;
}
}
return $self;
}
Now, I'm setting my question like this:
my $question = Question->new(
--type => Integer,
--question => "Pick a number between 1 and 10.",
--help => "Try using the top row of your keyboard...",
--from => "1",
--to => "10",
);
if ( not defined $question ) {
die qq(The question is invalid!);
}
Darch use of the Try::Tiny is nice. It looks way better than wrapping everything in an eval. Unfortunately, it's not a standard module. This program is going on almost 100 separate systems, and using CPAN modules is too difficult. This is especially true since these systems are behind a firewall and can't access the CPAN website.
I basically use Darch's method except I create a _real method in my super-class that I try after I bless the object. If it executes (that's all I really care), then this is a sub-class of my super-class.
This does what I really want: Hide my sub-classes behind my superclass -- much like File::Spec does. Most of my classes have the same methods, and a few have one or two extra methods. For example, my Regex question type has a Pattern method that allows me to make sure the answer given matches a given pattern.
I'm working with a few Perl packages, we'll call them Some::Parser and Some::Data. A Some::Parser object has methods to return objects of type Some::Data. I have written a class that extends the Some::Data class, let's call it My::Data. Objects of class My::Data are really just objects of class Some::Data, but with additional methods that make it easier to work with.
My problem is that I want to continue to use the Some::Parser class to do the hard work of parsing the data. As I said earlier, Some::Parser objects give me Some::Data objects. Once I have a Some::Data object in hand, is there any way to reclassify it as a My::Data object? How would I do this?
I'm totally willing to change my approach, assuming someone can suggest a better way of doing what I want to do, but writing my own parser is not something I'm interested in doing!
This smells like a bit of a kludge. It might be time to rethink your strategy. For example, maybe you should write My::Parser which returns My::Data objects.
But if you don't want to do that, you can manually use bless to change an object's class:
my $obj = Some::Data->new;
bless $obj, 'My::Data';
See bless in perldoc.
Probably the best way to handle something like this is for Some::Parser to provide a way to specify the class it should be using for data objects. For example, HTML::TreeBuilder provides the element_class method. If you want TreeBuilder to produce something other than HTML::Element nodes, you subclass HTML::TreeBuilder and override element_class to return your desired node class. (The actual code in TreeBuilder is a bit more complex, because there was a different mechanism for doing this prior to HTML-Tree 4, and the new maintainer didn't want to break that.)
I take it that you didn't write Some::Parser, but perhaps it has this capability already. If not, maybe its maintainer will accept a patch. It should be a fairly simple change. You'd just add a data_class method (sub data_class { 'Some::Data' }), and then change Some::Data->new to $self->data_class->new. Then you can subclass Some::Parser to create My::Parser, and just override data_class.
You can rebless anything.
Inheritance in Perl 5 is nothing more than searching #ISA.
You can re-bless the returned object to whatever your heart desires:
#!/usr/bin/perl
package Some::Data;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub a { $_[0]->{a} }
package My::Data;
use strict; use warnings;
use base 'Some::Data';
sub a_squared {
my $self = shift;
my $v = $self->a;
return $v * $v;
}
package Some::Parser;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub parse { return Some::Data->new(a => 3) }
package main;
use strict; use warnings;
my $data = Some::Parser->new->parse;
bless $data => 'My::Data';
printf "%.1f\t%.1f\n", $data->a, $data->a_squared;
Alternatively, you can use #cjm's idea:
#!/usr/bin/perl
package Some::Data;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub a { $_[0]->{a} }
package My::Data;
use strict; use warnings;
use base 'Some::Data';
sub a_squared {
my $self = shift;
my $v = $self->a;
return $v * $v;
}
package Some::Parser;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub parse {
my $self = shift;
return $self->data_class->new(a => 3);
}
sub data_class { $_[0]->{data_class} }
package main;
use strict; use warnings;
my $data = Some::Parser->new(data_class => 'My::Data')->parse;
printf "%.1f\t%.1f\n", $data->a, $data->a_squared;
I'd consider re-blessing venturesome. Once you have an object you can't really tell if it was created using its constructor ( usually Foo::new() ), or someone re-blessed some other object.
The problem is, some constructors are fat, this means they do a whole lotta more than just blessing something:
sub new {
my $pkg = shift;
my ($required) = #_;
croak "Bad call" unless defined $required;
_do_something_magic ($required);
my $self = { 'foo' => $required };
return bless $self, $pkg;
}
In this case your re-blessed object might not be the one you'll expect later in code.
One may consider constructors with "re-blessing" functionality build in. But such "object converters" will make the design even more complicated.
Stick to the basic definition: "An object is an instance of the class. Forever.".