perl オブジェクト指向

うーん、久々に書くと忘れとるな
つーことで、過去の snippet を適当に

基本型

コード

$ pbpaste
sub new { bless {}, shift }
sub add { ++ shift->{c} }


my $c = main->new ;
print $c->add for 0 .. 9 ;
print $c->{c};

pbpaste は mac のクリップボードからペーストするコマンド

実行

$ pbpaste | perl -l
1
2
3
4
5
6
7
8
9
10
10

コンストラクタからのメソッド呼び出し

初期化メソッド的なアレとか。

コード

$ pbpaste
sub init { $_[0]->{c} = 100 ; $_[0]}
sub new  { my $r = {} ; bless $r, shift ; $r->init  }
sub add  { ++ shift->{c} }


my $c = main->new ;
printf "init: %d\n", $c->{c} ;
printf "one:  %d\n", $c->add for 0 .. 3 ;
printf "init: %d\n", $c->init->{c} ;
printf "two:  %d\n", $c->add for 0 .. 3 ;

実行

$ pbpaste | perl -l
init: 100
one:  101
one:  102
one:  103
one:  104
init: 100
two:  101
two:  102
two:  103
two:  104

インサイドアウト

手抜きコード

$ pbpaste
my %h ;
sub new { bless \my $s, shift ; }
sub add { ++ $h{c}  }


my $c = main->new ;
print $c->add for 0 .. 9 ;
print Dumper $c ;
# print $c->{c} ;

手抜き実行

$ pbpaste | perl -MData::Dumper -l
1
2
3
4
5
6
7
8
9
10
$VAR1 = bless( do{\(my $o = undef)}, 'main' );

真面目に書いた場合

$ pbpaste
{
    package D;
    use Scalar::Util qw(refaddr) ; 
    my %hash ; 
    sub new { 
        my $obj = bless \do{my $d}, shift ;
        $hash{ refaddr $obj } = shift ;
        $obj ;
    } 
    sub getter { $hash{ refaddr shift} ; } 
    sub setter { $hash{ refaddr shift} = pop ; return ; } 
    sub DESTROY { delete $hash{ refaddr shift } ; }
}
my $obj = D->new('XYZ');
print Dumper $obj ;
print $obj->getter ;

実行

$ pbpaste | perl -MData::Dumper -l
$VAR1 = bless( do{\(my $o = undef)}, 'D' );

XYZ

シングルトン

コード

$ pbpaste
my $s ;
sub new { $s ||= bless {}, shift ; }
sub add { ++ shift->{c} }

my $o = main->new ;
my $p = main->new ;
print $o->add ;
print $p->add ;
print $o->add ;
print $p->add ;

実行

$ pbpaste | perl -l
1
2
3
4

コールバック

コード

$ pbpaste
{
    package D ;
    sub new     { bless pop, shift ; } ;
    sub execute { shift->(pop); }
}

my $obj = D->new( sub { print $_[0] ; } ) ;
$obj->execute( 'foo' ) ;

実行

$ pbpaste | perl -l
foo

継承

コード

$ pbpaste
sub new{ bless {c => 0}, shift }
sub add{ ++ shift->{c} }
{
    package D;
    use base qw(main) ;
    sub new  { my $r = main->new ; $r->{d} = 0 ; bless $r, shift }
    sub add  { ++ shift->{d} }
    sub addp { shift->SUPER::add }
}

my $c = main->new ;
printf "main add: %s\n", $c->add for 0 .. 1 ;
printf "main {c}: %s\n",  $c->{c};

my $d = D->new ;
printf "D add:    %s\n",  $d->add for 0 .. 1 ;
printf "D {c}:    %s\n",  $d->{c};
printf "D {d}:    %s\n",  $d->{d};
printf "D addp:   %s\n",  $d->addp ;
printf "main {c}: %s\n",  $c->{c};
printf "D {c}:    %s\n",  $d->{c};
printf "D {d}:    %s\n",  $d->{d};

• SUPPER::method は継承元へのアクセス

実行

$ pbpaste | perl
main add: 1
main add: 2
main {c}: 2
D add:    1
D add:    2
D {c}:    0
D {d}:    2
D addp:   1
main {c}: 2
D {c}:    1
D {d}:    2

クローン

コード

$ pbpaste
sub new   { my $c = shift ; bless { @_}, $c }
sub add   { ++ shift->{c} }
sub clone { do{ ref $_[0] }->new( c => 10 );}

my $obj = main->new ;
print $obj->add ;
my $obj2 = $obj->clone ;
print $obj2->add ;
print $obj->add ;
print $obj2->add ;

実行

$ pbpaste | perl -l
1
11
2
12

間接オブジェクト記法

についてのメモ。断捨離。

{
    package D;
    sub new { bless {}, shift } 
    sub get { "get" }
}

print D->new->get ; # 直接ならあっさり 
# 間接が一個でも混ると 
#print get new D ; # ダメ 
#print get { new D } ; # ダメ 
print STDOUT get { new D } ; 
print STDOUT get { D->new } ; 
print do{ new D }->get ;