Version 3 (modified by atzm, 18 years ago) (diff) |
---|
Perl
Python で言うところの getattr してみる
ていうかむしろ eval してるだけ. eval じゃなくてホントに getattr したいんだけど,どうやってやるんだろう?
- hoge.pm
use strict; use warnings; package hoge; our $foo = "hogeraccho"; 1; __END__
- unko.pm
use strict; use warnings; package unko; our $foo = "unkokko"; 1; __END__
- modules ファイル
unko hoge foo
- main.pl
#!/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);
- 実行結果
bash$ perl main.pl $unko::foo = unkokko $hoge::foo = hogeraccho WARNING: Can't locate foo.pm in @INC ...
データの永続化
Storable を使って文字列で Perl オブジェクトをやりとりしてみる.nfreeze を使う場合,改行をエスケープする必要があるようだ.
バイナリでのやりとりも可であれば,nstore を使うのが良い.
- freeze.pl
#!/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
#!/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; }
- 実行結果
$ ./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
#!/usr/bin/perl use strict; use diagnostics; use warnings; package object; sub new { my $class = shift; bless { "1" => "hogera" }, $class; } sub unko { my $self = shift; return $self->{"1"}; } 1; __END__
- freeze.pl
#!/usr/bin/perl use strict; use diagnostics; use warnings; use Storable qw(nfreeze); use object; my $obj = new object; 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
#!/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; }
- 実行結果
$ ./freeze.pl | ./thaw.pl hogera