asin:487311280X
実用Perlプログラミング
Simon Cozens / 菅野良二訳
[原著:Advanced Perl Programming]

これを見てるうちについカッとなってやった、今は後悔する代わりに公開することにする。

WTF?

まず、モジュール自体がQuine。

{local$_=q{
{
    package Quine;
    use strict;
    use warnings;
    our $VERSION = sprintf "%d.%02d", q$Revision: 0.2 $ =~ /(\d+)/g;
    my $head = '{local$_=q' . "\x7B\n";
    my $tail = 'print"{local\$_=q{$_};eval}\n"' . "\x7D;eval}\n";

    sub new {
        my $class = shift;
        my $quine = $head . shift;
        my $ret   = shift || 1;
        my $ln    = ( $quine =~ tr/\n/\n/ );
        $ln++;
        $quine .= "return $ret if caller(1)or(caller)[2]!=$ln;$tail";
        bless \$quine, $class;
    }

    sub from_file {
        my ( $class, $fn, $ret ) = @_;
        local $/;
        open my $fh, '<', $fn or die "$fn : $!";
        my $src = <$fh>;
        close $fh;
        $class->new( $src, $ret );
    }

    sub quine { ${ $_[0] } }

=head1 NAME

Quine - turn your perl modules/apps into a true quine!

=head1 VERSION

$Id: Quine.pm,v 0.2 2010/09/15 20:23:53 dankogai Exp dankogai $

=head1 SYNOPSIS

  use Quine;
  print Quine->from_file("woot.pl")->quine;
  print Quine->from_file("moot.psgi", '$app')->quine;

=cut
}
return 1 if caller(1);print"{local\$_=q{$_};eval}\n"};eval}

% perl Quine.pm >! 1.pl 
% diff Quine.pm 1.pl

__FILE__や$0を使った自己参照は一切なし。

しかしモジュールとして呼び出されると、perlスクリプトをquine化するメソッドを提供する。

% perl -MQuine -e 'print Quine->from_file(shift, q($app))->quine' \
       hello.psgi >! quine.psgi
% perl quine.psgi 
{local$_=q{
my $app = sub {
    my $env = shift;
    [ 200, [ "Content-Type", "text/plain" ], [ "Hello World" ] ];
};
return $app if caller(1)or(caller)[2]!=6;print"{local\$_=q{$_};eval}\n"};eval}
% perl quine.psgi >! 2.psgi
% diff quine.psgi 2.psgi

{local$_=q{
my $app = sub {
    my $env = shift;
    [ 200, [ "Content-Type", "text/plain" ], [ "Hello World" ] ];
};
return $app if caller(1)or(caller)[2]!=6;print"{local\$_=q{$_};eval}\n"};eval}

このquineはしかしPSGIアプリとしてもきちんと動作する。

% plackup quine.psgi
HTTP::Server::PSGI: Accepting connections at http://0:5000/
127.0.0.1 - - [16/Sep/2010 05:28:52] "GET / HTTP/1.1" 200 11 "-" "lwp-request/5.834 libwww-perl/5.836"
^C

SUNABAの遊具としてもちゃんと使える。

たねあかし

まずは最もシンプルなquineを考える。

RubyでうどんげQuine(とAA型Quineの作り方講座) - ぬいぐるみライフ(仮)
evalを使うと以下のような感じでQuineのコードを書くことができる． 
eval s="puts'eval s='+s.inspect"

Perlでこれに相当するのは、以下である。

$_=q{print"\$_=q{$_};eval"};eval

よく観察すると、q{}の中のprint文の前後なら、perlコードとして正しいものなら何でも入ることが見えてくる。実行されてもSTDOUTに触らなければなんでもありなのである。

$_=q{

my $app = sub{ 
  [ 404, [ "Content-Type", "text/plain" ], [ "Blog Not Found" ] ]
};

print"\$_=q{$_};eval";

"Just Another Perl Hacker";

};eval

そう。なんでも。

$_=q{                                                                         q[
01111110000000000000000000000000000000000000000000111100000000000000000000000000
00110001000000000000000000000000000000000000000111111100000000000000000000000000
00011100100000000000000000000000000000000001111100011110000000000000000000000000
00001110110000000000000000000000000000011100000111111110000000000000000000000000
00000111011000000000000000000000000000110000111111111100000000000000000000000000
00001111011000000000000000000000000000100011111111111000000000000000000000000000
00011110011000000000000000000000000000101111111111000000000000000000000000000000
00011100011000000000000000000000000000101111111000000000000000000000000000000000
00111100001100000000000000000000000000101111111000000000000000000000000000000000
00111110000110000000000000000000000010001110111000000000000000000000000000000000
00011111100001100000000000000000011100010111111000000000000000000000000000000000
00001111110000010000000000000001000001111111011000000000000000000000000000000000
00000001111000010001111111111110011111111111100000000000000000000000000000000000
00000000011111110111110000000111011111010100000000000000000000000000000000000000
00000001110111111010000000000011011101110000000000000000000000000000000000000000
00000011011111000000000000000000000001111100000000000000000000000000000000000000
00000111100000000100000000000000000000000111100000000000000000000000000000000000
00001110000110001000000010000000000100001011111100000000000000000000000000000000
00011110001100011011000011001101100100011111011111110000000000000000000000000000
00101110001000111010110110100101011100011111011101010000000000000000000000000000
01010110010001110111011010111111111001011111010010011101110000000000000000000000
11111100010001001111111111111111101011001011111011000011001110000000000000000000
11111010011010000110011100000011111111011001101001110000100001110000000000000000
11111110011111100110000100011101110110010011101000101100001010001110000000000000
00110111001110010000000000001110111110110010111100110011100001110000111000000000
00010110111110111000000000001110110101010100100100111111111000001110000101100000
00000011101110011000000000000000111110101101100110011111111111000001010000001110
00000000101001000001000000000001111111110011111010001001111111000000001111111111
00000001110011100000000000000001110011110111101001100100011111111111111000111100
00000001100110110000011110000011110011011110101111111111100111111110001111111111
00000010111110011000000000000011111001110011100011111111111111011100000001110000
00000101110000100111110001111101111100110100001111000000111011111111111000001110
00000110111001101101100111000001101110111101011001011111110000000000111110111101
00001101100111011001111000000001010001111011110111010000001111111111111110000000
00001001001110000001000000000000110000011100000000000000000000000000011111111000
];print                                                  "\$_=q{$_};eval";};eval

あとは創意工夫あるのみ。

しかしcaller()は一体なにをしているのか?

それは読者の宿題ということで。

Enjoy!

Dan the Perl Monger