Perl Moose 添加实例属性而不是类属性

Question

我需要为 Moose 类实例添加属性。在下面的代码中，当我创建 Child 类的实例并向其添加属性“app”时，我发现在创建下一个实例时也添加了此属性。我做错了什么，我再次需要每个创建实例的属性。

#!C:\perl\bin\perl.exe
#!/usr/bin/perl

use v5.10;
use Moose;
use Data::Dumper;

{
    package Child;

    use Moose;
    use utf8;

    sub name {
        say "My name is Richard";
    }
}

sub add_attribute {
    my ($object, $attr) = @_;

    my $meta = $object->meta;

    if (!$object->can("app")) {
        $meta->add_attribute(app => (is => 'rw', default => sub{$attr}));
        $object->app($attr);
    }
    else {
        #$object->app($attr);
        say "attr $attr already exists: object=". ref($object) . ", attr=".($object->app);
    }
}

my $child = Child->new;
$child->name;
add_attribute($child, "First");
say "Child Attr: " . $child->app;
say "";
say Dumper($child);

my $child1 = Child->new;
$child1->name;
#add_attribute($child1, "Second");
say "Child1 Attr: " . $child1->app;
say Dumper($child1);
#say Dumper($child1->meta);

输出：

My name is Richard
Child Attr: First

$VAR1 = bless( {
                 'app' => 'First'
               }, 'Child' );

My name is Richard
Child1 Attr: First
$VAR1 = bless( {
                 'app' => 'First'
               }, 'Child' );

Answer 1

诀窍是创建原始类的新子类，为其添加属性，然后将实例重新分配到新子类中。这是一个例子：

use v5.14;

package Person {
  use Moose;
  has name => (is => 'ro');
}

sub add_attribute {
  my ($obj, $name, $value) = @_;
  my $new_class = Moose::Meta::Class->create_anon_class(
    superclasses => [ ref($obj) ],
  );
  $new_class->add_attribute($name, is => 'rw');
  $new_class->rebless_instance($obj, $name => $value);
}

my $alice  = Person->new(name => 'Alice');
my $bob    = Person->new(name => 'Bob');

add_attribute($alice, foot_size => 6);

say $alice->foot_size;

say $bob->foot_size;  # dies, no such method