perl - 如何在构建时根据输入创建（或不创建）类实例方法？

Question

我将如何创建我的类，以使某些方法仅在将某些值传递给构造函数时才会存在于实例中？

也许更通用的提问方式是：如何向现有的类实例添加方法？

score 3 · Accepted Answer

您可以根据标志将匿名子附加到对象：

use strict;
use warnings;
package Object;
sub new {
   my $class = shift;
   my $self = bless {}, $class;
   my %args = @_; 
   if ($args{method}) {
       $self->{method} = sub { print "hello\n" }
   }   
   return $self;
}

sub method {
    my $self = shift;
    if (not defined $self->{method}) {
        warn "Not bound\n";
        return;
    }   
    $self->{method}->();
}
1;

使用：

use Object;
my $obj1 = Object->new(method=>1);
$obj1->method();
my $obj2 = Object->new();
$obj2->method();

您可以通过相同的接口将其扩展到许多方法。

score 2 · Accepted Answer

您可以使用 Moose 在运行时应用角色。

package My::Class;
use Moose;

has foo => ( isa => 'Str', is => 'ro', required => 1 );

sub BUILD {
  my $self = shift;

  if ($self->foo eq 'bar') {
    My::Class::Role->meta->apply($self);
  }  
}

no Moose;

package My::Class::Role;
use Moose::Role;

sub frobnicate {
  my $self = shift;

  print "Frobnicated!\n";
}

no Moose;

my $something = My::Class->new( foo => 'bar' );
print $something, "\n";
$something->frobnicate;
my $something_else = My::Class->new( foo => 'baz' );
print $something_else, "\n";
$something_else->frobnicate;

给出：

Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x2fd5a10)
Frobnicated!
My::Class=HASH(0x2fd2c08)
Can't locate object method "frobnicate" via package "My::Class" at testmoose.pl line 32.

score 1 · Accepted Answer

用于AUTOLOAD定义函数。例如，如果调用方法 foo$self->{foo} exists

sub AUTOLOAD {
    my $methodname = $AUTOLOAD;
    if ($methodname eq "foo" && exists($_[0]->{foo})){
          goto &fooimplementationsub;
    }
    return;
}

另一种技术是使用 glob 在运行时定义新方法

*PACKAGE::method = sub { 
    #code here
};

这有一个缺点，即该方法现在对类的所有实例都是可见的，因此不是您想要的。

第三种可能风险更大/效率低的方法是使用字符串 eval

eval <<EOF
sub foo { 
    #code here
};
EOF

同样，这有一个缺点，即该方法现在对类的所有实例都是可见的，因此并不是您想要的。

score 1 · Accepted Answer

Don't do too much magic. I've gotten away from AUTOLOAD because it causes maintenance issues where mysterious methods suddenly appear and disappear.

One way to handle what you want is to define all the methods you need, and if a particular object is of the wrong type, simply cause that method to croak:

sub Foo {
    my $self       = shift;
    my $parameter  = shift;

    if ( $self->Class_type ne "Foo" ) {
        croak qq(Invalid method 'Foo' on object @{[ref $self]});
    }
    print "here be dragons\";
    return "Method 'Foo' successfully called";
}

The above will not allow method Foo to be called unless the class type is Foo.

If your objects won't change (or you don't want them to change) once an object is created, you can define that object as a sub-class.

Before you bless a newly created object, check that special value and decide whether or not you need to create a specific sub-class instead.

package My_class;

sub new {
    my $class      = shift;
    my $class_type = shift;

    my $self = shift;

   if ( $class_type eq "Foo" ) {
      bless $self, "My_class::Foo";
   }
   else {
     bless $self, $class;
   }

package My_class::Foo;
use base qw(My_class);

sub Foo {
    my $self = shift;
    return "Foo Method successfully called!";
}

Notice that my class My_class::Foo is a sub-class of My_class via the use base pragma. That means all methods for My_class are valid with objects of My_class::Foo. However, only objects of My_class::Foo can call the Foo method.

When I create my object (via the new subroutine), I look at the $class_type parameter. If it's a type Foo, I bless the class as My_class::Foo.

Here's an example where I use sub-classes to do what you want.

Every object is a class type of Question. You can see my constructor on line 1129. I pass in a question type as one of the parameters to my constructor.

In line 1174 to 1176, I create my object, but then append the question type to the class, and then bless the question as that sub-class type. All of my subclasses are a type Question (see my use base qw(Question); below each package declaration. However, only questions of sub-class Question::Date and Question::Regex have a method Format. And, only objects of type Question::Words have a method Force.

Hope this helps.

score 1 · Accepted Answer

方法只是包中的子例程，而包只是一个包含 typeglob 的散列。并且可以在运行时修改哈希值。

因此，理论上，您可以在构造函数中添加或删除给定值的方法。

package WeirdClass;

sub new {
  my ($class, $name, $code) = @_;
  if ($name) {
    no strict;
    *{__PACKAGE__ . "::$name"} = $code;
  }
  bless {} => $class;
}

然后像这样使用它：

my $object = WeirdClass->new(foo => sub {say "foo"});
$object->foo(); # prints "foo\n";

但是，此方法可用于该类的所有对象：

my $another_object = WeirdClass->new();
$another_object->foo; # works too.

使用自动加载，可以模拟任意方法：

package BetterClass;

sub new {
  my ($class, %args) = @_;
  bless \%args => $class;
}

# destructor will be called at cleanup, catch with empty implementation
sub DESTROY {}; 

sub AUTOLOAD {
  my $self = shift;
  (my $method = our $AUTOLOAD) =~ s/.*://; #  $AUTOLOAD is like "BetterClass::foo"

  # check if method is allowed
  die "forbidden method $method" unless $self->{can}{$method};

  # mock implementations
  given ($method) {
    say "foo" when "foo";
    say "bar" when "bar";
    when ("add") {
      my ($x, $y) = @_;
      return $x + $y;
    }
    default { die "unknown method $method" }
  }
}

然后：

my $o = BetterClass->new(can => { foo => 1, bar => 0});
$o->foo;
my $p = BetterClass->new(can => {bar => 1, add => 1});
$p->bar;
say $p->add(5, 6);

当然，这些技术可以自由组合。

编辑：`can()`

要AUTOLOAD使用 can，应将受保护的方法移动到数据结构中：

my %methods;
BEGIN {
  %methods = (
    foo => sub {say "foo"},
    bar => sub {say "bar"},
    add => sub {
      my ($self, $x, $y) = @_;
      $x + $y;
    },
  );
}

然后重写该can方法：

# save a reference to the origional `can` before we override
my $orig_can;
BEGIN{ $orig_can = __PACKAGE__->can("can") }

sub can {
  my ($self, $meth) = @_;

  # check if we have a special method
  my $code = $methods{$meth} if ref $self and $self->{can}{$meth};
  return $code if $code;

  # check if we have a normal method
  return $self->$orig_can($meth);
}

并将AUTOLOAD更改为

my ($self) = @_; # do not `shift`
(my $method = our $AUTOLOAD) =~ s/.*://;
my $code = $self->can($method) or die "unknown method $method";
goto &$code; # special goto. This is a AUTOLOAD idiom, and avoids extra call stack frames

score 1 · Accepted Answer

到目前为止给出的答案都没有真正处理实际提出的问题。

不直接支持在 Perl 中向实例添加方法。对象实例始终是某个类的实例，而该类是实际具有方法的东西。您不能将方法添加到类的单个实例，而不使该方法在同一类的每个其他实例上也可用。

对于您的问题，您有两个基本解决方案：

始终提供方法，但测试一个标志以查看该方法是否应应用于给定实例。这是迄今为止最简单的。
根据标志将每个对象祝福为子类。子类化主类以提供适当的方法。

如果您真的想在单个实例上添加方法，那么您必须将每个实例安排为每个对象的新派生类的单个实例。DESTROY这变得更难安排，加倍 - 所以如果你想避免泄漏内存并在对象被编辑后清理类。然而，这将允许真正的每个实例方法。

由于您不太可能真正需要第三个选项，因此最好使用第一个选项。

perl - 如何在构建时根据输入创建（或不创建）类实例方法？

6 回答 6

编辑：can()

Related

Reference

编辑：`can()`