2009-12-10

PHPのあの関数Perlでやるには?

元ネタ http://phpspot.org/blog/archives/2009/12/phpjavascriptph_1.html

面白そうだと思ったので僕もやってみた。モジュールPerl5.8系の標準モジュールのみ利用可という制限。

全部はキツイので関数処理関係の関数(http://php.benscom.com/manual/ja/ref.funchand.php)だけ実装してみた。

use strict;
use warnings;

=head2 call_user_func

 $ret = call_user_func($function,@param);
 $ret = call_user_func([$class,$method],@param);

example1

 sub plus { $_[0] + $_[1] }
 print call_user_func('plus',10,20); # 30

example2

 package Foo;
 sub plus { $_[1] + $_[2] }
 package main;
 print call_user_func(['Foo','plus'],10,20); # 30

=cut

sub call_user_func {
    my $proto = shift;
    if ( ref $proto eq 'ARRAY' ) {
        return $$proto[0]->${\$$proto[1]}(@_);
    }
    else {
        require Pod::Functions;
        if ( $Pod::Functions::Flavor{$proto} ) {
            return eval qq{$proto(\@_)};
        }
        else {
            no strict 'refs';
            return $proto->(@_);
        }
    }
}

=head2 call_user_func_array

 $ret = call_user_func_array($function,\@param);
 $ret = call_user_func_array([$class,$method],\@param);

example

 sub plus { $_[0] + $_[1] }
 print call_user_func_array('plus',[10,20]); # 30

=cut

sub call_user_func_array {
    return call_user_func(shift,@{+shift});
}

=head2 create_function

 $code = create_function($args_str,$code_str);

example

 $code = create_function('$c,$d=1','print $c+$d');
 $code->(10); # 11

=cut

sub create_function {
    my $args = shift;
    my $code = shift;
    my $default = 0;
    my @args = split /,/,$args;
    my $code_str = 'sub {';
    for my $arg (@args) {
        if ( $arg =~ /^\s*(\$[a-zA-Z][\w]*)\s*(?:=\s*(.+))?\s*$/ ) {
            my $val = $1;
            my $def = $2;
            if ( defined $def ) {
                $default = 1;
                $code_str .= qq{my $val = \@_ ? shift : $def;\n};
            }
            else {
                die 'parse error' if $default;
                $code_str .= qq{my $val = shift;\n};
            }
        }
    }
    $code_str .= $code . '}';
    my $sub = eval $code_str;
    die $@ if $@;
    return $sub;
}

=head2 forward_static_call

 $ret = forward_static_call($function,@param);
 $ret = forward_static_call([$class,$method],@param);

=cut

sub forward_static_call {
    call_user_func(@_);
}

=head2 forward_static_call_array

 $ret = forward_static_call_array($function,\@param);
 $ret = forward_static_call_array([$class,$method],\@param);

=cut

sub forward_static_call_array {
    call_user_func_array(@_);
}

=head2 func_get_arg

 $arg = func_get_arg($no)

example

 sub foo { print func_get_arg(1) }
 foo(100,200); # 200

=cut

sub func_get_arg {
    my $n = shift;
    package DB;
    @DB::args = ();
    () = caller(1);
    return defined $DB::args[$n] ? $DB::args[$n] : undef;
}

=head2 func_get_args

 @args = func_get_args()

example

 sub foo { print join ':', func_get_args() }
 foo(11,22,33); # 11:22:33

=cut

sub func_get_args {
    my $n = shift;
    package DB;
    @DB::args = ();
    () = caller(1);
    return @DB::args;
}

=head2 func_num_args

 $arg_count = func_num_args()

example

 sub foo { print func_num_args() }
 foo(11,22,33); # 3

=cut

sub func_num_args {
    my $n = shift;
    package DB;
    @DB::args = ();
    () = caller(1);
    return scalar @DB::args;
}

=head2 function_exists

 $bool = function_exists($func)

example

 sub foo {}
 print function_exists('foo');  # 1
 print function_exists('bar');  # 0
 print function_exists('rand'); # 1

=cut

sub function_exists {
    my $func = shift;
    return 1 if exists &$func;
    require Pod::Functions;
    return $Pod::Functions::Flavor{$func} ? 1 : 0;
}

=head2 get_defined_functions

 $funcs = get_defined_functions()

=cut

sub get_defined_functions {
    require Pod::Functions;
    return {
        internal => [ keys %Pod::Functions::Flavor ],
        user     => [ grep { exists &$_ } keys %:: ],
    };
}

=head2 register_shutdown_function

 register_shutdown_function($func,@param);
 register_shutdown_function([$class,$method],@param);

=cut

{
    my $REGISTER_SHUTDOWN_FUNCTION = [];
    sub register_shutdown_function {
        my $proto = shift;
        push @$REGISTER_SHUTDOWN_FUNCTION, [
            do {
                if ( ref $proto eq 'ARRAY' ) {
                    $$proto[0]->can($$proto[1]);
                }
                else {
                    require Pod::Functions;
                    if ( $Pod::Functions::Flavor{$proto} ) {
                        sub { eval qq{$proto(\@_)} };
                    }
                    else {
                        no strict 'refs';
                        \&$proto;
                    }
                }
            },
            [@_]
        ]
    }
    END {
        $_->[0]->(@{$_->[1]}) for @$REGISTER_SHUTDOWN_FUNCTION;
    }
}

思ったよりも難しかった。標準関数一覧を取る手段がなかったので標準モジュールを利用して標準関数の一覧を取得した。

あと文字列から標準関数を呼び出すスマートな手段が思いつかなかったのでeval便りに。

create_functionはかなりゴリ押し。myを勝手に付けたりデフォルト引数にも対応してたり細かい芸が光る(自分で言うな)

forward_static_callはぶっちゃけPerl的にcall_user_funcと殆ど処理が変わらないのでそのまま利用。

func_get_arg系は結構クリティカルだなー。@DB::argsをリアルに使ったの初めてだよ。

register_shutdown_functionはちょっとねー。ENDブロックを利用してるわけなんだけど当然mod_perlとかではうまく動かない。あとシグナルとか使った方が良いのかもしれない。

ヒマがあったら他の関数とかも実装してみたいかも。

プログラ増田のあなぐら

トラックバック - http://anond.hatelabo.jp/20091210183908
  • プログラ増田のあなぐら

    40行で作るPerl用テンプレートエンジン PerlのClass::Data&#58...

    • [perl]「,」と「=>」の違いについて

      結論→一緒。 すまん嘘。 ほぼ同じ意味だって言いたかったの。カンマもイコールダイナリもほとんど同じ感覚で使用できる。 唯一つ違うのはイコールダイナリの左辺に置いた文字列は...

    • [perl]内部的に数値か文字かを判別する

      どうーでもいいーですよー。 どうでもいい話ー、聞いてください。 Perlというやつは一応内部的には数値か文字列かをちゃんと分けて変数の管理をしているのです。 でわ、現在ある変...

    • Shift_JISにおける危険な文字まとめ

      今時Shift_JISでプログラミングするバカな奴はいないだろうけど折角まとめたので公開 2バイト目がアスキーコードど丸被りしているものを列挙する @ [ \ ] ^ _ ` { | }...

      • [セキュリティ]今日は増田的情報セキュリティの日

        私は単なる一増田でしかないのだが、なんとなく今日を増田的情報セキュリティの日とすることに決めた。 なぜって、今日は、年末年始という忙しく、そして狙われやすい時期をはさみ...

      • [UTF8][EUC-JP][Shift_JIS]

        Shift_JISにおける危険な文字まとめ 携帯サイトをUTF-8で出力するかShift_JISで出力するか - F.Ko-Jiの「一秒後は未来」

    • [perl]autobox::Unix

      autoboxが流行ってるのになんで誰もコレを作らないのか不思議遊戯 package autobox::Unix;sub SCALAR::rm { my $dir = shift; my $option = shift; `rm $option $dir`;}# etc・・・use autobox;use autobox::Core;use autobox...

    • [PHP]PHPでPerlのqwを実現するお!

      function qw ($str) { return preg_split('/\s+/',$str,-1,PREG_SPLIT_NO_EMPTY);}$data = qw(' hoge muge dae');print_r($data); にゃろめ。 プログラ増田のあなぐら

    • [ruby]rubyでNabeAtzz

      そろそろ FizzBuzz に飽きた - にぽたん研究所 NabeAtzzが空前のブームということで俺もRubyで書いてみた。 list = %W/さん ろく きゅう じゅうに じゅうさん じゅうご じゅうはち にじゅういち ...

    • 敬意を払おう

      フレームワークとか使ってるともはや隠蔽されすぎて自分で実装しようなんて思わないのが普通である。 ましてや車輪の再開発などもってのほか、バグを生み出す温床にしかならない。 ...

      • http://anond.hatelabo.jp/20160323090449

        ブコメの。 さそりアーマーに殺される夢を見た増田 俺はさそりアーマーに殺される夢を見たな 80年代女性アイドル論の増田 マスダ80年代女性アイドル論~総論 おまえは今まで食っ...

    • PerlのClass::Data::Inheritableの解析

      唐突にClass::Data::Inheritableのソースコードについて説明してやんよ。 使い方とかの説明はこの辺でも読んでから出直して来い、ごるぁ! まぁとりあえずソース見てみろ、下記にはっつけ...

    • 4Uの画像が美しすぎてPerlでプログラム組んでみた

      4Uって知ってるかい? http://4u.straightline.jp/ ”世界中の美女画像を皆でシェアするソーシャルイメージブックマークサービス” とのことさ。それはほんともう美しい画像が満載で毎日見...

      • http://anond.hatelabo.jp/20080821224627

        これのおかげで画像ファイルがとうとう8,000個(1GB!)を超えてしまい、どうしたものかと思っていたところ、いいものを発見。 Vredefort(フレデフォート) いわゆるデジタルフォトフレーム。SON...

        • http://anond.hatelabo.jp/20080821224627

          おー、使ってくれてる奇特な奴がいるとはうれしいねぇ。 感謝の気持ちを込めて実はアレから少しバージョンアップしてるのでそれを公開しますよ! 改善点は2点。 終了判定の変更 ...

          • http://anond.hatelabo.jp/20080822142610

            バージョンアップ、キタ━━━━━━(゜∀゜)━━━━━━ !!!!! [明日ためす]

          • http://anond.hatelabo.jp/20080822142610

            スーパーpre記法がアレなまま直ってないわけで。 姉妹サイト(?)ができていたわけで。 なにやらcookieを食べようとした形跡があるわけで。 #!/usr/local/bin/perl -wuse strict;use warnings;use Web::Scraper...

    • [perl][Moose]Moose?Mooseってなんだ?あれか?整髪料か?え?Perl?

      最近Perl界隈ではMoose、MooseってなんかMooseってのが流行ってるらしい。 もう完全に出遅れてしまったので増田で書き殴ってみる。 自分自身のブログでは、さもずっと前からMoose知ってた...

    • [perl]もういつでもどこでもだれでもMooseでいいじゃねぇか

      おれはもうMooseしかつかわねぇ。後にも先にもMooseMooseMooseMooseMoose!!!!!!!!!!!1111111 ってな人の為にいつでもどこでもMooseする。automooseを実装しますた。 package automoose;use stric...

    • うんコード

      例えば下記の擬似コード i = 1; while( i & 7 ) { i++; } 勘弁して。いや、わかるよ。言いたいことはさ。でも俺こういう書き方慣れてないから脳内で素早く2進数変換できないの。 いや単...

    • 増田でリンク名付きでURL張ると化けるので

      つまり下記のような書き方をした場合の話 [http://anond.hatelabo.jp/0000000:title=あああテスト] キーワードがリンクされてしまってうまくリンク名として認識されない。 詳しくはこの記事を読...

    • PHPの比較の素晴らしさ加減は正常

      if ("0x0A" == "10") { print '(´ε` )チュッ';} チュッ。されちゃいます。 文字列であっても整数と解釈できる文字列の場合は勝手に型変換しやがる今世紀最大の愚行を犯してしまうっての...

      • http://anond.hatelabo.jp/20090617130518

        興味深い。できたらblogでやってほしいところ。 増田だと流れちまうからなあ。

      • http://anond.hatelabo.jp/20090617130518

        プログラミングのこういう細かいところが死ぬほど嫌い。発狂するほど嫌い。 文字コードとかマジクソが死ねよって感じ。 こういうののせいでいつまでたってもプログラミングが好きに...

        • http://anond.hatelabo.jp/20090617132348

          PHPみたいな糞とまともなプログラミング言語を一緒にするなよw 文字コードについては言語レベルではどうにもならんことはあるが、他の言語での扱いは少なくともPHPよりは楽。 バッド...

          • http://anond.hatelabo.jp/20090617140839

            PHPに限らず、CとかC++もめんどくせーこと多くて嫌いなんだよ…。 あ、C/C++もまともな言語じゃないっすか。そうっすか…。

            • http://anond.hatelabo.jp/20090617144121

              C/C++はあくまでもCPU依存性を減らしたアセンブラであって、面倒くささを耐える代わりに速度を稼ぐという特殊用途言語なんだから、「プログラミングは面倒だ」というには局所的すぎる...

              • http://anond.hatelabo.jp/20090617212621

                バッドノウハウ…! これですよ。こういうのがマジウザい。 何がバッドノウハウだよただ仕様が終わってるだけじゃねーかカスが!って思う。 ああいうクソ仕様素晴らしい仕様をいか...

                • http://anond.hatelabo.jp/20090617215552

                  バッドノウハウってのはかっこつけた単語じゃなくて、奥が深い症候群を戒めた語だよ。 自分が知ってる「業界の雰囲気」ってのが偏ったものだと知覚した方がいい。 それが相応しい...

                  • http://anond.hatelabo.jp/20090617223655

                    職務的にはC++が適してるから使ってるんだなあこれがまた。 業務系SEやってる友達と話したときはC++wwwねえよwwwせめてC#にしとけwwwって感じだったけど。 業務系システムはプログラミン...

            • http://anond.hatelabo.jp/20090617144121

              C・C++の面倒くさいことって具体的に何? 自分は仕VB・C・C++しか使ったことないが、面倒くさいと思ったことない。 他の言語ってそんなに楽なんだろうか?

              • http://anond.hatelabo.jp/20090617222616

                その経歴なら是非スクリプト言語を使ってみることを勧める。 Ruby, Perl, Pythonのうち1つは覚えた方がいい。絶対役に立つよ。 一昔前ならPerlを進めてたところだけど、今ならRubyかな。 ht...

              • http://anond.hatelabo.jp/20090617222616

                型。状況や文脈を判断してよきに計らってほしい。 ポインタ。と言うよりメモリ管理か。必要に応じて増やすなり減らすなりよきに計らってほしい。

              • http://anond.hatelabo.jp/20090617222616

                めんどくせーめんどくせー言ってる増田だけど。 C/C++はまずガベージコレクタが無いのがめんどくさすぎる。いちいちライブラリ導入したりboostのスマートポインタ使ったりしなきゃいけ...

                • http://anond.hatelabo.jp/20090617231810

                  適材適所 sed ちょっとした正規表現抜き出しに perl そこそこの文書処理に Java わりと何でもいけるが、わりと平均的にめんどくさい JSP メモリ64K制限さえなければすばらしかったが、Ja...

      • http://anond.hatelabo.jp/20090617130518

        PHPで一番困るのは、この手の変換が直感的でも統一的でもなことだな。 「自分が何をしようとしているのか」が素直に書けないんだよね。 言語として元になっているPerlにも文字と数値...

      • http://anond.hatelabo.jp/20090617130518

        PHPの「==」は「数値として比較する」ためのものであって、そもそも文字列として比較するときに使うためのものではないという説。 文字列比較を意図するのであれば、 if (strcmp("0x0A...

        • http://anond.hatelabo.jp/20090617164618

          文字列比較を意図するのであれば、 if (strcmp("0x0A", "10")) { print '(´ε` )チュッ';} とすべき。当然チュッされない。 strcmp()は文字列が等しいときに0になるから、これだとチュッされ...

        • http://anond.hatelabo.jp/20090617164618

          そこの増田よ。 strcmpの使い方を間違っておられる。 さっと手元で書いたから間違えたのならまだいいが、いつもその書き方をしてるのなら君書いたプログラムには重大なバグが潜んで...

      • PHPではa==b, b==cでもc!=aなことがある

        PHPの比較の素晴らしさ加減は正常 @ はてな匿名ダイアリー PHPの「==」は数値比較なので、文字列は数値に変換されてから比較される。 PHPの「文字列→数値」の暗黙の変換は、文字...

      • http://anond.hatelabo.jp/20090617130518

        ===演算子を使えよ if ("0x0A" === "10") { print '(´ε` )チュッ';}else{ print '\(^o^)/';} \(^o^)/ ==演算子は方をキャストしながら、ほぼ同じなら同じと見なせという意味。 HTMLとかで曖昧に...

        • http://anond.hatelabo.jp/20090618113950

          自己レス 012とかは、よく桁のパディングで 000001 と 1が同じであることを見つけるとかって処理をするから、8進数と見なしてくれるより、10進数で0詰めって見なしてくれた方が、テキ...

        • http://anond.hatelabo.jp/20090618113950

          もちつけ。 ===演算子を使うなとは書いてないし、8進数使いたいとも書いてない。 元記事はただ事実をありのまま書いているだけだ。 そして誰も「つのだ★ひろ」には突っ込まないw

          • http://anond.hatelabo.jp/20090618115402

            えー、PHPの世界ではそういうときは===をつかうってなってるのに・・・ わざわざ==を使って 他の言語の規則を持ってきてどうのこうの言って===に触れないってのは、ちょっと意地悪い...

            • http://anond.hatelabo.jp/20090618115804

              ===なんていう意味不明な変態演算子をわざわざ使わなきゃいけない言語なんて…。 まぁPHPさわったことないけど。

            • http://anond.hatelabo.jp/20090618115804

              String型同士の比較であっても整数と解釈される文字列の場合は整数に変換される。 この仕様は知っていたが、まさか0x0Aという文字列が、普通にキャストした場合は0にしかならないのに...

              • http://anond.hatelabo.jp/20090618121442

                もともと if("0x0a" == 10){ } を成り立たせた方が都合がよい。というのの応用で "0x0a" == 10 == "10" となるだけだからねぇ。 if ("0x0A" == 0x0A) { print '(´ε` )チュッ';}else{ print '\(^o^)/';} は'(...

      • [PHP]PHP「”0x0A” == ”10”はTRUEですがよろしいですか」

        ぼく「えっ」 PHP「”0x0A” == ”10”はTRUEになりますが」 ぼく「いえFALSEです」 PHP「えっ」 ぼく「えっ」 PHP「まだ比較したことがないということでしょうか」 ぼく「えっ」 PHP「えっ」 ...

      • [PHPコーディング規約][PHP]

        PHPコーディング規約  http://www.sksk.info/php.html 404 Blog Not Found:そろそろPHPに関して一言いっとくか  http://blog.livedoor.jp/dankogai/archives/50835571.html 404 Blog Not Found:「PHPなめんな」と「(Perl|Pytho...

        • http://anond.hatelabo.jp/20090618152620

          こうやって並べてみると PHP(C/Java/Ruby/Python好きな物に置換可能)は、良い・悪いの議論って、 本当に、隣の葡萄はすっぱい。俺のレモンは甘い 議論なんだなぁと。

      • 「はてな匿名ダイアリーによるプログラミング言語ユーザー論まとめ」をトゥギャりました

        プログラミング言語ヒエラルキーにおける罵倒 http://anond.hatelabo.jp/20070502200124 phpのいやなところ / perlのいやなところ http://anond.hatelabo.jp/20070522174725 LL編プログラミング言語ヒエラルキーに...

    • [PHP]create_functionで生成された匿名関数の一覧を得る関数

      ひーほー。いやぁさてさて一体このコード中に何度create_functionで匿名関数が生成されたのかふと気になったあなたのためにこんな関数を作ってみたよ! function get_lambda_functions () { $i ...

    • うたまっぷと歌ネットの歌詞をコピペするブックマークレット

      を作ってみた。 うたまっぷ javascript:(function(){%20var%20t;%20var%20d=document;%20var%20h=new%20XMLHttpRequest();%20var%20r=d.location.href.match(/surl=([A-Za-z0-9]+)/);%20h.open('GET','phpflash/flashfalsephp.php?unum=?'+r[1],true);%2...

    • PHPでQuineプログラミング

      RubyでうどんげQuine(とAA型Quineの作り方講座) perl - Q&#...

    • [ruby]闇プログラマーによる、うるう年の判定処理

      以下の記事を読んだ私は違和感を覚えた。 私がソフトウェア技術者をやめた理由 今時のソフトウェア技術者というものは...

      • http://anond.hatelabo.jp/20100925163206

        sqlとかでisdateしてやれば済むお話しさー。 最初の要件定義にうるう年について書かれていなければ、うるうどしが来たらうるう年対応でお金をもらえばいいじゃない。 というより、綺麗...

        • http://anond.hatelabo.jp/20100925165528

          超人が500行で1時間で書いたスマートなプログラムよりも、凡人が10000行、1カ月かけてつくったプログラムのほうがお金にはなるんだ。 マジレスすると、上記の条件であれば、案件...

    • より良いPHPerにならないための20Tips

      http://1-byte.jp/2011/03/20/20_tips_you_need_to_learn_to_become_a_better_php_programmer/ 良いPHPerだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる分いくらかマシだ。 つまり...

      • http://anond.hatelabo.jp/20110320223445

        ペロペロ 1. htmlのはき出しがあるやつは?>を書いたほうがいいよ。それ以外は最近はかないのがはやりだねさらに昔はevalとかで書いてた 2. configこれはwwwやpublic_html以下にしかconfigを配...

      • http://anond.hatelabo.jp/20110320223445

        21. 分散SCMを使え なにはともあれまずはコミットだ 粒度だクソだはpushするときにかんがえろ 1コミットで合わせて全然関係ない別の場所を変更したおまえは死刑だ

      • より良いPHPerになるための20Tips

        去年の話ですが、海外でこんな記事が上がっていました。 20 Tips you need to learn to become a better PHP Programmer 記事の内容は、かなりレベルが低いです。 しかし、初心者のうちに知っておけば、...

    • プログラミング出来ない奴あっちよりこっち来い

      http://anond.hatelabo.jp/20130322031333 プログラミング出来る方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる分いくらかマシだ。 こんなタイトルに...

      • 英語しゃべれない奴ちょっと来い

        http://anond.hatelabo.jp/20130322202542 コレ見て書いてみたくなっただけ。 英語が話せるようになる方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる...

      • 英語しゃべれない奴ちょっと来い

        http://anond.hatelabo.jp/20130322202542 コレ見て書いてみたくなっただけ。 英語が話せるようになる方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる...

      • 英語しゃべれない奴ちょっと来い

        http://anond.hatelabo.jp/20130322202542 コレ見て書いてみたくなっただけ。 英語が話せるようになる方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる...

      • 英語しゃべれない奴ちょっと来い

        http://anond.hatelabo.jp/20130322202542 コレ見て書いてみたくなっただけ。 英語が話せるようになる方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる...

      • 英語しゃべれない奴ちょっと来い

        http://anond.hatelabo.jp/20130322202542 コレ見て書いてみたくなっただけ。 英語が話せるようになる方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる...

      • 英語しゃべれない奴ちょっと来い

        http://anond.hatelabo.jp/20130322202542 コレ見て書いてみたくなっただけ。 英語が話せるようになる方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる...

      • 英語しゃべれない奴ちょっと来い

        http://anond.hatelabo.jp/20130322202542 コレ見て書いてみたくなっただけ。 英語が話せるようになる方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる...

      • 英語しゃべれない奴ちょっと来い

        http://anond.hatelabo.jp/20130322202542 コレ見て書いてみたくなっただけ。 英語が話せるようになる方法教えるだって?そんなものは丸めてゴミ箱にでも捨ててしまった方が資源の再利用になる...

記事への反応(ブックマークコメント)

アーカイブ ヘルプ
ログイン ユーザー登録
ようこそ ゲスト さん