Mooseを使ってちょっと演奏させてみた

ということで、『モダンPerl入門』を読んでたらちょっとコード書きたくなってきたので作ってみました。ただのサンプルコードみたいな感じなんで音なったりはしません(笑)。使い方がまだ頭に入っていないので、本を片手に作ったんですが、結構スイスイ書けたので使いやすいなと実感できた感じです。ではでは使い始めたばっかりでちょっと粗が目立つかも知れませんがはってみます。趣味モロ出しです。そしてそれなりに長いです。一通り基礎的なとこは抑えたかなと。実行結果は一番最後に。

live.plのベタ書きの部分はBandとかってクラスを作ってもうちょっとスマートにできそうなので後で修正すると思います。合わせてクラス図とかも描いてみるかな。

Person.pm

#!/usr/bin/perl

use strict;
use warnings;

package Person;
use Moose;

has 'name' => (
  is => 'rw',
  isa => 'Str',
  required => 1,
  default => "John Doe"
);

__PACKAGE__->meta->make_immutable;

no Moose;

sub say_name {
  my $self = shift;

  my $name;

  $name = $self->name;

  print "$name! ";
}

1;

Musician.pm

#!/usr/bin/perl

use strict;
use warnings;

package Musician;
use Moose;

extends 'Person';

has 'item' => (
  is => 'rw',
  isa => 'Str',
  required => 1
);


has 'role' => (
  is => 'rw',
  isa => 'Str',
);

__PACKAGE__->meta->make_immutable;

no Moose;

sub play {
  my $self = shift;
  my $song = shift;

  my ($name, $melody);

  $name = $self->name;
  $melody = $song->melodies->{$self->role};

  print "$name: $melody\n";
}

sub setup {
  my $self = shift;
}

1;

Vocal.pm

#!/usr/bin/perl

use strict;
use warnings;

package Vocal;
use Moose;

extends 'Musician';
with 'Hello';


sub BUILDARGS {
  my ($class, %args) = @_;

  # roleを初期化
  $args{role}= __PACKAGE__;

  return {%args};
}

__PACKAGE__->meta->make_immutable;

no Moose;

sub hello {
  my $self = shift;
  my $place = shift;

  my $name;

  $name = $self->name;

  print "$name: のってるかー$place!\n";
}


1;

Guitarlist.pm

#!/usr/bin/perl

use strict;
use warnings;

package Guitarlist;
use Moose;

extends 'Musician';
with 'Tuning';

sub BUILDARGS {
  my ($class, %args) = @_;

  # roleを初期化
  $args{role}= __PACKAGE__;

  return {%args};
}

override 'setup' => sub {
  my $self = shift;

  $self->tuning();

};

__PACKAGE__->meta->make_immutable;

no Moose;

sub tuning {
  my $self = shift;

  my ($name, $item);

  $name = $self->name;
  $item = $self->item;

  print "${name}'s $item: ぎゅい〜〜〜〜〜〜ん\n";
}

1;

Bassist.pm

#!/usr/bin/perl

use strict;
use warnings;

package Bassist;
use Moose;

extends 'Musician';
with 'Tuning';

sub BUILDARGS {
  my ($class, %args) = @_;

  # roleを初期化
  $args{role}= __PACKAGE__;

  return {%args};
}

override 'setup' => sub {
  my $self = shift;
  
  $self->tuning();
};

__PACKAGE__->meta->make_immutable;

no Moose;

sub tuning {
  my $self = shift;

  my ($name, $item);

  $name = $self->name;
  $item = $self->item;

  print "${name}'s $item: どぅーーーーーーどぅどぅどぅ\n";
}

1;

Drummer.pm

#!/usr/bin/perl

use strict;
use warnings;

package Drummer;
use Moose;

extends 'Musician';
with 'Tuning';

sub BUILDARGS {
  my ($class, %args) = @_;

  # roleを初期化
  $args{role}= __PACKAGE__;

  return {%args};
}

override 'setup' => sub {
  my $self = shift;

  $self->tuning();

};

__PACKAGE__->meta->make_immutable;

no Moose;

sub tuning {
  my $self = shift;

  my ($name, $item);

  $name = $self->name;
  $item = $self->item;

  print "${name}'s $item: たん、たん、たん、たん\n";
}

1;

Hello.pm

#!/usr/bin/perl

use strict;
use warnings;

package Hello;
use Moose::Role;
requires 'hello';

1;

Tuning.pm

#!/usr/bin/perl

use strict;
use warnings;

package Tuning;
use Moose::Role;
requires 'tuning';

1;

Song.pm

#!/usr/bin/perl

use strict;
use warnings;

package Song;
use Moose;

has 'name' => (
  is => 'rw',
  isa => 'Str',
  required => 1,
  default => 'no title'
);

has 'melodies' => (
  is => 'rw',
  isa => 'HashRef[Str]',
);

__PACKAGE__->meta->make_immutable;

no Moose;

1;

live.pl

#!/usr/bin/perl

use strict;
use warnings;

use Vocal;
use Guitarlist;
use Bassist;
use Drummer;
use Song;

my ($hyde,$ken,$tetsu, $yukihiro, @members);
my ($honey, $flower);

## -- インスタンス生成

# メンバー
$hyde = Vocal->new(name => "hyde", item => "マイク");
$ken = Guitarlist->new(name => "ken", item => "ギター");
$tetsu = Bassist->new(name => "tetsu", item => "ベース");
$yukihiro = Drummer->new(name => "yukihiro", item => "ドラム");

@members = ($hyde, $ken, $tetsu, $yukihiro);

# 曲
$honey = Song->new(
                    name => "honey",
                    melodies => {
                      Vocal => "乾いた風を絡ませ、あなたを連れていくのさ",
                      Guitarlist => "じゃんじゃじゃーんじゃじゃ。じゃんじゃじゃーんじゃじゃ。",
                      Bassist => "....",
                      Drummer => "...."
                    }
                  );

$flower = Song->new(
                    name => "flower",
                    melodies => {
                      Vocal => "そう気づいていた、午後の光にまだ",
                      Guitarlist => "とぅとぅとぅとぅーん",
                      Bassist => "どぅっどぅどぅーどぅ、どぅどぅーどぅどぅ",
                      Drummer => "たたたん、たたたん、たたたん、たたたん"
                    }
                  );

## -- メイン処理

&ready;
&greeting('東京');
&play($honey);
&play($flower);

## -- サブルーチン 
sub ready {
  foreach my $member (@members) {
    $member->setup;
  }
  print "\n";
}

sub greeting {
  my $location = shift;

  print "L'Arc-en-Ciel are ...";
  foreach my $member (@members) {
    $member->say_name;
  }
  print "\n";
  $hyde->hello($location); 
  print "\n";
}

sub play {
  my $song = shift;

  my $name;

  $name = $song->name;

  print "Are you ready !? next song is $name!!!!!!!!\n\n"; 
  foreach my $member (@members) {
    $member->play($song);
  }
  print "\n";
}

実行結果

ken's ギター: ぎゅい〜〜〜〜〜〜ん
tetsu's ベース: どぅーーーーーーどぅどぅどぅ
yukihiro's ドラム: たん、たん、たん、たん

L'Arc-en-Ciel are ...hyde! ken! tetsu! yukihiro! 
hyde: のってるかー東京!

Are you ready !? next song is honey!!!!!!!!

hyde: 乾いた風を絡ませ、あなたを連れていくのさ
ken: じゃんじゃじゃーんじゃじゃ。じゃんじゃじゃーんじゃじゃ。
tetsu: ....
yukihiro: ....

Are you ready !? next song is flower!!!!!!!!

hyde: そう気づいていた、午後の光にまだ
ken: とぅとぅとぅとぅーん
tetsu: どぅっどぅどぅーどぅ、どぅどぅーどぅどぅ
yukihiro: たたたん、たたたん、たたたん、たたたん