wiki:Perl

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