[Tokyo.pm] サブルーチンの実装の抽出

Hiroyuki OYAMA oyama @ crayfish.co.jp
2002年 2月 26日 (火) 20:37:07 CST


クレイフィッシュの小山です。

あるモジュールで実装されているサブルーチンの*コード*を取り
出す方法を探しています。

B::Deparseモジュールでコードリファレンスからコード本体を得
ることが出来るのですが、この方法だと元々のコードのスタイル
やコメント等の情報が欠落してしまいます。

perl -MB::Deparse -e '$m=shift;$m=~/(^.+)::/;eval "require
$1"; print B::Deparse->new->coderef2text(\&$m)' Module::function


別に

perldoc -m Module | perl -ne 'print if /^sub function/ .. /^}/'

とかでも概ね上手く行くのですが、確実とはいえない物で。なん
かいい方法は無いでしょうか?

___
とりあえずB::Deparseを使ったこんなのを使ってみてます。

#!perl

use B::Deparse;
use Getopt::Std;
use strict;
use vars qw($VERSION);
$VERSION = '0.01';


my %args;
getopts 'hvl', \%args;
my $symbol = shift;
show_version() if $args{v};
show_usage()   if $args{h} or not defined $symbol;

my @symbol = split /::/, $symbol;
for my $index (reverse 0.. scalar @symbol - 1) {
	my $class = join '::', @symbol[0..$index];
	eval "require $class";
	if ($@) {
		print STDERR $@;
		next;
	}

	$args{l}
		? show_all_method($symbol)
		: show_code($symbol);
	last;
}
exit;



sub show_code
{
	my $symbol = shift;
	my $parser = B::Deparse->new;
	print $parser->coderef2text(\&$symbol);
}


sub show_all_method
{
	my $symbol = shift;
	no strict;
	while (my ($key, $value) = each %{*{"$symbol\::"}}) {
		printf "%s%s()\n", $key if defined *$value{CODE};
	}
}


sub show_usage
{
	die <<__USAGE__;
Usage: perlfunc [-hvl] Class::method
       perlfunc Class::method
       perlfunc -l Class

  -l  dump all method
  -h  display this help and exit
  -v  print version information and exit
__USAGE__
}


sub show_version
{
	die <<__VERSION__;
perlfunc $VERSION
__VERSION__
}

__END__


モジュールに含まれるサブルーチンの一覧表示
	% perlfunc -l CGI::Cookie

サブルーチンのコード表示
	% perlfunc CGI::Cookie::parse

ってな使い方します。
______________
Hiroyuki OYAMA <oyama @ crayfish.co.jp>
System Operations Dept.
Crayfish Co.,Ltd. <http://Crayfish.CO.JP/>
  "PerlとRubyでYahoo!Messenger"
   -> http://ymca.infoware.ne.jp/




Tokyo-pm メーリングリストの案内