Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Creating packages on the fly

by Jouke (Curate)
on Jun 06, 2006 at 08:27 UTC ( #553761=perlquestion: print w/ replies, xml ) Need Help??
Jouke has asked for the wisdom of the Perl Monks concerning the following question:

Dear Brothers and Sisters,

Most of you probably know the AUTOLOAD mechanism, where we can handle subroutines that are not explicitly defined. I want something similar for entire packages. Let me explain in a little more detail what I want to achieve and why:

I want to build something that subclasses each and every class that Wx defines. I could of course create many packages by hand and make them subclasses of the specific Wx:: subclass. However, apart from it being a time-intensive job, each subclass I create would do almost the same (I don't like to write the same code multiple times), and apart from that, if there's a new version of Wx that has a new class that I don't handle yet, I have to release a new version.

Therefore I want to ask you if you see a possibility to let me create one package (Foo) in such a way, that if I call Foo::Bar->new() (where Foo::Bar isn't defined explicitly), it defines Foo::Bar on the fly and let me do the magic that I want with it.

Any suggestion is appreciated, even if it doesn't fully do what I want...


Jouke Visser
Using Perl to enable the disabled: pVoice

Comment on Creating packages on the fly
Re: Creating packages on the fly
by vkon (Deacon) on Jun 06, 2006 at 08:42 UTC
    This file from Tcl::Tk CPAN distribution has many in common with your questions:
    • its a part of perl module to deal with external GUI library
    • it creates required widgets on the fly
    • it heavily uses AUTOLOAD and brings into existance widget's package where newborn widgets of that class will be blessed

    However its not necessary to look into much detail, because actually in case of Tcl::Tk wdiget's package is simple and there is some stub string which is "eval"-ed to create package.

    Here are excerpts from code:

    $Tcl::Tk::VTEMP = <<'EOWIDG'; package Tcl::Tk::Widget::[[widget-repl]]; use vars qw/@ISA/; @ISA = qw(Tcl::Tk::Widget); sub DESTROY {} # do not let AUTOLOAD catch this method sub AUTOLOAD { print STDERR "<<@_>>\n" if $Tcl::Tk::DEBUG > 2; $Tcl::Tk::Widget::AUTOLOAD = $Tcl::Tk::Widget::[[widget-repl]]::AU +TOLOAD; return &Tcl::Tk::Widget::AUTOLOAD; } 1; print STDERR "<<starting [[widget-repl]]>>\n" if $Tcl::Tk::DEBUG > 2; EOWIDG
    and then
    # here we create Widget package, used for both standard cases like # 'Button', 'Label', and so on, and for all other widgets like Baloon # TODO : document better and provide as public way of doing things? my %created_w_packages; # (may be look in global stash %:: ?) sub create_widget_package { my $widgetname = shift; _DEBUG(2, "AUTOCREATE widget $widgetname (@_)\n") if DEBUG; unless (exists $created_w_packages{$widgetname}) { _DEBUG(1, "c-PACKAGE $widgetname (@_)\n") if DEBUG; $created_w_packages{$widgetname} = {}; die "not allowed widg name $widgetname" unless $widgetname=~/^\w+$ +/; # here we create Widget package my $package = $Tcl::Tk::VTEMP; $package =~ s/\[\[widget-repl\]\]/$widgetname/g; eval "$package"; die $@ if $@; # Add this widget class to ptk_w_names so the AUTOLOADer properly # identifies it for creating class methods $widgetname = quotemeta($widgetname); # to prevent chars corruptin +g regexp $ptk_w_names .= "|$widgetname"; } }

    Actually it could be implemented without any string-eval, (moving CODE to some package, and it will be autocreated), but I decided to go easy way, because it was safe and efficient in this particular case.

      I may be overlooking something, but how does that create packages that the code doesn't know about yet on the fly?

      Maybe I need to be clearer:

      Wx provides Wx::Window. Let's say that I'm going to use the namespace Jouke:: and my Wx::Window subclass would become Jouke::Wx::Window. I don't want to have a predefined list of classes I want to subclass under Jouke::, but whenever the main program calls Jouke::Wx::Window->new() it should be able to identify if Wx::Window->new can be called, and if so, subclass it as Jouke::Wx::Window, and add functionality to it.

      The only part I'm having trouble with, is having a mechanism that catches every call to Jouke::Foo->whatever_method() without having to define Jouke::Foo in advance.


      Jouke Visser
      Using Perl to enable the disabled: pVoice
        you're right, Jouke::Foo->whatever_method() isn't covered in my example.

        Here is one that do:

        sub UNIVERSAL::AUTOLOAD { print STDERR "[[@_]]"; } package main; Jouke::Foo->whatever_method();
        outputs
        D:\TESTS\tperl>perl -w autocr.pl [[Jouke::Foo]]
Re: Creating packages on the fly
by gellyfish (Monsignor) on Jun 06, 2006 at 08:58 UTC

    I'm not entirely sure that what I am about to suggest is very sensible as it may well break all sorts of other things, so anyone of a sensitive nature should look away now.

    It is entirely possible to add an AUTOLOAD subroutine to the UNIVERSAL package which every other package inherits from implicity, so you can do something like:

    #!/usr.bin/perl use strict; use warnings; Foo::Bar->baz(); Foo::Bar->baz(); package UNIVERSAL; sub AUTOLOAD { my ($class, @args) = @_; our $AUTOLOAD; (my $method = $AUTOLOAD) =~ s/.*:://; print "$AUTOLOAD was called via autoload\n"; no strict 'refs'; *{$AUTOLOAD} = sub { print "I'm alive\n"}; $class->$method; }
    This creates your methods in unknown packages on the fly. If you want to do subclassing on the fly you can do something like:
    #!/usr.bin/perl use strict; use warnings; Foo::Bar->baz(); Foo::Bar->baz(); package UNIVERSAL; sub AUTOLOAD { my ($class, @args) = @_; our $AUTOLOAD; (my $method = $AUTOLOAD) =~ s/.*:://; (my $parent = $class) =~ s/::[^:]*$//; print "$AUTOLOAD was called via autoload\n"; no strict 'refs'; push @{"${class}::ISA"},$parent; $class->$method; } package Foo; sub baz { my ($self) = @_; print "I'm alive\n"; }

    But don't say I didn't warn you that this was probably a bad idea

    /J\

      Dear sir,

      you are evil sick and wrong. That's why I love you.

      Hugs n kisses

      Dave

      First of all, thanks! This is indeed what I want to achieve. The UNIVERSAL::AUTOLOAD sub will of course do more checking than just this to implement what I want.

      However, like you said, this may not be a good idea. What if more people start using this scheme? Then things will break immediately. I'm pretty sure I can catch that by checking if UNIVERSAL::AUTOLOAD has already been defined (right?).

      nevertheless this may just be the push in the right direction I need


      Jouke Visser
      Using Perl to enable the disabled: pVoice

        Yeah, I can't see any reason why you couldn't (say in the import() of the module that defines this) save any existing UNIVERSAL::AUTOLOAD and then call that at some point in your version, of course you might be stuffed if (as some more normal AUTOLOAD subroutines do) it does goto &{$AUTOLOAD};. However I don't actually know of anything that uses this hack in the wild.

        /J\

Re: Creating packages on the fly
by DrHyde (Prior) on Jun 06, 2006 at 09:19 UTC
    You may be able to adapt some of the code from Class::CanBeA. For it to figure out what can be what, it first has to examine all the packages that have been loaded.
Re: Creating packages on the fly
by Gilimanjaro (Hermit) on Jun 06, 2006 at 13:38 UTC

    I would think that a UNIVERSAL::AUTOLOAD method would be the only way to catch this, if you want to avoid any predefinitions...

    Another approach maybe to find all Wx:: classes and subclass them at startup... This may subclass a whole bunch of classes that you won't be using, but it avoids AUTOLOAD nastiness... Something like the following maybe:

    use Wx; my $symbol_table = Symbol::Table->New(PACKAGE=>'main::Wx'); while(my $package = each %$symbol_table) { eval "package Groninger::Wx::$package; use base 'Wx::$package;"; }

    This code doesn't recurse (so only packages directly in the Wx:: namespace will be subclassed) and it only works if the packages in that namespace have already been use'd. But that could be done automatically I suppose...

    But perhaps it would then make more sense to generate them specifically for the packages you want to subclass using a syntax like:

    use Class::SubclassSet Groninger => qw(Wx::App Wx::Frame Wx::Menu); package Class::SubclassSet; sub import { my ($this,$into,@classes); for my $class (@classes) { eval "package ${into}::$class; use base '$class';"; } }

    That would reduce the duplicate code you'd be typing, prevent redundant subclassing and avoid UNIVERSAL::AUTOLOAD;

    (All code untested; just brainstorming here...)

    Regards, Giel

      Hey Giel,
      Thanks for this. If I can't achieve what I want using the UNIVERSAL::AUTOLOADER idea (although it looks like it), I'm going to try this one.


      Jouke Visser
      Using Perl to enable the disabled: pVoice
Re: Creating packages on the fly
by Anonymous Monk on Jun 06, 2006 at 15:08 UTC
    Could perhaps Package::Generator be of assitance here? I admit when I first saw this module I wasn't too sure of its use, but it could be that it is an answer to your query (speaking of synchronicity)!

    CountZero

    "If you have four groups working on a compiler, you'll get a 4-pass compiler." - Conway's Law

Re: Creating packages on the fly
by Gilimanjaro (Hermit) on Jun 06, 2006 at 21:13 UTC

    Here's what I whipped up using UNIVERSAL::AUTOLOAD; it seems to actually work! It also attempts to store an already setup UNIVERSAL::AUTOLOAD and use it if the requested package isn't one that should be auto-generated, so it should be safe to use with other UNIVERSAL::AUTOLOAD'ing stuff, as long as this one is use'd last (or the others are smart too).

    #!/usr/bin/perl use strict; use warnings; use lib '.'; use Wx; use Class::Generate::Auto 'Jouke::Wx' => 'Wx'; my $w = Jouke::Wx::App->new; exit; package Class::Generate::Auto; use strict; use warnings; our $AUTOLOAD; our %mapping; my $old_ua = undef; sub import { my $this = shift; while(@_) { my $prefix = shift; my $superclass = shift; $mapping{$prefix} = $superclass; } my $current_ua = UNIVERSAL->can('AUTOLOAD'); if($current_ua and $current_ua!=\&autoloader) { $old_ua = $current_ua; } *UNIVERSAL::AUTOLOAD=\&autoloader; } sub autoloader { my ($package,$method) = $AUTOLOAD =~ /^(.*)::(.*)$/; return if $method eq 'DESTROY'; keys %mapping; while(my ($prefix,$superclass) = each %mapping) { my ($extra) = $package =~ /^${prefix}::(.*)$/ or next; $superclass .= "::$extra" if $extra; eval "package $package; use base q{$superclass};"; die "Unable to auto-generate class $package as subclass from $ +superclass: $@" if $@; my $method_ref = $package->can($method); die "Freshly auto-generated class $package can't $method (prob +ably $superclass can't either)" unless $method_ref; goto $method_ref; } goto $old_ua if $old_ua; die "Class $package can't $method and no autoloader was present be +fore ".__PACKAGE__." was loaded"; } 1;
      hehehe...very nice....and scary close to what I have here. I'm running into some practical problems however, that I'm trying to work out now.
      The problems I run into now are related to the specific implementation I had in mind. I'm sure that with your and gellyfish's suggestions I'll be able to work it out tho'

      Thanks guys!


      Jouke Visser
      Using Perl to enable the disabled: pVoice

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2014-07-12 12:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (239 votes), past polls