Question

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.

Answer 1

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.