tokuhirom's Blog

B::Hooks::Parser と B::OPCheck をもちいたソースフィルターの作り方

ソースフィルターの用途は大きくわけて2種類

• ぜんぜん perl でないコードを perl にする
• perl コードの一部をかきかえる

前者は、普通に文字列置換なりでやればいいのだが、後者は意外とむずかしい。
Perl のコードをパースするのは非常にむずかしいのだ。

そこで、Devel::Declare という仕組みが考案されて、キーワードなどに反応して、そこからしばらくの文字列をソースフィルターで置換する仕組みができたわけです。

しかし、Devel::Declare はちょっとゴツいし、なかなかつかいこなすのがむずかしい。

そんなわけで、Devel::Declare の機能は分割され、いくつかの B::* モジュールとして提供されています。

B::Hooks::Parser と B::OPCheck をつかうと、以下のようにして簡単に Devel::Declare 相当のことができます。

以下は、package 宣言をみつけて、package 宣言の直後に use Moo を追加するというコードです。

package Moo::Auto;
use strict;
use warnings;
use utf8;

use 5.008005;
our $VERSION = '0.01';
use B::Hooks::Parser;

sub import {
    my $class = shift;
    my $pkg = caller(0);

    B::Hooks::Parser::setup();
    my $linestr = B::Hooks::Parser::get_linestr();
    my $offset  = B::Hooks::Parser::get_linestr_offset();
    substr($linestr, $offset, 0) = 'use B::OPCheck const => check => \&Moo::Auto::_check;';
    B::Hooks::Parser::set_linestr($linestr);
}

sub _check {
    my $op = shift;
    return unless ref($op->gv) eq 'B::PV';

    my $linestr = B::Hooks::Parser::get_linestr;
    my $offset  = B::Hooks::Parser::get_linestr_offset;
    if (substr($linestr, $offset, 7) eq 'package') {
        my $line = substr($linestr, $offset);
        if ($line =~ /\A(package\s+(?:[A-Za-z0-9_:-]+)\s*[\{;])/) {
            substr($linestr, $offset+length($line)-1, 0) = ';use Moo;';
            B::Hooks::Parser::set_linestr($linestr);
        }
    }
}

1;

コードの内容自体は非常に単純でわかりやすいかとおもいます。