Hatena::ブログ(Diary)

ヒルズで働く@robarioの技ログ このページをアンテナに追加 RSSフィード

2006年10月08日

[]use無しでどこでも変数をダンプするpackage P;p

perl - Perl6の$variable.perlをPerl5で

[Perl] Dumping variables Everywhere without use() - Bulknews::Subtech - subtech

最初CHECKブロックでできるかなと思っていたのですが、シンボルの解決はCHECKでは遅くてBEGINでやらなきゃいけないようです。外部からあるパッケージにエクスポートしようとしてもBEGIN時にはプログラム全体でどういうパッケージが定義されるか分からないので、各モジュールごとにuseしなきゃいけなくなってしまいます。

まぁそれなら明示的に指定しちゃえばいいんじゃね?というわけで書いてみた。


こういうFoo.pmがあるとき、

package Foo;
p "test";

SYNOPSISはこんな感じで、環境変数Pか、モジュールPの引数にsub pをエクスポートしたいパッケージを指定します。

% perl -MP=Foo main.pl
--- test 

% P="Foo" perl -MP main.pl
--- test

明示的に指定するのは面倒だし、指定していないパッケージでpが使われるとエラーになるので何とも使えなさ感が溢れています。全パッケージを環境変数Pに指定しちゃえばマシに使える気が・・・しないか。

package P;
use strict;
use warnings;

use YAML;

sub import {
    my ($class, @modules) = @_;
    push @modules, split /[,\s]+/msx, $ENV{P} || q{};
    foreach my $module (@modules) {
        no strict qw(refs);
        *{$module.'::p'} = sub {
            warn YAML::Dump(shift);
        }
    };
}

1;

[]use Smart::Commentsをソースに書かずに有効にする方法

Filter::Simple使わずにGlobalSmartComments::importで全部やればできますね。ということで後でちょっとやってます。

[Perl

というわけでやってみた。多分これで終わり。力技過ぎてつまらなくなってきました。

頭良い人がすごくPerlらしい方法でやってくれると思います。っていうか実はすでにFilter::Global的なものがあったりします?

使い方ですが、例えばこんなFoo.pm

package Foo;
use Foo::Bar;

### This is Foo...

sub run {
    ### This is Foo#run...
}
1;

と、こんなFoo/Bar.pm

package Foo::Bar;

### This is Foo-Bar...

1;

と、こんなmain.pl

use Foo;
Foo->run;

があるとき、こんな風にFoo,Foo::Barを指定するとFoo,Foo::BarでSmart::Commentsが有効になります。

% perl -MSmart::Comments::Global=Foo,Foo::Bar main.pl

### This is Foo-Bar...

### This is Foo...

### This is Foo#run...

もちろんFooしか指定しなければFoo::Barでは有効にならず「### This is Foo-Bar...」は出ません。

main.plをこんな感じ

use Smart::Comments::Global qw(Foo Foo::Bar);
use Foo;
Foo->run;

にしても良いのですが、use Smart::Comments::Global以降の行にしか効果はありませんので最初に書く必要があります。

ソースはこんなSmart/Comments/Global.pm

package Smart::Comments::Global;
use strict;
use warnings;

use Fatal qw(open);
use File::Path;

my $inc = '/tmp/SmartCommentsGlobal';

sub import {
    my $class = shift;

    rmtree( [$inc] );
    mkpath( [$inc] );
    unshift @INC, $inc;

    foreach my $module (@_) {
        my $srcfile = `perldoc -mT $module`;
        chomp $srcfile;
        next if !$srcfile;

        my ( $destdir, $filename ) = $module =~ /(.*?)([^:]+)$/msx;
        $filename .= '.pm';
        $destdir =~ s{::}{/}gmsx;
        $destdir = $inc . q{/} . $destdir;

        my $destpath = $destdir . q{/} . $filename;

        mkpath( [$destdir] );

        open my $fh, q{>}, $destpath;
        print {$fh} "use Smart::Comments;\n";
        print {$fh} $srcfile;
        close $fh;
    }
    return;
}

1;

[]use Smart::Commentsやっぱいらないんじゃね?w

[perl] use Smart::Comments - Bulknews::Subtech - subtech

use Smart::Commentsはいらないと思う - ヒルズで働く@robarioの技ログ

> グローバルフィルターみたいに働くうまい仕組みは無いですかねぇ。

というわけで、各ファイルに自動的に「use Smart::Comments」を埋め込めばできるかな〜と思ってめちゃくちゃなスクリプトをでっちあげてみた。

先に言っておきますが、こんなことするぐらいなら素直に「use Smart::Comments」した方が良いと思います。タイトルはネタです。

「use Smart::Comments」が無いFoo.pm

package Foo;
sub run {
    ### This is Foo...
}
1;

を呼び出すmain.pl

use Foo;
Foo->run;

を実行するときに、-MGlobalSmartComments=Fooを指定して実行すると

% perl -MGlobalSmartComments=Foo main.pl

### This is Foo...

Foo.pmでSmart::Commentsが有効になります。



GlobalSmartComments.pmは見ての通り、精一杯の力技w

perldoc -mlでソースの場所を特定して、/tmp以下に「use Smart::Comments」を挿入しながらコピーしています。コピーした先を@INCの先頭に入れているので、「use Smart::Comments」が付いている方のモジュールが読み込まれるようになります。

  • 階層掘ってないので「::」を含むモジュールが動きません。(ただの手抜き)
  • perldocを呼び出しているので遅い
  • 「use Module ...;」の引数が無視されている
  • UNIX系コマンド(cat,echo)が必要(ただの手抜き)

あ・・・最初ソースフィルタで何とかなると思ってFilter::Simpleを使っていましたけど、それは無理だから各ファイルに「use Smart::Comments」が必要なんですよね。。。

Filter::Simple使わずにGlobalSmartComments::importで全部やればできますね。ということで後でちょっとやってます。やってみました→use Smart::Commentsをソースに書かずに有効にする方法

本当にネタのつもりなので、突っ込みはお手柔らかに・・・

package GlobalSmartComments;
use strict;
use warnings;

use UNIVERSAL::require;
use List::Util qw(first);

my @modules;
my $inc = '/tmp/SCG';

sub import {
    my $class = shift;
    @modules = @_;
    mkdir $inc;
    unshift @INC, $inc;
}

use Filter::Simple sub {
    s{(\s?use\s+([^;]+))}{
        my $all = $1;
        my $args = $2;
        if (first {$args =~ /$_/} @modules) {
            'BEGIN{' . __PACKAGE__ . "::use('$args');}";
        } else {
            $all;
        }
    }egmsx;
};

sub use {
    my $module = shift;

    my $src = `perldoc -ml $module`;
    chomp $src;
    my $dest = $inc . '/' . $module . '.pm';

    `echo 'use Smart::Comments;\n' | cat - $src > $dest`;

    package main;
    $module->use;
}

1;