diotalevi has asked for the wisdom of the Perl Monks concerning the following question:

I'd like to install one or a few methods into a given slot. If no method already exists in a given slot then my copy should be directly copied. If I need a second or more method to then I need to have a stub method call each of the real methods. While the actual code for this is pretty simple I think this far too messy for something in a database application and I don't want to force volunteer programmers to cope with this.

This is intended to be used in an application using the Alzabo OR mapping system and in this case I need to call both an auditing and versioning method when the pre_insert event occurs. For one method call I'd just copy *pkg::pre_insert = *auditing_pre_insert and leave it at that but since it isn't that trivial I don't feel comfortable doing this right in the application.

I'm hoping someone here knows of a nice module for this so I can use that instead. Suggestions?

if (*{"GreenPartyDB::Database::${table}::${hook}"}{CODE}) {
    my $old = *{"GreenPartyDB::Database::${table}::${hook}"}{CODE};
    my $new = *{__PACKAGE__."::${prefix}${hook}"}{CODE}
    *{"GreenPartyDB::Database::${table}::${hook}"} =
    sub { $_[0]->$old( @_[ 1 .. $#_ ] );
          $_[0]->$new( @_[ 1 .. $#_ ] ); };
} else {
    *{"GreenPartyDB::Database::${table}::${hook}"} =
        *{__PACKAGE__."::${prefix}${hook}"}{CODE};
}

[download]

Replies are listed 'Best First'.
Re: Installing chained methods (Hook::*?)
by Aristotle (Chancellor) on Apr 21, 2003 at 02:33 UTC
[reply]

      Nothing in the Hook:: class namespace does the right thing here (including Class::Hook). Thank you though. All the Hook:: modules assume that the method already exists and I'm looking at it from the other direction - initially the method doesn't exist and the code just installs it somewhat like Exporter.

      Oh well - absent any good suggestions (after waiting a while) I'll just write the darn thing and upload it. Thank you for suggesting Hook:: though - that search keyword didn't occur to me.

[reply]
        Aha, I see. Maybe like so? 
        use Hook::WrapSubs;

do {
    no strict 'refs';
    *{"GreenPartyDB::Database::${table}::${hook}"} = sub {};
} unless UNIVERSAL::can("GreenPartyDB::Database::${table}", $hook)

wrap_subs(
    "GreenPartyDB::Database::${table}::${hook}",
    UNIVERSAL::can(__PACKAGE__."::${prefix}", $hook),
);

        [download]
        Note that using UNIVERSAL::can() will respect inherited methods, which is not unlikely to be better than what you started out with (or may be not, of course - your call).

        Makeshifts last the longest.

[reply]
[d/l]

Back to Seekers of Perl Wisdom