Template-Toolkitでマルチバイトな話
先に言っておくと、hide-kさんのまとめが分かりやすいです。
最もCatalystを使う際にと言う事ですが。
utf8フラグを立てないでTTを使う場合
ソース自身はutf8で書くんですけど、
#!/usr/bin/perl use strict; use warnings; use Carp::Clan; use Path::Class; use Template; my $base_dir = dir($ENV{HOME}, qw/tmp tt_test/); my $template = Template->new({ COMPILE_DIR => $base_dir->subdir('tt.cache')->stringify, COMPILE_EXT => 'c', }); my $output = ''; my $vars = { id => 'ZIGOROu', name => 'ますだ じごろう' }; $template->process(\*DATA, $vars, \$output) || carp $template->error; print $output; __DATA__ [% id %] [% name %] [% name | truncate(7) %]
こうすると指定したディレクトリにtt.cacheってディレクトリが出来て、コンパイル済みのファイルが出来ます。
が、やってみると分かりますが、truncateの出力で悲しい目に遭います。*1
utf8フラグを立てる場合
こんな感じ。
#!/usr/bin/perl use strict; use warnings; use Carp::Clan; use Path::Class; use Template; use Template::Provider::Encoding; use Template::Stash::ForceUTF8; my $base_dir = dir($ENV{HOME}, qw/tmp tt_test/); my $template = Template->new({ LOAD_TEMPLATES => [ Template::Provider::Encoding->new({ COMPILE_DIR => $base_dir->subdir('tt.cache')->stringify, COMPILE_EXT => 'c', }) ], STASH => Template::Stash::ForceUTF8->new, }); my $output = ''; my $vars = { id => 'ZIGOROu', name => "ますだ じごろう" }; $template->process(\*DATA, $vars, \$output) || carp $template->error(); utf8::encode($output); print $output; __DATA__ [% id %] [% name %] [% name | truncate(7) %]
ほとんど変わらないんですが、
を使ってるって事が大きく違います。
前者は渡した変数をテンプレート内部でutf8フラグを強制的に立ててくれる物で、後者はテンプレートそのものを指定したencodingでutf8フラグを立ててしまうという物です。
あとはこのようにTemplate::Providerの子孫クラスをnewしてLOAD_TEMPLATESに渡すので、事前にProviderに必要なconfigをProvider自体に渡しておかないとトラブルがおきます。
例としては、
- 通したはずのINCLUDE_PATHからテンプレートファイルが見つからない
- COMPILEされるはずがされない
などなど。
詳しいオプションは、
を見て下さい。
まとめ
TTの枠組みくらい理解しておかないとダメだなと思った＞＜
実践あるのみですね。
*1:ここはutf8フラグが立ってないので当然っちゃ当然ですが
Japanese Mozilla HackersなブログのフィードをOPML化
実は、ニッチなJavaScriptブログと言う位置づけで、Ci.nsIZIGOROu - Mozilla 拡張機能勉強会と言うブログもやってる訳ですが、
最近こんなエントリを書きました。
で見かけたブクマコメントですが、id:tokuhiromさんが、
OPMLにしてほしい
と申していたのでOPML化してみました。
ご自由にお使い下さい。
でOPML化したときのスクリプト
なんかちまちま作るのはバカらしいので、こういうときはPerlで書かないと。
元の記事から本文っぽぃ部分にあるアンカーをモリっとXPathで取って来て、Feed Discoveryかけて〜ってな感じです。
#!/usr/bin/perl use strict; use warnings; use DateTime; use DateTime::Format::HTTP; use URI; use URI::Match; use LWP::UserAgent; use HTML::TreeBuilder::XPath; use XML::Atom; use XML::Feed; use XML::Feed::RSS; use XML::OPML; use XML::Liberal; use Encode; $XML::Feed::RSS::PREFERRED_PARSER = "XML::RSS::LibXML"; $XML::Atom::ForceUnicode = 1; my $ua = LWP::UserAgent->new; my $res = $ua->get("http://moz-addon.g.hatena.ne.jp/ZIGOROu/20071223/1198434207"); die unless ($res->is_success); my $tree = HTML::TreeBuilder::XPath->new; $tree->parse_content($res->content); my $nodes = $tree->findnodes('/descendant::div[@class="section"]/descendant::a[@target="_blank"]'); die if ($nodes->size == 0); my $opml = XML::OPML->new(version => "1.1"); $opml->head( title => 'Mozilla Japanese Hackers OPML', dateCreated => 'Wed, 26 Dec 2007 06:25:38 GMT', dateModified => DateTime::Format::HTTP->format_datetime(DateTime->now), ownerEmail => "zigorou\x40cpan.org", ); my %seen = (); XML::Liberal->globally_override('LibXML'); for (my $i = 0; $i < $nodes->size; $i++) { my $node = $nodes->get_node($i); my $uri = URI->new($node->attr("href")); next if (exists $seen{$uri->as_string}); $seen{$uri->as_string} = 1; next if ($uri->match_parts(host => qr/^(b\.hatena\.ne\.jp|twitter\.com)/)); my @feeds = XML::Feed->find_feeds($uri); for my $feed_url (grep { $_->match_parts(scheme => qr/^https?$/) } map { URI->new($_) } @feeds) { next if ($feed_url->match_parts(path => qr/rss2$/)); my $res = $ua->get($feed_url->as_string); next unless ($res->is_success); my $content = $res->content; my $feed = XML::Feed->parse(\$content); if (XML::Feed->errstr) { XML::Feed->error(""); next; } $opml->add_outline(type => 'rss', version => 'RSS', title => $feed->title, description => $feed->description, htmlUrl => $feed->link, xmlUrl => $feed_url); last; } } print Encode::encode("utf-8", $opml->as_string);
多分にPlagger::FeedParserのソースを参考にしました。
と言うかもの凄くパクった。
Nagios::Plugins::Memcached 0.02 Release
昨日、ちょっと修正して0.02をリリースしました。
Nagiosのプラグインでmemcachedを監視するコマンドです。*1
監視項目は、
- 接続できるか
- レスポンスタイム
- キャッシュサイズ
- キャッシュヒット率
の4つです。
接続とレスポンス
指定時間内に接続出来るかどうかは、ソース上では以下のようになってます。
local $SIG{ALRM} = sub { $self->add_message( CRITICAL, "Timeout $timeout sec." ); croak("Timeout $timeout sec"); }; alarm $timeout; my $cache = Cache::Memcached->new( { servers => $hosts } ); $cache->set_cb_connect_fail( sub { my $prefip = shift; $self->add_message( CRITICAL, "Can't connect to $prefip" ); croak("Can't connect to $prefip"); } ); my $start = time(); my $stats = $cache->stats( [qw/misc/] ); my $end = time(); $stats->{time} = $end - $start;
Cache::Memcached#stats()メソッドを接続としちゃってるので厳密じゃないですけど、まぁそういう実装です。
ちなみにCache::Memcached#set_cb_connect_fail()で接続失敗した際のコールバックが登録出来るようになってます。
キャッシュサイズ、キャッシュヒット率
ここら辺は全部Cache::Memcached#stats()から取れるデータを全面的に信用して採用してます。
Nagiosのプラグイン開発
これはデブサミでid:kazeburoさんがプレゼンしてます。
デブサミ2007の発表資料 Nagiosのプラグインの話 : blog.nomadscafe.jp
僕はNagios::Pluginモジュールを継承して作ってます。
シンプルなんですぐ出来るはず。
バッドノウハウの最たる物はコマンド自体にPODを書いてはいけないと言う点。これ凄い重要＞＜
その他の留意点はPerlで書く場合は、Nagios plug-in development guidelines - 4. Perl Pluginsを見て下さい。
WWW::Mechanize付属のmech-dumpが便利な件
Scrapingは余りやらないんですけど、いざやる場合にフォームのパラメタとか調べるのは面倒です。そんな時にWWW-Mechanizeに付属のコマンドのmech-dumpを使うと便利です。
サンプル
例えば、Pathtraqのトップページなら、
$ mech-dump --forms http://pathtraq.com/ GET http://pathtraq.com/analytics url=解析したいサイトのURLを入れてください (text) <NONAME>=解析する (submit) m=hot (radio) [upcoming|*hot|popular|site]
と言う風に出力されます。*1
つまり、
| name | type | value | |||
| url | text | -- | |||
| |
submit | 解析する | |||
| m | radio | hot(/upcoming/popular/site) |
って感じだと分かる訳ですね。
使い方
は--help見れば分かる！
$ mech-dump --help
Usage:
mech-dump [options] [file|url]
Options:
--forms Dump table of forms (default action)
--links Dump table of links
--images Dump table of images
--all Dump all three of the above, in that order
--absolute Show URLs as absolute, even if relative in the page
--help Show this message
The order of the options specified is relevant. Repeated options get
repeated dumps.
*1:Wide Characterのwarningは省略してますw
堅牢なパスワードを強制するテクニック
やっぱりサービス側で堅牢なパスワードをユーザーに強制する仕組みが無いと問題があるサービスと言うのはたくさんあるって事で、Perlで出来る限り簡単にそういう仕組みを作れないかなと。
幾つかピックアップしてみました。
Data::Passwordモジュールを使う
真っ先にこれ。UNIX系OSでのパスワードの強度チェックと似たモジュールのようです。
use Data::Password qw(:all); print IsBadPassword("hogehoge");
文字列が表示されちゃう場合はNGなパスワード。
このモジュールは辞書設定も出来るようです。
@Data::Password::DICTIONARIESに辞書ファイルを指定しておくとそこの内容も見てくれるみたい。
ありがちなパスワード集はftp://ftp.ox.ac.uk/pub/wordlists/に言語別にあります。
またUNIX系OSのようにユーザー名とのコンボもあります。
use Data::Password qw(:all); print IsBadPasswordForUNIX("zigorou", "hogehoge");
Data::Password::Checkモジュールを使う (追記1: 2007-10-29T03:30:04+09:00)
このモジュールは結構使い勝手が良さそう。
use Data::Dump qw(dump); use Data::Password::Check; my $pwchk = Data::Password::Check->check({ password => "hogehoge" }); if ($pwchk->has_errors) { print dump($pwchk->error_list); }
checkメソッド時に検証プロフィールを幾つか設定出来る模様。
String::Trigramモジュールを使う
livedoor Techブログ : String::Trigram でテキストの類似度を測るにヒントを得てなんですけど、ありがちなパスワードって、真っ先に挙がるのは
- JOE
- 自分のアカウント名＋誕生日の数字
- 自分のアカウント名の置換
とかなんですよね。つまりもとのアカウント名に似ているケースが多い。
って事は類似度が高いパスワードを計算してあげて、その閾値を超える物はNGみたいな判定してあげれば強固なパスワードになるんじゃないのかなと。
use String::Trigram; print String::Trigram::compare("zigorou", "zigo1224");
結果は、
0.266666666666667
ちなみに完全一致が1です。
まとめ
- ありがちな辞書アタックで引っかかるのはダメ
- JOEダメ
- 似すぎててもダメ
にさらに記号も入れなきゃダメって条件つけたら相当硬いパスワードなんじゃないすかねぇ。
覚えづらいけどもｗ
他にもたくさんありがちなケースがあるっちゃあるけど、サービス側でこうしたチェックをしてあげるのはやはりユーザーに対して親切じゃないかなと思うわけです。
Term::ANSIColorでカラフルなシェルを作るたった一つの方法
もはや何も言うまい。
$ perl -MTerm::ANSIColor=:constants -e 'print BLUE BOLD ON_WHITE "bold blue", RESET . "\n";'
Time::Progressでプログレスバーを実現する。
ひょっとしたら役に立つかもしれないけど、基本的には無駄な知識です。あしからず。
サンプルソース
#!/usr/bin/perl use strict; use warnings; use Time::Progress; my @actions = qw(setup prepare accept finalize); my $progress = Time::Progress->new; $progress->attr(min => 0, max => 100); print "Sample Progress Bar: \n"; { local $| = 1; for (my $c = 0; $c <= 100; $c += 5) { if ($c % 25 == 0) { my $action = $actions[($c / 25) - 1]; print " " x 100 . "\r"; print $progress->report("progress: %40b %p, eta: %E min, Starting $action\r", $c); } else { print " " x 100 . "\r"; print $progress->report("progress: %40b %p, eta: %E min\r", $c); } sleep 1; } } $progress->stop; print "\n"; print $progress->elapsed_str;
表示サンプル
$ perl progress.pl Sample Progress Bar: progress: ######################################.. 95.0%, eta: 0:01 min
どう見ても
ネタです。
