Perl - データのあるオブジェクト(インスタンス)

続・初めてのPerl 改訂版
Randal L. Schwartz
brian d foy, Tom Phoenix 著

開発環境

• OS X Lion - Apple(OS)
• TextWrangler(Text Editor) (BBEditの機能制限無料版、light版)
• Script言語:Perl

『続・初めてのPerl 改訂版』(Randal L. Schwartz, brian d foy, Tom Phoenix 著、伊藤 直也、田中 慎司、吉川 英興 監訳、株式会社ロングテール/長尾 高弘 訳、オライリー・ジャパン、2006年、ISBN4-87311-305-9) の12章(データのあるオブジェクト),　12.15(練習問題)1を解いてみる。

その他参考書籍

• プログラミングPerl〈VOLUME1〉
• プログラミングPerl〈VOLUME2〉
• Perlクックブック〈VOLUME1〉
• Perlクックブック〈VOLUME2〉

1.

コード(TextWrangler)

sample.pl

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use 5.016;
binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';

{package Animal;
  use Carp qw(croak);
  sub named{
    ref(my $class = shift) and croak "class name needed";
    my $name = shift;
    my $self = {Name => $name, Color => $class->default_color};
    bless $self, $class;
  }
  sub default_color{ "brown" }
  sub name{
    my $either = shift;
    ref $either
      ? $either->{Name}
      : "an unnamed $either";
  }
  sub set_name{
    ref(my $self = shift) or croak "instance variable needed";
    $self->{Name} = shift;
  }
  sub get_name{
    ref(my $self = shift) or croak "instance variable needed";
    $self->{Name};
  }
  sub color{
    my $either = shift;
    ref $either
      ? $either->{Color}
      : $either->default_color;
  }
  sub set_color{
    ref(my $self = shift) or croak "instance variable needed";
    $self->{Color} = shift;
  }
  sub get_color{
    ref(my $self = shift) or croak "instance variable needed";
    $self->{Color};
  }
  sub speak{
    my $either = shift;
    print $either->name, " goes ", $either->sound, "\n";
  }
}

{package Cow;
  our @ISA = qw(Animal);
  sub sound{'mooo'}
}

{package Horse;
  our @ISA = qw(Animal);
  sub sound{'neigh'}
}

{package Sheep;
  our @ISA = qw(Animal);
  sub sound{'baaaah'}
}

{package Mouse;
  our @ISA = qw(Animal);
  sub sound{ 'squeak' }
  sub speak{
    my $class = shift;
    $class->SUPER::speak;
    print "[but you can barely hear it!]\n";
  }
}

my $tv_horse = Horse->named("mr. Ed");
$tv_horse->set_name("Mister Ed");
$tv_horse->set_color("grey");
print $tv_horse->name, " is ", $tv_horse->color, "\n";
print Sheep->name, " colored ", Sheep->color, " goes ", Sheep->sound, "\n";

入出力結果(Terminal)

$ ./sample.pl
Mister Ed is grey
an unnamed Sheep colored brown goes baaaah
$