Last week I was bitten twice by accidentally overriding methods in a subclass. While I am not a fan of inheritance, we (ab)use this in our application at work. What I would like to do is provide some declarative syntax for stating that a method is overriding a parent method. Something like this:
use Attribute::Override;
use parent 'Some::Class';
sub foo : override { ... } # fails if it doesn't override
sub bar { ... } # fails if it does override
There are a couple of issues here. First, if method loading is delayed somehow (for example, methods loaded via AUTOLOAD or otherwise later installed in the symbol table), this won't detect those methods.
Walking the inheritance tree could also get similarly expensive. I do this with Class::Sniff, but it's not really suitable for running code. I could walk the inheritance tree and simply match where there's a defined CODE slot in the appropriate symbol table and that would be faster, but if the method cache is invalidated, that would break if I were to cache those results.
So I have two questions: is this a reasonable approach and is there a hook which allows me to check if the method cache has changed? (search for 'cache' in 'perldoc perlobj').
Of course, this shouldn't break production code, I am thinking about only having it fail or warn if the TEST_HARNESS environment variable is active (and have an explicit environment variable to force it to be inactive, if production code were to set the TEST_HARNESS environment variable for some reason).
One way to enforce this:
package Base;
...
sub new {
my $class = shift;
...
check_overrides( $class );
...
}
sub check_overrides {
my $class = shift;
for my $method ( #unoverridable ) {
die "horribly" if __PACKAGE__->can( $method ) != $class->can( $method );
}
}
Memoization of check_overrides may be helpful.
If there are some cases where you want exemptions, have an alternate method name and
have the base class call that:
package Base;
...
my #unoverridable = 'DESTROY';
sub destroy {}
sub DESTROY {
my $self = shift;
# do essential stuff
...
$self->destroy();
}
Related
I have this perl object. After the object is instantiated, I'm trying to add a new method to the object within a loader method, that can then be called later.
I've tried a whole bunch of stuff that hasn't worked. Examples include:
sub loader {
my ($self) = #_;
sub add_me {
my ($self, $rec) = #_
warn "yayyyyyy";
return $rec;
}
#here are the things I've tried that dont work:
# &{$self->{add_me}} = \&add_me;
# \&{$self->{add_me}} = \&add_me;
# assuming the class definition is in Holder::Class try to add it to symblol table
# *{Holder::Class::add_me} = \&add_me;
}
EDIT:
The reason that I need to do this is I'm adding a hook in my code where the user of my software will have the ability to inject their own sub to edit a data structure as they will.
To do this, they will be able to edit a secondary file that will only contain one sub and get the data structure in question passed in, so something like:
sub inject_a_sub {
my ($self, $rec) = #_;
#do stuff to $rec
return $rec;
}
then inside my original object upon its instantiation, I check to see if the above mentioned file exists, and if so read its contents and eval them. Lastly, I want to make the eval'd code which is just a sub, a method of my object. To be precise, my object is already inheriting a method called do_something and i want to make the sub read in by the eval override the do_something method being inherited so that when called the sub from the external file runs.
its a weird problem :/
and it hurts me :(
Obi wan kenobi you're my only hope!
Cheers!
If you just want to attach functionality to a specific object, and don't need inheritance, you can store a code ref in the object and call it.
# Store the code in the object, putting it in its own
# nested hash to reduce the chance of collisions.
$obj->{__actions}{something} = sub { ... };
# Run the code
my #stuff = $obj->{__actions}{something}->(#args);
Problem is, you need to check that $obj->{__actions}{something} contains a code reference. What I would suggest is to wrap a method around this procedure.
sub add_action {
my($self, $action, $code) = #_;
$self->{__actions}{$action} = $code;
return;
}
sub take_action {
my($self, $action, $args) = #_;
my $code = $self->{__actions}{$action};
return if !$code or ref $code ne 'CODE';
return $code->(#$args);
}
$obj->add_action( "something", sub { ... } );
$obj->take_action( "something", \#args );
If you already know the class name you want to inject a method into, write the subroutine as normal but use the fully qualified name.
sub Some::Class::new_method {
my $self = shift;
...
}
Note that any globals inside that subroutine will be in the surrounding package, not in Some::Class. If you want persistent variables use state inside the subroutine or my outside the subroutine.
If you don't know the name at compile time, you'll have to inject the subroutine into the symbol table, so you were close with that last one.
sub inject_method {
my($object, $method_name, $code_ref) = #_;
# Get the class of the object
my $class = ref $object;
{
# We need to use symbolic references.
no strict 'refs';
# Shove the code reference into the class' symbol table.
*{$class.'::'.$method_name} = $code_ref;
}
return;
}
inject_method($obj, "new_method", sub { ... });
Methods in Perl are associated with a class, not an object. In order to assign a method to a single object, you have to put that object into its own class. Similar to the above, but you have to create a subclass for every instance.
my $instance_class = "_SPECIAL_INSTANCE_CLASS_";
my $instance_class_increment = "AAAAAAAAAAAAAAAAAA";
sub inject_method_into_instance {
my($object, $method_name, $code_ref) = #_;
# Get the class of the object
my $old_class = ref $object;
# Get the special instance class and increment it.
# Yes, incrementing works on strings.
my $new_class = $instance_class . '::' . $instance_class_increment++;
{
# We need to use symbolic references.
no strict 'refs';
# Create its own subclass
#{$new_class.'::ISA'} = ($old_class);
# Shove the code reference into the class' symbol table.
*{$new_class.'::'.$method_name} = $code_ref;
# Rebless the object to its own subclass
bless $object, $new_class;
}
return;
}
I left out the code to check whether or not the instance has already had this treatment by checking if its class matches /^${instance_class}::/. I leave that as an exercise for you. Creating a new class for every object is not cheap and will cost memory.
There are valid reasons to do this, but they are exceptional. You should really, really question whether you should be doing this sort of monkey patching. In general, action at a distance should be avoided.
Can you accomplish the same thing using a subclass, delegation or role?
There already exist Perl OO systems which will do this for you and much much more. You should be using one. Moose, Moo (via Role::Tiny) and Mouse can all add roles to an instance.
I have a Moose BaseDBModel which has different subclasses mapping to my tables in the database. All the methods in the subclasses are like "get_xxx" or "update_xxx" which refers to the different DB operations.
Now i want to implement a cache system for all these methods, so my idea is "before" all methods named like "get_xxx", I will search the name of the method as key in my memcache pool for value. If i found the value, then I will return the value directly instead of method.
ideally, my code is like this
BaseDBModel
package Speed::Module::BaseDBModel;
use Moose;
sub BUILD {
my $self = shift;
for my $method ($self->meta->get_method_list()){
if($method =~ /^get_/){
$self->meta->add_before_method_modifier($method,sub {
warn $method;
find_value_by_method_name($method);
[return_value_if_found_value]
});
}
}
}
SubClasses Example 1
package Speed::Module::Character;
use Moose;
extends 'Speed::Module::BaseDBModel';
method get_character_by_id {
xxxx
}
Now my problem is that when my program is running, it's repeatedly modify the methods, for example:
restart apache
visit the page which will call get_character_by_id, so I can see one warning message
Codes:
my $db_character = Speed::Module::Character->new(glr => $self->glr);
$character_state = $db_character->get_character_by_id($cid);
Warnings:
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
but if I refresh the page, I saw 2 warning messages
Warnings:
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
get_character_by_id at /Users/dyk/Sites/speed/lib/Speed/Module/BaseDBModel.pm line 60.
I am using mod_perl 2.0 with apache, every time i refresh the page, my get_character_by_id method will be modified which I don't want
Isn't your BUILD doing the add_before every time you construct a new instance? I'm not sure that's what you want.
Well, the simple/clunky way would be to set some package-level flag so you only do it once.
Otherwise, I think you want to hook into Moose's own attribute building. Have a look at this: http://www.perlmonks.org/?node_id=948231
The problem is BUILD runs every time your create an object (i.e. after every ->new() call), but add_before_method_modifier adds modifier to class, i.e. to all objects.
Simple solution
Mind, that use calls import function from used package every time. That is the place where you want to add modifiers.
Parent:
package Parent;
use Moose;
sub import {
my ($class) = #_;
foreach my $method ($class->meta->get_method_list) {
if ($method =~ /^get_/) {
$class->meta->add_before_method_modifier($method, sub {
warn $method
});
}
}
}
1;
Child1:
package Child1;
use Moose;
extends 'Parent';
sub get_a { 'a' }
1;
Child2:
package Child2;
use Moose;
extends 'Parent';
sub get_b { 'b' }
1;
So now it works as expected:
$ perl -e 'use Child1; use Child2; Child1->new->get_a; Child2->new->get_b; Child1->new->get_a;'
get_a at Parent.pm line 11.
get_b at Parent.pm line 11.
get_a at Parent.pm line 11.
Cleaner solution
Since you can't be 100% sure import will be called (since you can't be sure use will be used) the more cleaner and straightforward solution is just add something like use My::Getter::Cacher in every derived class.
package My::Getter::Cacher;
sub import {
my $class = [caller]->[0];
# ...
}
In this case every derived class should contain both extends 'Parent' and use My::Getter::Cacher since the first line is about inheritance while the second is about adding before modifier. You may count it a bit redundant, but as I said I believe it's more cleaner and straightforward.
P. S.
Maybe you should give a glance at Memoize module.
Suppose I have a function that returns a closure:
sub generator
{
my $resource = get_resource();
my $do_thing = sub
{
$resource->do_something();
}
return $do_thing;
}
# new lexical scope
{
my $make_something_happen = generator();
&$make_something_happen();
}
I would like to be able to ensure that when $make_something_happen is removed from scope, I am able to call some $resource->cleanup();
Of course, if I had a class, I could do this with a destructor, but that seems a bit heavyweight for what I want to do. This isn't really an "object" in the sense of modelling an object, it's just a functiony thing that needs to execute some code on startup and immediately prior to death.
How would I do this in Perl( and, out of curiosity, does any language support this idea)?
I'd just use a class for this. Bless the subroutine reference and still use it like you are. The get_resource then uses this class. Since I don't know what that looks like, I'll leave it up to you to integrate it:
package Gozer {
sub new {
my( $class, $subref );
bless $subref, $class;
}
sub DESTROY {
...; #cleanup
}
}
If every thing can have it's own cleanup, I'd use the class to group two code refs:
package Gozer {
sub new {
my( $class, $subref, $cleanup );
bless { run => $subref, cleanup => $cleanup }, $class;
}
sub DESTROY {
$_[0]{cleanup}();
}
}
In Perl, I don't think this is heavyweight. The object system simply attaches labels to references. Not every object needs to model something, so this is a perfectly fine sort of object.
It would be nice to have some sort of finalizers on ordinary variables, but I think those would end up being the same thing, topologically. You could do it with Perl as a tie, but that's just an object again.
I think I understand your question. In my case I want:
* A global variable that may be set at any point during the script's runtime
* To last right up to the end of the life of the script
* Explicitly clean it up.
It looks like I can do this by defining an END block; It will be run "as late as possible".
You should be able to do your $resource->cleanup(); up in there.
More here:
http://perldoc.perl.org/perlmod.html#BEGIN%2c-UNITCHECK%2c-CHECK%2c-INIT-and-END
The begincheck program on that page has the code.
I simply hate how CGI::Application's accessor for the CGI object is called query.
I would like my instance classes to be able to use an accessor named cgi to get the CGI object associated with the current instance of my CGI::Application subclass.
Here is a self-contained example of what I am doing:
package My::Hello;
sub hello {
my $self =shift;
print "Hello #_\n";
}
package My::Merhaba;
use base 'My::Hello';
sub merhaba {
goto sub { shift->hello(#_) };
}
package main;
My::Merhaba->merhaba('StackOverflow');
This is working as I think it should and I cannot see any problems (say, if I wanted to inherit from My::Merhaba: Subclasses need not know anything about merhaba).
Would it have been better/more correct to write
sub merhaba {
my $self = shift;
return $self->hello(#_);
}
What are the advantages/disadvantages of using goto &NAME for the purpose of aliasing a method name? Is there a better way?
Note: If you have an urge to respond with goto is evil don't do it because this use of Perl's goto is different than what you have in mind.
Your approach with goto is the right one, because it will ensure that caller / wantarray and the like keep working properly.
I would setup the new method like this:
sub merhaba {
if (my $method = eval {$_[0]->can('hello')}) {
goto &$method
} else {
# error code here
}
}
Or if you don't want to use inheritance, you can add the new method to the existing package from your calling code:
*My::Hello::merhaba = \&My::Hello::hello;
# or you can use = My::Hello->can('hello');
then you can call:
My::Hello->merhaba('StackOverflow');
and get the desired result.
Either way would work, the inheritance route is more maintainable, but adding the method to the existing package would result in faster method calls.
Edit:
As pointed out in the comments, there are a few cases were the glob assignment will run afoul with inheritance, so if in doubt, use the first method (creating a new method in a sub package).
Michael Carman suggested combining both techniques into a self redefining function:
sub merhaba {
if (my $method = eval { $_[0]->can('hello') }) {
no warnings 'redefine';
*merhaba = $method;
goto &merhaba;
}
die "Can't make 'merhaba' an alias for 'hello'";
}
You can alias the subroutines by manipulating the symbol table:
*My::Merhaba::merhaba = \&My::Hello::hello;
Some examples can be found here.
I'm not sure what the right way is, but Adam Kennedy uses your second method (i.e. without goto) in Method::Alias (click here to go directly to the source code).
This is sort of a combination of Quick-n-Dirty with a modicum of indirection using UNIVERSAL::can.
package My::Merhaba;
use base 'My::Hello';
# ...
*merhaba = __PACKAGE__->can( 'hello' );
And you'll have a sub called "merhaba" in this package that aliases My::Hello::hello. You are simply saying that whatever this package would otherwise do under the name hello it can do under the name merhaba.
However, this is insufficient in the possibility that some code decorator might change the sub that *My::Hello::hello{CODE} points to. In that case, Method::Alias might be the appropriate way to specify a method, as molecules suggests.
However, if it is a rather well-controlled library where you control both the parent and child categories, then the method above is slimmmer.
I think I read somewhere that some modules only have object oriented interfaces ( though they didn't create objects, they only held utility functions ). Is there a point to that?
First, its important to remember that in Perl, classes are implemented in a weird way, via packages. Packages also serve for general namespace pollution prevention.
package Foo;
sub new {
my ($class) = #_;
my $self = bless {}, $class;
return $self;
}
1;
That is how you make a Foo class in Perl (which can have an objected instantiated by calling Foo->new or new Foo). The use of new is just a convention; it can be anything at all. In fact, that new is what C++ would call a static method call.
You can easily create packages that contain only static method calls, and I suspect this is what you're referring to. The advantage here is that you can still use OO features like inheritance:
package Bar;
sub DoSomething {
my ($class, $arg) = #_;
$class->Compute($arg);
}
sub Compute {
my ($class, $arg) = #_;
$arg * 2;
}
1;
package Baz;
#Baz::ISA = qw(Bar);
sub Compute {
my ($class, $arg) = #_;
$arg * 2 - 1
}
1;
Given that, then
say Bar->DoSomething(3) # 6
say Baz->DoSomething(3) # 5
In fact, you can even use variables for the class name, so these can function very much like singletons:
my $obj = "Baz"; # or Baz->new could just return "Baz"
print $obj->DoSomething(3) # 5
[Code is untested; typos may be present]
I suspect that this is mostly a philosophical choice on the part of authors who prefer OO to imperative programming. Others have mentioned establishing a namespace, but it's the package that does that, not the interface. OO is not required.
Personally, I see little value in creating classes that are never instantiated (i.e. when there's no object in object-oriented). Perl isn't Java; you don't have to write a class for everything. Some modules acknowledge this. For example: File::Spec has an OO interface but also provides a functional interface via File::Spec::Functions.
File::Spec also provides an example of where OO can be useful for uninstantiated "utility" interfaces. Essentially, File::Spec is an abstract base class -- an interface with no implementation. When you load File::Spec it checks which OS you're using and loads the appropriate implementation. As a programmer, you use the interface (e.g. File::Spec->catfile) without having to worry about which version of catfile (Unix, Windows, VMS, etc.) to actually call.
As others have said, inheritance is the big gain if an actual object is not needed. The only thing I have to add here is the advice to name your variables well when writing such interfaces, e.g.:
package Foo;
# just a static method call
sub func
{
my $class = shift;
my (#args) = #_;
# stuff...
}
I named the variable that holds the classname "$class", rather than $this, to make it clear to subsequent maintainers that func() will be called as Foo->func() rather than $foo->func() (with an instantiated Foo object). This helps avoid someone adding this line later to the method:
my $value = $this->{key};
...which will fail, as there is no object to deference to get the "key" key.
If a method might be called either statically or against an instantiated object (for example, when writing a custom AUTOLOAD method), you can write this:
my method
{
my $this = shift;
my $class = ref($this) || $this;
my (#args) = #_;
# stuff...
}
namespacing, mostly. Why not? Everything that improves perl has my full approval.