[[PageOutline]]

= Perl =
== Python で言うところの getattr してみる ==
ていうかむしろ eval してるだけ．
eval じゃなくてホントに getattr したいんだけど，どうやってやるんだろう？

 * {{{hoge.pm}}}
{{{
#!perl
use strict;
use warnings;

package hoge;

our $foo = "hogeraccho";

1;

__END__
}}}
 * {{{unko.pm}}}
{{{
#!perl
use strict;
use warnings;

package unko;

our $foo = "unkokko";

1;

__END__
}}}
 * {{{modules}}} ファイル
{{{
unko
hoge
foo
}}}
 * {{{main.pl}}}
{{{
#!perl
#!/usr/bin/env perl

use strict;
use warnings;
use Symbol;

my $sym = gensym;
open($sym, "modules");
while (my $module = <$sym>) {
    chomp $module;
    next unless $module;

    eval {
        require $module . '.pm';
        my $foo = eval("\$${module}::foo");
        print "\$${module}::foo = $foo\n";
    };
    warn "WARNING: $@" if $@;
}
close($sym);
}}}
 * 実行結果
{{{
#!sh
bash$ perl main.pl
$unko::foo = unkokko
$hoge::foo = hogeraccho
WARNING: Can't locate foo.pm in @INC ...
}}}

== データの永続化 ==
Storable を使って文字列で Perl オブジェクトをやりとりしてみる．nfreeze を使う場合，改行をエスケープする必要があるようだ．

バイナリでのやりとりも可であれば，nstore を使うのが良い．

 * freeze.pl
{{{
#!perl
#!/usr/bin/perl

use strict;
use diagnostics;
use warnings;
use Storable qw(nfreeze);

my $hash = {
    "1" => "hogera",
    "2" => 1,
    "3" => [1, 2, 3],
    "4" => {"a" => 1},
    "5" => {
        "a" => 1,
        "b" => [1, 2, 3],
        "c" => {"i" => 2},
    },
};

my $serialized = nfreeze($hash);
print r_escape($serialized);

sub r_escape {
    my $s = shift;
    $s =~ s/([%\r\n])/sprintf("%%%02X", ord($1))/ge;
    return $s;
}

}}}

 * thaw.pl
{{{
#!perl
#!/usr/bin/perl

use strict;
use diagnostics;
use warnings;
use Storable qw(thaw);
use Data::Dumper;

my $line = "";
$line .= $_ while (<>);

my $hash = thaw(r_unescape($line));
print Dumper($hash);

sub r_unescape {
    my $s = shift;
    $s =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge;
    return $s;
}
}}}

 * 実行結果
{{{
#!sh
$ ./freeze.pl | ./thaw.pl 
$VAR1 = {
          '1' => 'hogera',
          '4' => {
                   'a' => 1
                 },
          '3' => [
                   1,
                   2,
                   3
                 ],
          '2' => 1,
          '5' => {
                   'c' => {
                            'i' => 2
                          },
                   'a' => 1,
                   'b' => [
                            1,
                            2,
                            3
                          ]
                 }
        };
}}}

=== オブジェクトの永続化 ===
当然のことながら，展開先ソースコードが必要になる．

 * object.pm
{{{
#!perl
use strict;
use diagnostics;
use warnings;

package object;

sub new {
    my $class = shift;
    bless { "1" => "hogera" }, $class;
}

sub set_1 {
    my ($self, $val) = @_;
    $self->{"1"} = $val;
}

sub unko {
    my $self = shift;
    return $self->{"1"};
}

1;

__END__

}}}

 * freeze.pl
{{{
#!perl
#!/usr/bin/perl

use strict;
use diagnostics;
use warnings;
use Storable qw(nfreeze);
use object;

my $obj = new object;
$obj->set_1("hage");

my $serialized = nfreeze($obj);
print r_escape($serialized);

sub r_escape {
    my $s = shift;
    $s =~ s/([%\r\n])/sprintf("%%%02X", ord($1))/ge;
    return $s;
}
}}}

 * thaw.pl
{{{
#!perl
#!/usr/bin/perl

use strict;
use diagnostics;
use warnings;
use Storable qw(thaw);
use object;

my $str = "";
$str .= $_ while (<>);

my $obj = thaw(r_unescape($str));
print $obj->unko(), "\n";

sub r_unescape {
    my $s = shift;
    $s =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge;
    return $s;
}
}}}

 * 実行結果
{{{
#!sh
$ ./freeze.pl | ./thaw.pl
hage
}}}

== constant とハッシュ ==
constant な値をハッシュのキーにすると，そのままでは文字列として解釈されてしまい，ハマる原因になる．括弧をつけること．

 * ダメな例
{{{
#!perl
use constant HOGE => "hoge";

my %hash = ("hoge" => "raccho");
print $hash{HOGE}, "\n";
}}}

 * OK な例
{{{
#!perl
use constant HOGE => "hoge";

my %hash = ("hoge" => "raccho");
print $hash{(HOGE)}, "\n";
}}}

== ハッシュ関連 ==
=== ハッシュが格納されている配列中で，ハッシュの中のある特定のキーの値が同じものを削除する ===
{{{
#!perl
sub keygrep($$) {
  my $array = shift;
  my $key   = shift;
  my %seen  = ();
  my @res   = ();

  @res = sort { $a->{$key} cmp $b->{$key} } @{$array};
  @res = grep(!$seen{$_->{$key}}++, @res);

  return \@res;
}
}}}
 * ([{a=>1, b=>2}, {a=>2, b=>3}, {a=>1, b=>3}], "a") が [{a=>1, b=>2}, {a=>2, b=>3}] で返る．

== OOP 関連 ==
=== 引数設定の自動化もどき ===
 * 意味があるのかどうかは知らん．
{{{
#!perl
use strict;
use warnings;
use diagnostics;
use Carp;

{
  package Base;

  sub new ($%) {
    my ($class, %argv) = @_;
    my $self = bless {__class__ => $class}, $class;
    return $self->__init__(%argv);
  }

  sub __init__ ($%) {
    my ($self, %argv) = @_;

    while (my ($key, $val) = each(%argv)) {
      $self->{$key} = $val;
    }
    return $self;
  }

  sub __class__ ($) {
    my $self = shift;
    return $self->{__class__};
  }

  sub __check__ ($@) {
    my ($self, @requisite) = @_;
    foreach (@requisite) {
      Carp::confess $self->__class__(), " requires argument ", $_
          unless (defined($self->{$_}));
    }
  }

  1;
}

{
  package Parent;

  use base qw(Base);

  sub __init__ ($%) {
    my @requisite = qw(parentname);

    my ($self, %argv) = @_;

    $self->SUPER::__init__(%argv);
    $self->SUPER::__check__(@requisite);

    return $self;
  }

  sub parent ($) {
    my $self = shift;
    printf "parent is %s\n", $self->{parentname};
  }

  1;
}

{
  package Child;

  use base qw(Parent);

  sub __init__ ($%) {
    my @requisite = qw(childname);

    my ($self, %argv) = @_;

    $self->SUPER::__init__(%argv);
    $self->SUPER::__check__(@requisite);

    return $self;
  }

  sub child ($) {
    my $self = shift;
    printf "child is %s\n", $self->{childname};
  }

  1;
}

my $parent = new Parent(parentname => "jobs");
$parent->parent();

my $child = new Child(childname => "michael", parentname => "mike");
$child->parent();
$child->child();
}}}