使用Perl'；构建对象时，如何引用该对象；s类：：结构？

我不熟悉面向对象的Perl，必须在同一对象的另一个子对象中访问同一对象的成员变量。示例代码如下：

use Class::Struct;

struct Breed =>
{
    name  => '$',
    cross => '$',
};

struct Cat =>
[
    name     => '$',
    kittens  => '@',
    markings => '%',
    breed    => 'Breed',
    breed2 => '$',

];

my $cat = Cat->new( name     => 'Socks',
                    kittens  => ['Monica', 'Kenneth'],
                    markings => { socks=>1, blaze=>"white" },
                    breed    => { name=>'short-hair', cross=>1 },
                    ** //breed2 => sub { return $cat->breed->name;}**

                  );

print "Once a cat called ", $cat->name, "\n";
**print "(which was a ", $cat->breed->name, ")\n";**
print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";

---

但我不知道如何在breed2的子例程中使用$cat->bride->name？有人能帮我吗。

不要使用Class:：Struct use

在该方案中，猫可以有任意数量的

品种

s，猫可以有任意数量的

小猫

，它们也是

猫

的对象

更新以专门解决您的问题

您可以将其隐式地包含在构造函数中，如果没有提供，则第二个品种是第一个品种

封装Cat；
子构建{
我的$self=shift；
$self->breeds->[1]=$self->breeds->[0]
如果$self->繁殖->[0]&&！$self->繁殖->[1]
}

您可以在构造函数中传入标识它的令牌（这应该很容易，但如果您愿意，我可以添加一个示例）

你可以让猫明白，如果只有一个品种，那么双亲都是一样的

封装Cat；
sub是纯种的{length@{${[0]->品种}==1？1:0}

您可以通过将猫的品种设置为

unde

，使其忽略猫的品种，并通过父母的品种确定猫的品种。这是因为你的品种始终是你血统的一个功能。您可以在驼鹿

触发器

中限制这一点，这只猫要么需要两只猫的父母，要么需要一个品种

脚注Moose对象序列化也很好：

---

不能在cat构造函数中使用$cat->BREAD->name。 但您可以将breed2（）定义为构造函数之后的方法：

sub Cat::breed2 {
    my ($self) = @_;
    return $self->breed->name;
}

---

breed2

中的问题是，您试图引用一个尚未定义的变量。它看起来是相同的名称，但它不是您正在创建的对象。这有点鸡和蛋的问题

我不太确定您是否希望在该插槽中使用这样的匿名子例程。你是吗 只是想把

$cat->breed->name

缩短为

$cat->breed2

？您可以从

breed2

中的

undef

开始，并在构造函数之后更改其值，因为此时您将拥有对对象的引用。但是，即使将子例程放在那里，也必须取消对它的引用：

my $cat = Cat->new( name     => 'Socks',
                    kittens  => ['Monica', 'Kenneth'],
                    markings => { socks=>1, blaze=>"white" },
                    breed    => { name=>'short-hair', cross=>1 },
                    breed2   => undef,

                  );
$cat->breed2( sub { $cat->breed->name } );

print "Once a cat called ", $cat->name, "\n";
print "(which was a ", $cat->breed2->(), ")\n";
print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";

---

首先，我将从几点评论开始，然后我将进入你问题的实质

OOPerl与其他OO系统有些不同。OO有一个非常薄的基本支持层，使您的对象可以做任何您想做的事情。另一方面，你可以让你的对象做任何你想做的事情。经典的OO Perl涉及大量样板代码，因为您为每个属性实现了访问器和变异器，可能还添加了类型检查等等。这就产生了各种各样的工具来自动生成样板代码

有三种方法可以实现OO Perl：Moose、基于经典哈希的全手工编码和Class:：Struct。Moose非常适合您有复杂需求的系统，但它对应用程序启动时间有很大影响。如果启动时间对您的应用程序很重要，那么Moose目前是不可能的。Struct是一种很好的方法，可以同时获得一个最小公分母、快速、简单的OO应用程序，但它不支持继承。这就是手工编码OOP的用武之地。如果Moose或Class:：Struct出于这样或那样的原因而不是可行的选项，那么我会从基础开始。这个策略对我很有效。在过去的几年里，我觉得唯一需要做的改变就是将Moose添加到我的标准工具包中。这是一个受欢迎的补充

Damian Conway的面向对象Perl是一本了不起的书，它清楚地解释了OOP、OO Perl是如何工作的，以及如何构建能够完成惊人任务的对象。虽然有点过时，但这本书仍然经得起考验。任何认真学习OOPerl的学生都应该读这本书

现在，回答你的问题--

在我看来，

breed2

不是对象的属性，而是方法

use Class::Struct;
use strict;
use warnings;

struct Breed =>
{
    name  => '$',
    cross => '$',
};

struct Cat =>
[
    name     => '$',
    kittens  => '@',
    markings => '%',
    breed    => 'Breed',
];

my $cat = Cat->new( name     => 'Socks',
                    kittens  => ['Monica', 'Kenneth'],
                    markings => { socks=>1, blaze=>"white" },
                    breed    => { name=>'short-hair', cross=>1 },
                  );

# Delegate to Breed::name
sub Cat::breed2 {
    my $self = shift;

    my $breed = $self->breed;  # Get the breed object

    my $name;

    eval { $name = $breed->name(@_) };

    warn "No breed specified for ".( $self->name )."\n"
        unless defined $name;

    return $name;
}

print  "Once a cat called ", $cat->name, "\n",
       "(which was a ", $cat->breed2, ")\n",
       "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";

如果您想保留一组预定义的品种，并且让

breed2

在未设置值的情况下按名称选择一个品种对象，那么事情就会变得更麻烦

这个精简的

Cat

实现使用类数据跟踪允许的猫品种，以及

package Cat;
use strict;
use warnings;
use Carp qw( croak );

my %breeds = map { $_->{name}, Breed->new( %$_ ) } (
    { name=>'short-hair', cross=>1 },
    { name=>'long-hair', cross=>1 },
    { name=>'siamese', cross=>0 },
);

sub new {
    my $class = shift;
    my %args = @_;

    my $self = {};
    bless $self, $class;

    for my $arg ( keys %args ) {
        $self->$arg( $args{$arg} ) if $self->can($arg);
    }

    return $self;
}

sub breed {
    my $self = shift;
    if( @_ ) {
        my $v = shift;
        croak "Illegal cat breed" unless eval {$v->isa( 'Breed' ) };
        $self->{breed} = $v;
    }

    return $self->{breed};
}

sub breed2 {
    my $self = shift;

    my @breed_args;

    if( @_ ) {
        my $v = shift;

        croak "$v is not a supported breed\n" 
            unless exists $breeds{$v};

        @breed_args = ( $breeds{$v} );
    }

    my $breed = $self->breed(@breed_args);

    return unless $breed;
    return $breed->name;
}

现在，让我们来看一个Moose解决方案，它使用了各种高级功能，如类型强制和重载：

BEGIN {
    package Breed;
    use Moose;

    has 'name'  => ( isa => 'Str',  is => 'ro', required => 1 );
    has 'cross' => ( isa => 'Bool', is => 'ro', required => 1 );

    use overload '""' => \&_overload_string;

    sub _overload_string {
        my $self = shift;

        return $self->name;
    }

    __PACKAGE__->meta->make_immutable;    
    no Moose;
    1;
}

BEGIN {
    package Cat;

    use Moose;
    use Moose::Util::TypeConstraints;
    use Carp;

    subtype 'MyTypes::CatBreed' => as class_type('Breed');

    coerce 'MyTypes::CatBreed' => 
        from  'Str' 
        => via  { Cat->supported_breed_by_name( $_ ) };



    has 'name'     => ( isa => 'Str',  is => 'rw', required => 1 );
    has 'kittens'  => ( 
        traits      => ['Array'],
        is          => 'ro',
        isa         => 'ArrayRef[Str]',
        default     => sub{ [] },
        handles     => {
           all_kittens   => 'elements',
           add_kittens   => 'push',
           get_kitten    => 'get',
           count_kittens => 'count',
           has_kittens   => 'count',
       },
    );
    has 'markings' => ( 
        traits      => ['Hash'],
        is          => 'ro',
        isa         => 'HashRef[Str]',
        default     => sub{ {} },
        handles     => {
            set_marking    => 'set',
            get_marking    => 'get',
            has_marking    => 'exists',
            all_markings   => 'keys',
            delete_marking => 'delete',
        },
    );
    has 'breed'    => ( 
        isa    => 'MyTypes::CatBreed', 
        is     => 'ro', 
        coerce => 1,
    );

    my %breeds;
    sub supported_breed_by_name {
        my $class = shift;
        my $name  = shift;

        croak 'No breed name specified' 
            unless defined $name and length $name;

        return $breeds{$name};
    }

    sub add_breed {
        my $class = shift;
        my $breed  = shift;

        croak 'No breed specified' 
            unless eval { $breed->isa('Breed') };

        croak 'Breed already exists'
            if exists $breeds{$breed};

        $breeds{$breed} = $breed;

        return $class;
    }

    sub delete_breed {
        my $class = shift;
        my $name  = shift;

        croak 'No breed name specified' 
            unless defined $name and length $name;

        return delete $breeds{$name};
    }

    __PACKAGE__->meta->make_immutable;    
    no Moose;
    1;
}


# Set up the supported breeds
Cat->add_breed($_) for map Breed->new( %$_ ), (
    { name=>'short-hair', cross=>1 },
    { name=>'long-hair', cross=>1 },
    { name=>'siamese', cross=>0 },
);

# Make a cat
my $cat = Cat->new( name     => 'Socks',
                    kittens  => ['Monica', 'Kenneth'],
                    markings => { socks=>1, blaze=>"white" },
                    breed    => 'short-hair',
);

print 
    "Once a cat called ", $cat->name, "\n",
    "(which was a ", $cat->breed, ")\n",
    "had ", , " kittens: ", join(' and ', @{$cat->kittens}), "\n";

---

您可以通过以下两种方式解决此问题：

use warnings;
use strict;

sub say {print @_, "\n"}

use Class::Struct;

struct Breed =>
{
    name  => '$',
    cross => '$',
};

struct Cat =>
[
    name     => '$',
    kittens  => '@',
    markings => '%',
    breed    => 'Breed',
    breed2   => '$',

];

sub Cat::breed_name {shift->breed->name}  #create a new accessor method

my $cat; # or declare $cat first
$cat = Cat->new( name     => 'Socks',
                    kittens  => ['Monica', 'Kenneth'],
                    markings => { socks=>1, blaze=>"white" },
                    breed    => { name=>'short-hair', cross=>1 },
                    breed2 => sub { return $cat->breed->name;},
                    # this is now ok, but a bit awkward to call
                  );

print "Once a cat called ", $cat->name, "\n";
print "(which was a ", $cat->breed2->(), ")\n";  #returns then calls code ref
print "(which was a ", $cat->breed_name, ")\n";  #new accessor method
print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";

闭包无法正常工作的原因是无法关闭当前语句中定义的变量。当

子{…}

试图关闭

$cat

时，它无法关闭，因为它还不在范围内。解决方案只是预先声明变量

---

然而，

Class:：Struct

似乎不允许您以这种方式干净地安装方法。相反，在

Cat:：

包中添加一个新的访问器方法，可以按预期调用该方法。

-1。OP询问如何使用Class:：Struct实现，这是一个完美的OO框架。Moose很棒，但我认为这个答案适得其反。对不起，Class:：Struct之所以存在，是因为它比驴子球更古老，转换成Moose应该很简单，而且它也让他的最终目标变得简单。如果你想默认繁殖一只猫，你所要做的就是

class猫；子构建{my$self=shift；$self->brides->[1]=$self->brides->[0]如果$self->brides->[0]&&&！$self->brides->[1]}

。你不是指骆驼球吗？：）“use Moose”是SO上“use jQuery”meme的Perl特定版本。这并不能真正回答实际问题。问题是提供一个快捷方式方法，在创建对象之前引用对象的一部分。驼鹿很好，但它仍然很可爱

BEGIN {
    package Breed;
    use Moose;

    has 'name'  => ( isa => 'Str',  is => 'ro', required => 1 );
    has 'cross' => ( isa => 'Bool', is => 'ro', required => 1 );

    use overload '""' => \&_overload_string;

    sub _overload_string {
        my $self = shift;

        return $self->name;
    }

    __PACKAGE__->meta->make_immutable;    
    no Moose;
    1;
}

BEGIN {
    package Cat;

    use Moose;
    use Moose::Util::TypeConstraints;
    use Carp;

    subtype 'MyTypes::CatBreed' => as class_type('Breed');

    coerce 'MyTypes::CatBreed' => 
        from  'Str' 
        => via  { Cat->supported_breed_by_name( $_ ) };



    has 'name'     => ( isa => 'Str',  is => 'rw', required => 1 );
    has 'kittens'  => ( 
        traits      => ['Array'],
        is          => 'ro',
        isa         => 'ArrayRef[Str]',
        default     => sub{ [] },
        handles     => {
           all_kittens   => 'elements',
           add_kittens   => 'push',
           get_kitten    => 'get',
           count_kittens => 'count',
           has_kittens   => 'count',
       },
    );
    has 'markings' => ( 
        traits      => ['Hash'],
        is          => 'ro',
        isa         => 'HashRef[Str]',
        default     => sub{ {} },
        handles     => {
            set_marking    => 'set',
            get_marking    => 'get',
            has_marking    => 'exists',
            all_markings   => 'keys',
            delete_marking => 'delete',
        },
    );
    has 'breed'    => ( 
        isa    => 'MyTypes::CatBreed', 
        is     => 'ro', 
        coerce => 1,
    );

    my %breeds;
    sub supported_breed_by_name {
        my $class = shift;
        my $name  = shift;

        croak 'No breed name specified' 
            unless defined $name and length $name;

        return $breeds{$name};
    }

    sub add_breed {
        my $class = shift;
        my $breed  = shift;

        croak 'No breed specified' 
            unless eval { $breed->isa('Breed') };

        croak 'Breed already exists'
            if exists $breeds{$breed};

        $breeds{$breed} = $breed;

        return $class;
    }

    sub delete_breed {
        my $class = shift;
        my $name  = shift;

        croak 'No breed name specified' 
            unless defined $name and length $name;

        return delete $breeds{$name};
    }

    __PACKAGE__->meta->make_immutable;    
    no Moose;
    1;
}


# Set up the supported breeds
Cat->add_breed($_) for map Breed->new( %$_ ), (
    { name=>'short-hair', cross=>1 },
    { name=>'long-hair', cross=>1 },
    { name=>'siamese', cross=>0 },
);

# Make a cat
my $cat = Cat->new( name     => 'Socks',
                    kittens  => ['Monica', 'Kenneth'],
                    markings => { socks=>1, blaze=>"white" },
                    breed    => 'short-hair',
);

print 
    "Once a cat called ", $cat->name, "\n",
    "(which was a ", $cat->breed, ")\n",
    "had ", , " kittens: ", join(' and ', @{$cat->kittens}), "\n";

use warnings;
use strict;

sub say {print @_, "\n"}

use Class::Struct;

struct Breed =>
{
    name  => '$',
    cross => '$',
};

struct Cat =>
[
    name     => '$',
    kittens  => '@',
    markings => '%',
    breed    => 'Breed',
    breed2   => '$',

];

sub Cat::breed_name {shift->breed->name}  #create a new accessor method

my $cat; # or declare $cat first
$cat = Cat->new( name     => 'Socks',
                    kittens  => ['Monica', 'Kenneth'],
                    markings => { socks=>1, blaze=>"white" },
                    breed    => { name=>'short-hair', cross=>1 },
                    breed2 => sub { return $cat->breed->name;},
                    # this is now ok, but a bit awkward to call
                  );

print "Once a cat called ", $cat->name, "\n";
print "(which was a ", $cat->breed2->(), ")\n";  #returns then calls code ref
print "(which was a ", $cat->breed_name, ")\n";  #new accessor method
print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n";