tags:

views:

215

answers:

4

So I am toying with some black magic in Perl (eventually we all do :-) and I am a little confused as to exactly how I am supposed to be doing all of this. Here is what I'm starting with:

use strict;
use warnings;
use feature ':5.10';
my $classname = 'Frew';
my $foo = bless({ foo => 'bar' }, $classname);
no strict;
*{"$classname\::INC"} = sub {
      use strict;
      my $data =  qq[
         package $classname
         warn 'test';
         sub foo {
            print "test?";
         }
      ];
      open my $fh, '<', \$data;
      return $fh;
   };
use strict;
unshift @INC, $foo;
require $foo;
use Data::Dumper;
warn Dumper(\@INC);
$classname->foo;

I get the following errors (depending on whether my require line is commented out):

With require:

Recursive call to Perl_load_module in PerlIO_find_layer at crazy.pl line 16.
BEGIN failed--compilation aborted.

without:

$VAR1 = [
      bless( {
               'foo' => 'bar'
             }, 'Frew' ),
      'C:/usr/site/lib',
      'C:/usr/lib',
      '.'
    ];
Can't locate object method "foo" via package "Frew" at crazy.pl line 24.

Any wizards who know some of this black magic already: please answer! I'd love to learn more of this arcana :-)

Also note: I know that I can do this kind of stuff with Moose and other lighter helper modules, I am mostly trying to learn, so recommendations to use such-and-such a module will not get my votes :-)

Update: Ok, I guess I wasn't quite clear originally with my question. I basically want to generate a Perl class with a string (that I will manipulate and do interpolation into) based on an external data structure. I imagine that going from what I have here (once it works) to that shouldn't be too hard.

A: 

A Perl class is little more than a data structure (usually a hashref) that has been blessed into a package in which one or more class methods are defined.

It is certainly possible to define multiple package namespaces in one file; I don't see why this wouldn't be possible in an eval construct that is compiled at run-time (see perlfunc for the two different eval forms).

#!/usr/bin/perl

use 5.010;
use strict;
use warnings;
use Data::Dumper;

eval q[
    package Foo;
    sub new {
        my ( $class, %args ) = @_;
        my $self = bless { %args }, $class;
        return $self;
    }
    1;
];
die $@ if $@;

my $foo = Foo->new(bar => 1, baz => 2) or die;

say Dumper $foo;
hillu
Perl doesn't really have classes (just namespaces), and you've confused that with instances.
brian d foy
Oh well. Let's just replace 'little' with 'nothing' then.
hillu
+6  A: 

Here is a version which works:

#!/usr/bin/perl

use strict;
use warnings;

my $class = 'Frew';

{
    no strict 'refs';
    *{ "${class}::INC" } = sub {
        my ($self, $req) = @_;
        return unless $req eq  $class;
        my $data = qq{
            package $class;
            sub foo { print "test!\n" };
            1;
        };
        open my $fh, '<', \$data;
        return $fh;
    };
}

my $foo = bless { }, $class;
unshift @INC, $foo;

require $class;
$class->foo;

The @INC hook gets the name of the file (or string passed to require) as the second argument, and it gets called every time there is a require or use. So you have to check to make sure we're trying to load $classname and ignore all other cases, in which case perl continues down along @INC. Alternatively, you can put the hook at the end of @INC. This was the cause of your recursion errors.

ETA: IMHO, a much better way to achieve this would be to simply build the symbol table dynamically, rather than generating code as a string. For example:

no strict 'refs';
*{ "${class}::foo" } = sub { print "test!\n" };
*{ "${class}::new" } = sub { return bless { }, $class };

my $foo = $class->new;
$foo->foo;

No use or require is necessary, nor messing with evil @INC hooks.

friedo
The mysterious crash I experienced when I thought I tried the equivalent of your code is gone ... Dunno what caused. Anyway +1 for solving the issue properly as well as stressing that this is very unnecessary for the purpose stated by the OP. I am going to delete my answer.
Sinan Ünür
+4  A: 

I do this:

use MooseX::Declare;

my $class = class {
    has 'foo' => (is => 'ro', isa => 'Str', required => 1);
    method bar() {
        say "Hello, world; foo is ", $self->foo;
    }
};

Then you can use $class like any other metaclass:

my $instance = $class->name->new( foo => 'foo bar' );
$instance->foo; # foo-bar
$instance->bar; # Hello, world; foo is foo-bar

etc.

If you want to dynamically generate classes at runtime, you need to create the proper metaclass, instantiate it, and then use the metaclass instance to generate instances. Basic OO. Class::MOP handles all the details for you:

my $class = Class::MOP::Class->create_anon_class;
$class->add_method( foo => sub { say "Hello from foo" } );
my $instance = $class->new_object;
...

If you want to do it yourself so that you can waste your time debugging something, perhaps try:

sub generate_class_name {
    state $i = 0;
    return '__ANON__::'. $i++;
}

my $classname = generate_class_name();
eval qq{
    package $classname;
    sub new { my \$class = shift; bless {} => \$class }
    ...
};

my $instance = $classname->new;
jrockway
I like this answer the most, but I *did* ask for no Moose :-)
Frew
A: 

For a simple example of how to do this, read the source of Class::Struct.

However, if I needed the ability to dynamically build classes for some production code, I'd look at MooseX::Declare, as suggested by jrockway.

daotoad