IMAKADO::BLOG RSSフィード

September 19, 2010

Amonでctx_request

Ark::Test や Catalyst::Test でおなじみの ctx_request をつかってテストを書く必要があったので書いてみました.

Data::Util or Moose を使う程ではないと思ったので, ベタっといった感じ.俺はそんな感じ.

正しい実装ではない可能性があることを断っておきます.

package Amon::Test::WWW::Mechanize::PSGI;
use parent 'Test::WWW::Mechanize::PSGI';
use strict;
use warnings;

our $VERSION = '0.01';

use Clone::PP qw/clone/;

sub ctx_request {
    my $self = shift;

    amon_install_context_getter();

    my $res = $self->request(@_);

    return $res, amon_context();
}

my $_amon_installed;
sub amon_install_context_getter {

    return if $_amon_installed;

    no strict 'refs';
    no warnings 'redefine';
    do {
        my $orig = *{'Amon::Web::Response::finalize'}{CODE};
        *{'Amon::Web::Response::finalize'} = sub {

            my @r;
            if (!defined wantarray) {
                $orig->(@_);
            }
            elsif (wantarray) {
                @r = $orig->(@_);
            }
            else {
                $r[0] = $orig->(@_);
            }

            amon_context(Amon->context);

            return wantarray ? @r : $r[0];
        };
    };
    do {
        my $orig = *{'Amon::Web::run'}{CODE};
        *{'Amon::Web::run'} = sub {

            my @r;
            if (!defined wantarray) {
                $orig->(@_);
            }
            elsif (wantarray) {
                @r = $orig->(@_);
            }
            else {
                $r[0] = $orig->(@_);
            }

            $Amon::_context = amon_context();

            return wantarray ? @r : $r[0];
        };
    };

    $_amon_installed = 1;
}

do {
    my $context;
    sub amon_context {
        if ($_[0]) {
            $context = $_[0];
            $context  = clone($context);
        }
        $context;
    }
};

1;
__END__

次のテストは通る。

use strict;
use warnings;
use Test::More;
use TestApp::Web;
use Amon::Test::WWW::Mechanize::PSGI;
use HTTP::Request::Common;

my $app = TestApp::Web->to_app;
my $mech = Amon::Test::WWW::Mechanize::PSGI->new(app => $app);

my ($ret, $c) = $mech->ctx_request(GET '/');

isa_ok $ret, 'HTTP::Response';

use Amon::Web::Declare;
isa_ok( c(), 'Amon::Web' );
isa_ok $c, 'Amon::Web';
isa_ok( Amon->context, 'Amon::Web' );
is_deeply( $c, Amon->context );

isa_ok $c->request, 'Amon::Web::Request';
isa_ok( Amon->context->request, 'Amon::Web::Request' );

is_deeply( Amon->context->pnotes, +{} );
is_deeply $c->pnotes, +{};

($ret, $c) = $mech->ctx_request(POST '/', { foo => 'bar' });

isa_ok $ret, 'HTTP::Response';
isa_ok $c, 'Amon::Web';

is $c->request->param_decoded('foo'), 'bar', 'param_decoded';
is param_decoded('foo'), 'bar', 'param_decoded';

done_testing;

April 25, 2010

emacs で anything 起動中に入力中のパターンを区切りマッチに変化させるコマンド

ik:anything-cycle-pattern を anything 起動中に起動させると入力中のパターンを「区切りにマッチする正規表現」に変化させる事ができます。連続して起動すると順番に変化していきます。

自分は Shift+d に割り当てています。

(define-key anything-map (kbd "D") 'ik:anything-cycle-pattern)

ik:anything-cycle-pattern 関数の定義は次のようになります。

(eval-when-compile
  (require 'cl))
(defvar ik:anything-cycle-pattern-count 0)
(defun ik:anything-cycle-pattern ()
  (interactive)
  (unless (string= "" anything-pattern)
    (let* ((los '(("\\<" "\\>")
                  "\\<"
                  "\\>"
                  ("\\_<" "\\_>")
                  "\\_<"
                  "\\_>"
                  nil))
           (cleanup-re (rx (or "\\<"
                               "\\>"
                               "\\_<"
                               "\\_>"))))
      (if (eq this-command real-last-command)
          (incf ik:anything-cycle-pattern-count)
        (setq ik:anything-cycle-pattern-count 0))
      (when (>= ik:anything-cycle-pattern-count (length los))
        (setq ik:anything-cycle-pattern-count 0))
      (when (eq this-command real-last-command)
        (save-excursion
          (loop while (re-search-backward cleanup-re nil t)
                do (replace-match ""))))
      (let ((sep (nth ik:anything-cycle-pattern-count los)))
        (etypecase sep
          (cons (save-excursion (backward-sexp) (insert (car sep)))
                (insert (second sep)))
          (string (cond
                   ((string-match "\\\\_?<" sep)
                    (save-excursion (backward-sexp) (insert sep)))
                   (t
                    (insert sep))))
          (null 'do-nothing))))))

April 23, 2010

70行で emacs に Text::MicroTemplate like なテンプレートを実装する

>>>> 2010/04/23 追記

未使用の変数消したので、69行になってしまいました。

<<<< 2010/04/23 追記ここまで


「(eval-when-compile (require 'cl))」まで加えて丁度70行です。

(eval-when-compile
  (require 'cl))

(defun* micro-template (mt/template &key (mt/source-type 'string))
  (flet ((mt/parse ()
          (let* ((state 'text)
                 (multiline_expression nil)
                 (tag-end "?>")
                 (tag-start "<?")
                 (tag-comment-start "<?#")
                 (tag-expression-start "<?=")
                 (token-separator-re
                  (regexp-opt (list tag-end tag-start
                                    tag-comment-start tag-expression-start))))
            (loop initially (goto-char (point-min))
                  with tokens
                  for token = (let ((p (point)))
                                (cond
                                 ((eobp) nil)
                                 ((looking-at token-separator-re)
                                  (prog1 (match-string 0)
                                    (goto-char (match-end 0))))
                                 ((re-search-forward token-separator-re nil t)
                                  (goto-char (match-beginning 0))
                                  (buffer-substring p (point)))
                                 (t
                                  (prog1 (buffer-substring p (point-max))
                                    (goto-char (point-max))))))
                  while token
                  do (cond ((string= tag-end token)
                            (setq state 'text
                                  multiline_expression nil))
                           ((string= tag-start token)
                            (setq state 'code))
                           ((string= tag-comment-start token)
                            (setq state 'comment))
                           ((string= tag-expression-start token)
                            (setq state 'expr))
                           (t
                            (unless (eq state 'comment)
                              (when multiline_expression
                                (setq state 'code))
                              (when (eq state 'expr)
                                (setq multiline_expression t))
                              (push (list state token) tokens))))
                  finally return (nreverse tokens))))
         (mt/compile (tree)
          (with-temp-buffer
            (insert "(progn ")
            (loop for (type value) in tree
                  do (ecase type
                       (text (prin1 `(insert ,value) (current-buffer)))
                       (code (insert value))
                       (expr (insert "(insert " value ")"))))
            (insert ")")
            (condition-case err
                (progn (goto-char (point-min)) (read (current-buffer)))
              (error (error "ERROR at compile time.\ntree: %S\ncompiled source: %s"
                            tree (buffer-string)))))))
    (with-temp-buffer
      (ecase mt/source-type
        (string (insert mt/template))
        (file (insert-file-contents mt/template)))
      (let ((mt/--form (mt/compile (mt/parse))))
        (with-temp-buffer
          (condition-case err
              (progn (eval mt/--form) (buffer-string))
            (error (error "ERROR at eval time.\ncompiled source: %S"
                          mt/--form))))))))

次のテストは pass します。

(dont-compile
  (when (fboundp 'expectations)
    (expectations
      (desc "+++++ micro-template +++++")

      (desc "output the result of expression")
      (expect "The perfect insider."
        (let ((o "insider")
              (tmpl "The perfect <?= o ?>."))
          (micro-template tmpl)))

      (desc "execute lisp code")
      (expect "The perfect outsider."
        (let ((o "outsider")
              (tmpl "The perfect <? (insert o) ?>."))
          (micro-template tmpl)))

      (desc "comment")
      (expect "comment-><-comment"
        (let ((tmpl "comment-><?# ya ya ya ?><-comment"))
          (micro-template tmpl)))

      (desc "backslash")
      (expect "The perfect <\\?= o ?\\>."
        (let ((o "insider")
              (tmpl "The perfect <\\?= o ?\\>."))
          (micro-template tmpl)))

      (desc "write literal tag inside template")
      (expect " ?> ."
        (let ((tmpl "<? (insert \" ?\\> \") ?>."))
          (micro-template tmpl)))

      (desc "complex")
      (expect "The perfect insider\nflag is non-nil"
        (let ((o "insider")
              (flag t)
              (tmpl "\
The perfect <?= o ?>
\<? (cond (flag ?>flag is non-nil<? ) ?><?# COND flag  ?>
<? (t ?><?# ELSE ?>flag is nil<? )) ?><?# end COND ?>"))
          (micro-template tmpl)))
      (desc "file")
      (expect "The perfect insider\nflag is non-nil"
        (let ((o "insider")
              (flag t)
              (tmpl "\
The perfect <?= o ?>
\<? (cond (flag ?>flag is non-nil<? ) ?><?# COND flag  ?>
<? (t ?><?# ELSE ?>flag is nil<? )) ?><?# end COND ?>"))
          (let ((tmp-file (make-temp-file "temp-file.")))
            (with-temp-file tmp-file
              (insert tmpl))
            (micro-template tmp-file :mt/source-type 'file))))
      )))

perl module の Text::MicroTemplate のコードを参考にしました。シンプルで美しかったです。ありがとうございます。

January 15, 2010

あけましておめでとうございます

しばらくご無沙汰でしたので、近況でも。


最近、自由に使える時間が少しばかり増えたので勉強をするようにしています。

今日なんかは数学をやっていたのですが、思ったより全然できないんですね。

あらあら、これはどうしたことか。忘れてしまったのかな。どのみちこのままではあかんべえと思い、記憶をたぐり寄せてみたのですが、どうにも思い出せません。

ちょっとの間考えてみたのですが、思い出せないものは仕様がないという結論に辿り着き、開き直りをしてお風呂に入る事にしました。

今、絶賛マイブーム中の半身浴ってやつです。主にダイエット目的なのですが、上がったあとに呑む焼酎の水割りが美味しくて仕様がなく、ついつい欲求に抗えず一杯、二杯と呑んでしまうため結局のところダイエットに関しては効果が現れる気配無しです。まあ、これはこれで美味しくお酒が呑めるので幸せではないかと、ここ最近ポジティブ指向思考プログラミングの自分は思うのですが。お、「しこう」って二回連続で続きましたね! 同音異義語、万歳!!ちなみにこの水割りを、生命の水、と自分は呼んでいます。

おっと、話しが平松政次のカミソリシュート並の切れ味で逸れてしまいました。む、例えが古すぎるか。伊藤智仁の高速スライダーばりの切れ味で・・・いや、星野のスローカーブのような・・・いや、佐々木のフォーク・・・今中の・・・いや、ダルビッシュの・・・。

結局、生命の水を三杯くらい呑んで、酔いも回り始め、ほろ酔いからいよいよ、ほろもとれかかりそうな時に思い出したんですよ、高校時代の数学が全然思い出せない理由を。

いやあ、そもそも高校にいってなかったんですねえ。高卒認定試験が受かる程度にしか高校数学をやってなかったんですわ。すっかり忘れていました。けすからんものです。テヘヘ。これにはさすがに、ここ最近の記憶力低下に危機感を持ち始めました。

最近は昨日の晩ご飯が思い出せないことがあったりします。かろうじて覚えているのは、いつくかの perl モジュールの使い方と、lisp の文法と関数名くらいなものです。それでも、まあ楽しく暮らしています。作りたい物も作れてますしね。


しかし、22にもなると一般教養の大切さが身にしみてわかって来るもので、時間を見つけては、ちょこちょこと勉強してみている次第です。

若い頃、若くはない人から「若い頃にしっかり勉強しとかないと、大人になった時に苦労するよ」なんて定型句を言われたもんですが、いやはや真理をついていました。

互いに面識のない大多数の人が同じ事を言った場合、少しばかりの例外を抜かして、それは大体正しい事ですな。うんうん。


昔は、勉強は必要になった時にすれば良いのだと思っていました。

わっかりにくい例えをすると、プログラムで言うところの lazy evaluation みたいなものだと考えていました。

delay で「あとで勉強するよ」って約束しといて、必要になったら、「やっべ、アルゴリズムが理解できねーよ!!」とあわてて force する感じ。

でもプログラムと違うのは、評価時に環境をうまく復元する事ができないので、若い時に勉強するのと年を重ねてから勉強をするのは全然別ものだって事ですかね。

いざ勉強しようと思ったところで、時間を割いて教えてくれる先生・教授もいなければ時間もないので、若い時にやったほうがずっと楽。

だから若い時にもっと勉強しとけばよかったな。後悔先に立たず、です。ほんと、人生の call/cc を渇望します。SFによくでてくる冷凍人間とか近いんですかね?

あ、でも、中学生の頃に年を誤摩化してバイトした事とか、ナイトバーでボーイさんの仕事した事も、その後の人生で結構役に立っているので、一概に後悔のみというわけでもないのですけれど。頑張れば、両立させることもできたかなあと。

バックアップとってなかったDBに、間違ったsql流したことを悔やむような、そんな感じです。


そんな事を考えていたら段々と脳がカオスになってきて。

レキシカルに amb評価機 をもちいて、人生設計を立てる事はできるけれど、自分の処理能力が低いのと、人生は有限ですぐ老いていっちゃう事から、やっぱり実行時間がたりなくて、富豪的には実行できないなあ。本当に頭のいい人は、うまい人生設計とか例外構造とかできているのかな。例えば、女性Aに絶縁状をつきつけられた例外をキャッチして、女性Bと付き合い始める。とか。もしくはそれ以前にマルチスレッドで実行が進んでいたり・・・。自分はそういうの、凄く苦手だな。Java並行処理プログラミングがまだ手元に届いていなくて、 synchronized とかよくわからないし。

とか。

んーじゃあ、無限ストリームだ! けれど、無限ストリームだって、結局のところ「自分の認識で無限に見えるだけ」だから、自分が死ねばそれ以上認識できなくなるので、やっぱり有限な気もするし。へ、屁理屈すぎる・・・もうなんでもありだな。風呂敷広げすぎて収集つかなくなった小説の、とってつけたような最終章みたいだ。なんてわけのわからない事が頭のなかで、くるぐる回り始めました。いや違う、あれは大槻ケンヂの小説や。グルグル回り始めました。こういうの嫌いではなく、結構楽しいのですが、端から見てただの酔っぱらいなので始末がつかないなあと思います。酔っぱらいって、友達がなるぶんには微笑ましくて好感がもてるのですが、自分がなると恥ずかしくて悶絶しますよね。興味深いものです。

酔った頭でいろいろと考えだすと、停止条件が抜けている再帰関数をうっかり実行したときのような状態になり、結構大変です。

しかも自分の脳は、バグなのか仕様なのか SIGINT 完全無視するので、ま、いっか! 寝よう寝ようと思い、C-c 押しても走り出したプロセスはスタックをつかいきるまで止まらないのも厄介です。

やっぱり、色々な事をしっかりと理解できていないのが原因だと思います。毎晩勉強。がんばらナイト。なんちゃって。どうみても酔っぱらい親父です。本当にありがとうございました。


兎にも角にも、22年間の中で一番頑張って生きてます。

皆様、今年もよろしく御願い致します。

近いうちに、いろいろと報告できればなと思います。


勉強に関しては、手遅れでなければいいんだけどなあ。

December 09, 2009

選択している文字列を camelcase<->snakecase に変換するコマンド

;; copied from rails-lib.el
(defun ik:decamelize (string)
  "Convert from CamelCaseString to camel_case_string."
  (let ((case-fold-search nil))
    (downcase
     (replace-regexp-in-string
      "\\([A-Z]+\\)\\([A-Z][a-z]\\)" "\\1_\\2"
      (replace-regexp-in-string
       "\\([a-z\\d]\\)\\([A-Z]\\)" "\\1_\\2"
       string)))))
(defun ik:camerize<->decamelize-on-region (s e)
  (interactive "r")
  (let ((buf-str (buffer-substring-no-properties s e))
        (case-fold-search nil))
    (cond
     ((string-match "_" buf-str)
      (let* ((los (mapcar 'capitalize (split-string buf-str "_" t)))
             (str (mapconcat 'identity los "")))
        ;; snake case to camel case
        (delete-region s e)
        (insert str)))
     (t
      (let* ((str (ik:decamelize buf-str)))
        ;; snake case to camel case
        (delete-region s e)
        (insert str))))))