5

所以我在 Perl 中玩弄一些黑魔法（最终我们都这样做了:-)，我对我应该如何做这一切感到有点困惑。这是我的开始：

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;

我收到以下错误（取决于我的要求行是否被注释掉）：

有要求：

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

没有：

$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.

任何已经知道一些这种黑魔法的巫师：请回答！我很想更多地了解这个奥秘:-)

另请注意：我知道我可以用 Moose 和其他更轻的辅助模块来做这种事情，我主要是在努力学习，所以使用这样那样的模块的建议不会得到我的投票:-)

更新：好的，我想我最初对我的问题不太清楚。我基本上想基于外部数据结构生成一个带有字符串（我将对其进行操作和插值）的 Perl 类。我想从我这里的东西（一旦它工作）到那个应该不会太难。

4

4 回答 4

10

这是一个有效的版本：

#!/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;

@INC钩子获取文件名（或传递给 的字符串）require作为第二个参数，并且每次有requireor时都会调用它use。所以你必须检查以确保我们正在尝试加载$classname并忽略所有其他情况，在这种情况下 perl 会继续向下@INC。或者，您可以将钩子放在@INC. 这是您的递归错误的原因。

ETA：恕我直言，实现这一目标的更好方法是简单地动态构建符号表，而不是将代码生成为字符串。例如：

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

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

没有use或require没有必要，也没有搞乱邪恶的@INC钩子。

于 2009-07-14T22:31:02.367 回答
6

我这样做：

use MooseX::Declare;

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

然后你可以像使用任何其他元类一样使用 $class ：

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

等等

如果要在运行时动态生成类，则需要创建合适的元类，将其实例化，然后使用元类实例生成实例。基本面向对象。Class::MOP 为您处理所有细节：

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

如果你想自己做，这样你就可以浪费时间调试一些东西，也许可以试试：

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;
于 2009-07-15T02:43:03.927 回答
0

有关如何执行此操作的简单示例，请阅读 Class::Struct 的源代码。

但是，如果我需要为某些生产代码动态构建类的能力，我会按照 jrockway 的建议查看 MooseX::Declare。

于 2009-07-15T03:59:17.607 回答
-3

Perl 类只不过是一种数据结构（通常是 hashref），它被放入一个包中，其中定义了一个或多个类方法。

当然可以在一个文件中定义多个包命名空间；eval我不明白为什么在运行时编译的构造中这是不可能的（参见perlfunc两种不同的 eval形式）。

#!/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;
于 2009-07-14T22:17:27.260 回答