続・初めてのPerl 第13章 「オブジェクトのデストラクション」

練習問題の回答をメモ。

#!/usr/bin/perl
use strict;
use warnings;

{ package Animal;
  use Scalar::Util qw(weaken);
  use Carp qw(croak);

  sub speak {
    my $class = shift;
    print $class->name, ' goes ',  $class->sound, "!\n";
  }
  sub name {
    my $either = shift;
    ref $either or croak "instance variable needed";
    $either->{Name};
  }

  our %REGISTRY;
  sub named {
    ref(my $class = shift) and croak 'class only';
    my $name = shift;
    my $self = { Name => $name, Color => $class->default_color };
    bless $self, $class;
    $REGISTRY{$self} = $self;
    weaken($REGISTRY{$self});
    $self;
  }
  sub registered {
    return map { 'a ' . ref($_) . " named " . $_->name } values %REGISTRY;
  }
  sub default_color { 'brown' }
  sub eat {
    my $either = shift;
    my $food = shift;
    print $either->name, " eats $food.\n";
  }
  sub color {
    my $self = shift;
    $self->{Color};
  }
  sub set_color {
    my $self = shift;
    $self->{Color} = shift;
  }
  sub DESTROY {
    my $self = shift;
    print '[', $self->name, " has died.]\n";
  }
}
{ package Horse;
  use base qw{Animal};
  sub sound { 'neigh' }
  sub default_color { 'white' }
  sub DESTROY {
    my $self = shift;
    $self->SUPER::DESTROY;
    print "[", $self->name, " has gone off to the glue factory.]\n";
  }
}
{ package RaceHorse;
  use base qw{Horse};

  my %DATA;
  sub named {
    my $self = shift->SUPER::named(@_);
    dbmopen(%DATA, "horse_db", 0644) or die "Cannot create horse_db: $!";
    my $db_data = $DATA{ref($self)};
    if (defined($db_data)) {
      @$self{ qw/wins places shows losses/ } = split / /, $db_data;
    } else {
      $self->{$_} = 0 for qw(wins places shows losses);
    }
    $self;
  }

  sub won { shift->{wins}++ }
  sub placed { shift->{places}++ }
  sub showed { shift->{shows}++ }
  sub lost { shift->{losses}++ }
  sub standings {
    my $self = shift;
    join ', ', map "$self->{$_} $_", qw(wins places shows losses);
  }
  sub DESTROY {
    my $self = shift;
    $self->SUPER::DESTROY;
    $DATA{ref($self)} = join ' ', map "$self->{$_}", qw(wins places shows losses);
  }
}
my $runner = RaceHorse->named('Billy Boy');
$runner->won;
print $runner->name, ' has standings ', $runner->standings, ".\n";

反省点

ハッシュリファレンスのスライスではまったよ（70行目）。

正しいハッシュリファレンスのスライス

@$self{ qw/wins places shows losses/ } = split / /, $db_data;

ハッシュリファレンスのスライス？これは間違い

@$self->{ qw/wins places shows losses/ } = split / /, $db_data;

前のエントリにまとめておいたよ。
Perl のハッシュリファレンスのスライスの書き方 - 英語とプログラミング気まぐれ日記