TTのWrapperを変えたいよね、と言う話。

perl catalyst

TTのWRAPPERって便利ですよね。ある程度のガワを用意すればbodyタグの中身だけを書くだけでいい。

けどWRAPPERの中身は変えられても外身は変えられないんですよね。


たとえばinner.htmlがこんなんで

This is inner!

outer.htmlがこんなん

This is outer!
[% contents %]

で、outer.htmlをWRAPPERに指定してinner.htmlをtemplateに指定すると

This is outer!
This is inner!

となるはずです。inner.htmlはすぐに変えられるんですがouter.htmlってどこで変えるのんと言うことでPOD探しても見つからなかったのでちょっと調査。


すると以外とあっさり見つかった。

#ref $self eq 'MyApp::View::TT'
$self->template->{SERVICE}->{WRAPPER}

をいじればWRAPPER変えられるみたいです！
ここにはarray refを入れなきゃ行けない模様で、それはTT内でのcontentsとプラスの使い方と同じみたいです。

[% contents a.html + b.html %]

は

$self->template->{SERVICE}->{WRAPPER} = [ qw/a.html b.html/ ]

と同じ見たいです。ごめんなさい逆さかもしれません、複数でプラスで結合は使ったこと無いのでよくわかりませんPOD見てください。


まぁこれだけじゃアレなので、templateはstashで指定するんだからwrapperもstashで指定出来たらいいんじゃね？と思い軽く書いてみた。

sub process {
    my($self,$c) = @_;

    if ( my $w = $c->stash->{wrapper} ) {
        $self->template->{SERVICE}->{WRAPPER} = ref $w eq 'ARRAY' ? $w : [$w];
    }

    $self->SUPER::process($c);
}

これをMyApp::View::TTに置きませう。WRAPPERが一つの時は文字列で、複数の時はarray refで。

#Controllerで
$c->stash->{wrapper} = 'another_wrapper.html'; #単数
$c->stash->{wrapper} = ['a.html', 'b.html'];   #複数

とかやったら幸せかなぁと思いました。作った後に思って今更ですけどWrapper変えるってそんなに無いですよね。まぁいいややったことなので。

CatalystのDispatcherでえらく感動したのでメモ。

catalyst

Catalystでログ的なウィンドウを出力したい訳です。エラーであるとか処理が完了したとか。

sub moge : Local {
  my($self,$c) = @_;

  if ($some_condition) {
    $c->stash->{info} = 'Some error happen!';
    $c->stash->{template} = 'info.html';
    return
  }
}

みたいな感じだと思うんです。stashにrenderするべきtemplateと値を入れてreturn。
何個もこれをやりたいとなるとこれをMyApp.pmとかに書いたりするわけです。


たとえばこれをrender_infoって名前でメソッドにして、普通に$c->render_infoって呼ぶと戻ってくる訳です。当たり前ですが。

sub MyApp::render_info {
  shift()->detach('/_render_info', \@_);
}

sub MyApp::_render_info : Private {
  # メッセージを表示するルーチン
}

なんてやれば戻ってこないが実現するんですがメソッド二つはどうよ、ということになってうーんとなる訳です。
それでdetachの元があるCatalyst::Dispatcherを見てみたら

sub detach {
    my ( $self, $c, $command, @args ) = @_;
    $c->forward( $command, @args ) if $command;
    die $Catalyst::DETACH;
}

$Catalyst::DETACHってなんだよ、とおもって倣ってdie $Catalyst::DETACHしてみたらstack戻ってない！
値を見てみたら

our $DETACH    = "catalyst_detach\n";

ってあるので定数ですね。

結論：die $Catalyst::DETACHするとそこでDispatcher止まります。それより先に行かないし戻らないみたいです。
throw-catchってこういう風に使うんだ、と感動した。

CatalystのDispatcherでえらく感動したのでメモ。

catalyst

Catalystでログ的なウィンドウを出力したい訳です。エラーであるとか処理が完了したとか。

sub moge : Local {
  my($self,$c) = @_;

  if ($some_condition) {
    $c->stash->{info} = 'Some error happen!';
    $c->stash->{template} = 'info.html';
    return
  }
}

みたいな感じだと思うんです。stashにrenderするべきtemplateと値を入れてreturn。
何個もこれをやりたいとなるとこれをMyApp.pmとかに書いたりするわけです。


たとえばこれをrender_infoって名前でメソッドにして、普通に$c->render_infoって呼ぶと戻ってくる訳です。当たり前ですが。

sub MyApp::render_info {
  shift()->detach('/_render_info', \@_);
}

sub MyApp::_render_info : Private {
  # メッセージを表示するルーチン
}

なんてやれば戻ってこないが実現するんですがメソッド二つはどうよ、ということになってうーんとなる訳です。
それでdetachの元があるCatalyst::Dispatcherを見てみたら

sub detach {
    my ( $self, $c, $command, @args ) = @_;
    $c->forward( $command, @args ) if $command;
    die $Catalyst::DETACH;
}

$Catalyst::DETACHってなんだよ、とおもって倣ってdie $Catalyst::DETACHしてみたらstack戻ってない！
値を見てみたら

our $DETACH    = "catalyst_detach\n";

ってあるので定数ですね。

結論：die $Catalyst::DETACHするとそこでDispatcher止まります。それより先に行かないし戻らないみたいです。
throw-catchってこういう風に使うんだ、と感動した。

IEでJS動かなかった時に直した時のメモ。

javascript

日付またいでさて日記でも書くか、と思ったけど18日の欄が出て来た、こういう仕様なのかな。


それはさておきFirefoxベースで開発していざIEで動かすとうごかねぇ！なんてよく聞く話ですが、例外無く私もはまりました。
「FirefoxのJS実装が正しいんじゃヴォケーー！IE使ってるやつなんざしらねぇぜタコ！」と言いたいとこですが残念ながらブラウザのシェアはまだまだIEが多いのでそうも言ってられません。
どなた様かの役に立てるかなと思い、メモっときます。当たり前すぎることばっかりかもしれませんが。

尻カンマ

prototypeでミスってるのかよ！とか思ってコロンを消したらあっさり動いた。びっくりした。つけるとIEではエラーでるのねん。
これはきっとPerl使いがはまる罠。

Moge.prototype = {
  initialize : function(){},
  some_process : function(){}, //<-このカンマをつけるとエラー
};

JSON evalのときに括弧をつける

これはIEっていうより古いFirefoxかな。prototype.jsとかjqueryでもやってるみたいなのでやっておきましょう。

var json_str = '[{moge:1},{fuga:2}]';
var json = eval('(' + json_str + ')');

IEの強力すぎるCaching

小耳に挟んではいたけどはまるとは。
IEではURIが同じだとCacheが明示的にクリアされるまでずっとその値を返し続けるんですね。何かしらランダムな値を入れてCachingを防がなきゃ行けない。
常套句と言うことで日付関数を使う。

if ( method == 'get' )  {
    params['rndstr'] = (new Date()).getTime();
}       

jQuery.ajax({
  url      : uri,  
  type     : method, 
  data     : params, 
  success  : function(json_str,stat) {
    #処理する
  }
});

Wrapしたメソッドか何かで上記見たいに書いておく。なんか見苦しいけど仕方が無い。

encode/decodeちゃんとやる。

これはJavaScript関係ないか。
encode関連っていつも忘れるんですよね。ちゃんとInflate/Deflateの設定ちゃんとすればいいんですけど。
外の世界からPerlの世界に文字列を入れる時はdecode。
Perlの世界から外へ出す時はencode。
忘れないように書いておこう。


全く関係ないですけどVMware Fusionいいですよ。検証用もかねて買ったんですけど、久しぶりにおかねだしてソフトウェア買って満足した感じ。
でもWin用だとVMware Playerあるからなんだかなぁと言う感じですけど、まぁVMwareにはお世話になってるので買っても損は無いかなと。

DBICのオレオレResultSetを作ったんだけど

perl dbic

ResultSetにメソッドを生やしたい訳です。ResultSourceのメソッドにresolve_prefetchっていうのがあって、prefetchとかjoinで指定するrelationのリファレンスを渡すとcolumnを返してくれるものがあります、{ blogs => 'user_id' }みたいなやつです。ただしそのままではlookupに使えないのと自分が無いのでちょっとWrapしたい訳です。
巷ではResultSetManager使うらしいんですが、Loader使ってるので使えません。で、自分のResultSetを作って

  my $source = $schema->resultset('Moge')->result_source;
     $source->resultset_class('MyApp::ResultSet');

みたいな感じでresultset_classを指定して自分の好きなことする訳です。
で、その指定する方法なんですけどどこに置いたらいいのかわからない。
とりあえず最初は

package MyApp::Schema;

use strict;
use base qw/DBIx::Class::Schema::Loader/;

__PACKAGE__->loader_options(
    relationships => 1,
);


__PACKAGE__->connection('dbi:mysql:test', agile => 'pass'); 

 
for my $moniker ( __PACKAGE__->sources )    {

    my $class = __PACKAGE__->class($moniker);
       $class->resultset_class('MyApp::ResultSet');
}


みたいにSchemaにconnect_info書くと言う何とも気持ち悪い方法で。
ふとdmakiさんのページを見て奇麗にしようと思ってこうしたわけです。

  package MyApp::Schema;
  use strict;
  use base qw(DBIx::Class::Schema::Loader);

__PACKAGE__->loader_options(
    relationships => 1,
);

sub connection {
  my $class = shift;
  my $schema = $class->SUPER::connection(@_);


   for my $moniker ( $schema->sources )    {
     my $class = __PACKAGE__->class($moniker);
        $class->resultset_class('MyApp::ResultSet');
   }

  $schema;
}

とりあえずこれで普通には動くんですけど、result_source_instanceつかって自分のビューを作ったクラスだとうまく行かない！一個前のやつだと自分のビューもオレオレResultSetも動くんですけど、、
http://www.removabletype.net/pods/DBIx/Class/Manual/Cookbook.html#arbitrary_sql_through_a_custom_resultsource
これですね。select * from table tblのtbl部分にSQLを書いて自分のSQLにする。

で、なんだかんだ悩んでたんですけど、結局は

#自分の生やしたいメソッド
sub DBIx::Class::ResultSet::test {
  warn "Hello!"
}


結局これをSchemaに書いておけばいいんではないかと言う結論に。なんか納得いかないけどとりあえずこれでいいか。いいのかなぁ。
というか自分のビュー作るコードはどこ置けばいいんだろう。Schemaはstaticに書き出した方がいいのかなぁ。

bulk insertでいろいろはまりはまり。

perl dbic

DBICでbulk insertしようと思ってハマッたわけです。insert into hoge values(1,1) (1,2)みたいなことをDBICでやりたい訳です。

はまった一個目。populateのcontext。DBIx::Class::ResultSetより

Pass an arrayref of hashrefs. Each hashref should be a structure suitable for submitting to a $resultset->create(...) method.

In void context, insert_bulk in DBIx::Class::Storage::DBI is used to insert the data, as this is a faster method.

と書いてある通り、contextがlistかvoidかを見て、動く内容が違う訳です。void contextにしないとbulk insertにならない。
で、試しにCatalystのAppでこんなコードを書いた訳です。

sub import : Local {
    my ($self,$c) = @_;

    $c->model('DBIC::Exhibition')->populate([
        {id=>20,exhibit_name => 'aaaaaa'},
        {id=>21,exhibit_name => 'bbb'}, 
        {id=>22,exhibit_name => 'bbb'}, 
    ]);
}

それでDBIC_TRACEの内容を見ても一行ずつしかinsertされなくておかしいなぁと思ってしばらくして気がつきました。
populateが戻り値になってる！

つまりは一番最後に書いてある文なので、perlは自動で一番最後の文の戻り値をreturnしようとする訳です。
最後の文がpopulateなので、voidじゃなくてlist contextになってしまった。普通に他の文を書き進めてれば良かった話。

これDBICあんまり関係ないな。でもwantarrayを使ってcontextを見ている物は要注意と学習しました。しばらくはまった。


はまりその2。bulk insertはlogに出ない。

環境変数のDBIC_TRACEを1にすると、実行されたSQLがログにでて、ここを見ながらDBICを試行錯誤する訳ですが、

INSERT INTO `exhibition` (`exhibit_name`, `id`) VALUES (?, ?): '0', '1'

とだけ出て、一行しか入ってないんじゃないの？って思うんですが、DBを直接見てみると入ってます。困ったら結果は直接見ろ、ですな。


いまはdebugだからhard codeでいいけど実際IDどこから持ってくるんだろうか。$rs->first->idとかでいいのかなぁ。

Test結果に色づけしたいというちょっと古いネタ。

Perl Test

ふと本棚を見てPerlHacksをみて、「あぁTestにFailした物だけを表示するやつやってなかったなぁ」
と思ってパッっと作ってみた。最初PerlHacksのやつコピペしただけで行けるかな？と思ったけど
動かなかったのでちょこちょこ直した。

#!/usr/bin/perl
use strict;
use warnings;
use Term::ANSIColor;
use Test::Harness::Straps;


open *STDERR, '>/dev/null' or die;


my $simple = $ARGV[0] eq '-s' ? shift @ARGV : 0;
my $strap = Test::Harness::Straps->new();
my $all_cnt = 0;
my $err_cnt = 0;


for my $file (@ARGV) {

	unless (-e $file)	{
		my @files = glob $file;
		next unless @files;

		push @ARGV, @files and next;
	}


    my $result = $strap->analyze_file($file);


	my $out = sprintf "%-40s", $file;
		$out =~ s/ /./g;
	print $out unless $simple;


	print $result->skip_all
		? coloring('bold yellow' => 'Skipped')
		: $result->passing
			? coloring('blue bold' => 'Success')
			: coloring('bold red' => sprintf("failed test %d of %d", $result->max - $result->ok, $result->max) ) unless $simple;

	print	map { "-----> $_->{name}\n" }
				grep { not $_->{actual_ok} }
					@{$result->details} unless $simple;

	$all_cnt += @{$result->details};
	$err_cnt += $result->max - $result->ok;
}

print $err_cnt == 0 ? "\n" : "E$err_cnt/A$all_cnt\n";


sub coloring	{
	my($color,$string) = @_;
	return color($color), $string, color('reset'), "\n";
}

とりあえずこんなとこで良いかな。細かいところはちょこちょこ変えて行こう。でももうちょっとエラー以外の出力減らしていいかも。
$simpleと最後の$err_cntがなかったら改行だけを出力してるのはscreenのstatuslineで使いたかったからです。

あとこれでつかったTest::Harness::Strapsて面白いね。テストの出力好き勝手にいじれます。