Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Adding a method to an existing object

by forgot_other_usrname (Novice)
on Feb 13, 2012 at 02:40 UTC ( #953383=perlquestion: print w/ replies, xml ) Need Help??
forgot_other_usrname has asked for the wisdom of the Perl Monks concerning the following question:

I'm in need of "runtime decorators". That is, a class whose constructor is to take an instance of either the base class or a separate "runtime decorator" and add functionality to it. I don't know ahead of time what the type of the object will be. Here's an extremely contrived example of what I want to do (this strategy makes sense in the actual problem domain).
package Base; sub new { my $package = shift; my $id = shift; return bless { id => $id, }, $package; } sub id { my ($self, $id) = @_; $self->{id} = $id if defined $id; return $self->{id}; } 1; package NameDecorator; sub new { my $package = shift; my $base_or_decorated = shift; my $self = $base_or_decorated->new(@_); $self->{name} = undef; return $self->{name}; } sub name { my ($self, $name) = @_; $self->{name} = $name if defined $name; return $self->{name}; } 1; ...do the same for an AgeDecorator
Then I could use it like follows
use Base; use NameDecorator; use AgeDecorator; my $decorated = AgeDecorator->new(NameDecorator->new(Base->new('id1')) +); $decorated->name('Edith'); $decorated->age(93);
I need the flexibility to be able to chain decorators together and still have available to methods added from the decorator before it. Is there a name for what I'm trying to do and can this be done easily without the help of a module or is there a module which can help me achieve this?

UPDATE: This is getting closer to what I want, but it still adds to the class rather than the object
package NameProto; use strict; use base qw(Base::Decorator); sub new { my $self = shift->SUPER::new(@_); $self->{age} = 0; no strict 'refs'; my $package = ref($self->{base}); *{$package . '::name'} = sub { my ($self, $name) = @_; $self->{name} = $name if defined $name; return $self->{name}; }; return bless $self, $package; } sub name { return shift->{base}->name(@_); } 1;

Comment on Adding a method to an existing object
Select or Download Code
Re: Adding a method to an existing object
by chromatic (Archbishop) on Feb 13, 2012 at 02:50 UTC

    I use a similar technique for a very simple plugin system. The main object is a Moose object, and all of the plugins are Moose roles. With in the main class (call it MyApp), I have a method:

    sub create_with_roles { my ($class, $roles, %args) = @_; for my $role (@$roles) { next if $role =~ /::/; $role = 'MyApp::Role::' . $role; } Moose::Util::ensure_all_roles( $class, @$roles ); return $class->new( %args ); }

    ... and within the drive program, I can write:

    my $app = MyApp->create_with_roles( [qw( List Of Role Names )], %constructor_arguments );

    ... and get back an object which is an instance of MyApp which performs all of the named roles. It's been working very well.


    Improve your skills with Modern Perl: the free book.

      Note that this will permanently change the MyApp class, which might not be what is desired. I tend to use MooseX::Traits in most of the general cases.


      Ordinary morality is for ordinary people. -- Aleister Crowley

        I should have mentioned that. It's no problem in my case, because I know none of the plugins will override each other (and no code wants to use an unmodified MyApp object), but Moose traits are more general and applicable.

Re: Adding a method to an existing object
by moritz (Cardinal) on Feb 13, 2012 at 07:15 UTC

    Well, methods are looked up in package tables, not in objects.

    So you have basically three options:

    1. create a new subclass per object into which the new methods go, and rebless the objects into their respective classes
    2. Carry around a custom method table (for example a hash) in the instance data of an object, and define an AUTOLOAD sub that considers this custom method table as a fallback
    3. Look what CPAN has to offer; somebody likely already implemented either approach.
Re: Adding a method to an existing object
by JavaFan (Canon) on Feb 13, 2012 at 10:08 UTC
    use 5.010; use strict; use warnings; sub Base::set_id {$_[0]{id} = $_[1]; $_[0]} sub Base::id {$_[0]{id}} sub Name::set_name {$_[0]{name} = $_[1]; $_[0]} sub Name::name {$_[0]{name}} sub Age::set_age {$_[0]{age} = $_[1]; $_[0]} sub Age::age {$_[0]{age}} sub gimme_object { state $class = "MyClass00000"; $class++; no strict 'refs'; @{"${class}::ISA"} = (Base => @_); bless {}, $class; } my $obj1 = gimme_object qw[Name]; my $obj2 = gimme_object qw[Age]; my $obj3 = gimme_object qw[Age Name]; $obj1->set_id(1)->set_name("Foo"); $obj2->set_id(2)->set_age(42); $obj3->set_id(3)->set_name("Bar")->set_age(15); printf "Object %d has name %s\n", $obj1->id, $obj1->name; printf "Object %d has age %d\n", $obj2->id, $obj2->age; printf "Object %d has name %s and age %d\n", $obj3->id, $obj3->name, $ +obj3->age; __END__ Object 1 has name Foo Object 2 has age 42 Object 3 has name Bar and age 15
Re: Adding a method to an existing object
by draegtun (Scribe) on Feb 17, 2012 at 16:56 UTC

    The following two modules on CPAN allow you to add methods to an object:

    * MooseX::SingletonMethod (for Moose objects)
    * Object::Method (for normal Perl objects)

    Alternatively in Moose you can apply roles directly to an object:

        YourRole->meta->apply( $your_object ); # $your_object now has the methods from YourRole

    I did a few blog posts on how roles work and howto implement singleton-methods (in Moose). They're listed in the MooseX::SingletonMethod CPAN page. Also this link should bring them up.

    /I3az/

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://953383]
Approved by Old_Gray_Bear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (8)
As of 2015-07-02 06:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (30 votes), past polls