たろマーク （はてなブックマーク）
-
[ javascript ][ test ] Rspec ライクな Javascript テストフレームワーク
-
[ ezpublish ] eZ のデータソースを CakePHP で使うためのアダプタ。Rails とか Django にこれを移植すれば！
-
[ iquestioner ]
-
[ ruby ]
-
[ lazy-people ] おつでしたー
■kansai.pm #12 10周年記念ミーティング行ってきた
ハイ！ というわけでね、ゴールデンウイーク初めは kansai.pm へ行ってきました。ノリと勢いで登録してみたものの13時スタートに間に合うのに結構早く出発しなくてはならないことに気がついて、前日会社の飲み会から帰った時に半ばあきらめてましたw 関東からはるばる寝癖全開ですいません。
写真はなみかわさんの発表に使用された kansai.pm 年表。発表の合間に付箋で色々追加したりしていました。google docs で今も管理されてます。何か追加したい人は ML に参加して言えば編集権限もらえると思います。
今回は JPA の牧さんが発表にきていたほかに聞く側でも関東組が何人か居ましたね！
Plack の話半分以上聞きそびれました。あとで動画見ます。Server::Starter 良いなと思いました。
この足はせんとくんの足です。
PDFJ の中島さんは、カメラの蛇腹を Web インタフェイスでパラメタ与えて PDF 生成するデモとか行ってました。本気カメラですね。光測って撮ってました。
lapis25 さんの PHPer 向け Perl の話は確かに UNIX ツールとして覚えてもらうのが良いですね。kansai perl casual も頑張ってください。
はしもとさんの Exif の話は面白かった。編集して回転しても Exif 書き換えておかないとさらに回転されるよとか、ヘッダ情報に付いてるサムネイルも編集しておいてねとか。
あと、AzureStone さんの Perl の日本語ドキュメントの話は、どういう疑問があって、どういう経路で Pod::PerldocJp に至ったかがわかりやすくて良かったですね。特に最初に結論を持ってきていたところが良かったです。
個人的には、ドキュメントの英語が分からない → コード読む → コードが分からない → ドキュメント読むのサイクルです。
懇親会は王寺のかごの屋さんで行われました。隣の人が昔、かごの屋の別な店舗でバイトしていたらしくなんか色々言っておりました。食べ放題と言うことですき焼き、しゃぶしゃぶ食べまくりました。
kansai.pm お疲れさまでしたー。10周年記念おめでとうございます！
そんなかんじで kansai.pm の話はココまで。もう少し躊躇せずにシャッター切れば良かったなぁ。
kansai.pm 終えてからは、tomyhero さんに連れられて、AzureStone さん、lapis25 さんとで放出に出向きました。他の人に「え？ 放出なんにもないよ？」と言われてたんですが何もなかったです！
ふつーに住宅街でしたw
そしてちょっと歩いたところのフレンドリーというファミレスに入って、AzureStone さんの疑問に答える会が開かれました。
今思うとサラダバーにして、デザートてんこ盛りにすれば良かったです。
翌日は大阪城に行ってきました！
ちょっとテンションの低い tomyhero さんに撮ってもらった写真です。
当時の姿がそのまま残っていて素晴らしかったですね！（中には入ってない）
あとは大阪に来たらミックスジュース飲むやろと言われて頼んでみました。子供の頃にミキサーでこんなんよく作ったわーと飲んでて思いました。
京橋で lapis25 さんと再開。だいぶ人気者でした。
帰りは新大阪駅にある蓬莱の豚まんを買って車内で食べて帰りましたとさ。
おかげさまでゴールデンウイーク初っぱなから充実しました。ありがとう！
ksansai.pm #12 10th anniversary!
| パーマリンク
| コメント (0)
| トラックバック (0)
| 
■JPerl Advent Calendar 2009 Hacker Trackの21日目を書きました。
というわけで、今まであまりエントリ書いたことない FormValidator::LazyWay の記事を書きました。
FormValidator::LazyWay で検証ルールをまとめよう - JPerl Advent Calendar 2009
25日まであと4日です。残りの4日、ななしさんのままなんだけど続くのでしょうか >_<
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■JPerl Advent Calendar 2009 Casual Trackの18日目を書きました。
自分の番まで結構あると思ってたら、あっという間でした >_<
みんな結構がっつり書いてて、お題探しで右往左往してましたw
Log::Disatch から、 Log::Dispatch::Config を復習代わりに実行しながら書きました。
もうあと少しですね！
hacker track の方が埋まってない見たいです。CPAN Author の方、どうですか！ って自分もですね。後で追加しておきます >_<
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■perl で Observer パターン
Ruby で Observer パターンをやってみたところで、Perl でもやってみたくなったので書いてみました。お題はコードの世界に載っているテキスト表示の時計です。
ruby にある observer モジュールは include で mixin して使うので、Perl では Moose の Role を使って実装してみます。（モダン Perl 入門にもデザパタの章で Observer パターンがありますが、あえて ruby の observer モジュールを模してみます。）
で、これが Observable な Role です。これは時計の心臓部 Tick の Role なので Tick::Role::Observable としました。
package Tick::Role::Observable;
use Moose::Role;
has observer => (
is => 'rw',
default => sub { {} },
);
has state => (
is => 'rw',
default => 0,
);
sub is_changed {
my ($self) = @_;
return $self->state();
}
sub changed {
my ($self) = @_;
$self->state(1);
}
sub notify_observers {
my ($self, @args) = @_;
return unless $self->is_changed;
$self->state(0);
foreach my $package ( keys %{$self->observer} ) {
eval {
$self->observer->{$package}->update(@args);
};
if ( $@ ) {
confess $@;
}
}
return 1;
}
sub add_observer {
my ($self, $obj) = @_;
my $package = ref $obj;
confess $obj . 'is not object'
unless $package;
confess $package . 'can not update'
unless $obj->can('update');
$self->observer->{$package} = $obj;
}
1;
このモジュールを with 'Tick::Role::Observable'; するとそのモジュールに Observer な振る舞いが付与されます。
元のお題の時計モジュールはこんな感じ。
package Tick;
use Moose;
with 'Tick::Role::Observable';
__PACKAGE__->meta->make_immutable();
no Moose;
use DateTime;
use DateTime::TimeZone;
use Time::HiRes qw(sleep gettimeofday);
sub start {
my ($self, @args) = @_;
my $tz = DateTime::TimeZone->new( name => 'Asia/Tokyo' );
while (1) {
my $now = DateTime->now( time_zone => $tz );
$self->changed();
$self->notify_observers($now->hour, $now->minute, $now->second);
# micro second 単位のズレを調整
sleep 1.0 - (gettimeofday)[1] / 1000000.0;
}
}
1;
Tick->new->start すると1秒ごと sleep するループに陥ります。
1秒ごとに changed メソッドで更新フラグを立てて、notify_observers メソッドで監視者のオブジェクトに更新を通知します。
では、監視者として時刻をテキスト表示するオブジェクトを用意します。
package TextClock;
use Moose;
__PACKAGE__->meta->make_immutable();
no Moose;
sub update {
my ($self, @args) = @_;
local $| = 1;
printf "\e[8D%02d:%02d:%02d", @args;
}
1;
Observable なモジュールの監視者になるには update メソッドが必要です。
notify_observer メソッドで更新通知される際には update メソッドが呼ばれるからです。
なので、 TextClock モジュールにも update メソッドを用意します。
引数には notify_observer メソッドに渡された引数が全部渡ってきます。
さて、これで時計の心臓部である Tick モジュールと TextClock モジュールができました。この二つを監視者と被監視者としてスクリプトにまとめてみます。
use Tick; use TextClock; my $tick = Tick->new(); $tick->add_observer( TextClock->new() ); $tick->start();
add_observer に update メソッドを持ったオブジェクトを渡してあげると、監視者と被監視者の関係が簡単にできます。
このスクリプトを実行すると現在時刻がテキストで表示され、1秒ごとに更新されます。
肝は接点が add_observer メソッドだけなところですね。
時計の表示を変えたくなったら update メソッドを持ったオブジェクトを作って add_observer してあげるだけで良くなります。（とコードの世界に書いてあった）
自分が普段使ってる言語で書き直せたらそれなりに理解できてるかしら？
日経BP出版センター
売り上げランキング: 44091
Rubyに導入された思考法
翔泳社
売り上げランキング: 18356
perl経験者は読んで損はしない Perl中級者におすすめしたい
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■指定日から一ヶ月後までに指定した曜日が何個あるか求める
一ヶ月だとどの曜日も4回は必ずあるよね。29日以上ある月の場合に余った日の中に指定した曜日があれば ++ する。もっとスマートにかけるような気もする。そしてあってるのかどうかわからないw
use strict;
use warnings;
use utf8;
use Test::More qw/no_plan/;
use DateTime;
is count_wdays(7, 2009, 10, 10), 5;
is count_wdays(6, 2009, 10, 10), 5;
is count_wdays(6, 2009, 9, 13), 4;
is count_wdays(1, 2010, 1, 12), 4;
is count_wdays(3, 2010, 1, 12), 5;
is count_wdays(7, 2010, 2, 1), 4;
is count_wdays(3, 2010, 6, 11), 4;
sub count_wdays {
my ( $wday, $year, $month, $day ) = @_;
my $first = DateTime->new(year => $year, month => $month, day => $day);
my $last = $first->clone->add( months => 1, end_of_month => 'limit' );
# 指定日から一ヶ月後までの日数を求める
my $dur = $last->delta_days($first);
my $days = $dur->in_units('days');
my $count = sprintf("%d", $days / 7);
my $remainder = $days % 7;
if ( $remainder ) {
my $min = $last->subtract( days => $remainder )->wday;
my $max = $min + $remainder;
if ( $min <= $wday && $max >= $wday ) {
$count++;
}
}
return $count;
}
これで間違いなければ、たぶん引数増やして最終日指定できるようにしてもうまく計算できると思うんだけどどうだろ。
こういう CPAN モジュールありそうだけどわからなかった。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■OAuth の署名付きリクエストを受け取る
OpenSocial で gadgets.io.makeReqeust() を受け付けとるときに OAuth の署名を確認したのでメモ。具体的に言うと mixi アプリで makeRequest() を受け取るとき。
perl で OAuth の署名確認には *::Lite の人のOAuth::Liteを使った。
mixi アプリのドキュメントにある公開鍵は、OAuth::Lite::SignatureMethod::RSA_SHA1 ではそのままだと使えなかったので public key だけ取り出しました。（Crypt::OpenSSL::RSA の new_public_key にそのまま渡されてるので）
openssl x509 -in mixi_rsa.pem -pubkey -noout
取り出した pub key を使って署名の確認。下記のコードは Catalyst のコントローラにべったり書いた。
use OAuth::Lite::SignatureMethod::RSA_SHA1;
use OAuth::Lite::Util qw(create_signature_base_string);
my $public_key = <<__END_OF_PUBLIC__;
-----BEGIN PUBLIC KEY-----
MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDASPndWVBy/VYe99aVM/5PWVdS
D3Vb5uAlK4cAPz091V/1SOeL3YSRuOposPMDjf5TlQuUr/TmNE6cbAUFV0hLFQuB
69KmJN+Bt8JwptFbuFetNKaMVESntg69+VPeuvuqo2+Ob7dcTXnvNxTfdJcwga9f
W5Af9jh82kQTWmZf5QIDAQAB
-----END PUBLIC KEY-----
__END_OF_PUBLIC__
# mixi アプリは RSA_SHA1 方式
my $verifier = OAuth::Lite::SignatureMethod::RSA_SHA1->new(
consumer_secret => $public_key,
);
my $params = $c->req->params;
# oauth sigunature も渡ってくるのでこれだけ取っておく。
my $oauth_signature = $params->{oauth_signature};
delete $params->{oauth_signature};
# HTTP Method, リクエストしてきた URI, oauth_signature 以外の parameter 全部を使って base_string 生成
my $base_string = create_signature_base_string($c->req->method, $c->uri_for(), $params );
# 真なら ok
my $result = $verifier->verify($base_string, $oauth_signature);
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■YAPC::Asia2009 で話してきました
まずは、二日目のスピーチは到着が遅くなってご心配おかけしてすいませんでした。
今年は JPA 初の運営ということで、lestrrat さん、スタッフの皆さん、お疲れさまでした。
YAPC は、手を挙げて受理されればセッションをもらえるというのはわかっていましたが、なかなか手を挙げる勇気もなく、毎年聞く側として参加していました。
ですが、今年はコーポレートトラックがあったので YAPC で話す良いきっかけとなったと思います。「せっかくだったら一般参加でも話そう！」と踏み切れました。
私たちの Catalyst の使い方
自分が勤めている株式会社 Plugin and Core での Catalyst の使い方を紹介させていただきました。
今日紹介した構成は、事例の中で紹介してる マンガ市場 DL が一番近いです。今はやっぱり $c->req, $c->session を渡すのをやめてしまってたりします。
ちなみにマンガ市場 DL の運営を行っているのはブックヴィレッジさんです。弊社は開発協力という形でリニューアルをお手伝いさせていただきました。
姉妹サイトの ToMiCo にも先日マンガ市場 DL との連携機能が付いたようです。
FormValidator::LazyWay で検証ルールをまとめよう
もう一つのセッションでは一般参加として、FormValidator::LazyWay を紹介させていただきました。
話し終わった後に質問をいただいたりして本当にうれしかったです。そして返答がおどおどしててすいません。
今思い出すと、「自分でルールを作るのはどうしたら良いか」という質問で、「自分で作ったルールを読み込ませる方法」を答えていたような気がする orz
ルールの作り方は、後日 POD に掲載したいと思いますが、簡単に説明すると（ご質問いただいた方がここを見てるとは限らないんですが……）、OreOre::Rule::Hoge というルールクラスを作って、その中に入力内容を検証するメソッドを書きます。
この検証するメソッドは、入力内容が検証ルールに沿っていたら1, 沿っていなかったら0を返す用にします。
参考）Rule::Email
それから、設定で指定した言語での表記名を入れたモジュールが無いとエラーになってしまうので、OreOre::Rule::Hoge::JA などを作って、そのルールに従わなかったときのルールを表す文章を返すメソッドを用意してください。
「__field__には、__rule__が使用できます。」といったメッセージで __rule__ に当てはまる部分です。（__field__ は項目名が入ってきます）
ちなみに発表の最後に多言語化の仕組みを変えたいと言ってたのはここの部分で、.po にしたいなぁと考えてたりします。
あと、このご質問で「いちいちコンフィグで読み込むルールモジュールを指定しておかないと行けないのも外したかったんだ、」というのを思い出しました。settings のとこに書いてあるルールモジュールを自動で読み込めばいいよね、と。
なんか早速パッチが届いたりしていて、YAPC::Asia で発表して良かったと思いました。
ほとんど blog とかで書いてなかったので、ユーザがいたとは自分でも驚きです。本当にありがとう！
自分のセッション以外では、自分以外のセッションを聞いたりしたのはもちろん、kansai.pm の人たちと再会したりいろんな人と話ができて楽しかったです。
来年も是非参加して、またなにか発表できたらいいなぁと思います。
お疲れさまでした−！
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■再度告知: YAPC::Asia Tokyo 2009 で「Catalyst」と「FormValidator::LazyWay」について話します！
もう今週ですよ！ やばい！
YAPC::Asia Tokyo 2009 で自分たちの Catalyst の使い方についてと、僕が開発のお手伝いとメンテをしている FormValidator::LazyWay について話します！
- 2009/09/10 14:50 Six Apart 講堂: プラコアでは Catalyst をこう使ってます！ / Plucore way of using Catayst
- 2009/09/11 09:45 西5号館: FormValidator::LazyWay で検証ルールをまとめよう
正直、段々と逃げたくなってまいりました！
昨日ちょっと練習してみたところ、おおよそ 20 分にはおさまってますというか、本番は緊張して早口になって15分くらいで終わったらどうしようとか、もう少し資料修正しようかなぁとか、LazyWay もう少し手直ししておけば良かったとか考えつつ、週末は風呂掃除でカビキラーまきすぎて気分悪くなったりしてました。
YAPC のチケットはもう追加販売分も売り切れたのかしら？ その後の特別研修は参加したいけどこれ以上休めないのよね >_<
あと前夜祭の yokohama.pm も行けそうにない orz
YAPC::Asia Tokyo×gihyo.jp presents―まもなく開催！アジア最大のPerl開発者の祭典，YAPC::Asia Tokyo 2009
各トラックの紹介記事へのリンク。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■MovableType で Text::Livedoor::Wiki 記法
先日、polocky さんによって Text::Livedoor::Wiki がリリースされてますね。（livedoor wiki の中の人ですよね？ って wiki に思いっきり書いてあったw）
全部の記法が plugin として書かれてて、その気になれば自分記法も作れそうな本気実装です。
自身の blog ではてな記法を livedoor 記法に含める と行ったネタも披露されてますねw
結構 Moose の話題とか書かれてたので、ひっそり読んでたところへの記法モジュール公開だったので、これを機会になにかトラックバック送るネタでもないかなぁと思って作ってみました。
mt の plugins ディレクトリ以下に TextLivedoorWiki ってディレクトリ作って TextLivedoorWiki.pl ってファイル名で突っ込んでおくと記事書くときのフォーマット欄に出てくると思います。
Text::Livedoor::Wiki の引数に渡してる storage は各々、CSS とか画像をダウンロードして、自分の URI に変えてください。（POD にも書いてありました）
MTOS-4.261-ja で確認しました。（ちなみにこの blog はまだ 3 系だったりする。MTOS にしたいけど、妙なカスタマイズしてしまってるのがアレです。）
MT の plugin はこんな書き方でよかったのかもちょっと自信ないけど動いてるのでよしとする polocky さん応援エントリw
（そして wiki ユーザとしては不良ユーザです、すいませんw）
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■YAPC::Asia Tokyo 2009 で「Catalyst」と「FormValidator::LazyWay」について話します！
どうやらスケジュールが fix したらしいのと、チケットの発売が始まったようなので宣伝です。
YAPC::Asia Tokyo 2009 で自分たちの Catalyst の使い方についてと、開発のお手伝いとメンテをしている FormValidator::LazyWay について話します！ スピーカーとしては初参加です！ よろしくお願いします！
- 2009/09/10 15:00 Six Apart 講堂: プラコアでは Catalyst をこう使ってます！ / Plucore way of using Catayst
- 2009/09/11 09:30 西5号館: FormValidator::LazyWay で検証ルールをまとめよう
Catalyst の使い方は以前、この blog で書いた構成の話と実際の事例の紹介、FormValidator::LazyWay はなぜ作ったのかとか使い方の紹介とかやるます。
正直20分ももつのか、今から gkbr です！w
今年は JPA の運営で今までの Perl らしい Hacker な人たちの尖ったトークに加えて、コーポレートトラックという企業ユーザ、学生向けな色あいも増えてますね。おかげさまで自分もトークに参加しようというきっかけになりました。
聴く側としては、HTTP::Engine に AnyEvent, Coro などここ一年くらいの盛り上がりが反映されていて、スケジュールを見ていてどのコマをとるか悩みますね。
楽しみだけどスピーカーとしての参加があると緊張しますねー。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■最近の Catalyst の構成
最近 Catalyst のエントリをよく見かけるので自分の構成をさらしてみます。コードは CodeRepos にあります。
share - Revision 30441: /lang/perl/Chaostr/trunk
元々は、作ろうとしたアプリがあったんですが、去年の Catalyst confernce 以降、MyApp 的実験場になってます。仕事で作ったものはさらせないので、構成だけ表に出す感じ。ちなみに今のところ Catalyst 5.7 系でしか使ってないです。
あと、Controller クラスのベースで Resources を使ってるけど、自分のやり方は推奨されない使い方をしてます。新規投稿や編集画面用の URL を作るために一度自前 Base クラスを噛ませてたんですが、new, edit はデフォールトであります。Resources の使い方とかはこっちに書きました。
クラス構成
現在の構成をざっと図にするとこんな感じです。
Config, Log, DB, Validator を Catalyst から切り離して Service(Logic) クラスでも直接扱えるようにしてます。
PseudoRequest については後述。
Chaostr::Class / Chaostr::Role
このあたりは、Angelos インスパイアです。と言うか最初はまるパクリだったw
Angelos::Class は Mouse ですが、Chaostr::Class は Any::Moose で、呼び出し元が Moose だったら、Moose、そうでなければ Mouse になります。Cat 5.8 系で Moose になってもいいようにと。test やコマンドラインからは Mouse がいいなぁと言う感じで。
Chaostr::Class::* は Service クラスで mixin して使用するクラスです。
config, log, db, validator とかも mixin されてます。mixin はこんなやり方でいいのかがちょっとわからない。
Chaostr::Config
tomyhero さんが書いてる CatalystとConfig - perl-mongers.org を見てもらうとわかると思います。
Config::Multi を singleton 化して、どこでも使えるようにしてるよ！
すこし違うのは __path_to()__ とか __uri()__ とかで Path::Class や URI オブジェクトになる点くらい。
Chaostr::Log
Log::Dispatch::Config 使ってます。
extlib に Log::Dispatch::Configurator::Hash というのをこさえてあって、hash から Log::Dispatch::Config::Configurator オブジェクトを作れるようにしてます。
開発中は Log::Dispatch::Colorful を使ってます。Log::Coloful は、Log::Dispatch のメソッドいじったりしてるので、Dumper が必要ない人は yappo さん作の Log::Dispatch::Color 使うといいよ。
$Log::Dispatch::Config::CallerDepth で呼び出し元からの深さを指定してるんだけど、Service から呼んだときと、Catalyst から呼んだときでエラー元の表示が変わってしまってるのが少し悩み。
Validator
FormValidator::LazyWay 使ってます。validator は Catalyst にあればいいかと思ってたんですが、Service クラスに Request を渡しているので Service クラスで validate できても良いなぁと思って切り離してます。
どっちでもできるようにしておいて、なるべく Service 側でできるようにという感じ。
DB
DBIx::Class です。これも Catalyst::Model::Schema::DBIC とかは使わずに自前 Singleton 化して Service クラスでも呼び出せるようにしてます。
Model
Catalyst::Model::MultiAdaptor を使用して、Service クラスが読み込まれる用にしています。
MultiAdaptor は、いくつかの LifeCycle をサポートしてますが、LifeCycle::Singleton に手を入れた LifeCycle::SingletonPerRequest っていうのを作って使ってます。
これは起動時に指定したクラスを require して instance 化するまでは同じですが、その instance 内でリクエスト毎に $c->request と $c->session が Service クラス側のアクセッサに渡ってくるようになってます。
sub install {
my $self = shift;
my $instance = $self->create_instance( $self->adapted_class, $self->config );
Sub::Install::install_sub(
{ code => sub {
my ( $component, $context ) = @_;
$instance->request($context->req);
$instance->session($context->session);
return $instance;
},
into => $self->model_class_name,
as => 'ACCEPT_CONTEXT',
}
);
}
もうね、Model として切り分けたときに request とか session をいちいち渡すのが面倒になって、「自動で全部渡してしまえ」と思った末の結果です。あとは、メソッド側で使いたいのだけ使えよと。
引数として必要な分だけ渡すと言う作りもできるよ。
後は、FormValidator::LazyWay を validator として使ってます。
validate は Catalyst 側でやればいいと思うんですが、作ってて Service 側でもやりたくなったら使おうくらいの考えで搭載しました。
CLI と test
Model のところ読んで、結局 Catalyst 依存してるじゃんかと思われるかもしれませんが、hash を渡すと request オブジェクトに変えてくれる PseudoRequest というクラスをこさえて、CLI や test も Service クラスを使えるようにしてます。
PseudoRequest にファイルの場所とか教えると $self->request->upload 的なこともできるので、ファイルアップロードのテストまで書けるようにはしたつもり。
参考
参考にしたというか、大元は avmaster さんのAV女優ブログ検索のソースで、この一年ぐらいちまちま育ててた感じです。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Log::Dispatch で Colorful!
追記
CodeRepos にコミットして CPAN うｐしましたー。
$default_color 無くしたので、color 指定しなければただの Dumper な Screen として使えると思います。
本文
Catalyst::Plugin::Log::Colorful を使って以来、開発中は Colorful な log じゃないと Debug モードの気がしなくなってしまった自分ですが、ちょっと、Log::Dispatch で Colorful な Dumper してみたくなったのでやってみました。
Log::Dispatch をよくわかってなくてきっとおかしな事をしていると思う。
message 周りの callback で一番最初に処理してほしいから頭に割り込んでみたり、Dumper したくて log メソッドの validate 外したり。
test_log.pl
Log::Dispatch::Config から使ってます。
use strict;
use warnings;
use lib qw(./lib);
use Data::Dumper;
use Log::Dispatch::Config;
use Log::Dispatch::Configurator::YAML;
my $config = Log::Dispatch::Configurator::YAML->new('log.yaml');
Log::Dispatch::Config->configure($config);
my $log = Log::Dispatch::Config->instance();
$log->notice('noooooootiiiiiiiiiceeeeeeeeeee');
$log->info('infoooooooooooooooooooooooo');
$log->error('eeeeeerrrrrrrrrrrrrrooorrrrrr');
$log->debug('deeeeeeeeebuuuuuuuuuuuuuug!');
$log->debug({
foo => 'bar',
});
log.yaml
log.yaml はこんな感じ。
dispatchers:
- screen
screen:
class: Log::Dispatch::Colorful
min_level: debug
stderr: 1
format: '[%d] [%p] %m at %F line %L%n'
color:
info:
text: green
debug:
text: red
background: white
error:
text: yellow
background: red
Log::Dispatch::Colorful
これがその Colorful さん。
package Log::Dispatch::Colorful;
use strict;
use warnings;
use base qw( Log::Dispatch::Output );
use Data::Dumper;
use Log::Dispatch::Output;
use Params::Validate qw(validate BOOLEAN SCALAR ARRAYREF CODEREF);
use Term::ANSIColor;
Params::Validate::validation_options( allow_extra => 1 );
our $VERSION = '0.01';
our %LEVELS;
BEGIN {
foreach my $l (qw( debug info notice warning err error crit critical alert emerg emergency )) {
my $sub = sub {
my $self = shift;
my $messages;
foreach my $message (@_) {
if ( ref $message ) {
$message = Dumper($message);
}
$messages .= $message || '';
}
$self->log( level => $l, message => $messages );
};
$LEVELS{$l} = 1;
no strict 'refs';
no warnings 'redefine';
*{ "Log::Dispatch::" . $l } = $sub;
}
}
sub new {
my $proto = shift;
my $class = ref $proto || $proto;
my %p = validate(
@_,
{ stderr => {
type => BOOLEAN,
default => 1
},
}
);
my $self = bless {}, $class;
$self->_basic_init(%p);
my $default_color = {
error => {
text => 'yellow',
background => 'red'
},
debug => { text => 'red' },
};
$self->{color} = exists $p{color} ? $p{color} : $default_color;
$self->{stderr} = exists $p{stderr} ? $p{stderr} : 1;
my $callbacks = [
sub {
my %p = @_;
if ( $self->{color}->{ $p{level} }->{text} ) {
$p{message}
= color( $self->{color}->{ $p{level} }->{text} )
. $p{message}
. color('reset');
}
if ( $self->{color}->{ $p{level} }->{background} ) {
$p{message}
= color( 'on_' . $self->{color}->{ $p{level} }->{background} )
. $p{message}
. color('reset');
}
$p{message};
},
@{ $self->{callbacks} }
];
$self->{callbacks} = $callbacks;
return $self;
}
sub log {
my $self = shift;
my %p = validate( @_, { level => { type => SCALAR }, } );
return unless $self->_should_log( $p{level} );
$p{message} = $self->_apply_callbacks(%p)
if $self->{callbacks};
$self->log_message(%p);
}
sub log_message {
my $self = shift;
my %p = @_;
if ( $self->{stderr} ) {
print STDERR $p{message};
}
else {
print STDOUT $p{message};
}
}
1;
Dumper できるの便利だけど、リファレンス渡すと他の Log クラスに Dispatch しづらくなるなぁ。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■CC::Resources と CC::RequestToken を一緒に使う
追記
Controller::Resources の作者に対応してもらったよ！ありがとう！
ここから元の記事
Catalyst::Plugin::RequestToken が廃止対象になって Catalyst::Controller::RequestToken が出てからだいぶ経ちましたが、Resources とどう組み合わせて使おうか悩んでいて、こうやったら一緒に使えるなぁと思ったのでやってみた。
package MyApp::Base::Controller::Resources;
use strict;
use warnings;
use base qw(Catalyst::Controller::Resource Catalyst::Controller::RequestToken);
use Catalyst::Utils;
sub setup_collection_actions {
my $self = shift;
my $maps = Catalyst::Utils::merge_hashes(
$self->{collection} || {},
{ list => { method => 'GET', path => '', token => 'create' },
do_create => { method => 'POST', path => '', token => 'validate' },
create => { method => 'GET', path => 'new', token => 'create' },
}
);
$self->setup_actions( collection => $maps );
}
sub setup_member_actions {
my $self = shift;
my $maps = Catalyst::Utils::merge_hashes(
$self->{member} || {},
{ show => { method => 'GET', path => '', token => 'create' },
do_update => { method => 'POST', path => 'update', token => 'validate' },
update => { method => 'GET', path => 'update', token => 'create' },
do_destroy => { method => 'POST', path => 'delete', token => 'validate' },
destroy => { method => 'GET', path => 'delete', token => 'create' },
}
);
$self->setup_actions( member => $maps );
}
sub _construct_action_attributes {
my ( $self, $chained_from, $map ) = @_;
return (
'Resource',
'Args(0)',
"Chained('$chained_from')",
"Method('$map->{method}')",
exists $map->{path} ? "PathPart('$map->{path}')" : 'PathPart',
( exists $map->{token} && $map->{token} eq 'create' ) ? 'CreateToken'
: ( exists $map->{token} && $map->{token} eq 'validate' ) ? 'ValidateToken'
: ''
);
}
_construct_action_attributes を上書きして、$map->{token} に入っている値を見て、CreateToken か ValidateToken アトリビュートを付加するようにしてます。
後は setup_(collection|member)_actions で token の指定するだけ。
list と show を CreateToken にしてるのは、一覧画面とか詳細画面自体にフォームがある場合があるからです。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■CA::Creditional::* で auto_create
ちょっと人に頼まれて、livedoor の認証 API を Catalyst で使うために Catalyst::Authentication::Credential::Livedoor を Catalyst::Plugin::Authentication::Credential::Livedoor からパクリつつ実装してたんだけど、認証 API だと元々手元の DB にはそのユーザはいないので、CA::Store::DBIx::Class とかを store に指定すると認証が通らなくなる。
そこで、auto_create を指定するらしいんだけど、ただ指定しただけだと auto_create なんてメソッド無いっていわれるので、テーブルクラスにメソッド生やしておく
package MyApp::Schema::Member;
use strict;
use warnings;
__PACKAGE__->resultset_class('MyApp::Schema::ResultSet::Member');
{
package MyApp::Schema::ResultSet::Member;
use Carp::Clan qw/^DBIx::Class/;
use base qw(DBIx::Class::ResultSet);
sub auto_create {
my ( $class, $hashref, $c ) = @_;
my $member = $class->create({
livedoor_id => $hashref->{livedoor_id} || undef,
});
return $member;
}
}
1;
んで、こんな感じ。
'Plugin::Authentication':
default_realm: members
realms:
members:
credential:
class: Livedoor
app_key: ************************
seacret: **********
get_livedoor_id : 1
store:
class: DBIx::Class
user_class: DB::Member
id_field: livedoor_id
auto_create_user: 1
こうすると my $user = $realm->find_user( $userinfo, $c ); なコードのところで、auto_create してくれる。単純に create メソッド使ってくれるとも少しうれしいんだけども。
参考にしたの
- Catalyst-Authentication-Credential-OpenID
- Catalyst::Authentication::Credential::OpenID(CodeRepos の方) でログイン
| パーマリンク
| コメント (0)
| トラックバック (1)
|
■perl-mongers.org を立ち上げました。
こんばんは！こんばんは！
皆さん今日も元気に Perl でコードを書いてますか？
ということで、勢い余って perl-mongers.org を立ち上げました。
当初は、日本の Perl Monger な人の blog とかを集めて、リダイレクトするだけのサイトにするつもりだったんですが、woremacx さんの nice job により、OpenID でログインして書ける blog となりました！（MTOS を OpenID で使えるようにする Hack もエントリされてます！）
なんか、Perl のチップスや初学者に向けてこれ覚えておくといいよ的な事とか、Perl Monger のみなさんにも書いていただけたら幸いです。
先行している、Perl-users.jp とも何か協力していけたらいいなぁ。
| パーマリンク
| コメント (0)
| トラックバック (1)
|
■YAPC::Asia 2008 行ってきました
写真ははてなフォトライフにアップしました。（はてなフォトライフのアップロード画面凄い。ビックリしたｗ）
今年は mobile 関連が充実してて、ちょうど欲しい情報が多くて良かった。
Encode::JP::Mobile と Catalyst::Plugin::Unicode::Encoding::MobileAgent を使って絵文字を含んだ文字コードの変換とかやってたんですが、使い方間違ってなくて良かったなぁと再確認しました。
mobile 系のセッションはどこも人が多かったのが印象的でした。
Encode::JP::Mobile は立ち見が出てましたね。
CP:Unicode::Encoding::MobileAgent は、HTTP::MobileAgent::Plugin::Charset を使って、アクセスしてきた端末に適した encoding を選択して、Encode::JP::Mobile で入出力をよしなに変換してくれる Plugin です。この plugin を使うと内部では Flagged UTF-8 として扱えばいいだけなので楽ちんです。
Encode::JP::Mobile は今のところ svn HEAD を使うのが良さそうです。（CP::Unicode::Encoding::MobileAgent は svn HEAD の Encode::JP::Mobile でないと動かなかった）
POD にも書いてありますが、encode_fallback を使って対応絵文字がない場合、img タグに置き換えたり出来るのがいいです。（これは Encode::JP::Mobile の機能ですね）
置き換える画像は TypeCast の絵文字がクリエイティブ・コモンズで公開されているのでそれを使うといいよと教えてもらいました。ありがとう ziguzagu さん。
携帯サイト作り始めたのは最近なんですが、情報とモジュールがすでに充実してて素晴らしいなぁと思いました。
YAPC::Asia に参加した皆さん、スタッフのみなさん、オーガナイザの皆さんお疲れさまでしたー。ありがとう。
あと、lapis25 さんもおつでしたー。部屋がカオスですいませんｗ
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Catalyst::Controller::Resouce を使って、Chained アクション書くのを楽する
追記(2009-05-20T16:46:42+09:00)
現在は Catalyst 5.8 系に対応した C:C::Resources がリリースされており、この方法は使用できません。
Catalyst 5.7 系 + C:C::Resources 0.4 系であれば使用可能です。
追記(2009-06-15T01:02:03+09:00)
perl-mongers.org に Cat 5.8 系の話を書きました。
Catalyst::Controller::Resources で Chaind を楽しよう
ここからもとの文章
本来は REST とかに使うらしい Catalyst::Controller::Resources ですが、このベースとなってる C:C:Resource を使って、自分用 base controller を作って Chained アクションを楽してみます。
（ちなみにヒントはこのあたり (sorry, vag*narepos commiter only.) から得ました。あとは、昔 YAPC か何かで Catalyst::Acrtion::REST を base にしてるのを見たんだけど見つからなかった。）
package Myapp::Web::Base::Controller;
use strict;
use warnings;
use base 'Catalyst::Controller::Resource';
use Catalyst::Utils;
sub setup_collection_actions {
my $self = shift;
my $maps = Catalyst::Utils::merge_hashes($self->{collection} || {}, {
list => { method => 'GET', path => '' },
do_create => { method => 'POST', path => '' },
create => { method => 'GET', path => 'new' },
});
$self->setup_actions(collection => $maps);
}
sub setup_member_actions {
my $self = shift;
my $maps = Catalyst::Utils::merge_hashes($self->{member} || {}, {
show => { method => 'GET', path => '' },
do_update => { method => 'POST', path => 'update' },
update => { method => 'GET', path => 'update' },
do_destroy => { method => 'POST', path => 'delete' },
destroy => { method => 'GET', path => 'delete' },
});
$self->setup_actions(member => $maps);
}
1;
これを controller で継承するとこんなかんじになります。
.-------------------------------------+--------------------------------------. | Path Spec | Private | +-------------------------------------+--------------------------------------+ | /hoges/new | /hoges/collection (0) | | | => /hoges/create | | /hoges/*/delete | /hoges/collection (0) | | | -> /hoges/member (1) | | | => /hoges/destroy | | /hoges | /hoges/collection (0) | | | => /hoges/do_create | | /hoges/*/delete | /hoges/collection (0) | | | -> /hoges/member (1) | | | => /hoges/do_destroy | | /hoges/*/update | /hoges/collection (0) | | | -> /hoges/member (1) | | | => /hoges/do_update | | /hoges | /hoges/collection (0) | | | => /hoges/list | | /hoges/* | /hoges/collection (0) | | | -> /hoges/member (1) | | | => /hoges/show | | /hoges/*/update | /hoges/collection (0) | | | -> /hoges/member (1) | | | => /hoges/update | '-------------------------------------+--------------------------------------'
controller の Chained アクションによるカオスからも解放されます。
試しに制作中の Catalyst アプリで使い始めてます。
ちなみに C:C:Resource は 0.04 で C:C:Resources::Base とかに変わるらしいです。
本来想定していない使い方なので、そのあたりは注意が必要ですね。
と言うか、なにか変わるときは教えてくださいｗ＞ikasam_a さん
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■validation の話
飲み会まとめ - dann@catalyst - Catalystグループ
- Validationをする場所
- Controllerのアクション単位でValidationするとうまく共通化できずに、一箇所変更が入ると他の箇所に影響が波及しやすい。けど、ModelでやるのもFormとModelが1:1に対応してないとValidationをModelでやるのも難しいと。
そうそう、この話は盛り上がってたね。
FormValidator::Simple の作者が居て、いま Validator を新たに作ってる人が二人居たし、Rails はこうだよ的な意見も飛んでた。
自分はホントは HTML 側で Validation したいんだけど、JavaScript 切られてたり、そもそも HTML 越しに来るとは限らないので、仕方なくアプリケーション側でやってるって感じが少しする。
あとは、JavaScript をそんなにすらすら書けないのと、やっぱりそのあたりうまく共通化できないとか個人的な問題はあるんだけど。
やっぱり、ユーザにしてみればその場で間違いを教えてくれるのが良いと思うんだよね。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■perl newbie best practice
昨日の飲み会で聞いた話を自分なりにまとめる。
分からないことがあったら
- google に聞く
- 同僚とか近くの人に聞く
- irc で聞く
- blog に書いてツッコミ待つ
検索して解決策が見つかる場合、それが一番早いと思うので、try する順はこんな感じで。
「一人で悩んでるのは時間の無駄。さっさと聞いた方が良い」って typester さんが言ってた。
この数ヶ月、初めて IRC やったわけですが、perl コミュニティは irc 文化だね。
（他の言語もそうかもしれないけど）
どちらかというと人見知りするんだけど、やっぱりこもってるのは良くないなぁと改めて思いました。
IRC がよく分からない人はIRC の接続の仕方(bayside++)を見るといいよ！
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Catalyst::Plugin::MakeURI コミットした
コミットしてから少し経ってしまいましたが。
元々は、「任意の場所で https なリンクを作りたい」「https な指定をしていても設定によって全部 http にしたい」と思ったのがキッカケなんですが、「どうせだったら base uri も自分で指定出来る uri_for を作ろう」と思って今の形になりました。
使い方は uri_for と同じはずです。
yaml
ssl: 1 base: uri: http://example.com
controller など
# https://example.com/path/to?foo=bar
$c->make_uri_for('https', '/path', 'to', { foo => 'bar' } );
これが、ssl:0 にするとこうなる。
http://example.com/path/to?foo=bar
戻り値は URI オブジェクトですので、戻り値もいじりやすいと思います。（ここも uri_for と同じか。）
コミット後に、ikasam_a さんから BuildURI の説明聞いて、「ああ、なるほど」とか思ったけど、base uri を自分で設定して uri_for したい！ SSL の切り替えしたい！ という人がいたら試してください。
追記
さっき tomyhero さんと話してて、Catalyst::Plugin::RequireSSL 使えば http | https の切り替えは解決することに気がついたよ！
追記2
BuildURI の作者さんからコメント来てたのに気がついてなかった！>_<
コメントありがとうございます！
# zigorou (2008年02月15日 12:14)> base uri を自分で設定して uri_for したい！ SSL の切り替えしたい！
BuildURIで出来ますよ。元々同じように思って作った物なので。
とのことです。
output 重要だなぁ。thanks!
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■Kansai.pm 行ってきました
昨日の Kansai.pm 参加してきました。発表時間が余ったとの話で飛び入りで発表してきました。社内勉強会で使った資料ですが。
発表資料置いておきます。
発表内容は Catalyst についてです。
久々に人前で話したけど、ものすごいあがったよ！ ああいうときは少しゆっくり話すくらいがいいんだけど、そんなことも忘れてマシンガンおつでした。次にこういう機会があったら、スクリーンばっかりじゃなく、聞いてる人たちを見ながらじっくり話せるように注意したいと思います。
懇親会、盛り上がっておもしろかった！
tomyhero さんが予想以上に面白い人だった。
lazy-people 初顔合わせは Kansai!
顔合わせただけで終わった感満載ですが！ｗ
Kansai.pm の皆様、参加された方々、お疲れさまでしたー。
thanks!
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■svk diff に色を付ける
less.sh + less.vim で svn diff の結果をカラーリングしてたんですが、svk diff だと色がつかないので何でかなーと思って調べてみた。
どうやら、vim はファイル名以外にファイルの内容でファイルタイプを決められるとのことなので以下のような内容で ~/.vim/scripts.vim を作って置いたらうまく色がつきました。
if did_filetype() finish endif if getline(1) =~ '^=== ' setfiletype diff endif
追記
id:xcezx さんからツッコミもらいました。
こっちの方が簡単でいいですね。ちょっと試したら出来ましたー。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■DBIx::Class::FromFormValidatorSimple を Data::FormValidator でも使ってみる
id:woremacx さんが作った DBIx::Class::FromFormValidatorSimple、$c じゃなくて $c->form(FormValidator::Simple::Results) を渡すようになって、FV::Simple だけじゃなくて Data::FormValidator も使えるんじゃないかなぁと改造してみた。
（ちなみに自分は Data::FormValidator は使ってないです。試してみたくなっただけ＞＜）
Index: lib/DBIx/Class/FromFormValidatorSimple.pm
===================================================================
--- lib/DBIx/Class/FromFormValidatorSimple.pm (リビジョン 1057)
+++ lib/DBIx/Class/FromFormValidatorSimple.pm (作業コピー)
@@ -16,9 +16,17 @@
sub create_from_fvs {
my ($self, $results, $args) = @_;
- my $allowed = "FormValidator::Simple::Results";
- croak "pass me a $allowed object" unless blessed($results) eq $allowed;
- croak "has error on form" if $results->has_error;
+ my $fvs = "FormValidator::Simple::Results";
+ my $dfv = "Data::FormValidator::Results";
+ if ( blessed($results) eq $fvs ) {
+ croak "has error on form" if $results->has_error;
+ }
+ elsif ( blessed($results) eq $dfv ) {
+ croak "has error on form" if $results->has_missing;
+ }
+ else {
+ croak "pass me a object of $fvs or $dfv";
+ }
my $cols = $args || {};
@@ -39,9 +47,15 @@
sub update_from_fvs {
my ($self, $results, $args) = @_;
- my $allowed = "FormValidator::Simple::Results";
- croak "pass me a $allowed object" unless blessed($results) eq $allowed;
- croak "has error on form" if $results->has_error;
+ my $fvs = "FormValidator::Simple::Results";
+ my $dfv = "Data::FormValidator::Results";
+ if ( blessed($results) eq $fvs ) {
+ croak "has error on form" if $results->has_error;
+ } elsif ( blessed($results) eq $dfv ) {
+ croak "has error on form" if $results->has_missing;
+ } else {
+ croak "pass me a object of $fvs or $dfv";
+ }
my $cols = $args || {};
なんか汚くなってしまったけど意図が伝われば幸い(;'-')
ちなみに試しに動かしてみたコードはこんなの。
#!/usr/local/bin/perl
use strict;
use warnings;
use lib qw( ./extlib ./lib );
use CGI;
use FFVS::Schema;
use Data::FormValidator;
use FormValidator::Simple;
use XXX;
my $schema = FFVS::Schema->connect('dbi:mysql:hoge','hoge','hoge');
my $q = CGI->new;
$q->param(name => 'taro');
$q->param(mail => 'taro@example.com');
$q->param(test => 'waha-');
my $profile = {
required => [qw/name mail/],
};
my $results = Data::FormValidator->check( $q, $profile );
# my $results = FormValidator::Simple->check( $q => [ name => [qw/NOT_BLANK/], mail => [qw/NOT_BLANK/], ] );
$schema->resultset('Test')->create_from_fvs($results,{mail => 'vkgtaro@example.com'});
追記
id:ikasam_a さんがスマートな解決策を提示してくれました。
DBIC::FromFVS を FVS と DFV と その他互換のあるモジュールでも使ってみる
なるほど、納得です。
| パーマリンク
| コメント (4)
| トラックバック (0)
|
■コミケ C72 参加のお知らせ
前回告知してから、放置しすぎましたこの blog。いや、意図的に放置してたわけじゃなくていろいろテンパッててですね気がついたらこんなに間が開いてしまいました(;'-')
んで、予定通り、コミケ C72 にサークル DTR's で参加するので再度お知らせです。
2007年8月17日（金）の場所は東地区カ-29bです。
サークルのトップページにも書いてあるとおり、当日は無償版と有償版の二種類の DVD を配布します。
無償版は会場に来られた方のみ 100 枚限定です。有償版はコミケ終了後、委託販売するらしいです。
僕は無償版に「perl で楽しむプログラミングライフ」、有償版に「Plam で Catalyst を解説するよ」という記事を書きました。もうね、作文が苦手だったのを思い出しつつ、全部ソースコードじゃダメか他の二人に聞いてみようとか頭の中で逃避行動しつつ仕上げました。ニホンゴムツカシイネー。英語はもっとダメだけど。とか言いつつも無償版の方は 1byte のソースコードの断片もないんですが。
ちなみに有償版の記事中に登場する Plam はすでに公開してます。ソースコード読んで、ココがおかしいとか、おまえの頭はおかしいとか、何かしら反応がいただけるとありがたいです。
（記事中ではバージョン 0.01 を扱ってるため、最新版とはちょっと異なってます。）
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Catalyst でテンプレートファイルがあったら表示するの術
スタティックな html 置くにしても、tt でモジュール化したのを上手く使いたいよねー、と言うことでちょっと考えてみた。
Root コントローラでこんな風に書くと、アクセスされた path に対応するテンプレートが /root/src/ 以下にあったら表示するようにできた。表示したいテンプレートの拡張子を .tts に限るようにしてるので、普段使ってるテンプレートが不意に見えてしまうことはないと思う。
sub default : Private {
my ( $self, $c ) = @_;
my $template = $c->req->path . '.tts';
if ( -s $c->path_to( '/root/src/' . $template ) ) {
$c->stash->{template} = $template;
return;
}
$c->res->status(404);
}
ちなみに Root#default で 404 Not Found にしてるのはこちらのアイデアをいただきました。
追記（2007-10-06T19:03:57+09:00）
id:holidays-l さんからご指摘いただきました。
$c->req->path より $c->action の方が良いとのことです。
| パーマリンク
| コメント (0)
| トラックバック (1)
|
■Catalyst で app 生成時に perlcritic なテストを吐く
Test::Perl::Critic は miyagawa さんのやり方をパクって使ってます。
んで、Catalyst で開発するときとか catalyst.pl MyApp した後にわざわざ t/99perlcritic.t なファイル作ってコピペしてたんですが、catalyst.pl MyApp したときに自動で吐くようにしてみました。ので Catalyst::Helper のパッチ。
*** Helper.pm.org 2007-05-26 19:23:49.000000000 +0900
--- Helper.pm 2007-05-26 19:32:56.000000000 +0900
***************
*** 397,402 ****
--- 397,404 ----
$self->render_file( 'apptest', "$t\/01app.t" );
$self->render_file( 'podtest', "$t\/02pod.t" );
$self->render_file( 'podcoveragetest', "$t\/03podcoverage.t" );
+ $self->render_file( 'perlcritic', "$t\/99perlcritic.t" );
+ $self->render_file( 'perlcriticrc', "$t\/perlcriticrc" );
}
sub _mk_cgi {
***************
*** 715,720 ****
--- 717,742 ----
plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
all_pod_coverage_ok();
+ __perlcritic__
+ use strict;
+ use warnings;
+ use Test::More;
+
+ eval { require Test::Perl::Critic; Test::Perl::Critic->import(-profile => "t/perlcriticrc") };
+ plan skip_all => "Test::Perl::Critic is not installed." if $@;
+ plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+ all_critic_ok("lib");
+ __perlcriticrc__
+ # for mkdir $dir, 0777
+ [-ValuesAndExpressions::ProhibitLeadingZeros]
+
+ # we do eval $asset_pl a lot
+ [-BuiltinFunctions::ProhibitStringyEval]
+
+ # no strict 'refs'
+ [TestingAndDebugging::ProhibitNoStrict]
+ allow = refs
__cgi__
[% startperl %]
意外と引っかからないなぁとか思ってたけど、severity を 1 にしたら結構色々言われました。こういうの見るとなるほどなぁとも思うんだけど、RCS keywords $Id$ not found とか言われるのはうっとうしいので severity は 1 にして、perlcriticrc を編集したらいいかなぁ。（ちなみに上のパッチは default の 5）
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■DBIC の Component を書いてみる。
WEB+DB PRESS の id:naoya さんの連載（Vol35, Vol36）を読んだり YAPC::ASIA 2007 での id:nekokak さん（資料）、id:tokuhirom さん（資料）の講演を拝聴したりして、最近はちょこちょこと DBIx::Class を使い始めてます。
んで、理解を進めるために自分で Component を書いてみました。Crypt::OpenPGP を使って、DB に突っ込むときに暗号化、取り出すときに復号化する Component です。
package DBIx::Class::OpenPGPColumns;
use strict;
use warnings;
use base 'DBIx::Class';
use Crypt::OpenPGP;
__PACKAGE__->mk_classdata( '_openpgp_columns' );
__PACKAGE__->mk_classdata( 'recipients' );
__PACKAGE__->mk_classdata( armour => 1 );
__PACKAGE__->mk_classdata( 'passphrase' );
=head2 openpgp
=cut
sub openpgp {
my $self = shift;
$self->{_openpgp} ||= Crypt::OpenPGP->new;
$self->{_openpgp};
}
sub openpgp_columns {
my $self = shift;
if (@_) {
foreach my $col (@_) {
$self->throw_exception("column $col doesn't exist")
unless $self->has_column($col);
}
return $self->_openpgp_columns({ map { $_ => 1 } @_ });
}
else {
return $self->_openpgp_columns;
}
}
sub get_column {
my ( $self, $column ) = @_;
my $value = $self->next::method($column);
my $cols = $self->_openpgp_columns;
if ( $cols and defined $value and $cols->{$column}) {
$value = $self->openpgp->decrypt(
Data => $value,
Passphrase => $self->passphrase,
);
}
$value;
}
sub store_column {
my ( $self, $column, $value ) = @_;
my $cols = $self->_openpgp_columns;
if ( $cols and defined $value and $cols->{$column}) {
$value = $self->openpgp->encrypt(
Data => $value,
Recipients => $self->recipients,
Armour => $self->armour,
);
}
$self->next::method( $column, $value );
}
1;
使うときは他の Component と同じように呼び出します。
package MyApp::Schema;
use strict;
use warnings;
use base qw/DBIx::Class::Schema::Loader/;
__PACKAGE__->loader_options(
debug => 0,
components => [qw(
OpenPGPColumns
)],
);
1;
んで、各テーブルクラスで recipient, passphrase, openpgp_columns をセットします。
package MyApp::Schema::User;
use strict;
use warnings;
__PACKAGE__->recipients('key id');
__PACKAGE__->passphrase('pass phrase');
__PACKAGE__->openpgp_columns(qw/secret/);
1;
これで create / update するときは暗号化されて、取り出すときは復号化されるようになりました。
参考にしたモジュール
- DBIx::Class::DigestColumns::Lite
- DBIx::Class::UTF8Columns
- DBIx::Class::Manual::Component
- DBIx::Class::InflateColumn::DateTime
| パーマリンク
| コメント (7)
| トラックバック (0)
|
■kansai.pm 行ってきました。
9 日の夕方には京都入りして、 AzureStone 氏の勤める会社にご挨拶に伺ったあと、そのままいつものように AzureStone 邸に宿泊させていただく。3日間お世話になりました。いつもありがとう！
んで今回の目的の kansai.pm ですが、遅刻してすいませんでした。元々方向音痴なんだけど、ちょっとトラブルがあって目的地を見失い、macbook 開いて検索とかしてました。（住所がわかんなくて、ガススタで「おやまビルかこやまビルか読み方わかんないんですけど、そういうビル近くにありませんか？」とか「北ってどっちですか？」とか「あれ、川って渡るんだっけ？」とかパニクりまくり。）
- はこべさんの発表の途中からでした。中島さん、はこべさん、すいませんごめんなさい。
- AzureStone さん「TripltaiL を選択した理由」
- 昨年末に勉強会で話してもらったプレゼンの改良版。遅刻した動揺から緊張していたようです(；'-')ゴメンよー。
- 次は実際に作ったものを用意したいとのこと。
- 一応補足しますが、僕は CGI::Application だけじゃなくて Catalyst も使ってます。要件によって使い分けてますよ。
- id:lapis25 さん「オブジェクト指向言語Perl」
- 資料お疲れさまでした。
- プレッシャーが大変だったらしい
- メイドコスプレ超うらやましい！！！奥さんについてｋｗｓｋ！
- Kansai.pm Perl 勉強会を4月か5月から定期的に始めるらしいです。関西圏の Perl Monger さんいかがですか。
- 僕はさすがに定期的には行けませんｗ
- CATWALK 萩原さん「Catalyst入門」
- Java, PHP, Perl, Ruby, Python といった言語とそれぞれの言語でよく使われてるフレームワークの分析が面白かった。
- フレームワークごとに使われてるサイトの紹介とか。
- 実は萩原さんが昔書いたコードを読む機会があったので、どんな方なのか楽しみにしてました(；'-')
懇親会でお話しできて良かったです。 - 少し余った時間で雑学 Perl クイズとか。
- オライリの正規表現本は題名に Perl って入ってません＞自分
- はてダの方に、ドメインだけ小文字化の URI モジュール使用版書いてみました。
- 懇親会
- perl より鍋。
- perl より雑炊。
- perl よりうどん。
- 食うの速すぎｗ
- 読んでる blog の人が何人かいらっしゃっいました。
- 自分の blog 読んでくださってる方がいた。技術系の話題が薄くてすいません＞＜
- id:fbis さん、id:penguin_niisan さん、えのきさん、id:lapis25 さん、AzureStone さんとで2次会
- id:fbis さんは「エフビス」さんじゃなくて「エフビーアイズ」もしくは「エフビーアイエス」さん
- id:fbis さんに持ってかれてたｗ
- id:penguin_niisan さんのやりとりも面白かったですｗ
- キュウリ無いのかよ
- サーモン酸っぱい
- 鶏の唐揚げ酸っぱい
- DBIC の Component を DBIC から出してよ。Class::Component とかにしてよ。
- タイトル聞いただけで弾さんのエントリだとわかる脳内 DB
こんなところでしょうか。後半 id:fbis さんだらけですがｗ
とにかくすごい楽しかったです。YAPC::Asia でも再会できそうな方も何人かいらっしゃったので、楽しみが増えました。kansai.pm にはまた、都合と予算が合えば行って見ようと思います。
皆様お疲れさまでした。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■livedoor テクノロジーセミナー行ってきました。
ちょっと出遅れましたが水曜日、livedoor テクノロジーセミナー行ってきました。
えと、詳しく書いている方がいらっしゃるのでそちらを参照していただいて、個人的な感想をば。
はてなの伊藤さんの話。はてブのユーザって、YAPC の時が 35,000 Users だったそうですから、倍近く増えてるんですねー。
はてなは今まで Perl 一筋なイメージがあったけど、Ruby を使う方が現れてから最近は Ruby も使うようになって幅が広がってきたとか。新しい血を取り込み始めたと言うところでしょうか。
LVS を MySQL 群の前に入れるって話は懇親会で同席した方々も「あのアイデアはいい」って盛り上がってましたよ。
それから、livedoor の ma.la さんの話。
Web アプリならではの利点から、いかにユーザを待たせることを無くすかと言った話まで、最速へのこだわりが伝わってきました。
『 「UIの速さ」は「サーバー速度」ではない』のあたりはすごく納得した。ユーザが気にするのは、Apache の反応速度じゃなくてレンダリング速度といったあたりとか、「おお、なるほど。」と思わされました。
あと、はてなの伊藤さんと livedoorの池邉さんの対談。ちょっと時間が押し気味で少し駆け足だったけど、その分盛り上がって濃密な対談になってました。企画屋さんの話が面白かったです。
セミナーが始まるまでに、席に用意されていた livedoor のパンフに池邉さんのお話しが載ってますが、こちらも興味深いです。パソコン博士に浸透したことが livedoor blog の普及につながった話とか。
んで、引っ込み思案なくせしてまたしても懇親会にまで行ってきましたよ。僕は緊張すると無口になるほうなんですが、前に座っていた方がものすごい喋りまくってて面白かったです。perl のソース読んだ話とか、GDB でデバッグとかｗ 一粒で二度美味しいセミナーでした。セミナーを主催していた livedoor の皆様、お疲れさまでした。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■京都へ行ってきました。
この週末、京都は AzureStone さん宅へ PIA さんと slp さんと僕で集まりました。
木曜夜
- PacketiX のセットアップに Skype で AzureStone さんに手伝ってもらいながら四苦八苦。
- Golden Eggs をつたくから返してもらう（お忙しいところありがとう）
金曜朝
- 出発時刻に目が覚める orz
- 出社してきたユースケさんに留守をお願いしますと伝えて出発。
金曜昼
- 新横浜にて AzureStone さんからモーニングコールｗ 前日の Skype が応えたようで寝坊したらしい（申し訳ナス）
- 自由席で充分だろと思っていたら、名古屋まで座れず orz
- 名古屋から座れたーと思って、ガリガリ作業してたらいつの間にか「もうすぐ京都」のアナウンス。焦って Mac をしまう。
- AzureStone さん宅最寄りの駅に到着。電話してみるが連絡つかず。
- AzureStone さん宅前に到着後、電話してみるが連絡つかず。
- とりあえず駅まで戻って喫茶店でも探そうかと思ったら前方から見覚えのある人が自転車で登場ｗ
- 僕の遅刻で到着時刻の推測がずれたらしい(；'-')
- パンチカーペットを敷くのを手伝って、こたつ布団取りに行くついでに遅いお昼ご飯を一緒に食べる。
- ひつまぶし久々！
- 紅玉林檎パフェうめぇｗｗｗｗｗｗｗ
金曜夜
- slp さん合流。
- AzureStone さん越しに知り合い、東方シリーズを教えてもらったりとネットでは交流があったんですが off で会うのはこれが初めて。
- 挨拶も早々にゲームセンターに行ってみたり。
- AzureStone さん、車のゲーム上手くなってたｗｗ
- 源平討魔伝があったんだけど懐かしんでいたのは僕だけでした。早くもジェネレーションギャップｗ
- 夕飯は、お好み焼き。お昼が遅かったんで、すぐおなかいっぱいになったけど AzureStone さんは相変わらずたらふく食べてましたｗ
- AzureStone さん宅に戻ってからは、slp さんの液晶モニタをセットして、東方やったり。
- 花映塚久々にやりました。コントローラ持っていって良かったｗ
土曜
- 予定通り 9 時には目を覚まし、眠気と戦ってました。
- 雑魚寝が辛い歳になったと痛感した＞＜
- 発表資料が完成してなかったので、ちょっと作業させてもらったりとか。
- 県庁の星を見たりとか。織田裕二は凹凸の激しい人生が似合うよｗ 「お金がない」をちょっと思い出しました。
- お昼頃から、PIA 師匠も合流。お久しぶりです。去年の GW 以来です。仕事が山場に突入してるようでした。お疲れさまです。
- 自分もちょっと、困った事態があったので少し聞いてみたりｗ
- PIA さんおすすめのコードギアスの 1 話を見る。つ、続きが気になる(；'-')
- 全員そろったところで恒例の焼き肉へ。
- AzureStone さんのハイペースな食べっぷりを知っている三人なので、とことん自分たちのペースを守るよう焼いてたｗ
- はてセリの「恐怖のメカニズム」が大ヒットｗ
- PIA さんは仕事の都合により、この日のみの出番となりました。残念。また次回お会いしましょう。年末？ｗ
日曜
- 起きてから、創聖のアクエリオンを 8 話まで見る。主題歌だけ買ってしまってたんだけど、初めて見たｗ
- お昼ついでに京都観光へ。おみやげ屋さんの目星もつけつつ、適当に昼食を取って、クレープを食べながら帰る。渡船があったので乗ってみようかと思いきや、結構なお値段だったので全員どん引きしてスルー。
- 戻ってきてから、勉強会を開始。
AzureStone さん「Tor + Plagger - 匿名通信による情報収集」
関西 OSS 2006 の再演ですね。右下消してない奴見られた。
slp さん「PC-WRAP によるお手軽ルータ」
すごく丁寧に作り込まれた資料を渡してもらって、それを見ながら説明していただきました。
（PC Engines 社という名前が出てくるたびに違うものを想像していたりｗ）
自分「私と私の開発環境について」
初対面の人もいるし、自己紹介を兼ねて、開発環境晒しをしました。今回集まる人の半数が運用系だったので、逆に面白いかなと思って。後で資料 up します。
AzureStone さん「TripletaiL を選択した理由」
今作りたいものがあるそうで、perl でフレームワークを選ぶ際にどうして TripletaiL を選んだのか、色々と理由を説明していただきました。
自分「Template-Toolkit」
本当は、さらに O/R マッパの説明も経て、Catalyst (not Cisco) までやりたかったんだけど資料を作るのが間に合わなくて小さくまとまりました。
これも後で up します。ちょっと無修正では up できない(；'-')
- そうこうしているうちに slp さんの帰宅時間に。
- 最寄り駅まで送ってくる。年末にまたお会いしましょう。
- 夕飯は AzureStone さんおすすめのラーメン屋に。またまたたらふく食べました。
- 帰ってきてから、バトルプログラマーシラセを 3 話まで見る。
月曜日
- いろんな疲れが出てついに昼起きでした(；'-')
- 昨日観光に行ったところへ出かける。お土産買いがてらお昼をすませる。でかい苺ショートケーキワロス。そしてまたクレープを食べながら帰る。
- 資料ができあがらなかったとのことですがせっかくなので、Fedora Core 6 の Desktop 環境について色々説明していただきました。
Gnome と言うと自分が初めて動かした Linux である Kondara/MNU を思い出すのですが、もう全然違うものでした。Mac OS X で驚いている場合ではなかった。 - そして、AzureStone さんに京都まで送ってもらい無事高幡不動へ帰還。
総括
アニメを途中まで見せられるのはものすごい罠だ。続きが気になる。
それでは仕事頑張ります。眠い(；'-')
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Class::DBI::Sweet の page メソッド
BETWEEN で空白混じった文字列使うとおかしな事になるような。
my $criteria = {
created_on => {
-BETWEEN => [
'2006-10-16 00:00:00',
'2006-10-18 00:00:00',
]
}
};
my ( $pages, $iter ) = Hoge::Model::DB::Bar->page(
$criteria,
{
rows => 20,
page => 1,
}
);
発行されたクエリ。一個目はページャ用のカウント。
SELECT COUNT(*)
FROM bar me
WHERE ( me.created_on BETWEEN '2006-10-16 00:00:00' AND '2006-10-18 00:00:00' )
んで二個目がイテレータ、なんだけど、二つめの値が空白から切り捨てられてる。
（追記：切り捨てられてるのはどう見てもハイフンから先。空白関係ない。）
SELECT me.id
FROM bar me
WHERE ( me.created_on BETWEEN '2006-10-16 00:00:00' AND 2006 ) LIMIT 0, 20
Class::DBI::Sweet の中身ちょっとのぞいたけど、深追い出来ず断念。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■復旧！
私は帰ってきた！！ということでサーバ復旧しました。
事の発端は、
WARNING: Kernel Errors Present
end_request: I/O error, dev 03:02 (hda)...: 1Time(s)
hda: dma_intr: error=0x40 { Uncorrect...: 1Time(s)
hda: dma_intr: status=0x51 { DriveReady SeekComplete Error }...: 1Time(s)
と言ったログを発見したからなんですが、よく見逃さなかったなーと自分に対して思います。
わからないなりにもログに目を通していて良かった。
この blog は、さくらインターネットさんの専用サーバにお世話になっているのですが、上記のログをメールしたらすぐご連絡を頂き、HDD 交換と OS の再インストールを勧められました。（OS の再インストールは有償なのですが、今回はハードウェアの異常が原因なので無償対応していただきました。）
で、今まで Redhat 9 を使っていたんだけど、もうさくらさんでは扱っていないとのことで、CentOS 4.3 に。
「CentOS だったら任せておけ！」と色々相談にのってくれた AzureStone さんありがとう。
↑ちょうど CentOS の特集が組まれてたのでリンク。今回、OS のインストールまではさくらさんにお任せだったんだけど、手元でやるときキックスタートは良さそうですね。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■サーバメンテナンスのためアクセスできなくなります。
この blog が置いてあるサーバの HDD に異常の兆候が見られたので、08月31日（木）にメンテナンスを行います。
当日は終日アクセス出来なくなると思われますがご了承ください。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■はてブと del.icio.us と LivedoorClip に同時ブクマ
以前から miyagawa さんの sbm-xpost を使ってはてブと del.icio.us にクロスポストしていたんですが、Livedoor Clip にも対応してみよう、ということでやってみました。
Livedoor Clip への投稿には、はてブのブクマを livedoor クリップにクリップしてみる件 - にぽたん研究所 の WWW::SyncSBS::H2L を使わせていただきました。（三つ同時ポスト前に同期取るのにも使わせてもらいました。）
そんなわけで、今後は Livedoor Clip にもお世話になります。
sbm-xpost.cgi （改造版）
#!/usr/local/bin/perl
use strict;
use CGI;
use DateTime;
use Encode;
use HTTP::Request::Common;
use LWP::UserAgent;
use Template;
use XML::Atom::Entry;
use XML::Atom::Client;
use YAML;
use lib qw( ./lib );
use WWW::SyncSBS::H2L;
(my $config = $ENV{SCRIPT_FILENAME}) =~ s/\.cgi$/.yaml/;
our $conf = YAML::LoadFile($config);
my $q = CGI->new;
if ($q->request_method eq 'POST') {
do_post($q);
} else {
do_form($q);
}
sub do_form {
my $q = shift;
print $q->header('text/html; charset=utf-8');
binmode STDOUT, ":utf8";
my $tt = Template->new;
$tt->process(\<<TEMPLATE, { q => $q });
<html>
<head>
<title>del.icio.us and Hatena cross-poster</title>
<style>body { font-family: trebuchet MS, Arial; font-size: 13px }</style>
<body onload="document.forms[0].tags.focus()">
<h1>del.icio.us and Hatena cross-poster</h1>
<form action="[% q.url('-query'=>0) %]" method="post">
<table>
<tr><td style="text-align:right">URL:</td><td><input size="64" type="text" name="url" value="[% q.param('url')|html %]" /></td></tr>
<tr><td style="text-align:right">Title:</td><td><input size="64" type="text" name="title" value="[% q.param('title') | html %]" /></td></tr>
<tr><td style="text-align:right">Comment:</td><td><input size="64" type="text" name="comment" /></td></tr>
<tr><td style="text-align:right">Tags:</td><td><input size="64" type="text" name="tags" /></td></tr>
</table>
<input type="submit" value=" Save " />
</form>
<div><a href="javascript:location.href='[% q.url %]?url='+encodeURIComponent(location.href)+'&title='+encodeURIComponent(document.title)">bookmarklet</a></div>
</body>
TEMPLATE
;
}
sub do_post {
my $q = shift;
post_delicious($q);
post_hatena($q);
post_livedoorclip($q);
my $url = URI->new("http://www.google.com/url");
$url->query_form(sa => 'D', q => $q->param('url'));
print $q->redirect($url);
}
sub post_delicious {
my $q = shift;
my $url = URI->new("https://api.del.icio.us/v1/posts/add");
$url->query_form(
url => $q->param('url'),
description => $q->param('title'),
extended => $q->param('comment'),
tags => $q->param('tags'),
dt => DateTime->now,
);
my $ua = LWP::UserAgent->new;
$ua->credentials("api.del.icio.us:443", "del.icio.us API", $conf->{delicious}->{username}, $conf->{delicious}->{password});
my $res = $ua->get($url);
warn $res->status_line unless $res->is_success;
}
sub post_hatena {
my $q = shift;
my $summary = join '', map "[$_]", split /\s+/, $q->param('tags');
$summary .= " " . $q->param('comment') if $q->param('comment');
Encode::_utf8_off($summary);
my $entry = XML::Atom::Entry->new;
my $link = XML::Atom::Link->new;
$link->rel('related');
$link->type('text/html');
$link->href($q->param('url'));
$entry->add_link($link);
$entry->summary($summary);
my $client = XML::Atom::Client->new;
$client->username($conf->{hatena}->{username});
$client->password($conf->{hatena}->{password});
$client->createEntry("http://b.hatena.ne.jp/atom/post", $entry)
or warn $client->errstr;
}
sub post_livedoorclip {
my $q = shift;
my $h2l = WWW::SyncSBS::H2L->new;
$h2l->livedoor_id( $conf->{livedoor}->{username} );
$h2l->password( $conf->{livedoor}->{password} );
$h2l->login_livedoor_clip
or warn 'failes to login to livedoor clip';
my @tags = split(' ', $q->param('tags') );
my $postdata = [{
url => $q->param('url'),
title => $q->param('title'),
tags => \@tags,
summary => $q->param('comment')
}];
$h2l->clip_to_livedoor( $postdata );
}
sbm-xpost.yaml
delicious:
username: yourname
password: password
hatena:
username: yourname
password: password
livedoor:
username: yourname
password: password
Original(Revision 1918) との差分
12a13,15
> use lib qw( ./lib );
> use WWW::SyncSBS::H2L;
>
53a57
> post_livedoorclip($q);
94a99,117
>
> sub post_livedoorclip {
> my $q = shift;
> my $h2l = WWW::SyncSBS::H2L->new;
> $h2l->livedoor_id( $conf->{livedoor}->{username} );
> $h2l->password( $conf->{livedoor}->{password} );
> $h2l->login_livedoor_clip
> or warn 'failes to login to livedoor clip';
> my @tags = split(' ', $q->param('tags') );
>
> my $postdata = [{
> url => $q->param('url'),
> title => $q->param('title'),
> tags => \@tags,
> summary => $q->param('comment')
> }];
> $h2l->clip_to_livedoor( $postdata );
>
> }
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■マンガの新刊を iCal で追いかける
まんが王倶楽部さんで配布されている新刊 の CSV を iCalendar 形式にする web app を作りました。（元ネタ）
iCal 形式のデータが読めるアプリだったら使えると思います。（Google Calendar と iPod しか試してない）
Google Calendar に import する手順はこんな感じです。
- 右上の Settings をクリック
- Calendars タブを選ぶ。
- 一番下にある add calendar をクリック
- Public Calendar Address タブを選ぶ。
- Comic2iCal で出てきた iCal の URL を入力して add ボタンを押す
Google Calendar は反映するのに多少時間かかるので適当に待ってください。
参考にさせていただきました。
Comic2iCal.pm
package Comic2iCal;
# $Id: Comic2iCal.pm 34 2006-07-17 00:16:08Z taro $
use warnings;
use strict;
use Carp;
use base qw( Class::Accessor::Fast );
use Readonly;
use DateTime;
use LWP::UserAgent;
use Text::CSV::Simple;
use Encode qw( from_to );
use Date::ICal;
use Data::ICal;
use Data::ICal::Entry::Event;
__PACKAGE__->mk_accessors( qw(cache date ua csv) );
Readonly my $base_uri => 'http://www.mangaoh.co.jp/download/comic';
our $VERSION = '0.2';
sub new {
my ($class, %fields) = @_;
my $self = bless {}, $class;
$self->cache( $fields{cache} || './cache' );
$self->date( DateTime->now( time_zone=>'local' ) );
$self->ua( LWP::UserAgent->new );
$self->ua->agent( 'Comic2iCal/' . $VERSION );
$self->csv( Text::CSV::Simple->new({binary=>1}) );
$self;
}
sub get_csv {
my $self = shift;
my $url = $base_uri . $self->date->strftime('%Y%m') . '.csv';
$self->ua->mirror($url, $self->cache);
}
sub search {
my $self = shift;
my @keys = @_;
$self->csv->field_map(qw/publisher date title writer price/);
my @datas = $self->csv->read_file( $self->cache );
my $ical = Data::ICal->new;
$ical->add_properties(
'X-WR-CALNAME' => join(' ',@keys),
);
for my $data ( @datas ) {
my $hit = 0;
next unless defined($data->{writer});
from_to($data->{writer}, 'sjis', 'utf8');
for my $key ( @keys ) {
$hit = 1
if ( $data->{writer} eq $key );
}
next unless $hit;
from_to($data->{title}, 'sjis', 'utf8');
from_to($data->{date}, 'sjis', 'utf8');
my $event = Data::ICal::Entry::Event->new;
my @date = split('/', $data->{date});
if ( $date[2] eq '上' ) {
$date[2] = 1;
} elsif ( $date[2] eq '中' ) {
$date[2] = 15;
} elsif ( $date[2] eq '下'
or $date[2] eq '末'
or $date[2] eq '未' ) {
my $dt = DateTime->last_day_of_month(
year => $date[0],
month => $date[1]
);
$date[2] = $dt->day;
}
$data->{date} = sprintf("%04d%02d%02d" , @date );
$event->add_properties(
summary => $data->{title},
description => $data->{price},
dtstart => $data->{date},
);
$ical->add_entry($event);
}
return $ical->as_string;
}
1;
__END__
=head1 NAME
Comic2iCal - まんが王倶楽部さんで配布されてる CSV を ical にする
=head1 SYNOPSIS
use Comic2iCal;
my $c2i = Comic2iCal->new;
$ci->get_csv;
print $ci->search( qw(椎名高志 ゆうきまさみ) );
=head1 DESCRIPTION
まんが王倶楽部さんで配布されてる CSV を取得し、
特定のマンガ家で絞り込んだ ical を出力します。
=head1 Methods
=over
=item new
コンストラクタです。
=item get_csv
まんが王倶楽部から CSV をダウンロードしてきます。
=item search
絞り込みたいマンガ家をリストで渡すと ical データを返します。
my $ical $ci->search( qw(椎名高志 ゆうきまさみ) );
=back
=head2 アクセサ
=over
=item cache
cache の場所を指します。
=item date
DateTime オブジェクトです。
$c2i->date->set(
year => 2006
month => 07
);
=head1 AUTHOR
Daisuke Komatsu C<< <taro@cpan.org> >>
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2006, Daisuke Komatsu C<< <taro@cpan.org> >>. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■（有）椎名百貨店 完成原稿速報の EntryFullText
うまく取れてるからたぶん大丈夫。
cna100.yaml
# cna100
author: taro
custom_feed_handle: http://www\.ne\.jp/asahi/cna100/store/news/
custom_feed_follow_link: \d{6}/\d{6}.htm
handle: http://www\.ne\.jp/asahi/cna100/store/news/\d{6}/\d{6}.htm
extract: <P>(.*)<P><FONT SIZE="-1"><TABLE BORDER=0 BGCOLOR="#009999" CELLSPACING=0 CELLPADDING=0 WIDTH="100%" HEIGHT=5>
extract_capture: body
config.yaml
include:
- /home/taro/plagger/global.yaml
plugins:
- module: Subscription::Config
config:
feed:
- url: http://www.ne.jp/asahi/cna100/store/news/news.htm
- module: CustomFeed::Simple
- module: Filter::EntryFullText
- module: Publish::Gmail
config:
mailto: foo@example.com
mailfrom: foo@example.com
mailroute:
via: smtp
host: localhost
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■CustomFeed::HatenaDiaryRSS
はてなダイアリを private mode で使ってる友達がいて、それも plagger で読めたらいいよね、ということで作ってみた。
package Plagger::Plugin::CustomFeed::HatenaDiaryRSS;
use strict;
use warnings;
use base qw( Plagger::Plugin );
use WWW::Hatena::Scraper;
use XML::Feed;
sub register {
my ( $self, $context ) = @_;
$context->register_hook( $self, 'subscription.load' => \&load, );
}
sub load {
my ( $self, $context ) = @_;
my $feed = Plagger::Feed->new;
$feed->aggregator( sub { $self->aggregate(@_) } );
$context->subscription->add($feed);
}
sub aggregate {
my ( $self, $context, $args ) = @_;
my $whs = WWW::Hatena::Scraper->new;
my $username = $self->conf->{username};
my $password = $self->conf->{password};
$whs->login( $self->conf->{username}, $self->conf->{password} )
or $context->log( warn => "Hatena login failed" );
my $content = $whs->get_content("http://d.haetna.ne.jp/");
my $rk = $whs->rk;
my $whs2 = WWW::Hatena::Scraper->new;
$whs2->login($rk)
or $context->log( warn => "Cookie is invalid or expired!" );
my $uri = 'http://d.hatena.ne.jp/' . $self->conf->{target} . '/rss';
$content = $whs->get_content($uri);
my $datas = eval { XML::Feed->parse( \$content ) };
unless ($datas) {
$context->log( error => "Error loading feed $uri: "
. ( $@ || XML::Feed->errstr ) );
return;
}
my $feed = Plagger::Feed->new;
$feed->type('hatena-diary');
$feed->title( $datas->title );
$feed->link($uri);
for my $data ( $datas->entries ) {
my $url = $data->link or next;
my $entry = Plagger::Entry->new;
$entry->title( $data->title );
$entry->link( $data->link );
$entry->author( $data->author );
$entry->body( $data->content->body );
$feed->add_entry($entry);
}
$context->update->add($feed);
}
1;
yaml はこんな感じ。
- module: CustomFeed::HatenaDiaryRSS
config:
username: your id
password: your password
target: target id
もちろん、id で許可されてないと読めません。
これちょっと変えるとはてブでも使えたりするんだけど、モジュール名がいい名前浮かばなかったので('-'；)
CustomFeed::HatenaRSS だと、はてな RSS ？とか思っちゃうし。あー、ターゲットをリストできるといいよね。何より同じ事してる plugin がないか心配ｗ
ちなみにあちこち参考にさせていただきました。あちこち参考にしすぎてそれと言えなくなってます(；'-')
WWW::Hatena::Scraper の部分は、Synopsis まんま('-'；)
追記
miyagawa さんから反応いただきました。
subtechグループ - Bulknews::Subtech - [Plagger] RSS with Authentication
はてなダイアリにログインした状態の Cookie ファイルをつくって (firefox か w3m など）
（省略）で、できるはず。
Cookies について理解してませんでした(；'-')
また無駄な苦労を orz
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■CPAN Author になりました。
さてやっとこさ、エイプリルフールネタですよ。じゃ無くてホントです。嘘じゃありませんって！
初 CPAN モジュールは Template-Toolkit の plugin です。Template::Plugin::PwithBR。段落を <p> でくくり、改行を <br /> に変換するだけ。それだけなんだけど、見当たらなかったんですよ。
html_para と html_break もしくは html_line_break をいろいろ組み合わせてみても期待した形にはならないんだよねぇ。それでいつも
$self->tt_config(
TEMPLATE_OPTIONS => {
RELATIVE => 1,
FILTERS => {
br => sub {
my $text = shift;
$text =~ s/(?<!\n)\n/<br>\n/g;
return $text;
}
}
},
);
こんなコード書いて、
[% text | br | html_para %]
こんな風に使ってました。きっかけは、id:nekokak さんの Kitten で html_line_break だけ使われてるの見たとき。あー、やっぱりそういうのは無いっぽいなと。（ちなみに Template の ML にも投げてみましたが反応ﾅｽ(´･ω･`)）
まーそんなこんなで、あまり他の人は気にしていないかもしれない地味なところからスタート。今後も微妙な線を突いていく CPAN Author として頑張ります。（今回もそうだけど、ネーミングセンスの無さは心配ｗ）
| パーマリンク
| コメント (7)
| トラックバック (0)
|
■YAPC::Asia 行ってきました。
うは、4/1 になってしまった。まぁ、嘘のような夢のようなという感じでしたのでそれはそれで、いまさらながらの感想をば。2日分まとめちゃったので、2日目の方にトラックバック。
とにかく、2日間楽しかったです。Shibuya.pm スゲーなーと改めて思った。perl のウリは、CPAN だけじゃない。perl には、すばらしい Perl Monger がたくさんいる。こういうイベントに参加するとそれを実感する。
- 流石にノート PC 持ってきてる多かった。
- 英語は全然わからないんだけども、スライドが日本語だったり、英語に訳がついてたりして理解は出来た。
- 笑いどころもわかったしね！（というか、speaker が上手い。）
- 海外組のノリのよさが楽しかった。
- 宮川さんの speech 、弾さんいじりウケタｗ
- Introduction to Pugs -- Audrey Tang さん
- （Pugs を指して）That is Toy! って言ってた。（これは聞き取れたｗ）ここのスライドの流れも印象的。楽しんでるなぁと思った。
- これで一気に興味が沸き、翌日 Learning Haskell を聞く事にした。
- Manuplexity*Manuplexity キッチリ*サクサク
- 抽象化はセクシーってのを聞いて、エッチじゃないのにエッチに聞こえる言葉を思い出したｗ しかもかなり納得したｗ 確かにセクシーな気がするｗ
- このあたりから、Audrey さんは語感のセンスがスゴイと思った。
- Module::Compile の セッションで Ingy さんはオノの話でモヒカンっぽい頭してたので、モヒカン族をおも（ｒｙ
- ちなみにソースフィルタリングが良く分かって無いので、Module::Compile が何者なのか結局理解できず orz
- Ruby on Perl(s) -- まつもとゆきひろさん
- Ruby は日本語的
- Perl は Unicode。Ruby は文字コードを切り替えるよ。
- Ruby の japh はアニメーション！！（ruby なので、 jarh ?）
- Plagger - RSS/Atom remixing platform -- 宮川さん
- ショコたんのメポッに笑った。
- Gmail に送るときは、+ 拡張使うと他のメールに混じらなくていい。（フィルタも作りやすい）
- widget はウィジェット（今まで読みがわからなかった。
- 高橋メソッドの高橋さん本家本元ｷﾀ━━━(ﾟ∀ﾟ)━━━━!!
- Ruby は使っているうちに洗脳していく Babel 17
- この一日でかなり Ruby に興味が出たよ。高橋メソッド恐るべし
- Perl Best Practices -- Damian Conway さん
- Damian カッコイイ。
- 今日のスライド、こんなのが多かったよね、と言った矢先に画面がグリーンにｗ
- Best Practices は習慣であって、規則じゃない。
- Perl Best Practices 買う決意したｗ
- 懇親会ではなんとか懇親できました。同じ席だった方ありがとう。
Larry と Damian にはさまれて写真！おまえさんありがとう！- このとき、Larry から T シャツにツッコまれた。
Larry「oh! geek! otaku?」
たろ「あーと、nerd!」（英語にも日本語にもなって無い返しｗ）
- Perl 5.8 and Unicode: Myths, Facts and Changes -- 弾さん
- Template Toolkit の方も気になったんだけど、やっぱりこっちの話も気になったので。
- utf8 flag の扱いがおかしいモジュールにはどんどん patch を送れ！
- 弾さんは use Encoding を推奨してない。
- レキシカルじゃない
- 少なくともモジュールでは使うな。
- use Encoding はあくまで下位互換性のため
- Perl 5.8 で Jcode は Encode の Wrapper の役割をするとかって話は、弾さんの blog あたりで見た気がするんだけど、ブクマ探しても見つからず。
- Perl 6 Update -- Damian さん
- ネコミミ演算子のところで Larry がネコタンネコタンって言ってたｗ
- package 宣言があれば、perl 5 として動作するので、CPAN もそのまま生かせる。
- p52p6 って言う perl5 の script を perl6 に変換するツールもあるらしい。
- Perl DateTime project -- Dave Rolsky さん
- 気になって聞いてみたけどやっぱり英語が……
- epoch がアペックって聞こえた。何メモッてるんだこれｗ
- Datetime は perl の core には入らないと思うよ
- Perl6 でも動くようにしてるよ
- Audrey の Learning Haskell も英語の壁を越えられなかった。もったいない。（というかちょっとうとうとしてた。スミマセン。）
- 他の発表の時と比べてじっくり話してた印象
- Getting Your Feet Wet With XS -- Daisuke Maki さん
- 前が少し押し気味だったので遅れて会場到着
- CPAN で英語がわからんときにソース見て、XS の壁にぶち当たる事がたまにあったけど、ちょっと氷解したかも。
- Inside Hatena::Bookmark's Backend で ハテナオヤさんが言ってた竹迫さんの資料ってこれだと思う。
- Lightning Talk はどっかんどっかん会場沸いてた。面白かった。
- Larry Wall さんの Keynote も英語の壁を越えきれず。何だけど Larry さんのさとすような話し方にただただ耳を傾けておりましたよ。駱駝・落第・楽だ
最初にも書いたけど、ホント二日間楽しかったです。Sibuya.pm はスゴイ。スタッフの方々、お疲れ様でした。そして、ありがとうございました。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■plagger 0.5.4 -> 0.5.7
0.5.4 使ってたんだけど、0.5.7 にしたら gmail_notify.tt が無いよと怒られたのでメモ。0.5.6 で変わったっぽい。
- config.yaml の global で、template_path: としてたところは、assets_path:
- テンプレートのたぐいは、/<assets_path>/common 以下に入れる。もしくは、/<assets_path>/plugins/<plugin_id>
- plugin_id は、Publish::Gmail なら、publish-gmail。Plagger::Plugin の class_id メソッドがそれ。
global:
plugin_path:
- /home/taro/plagger/plugins
assets_path: /home/taro/plagger/assets
timezone: Asia/Tokyo
plugins:
- module: Cache
config:
file: /home/taro/plagger/cache
diff_mode: 1
- module: CustomFeed::Mixi
config:
email: foobar@example.com
password: password
fetch_body: 1
show_icon: 1
- module: Publish::Gmail
config:
mailto: example@gmail.com
mailfrom: you@example.com
mailroute:
via: smtp
host: localhost
| パーマリンク
| コメント (0)
| トラックバック (1)
|
■Web 拍手みたいな奴作って付けた。
いや、Web 拍手もちょっと良く分かって無いんだけどもね。要するに一言書いてどっかに送信できるものがあるといいなぁと思って。うちの blog は RSS で読んでくださっている方が意外と居らっしゃる（興味もってくれてありがとうございます）んですが、特にコメントとかはつかない。もう少し気楽にフィードバックもらえるものがあればいいかなぁと。（ちなみにサイドバーの検索フォームからコメントを入れてくれる人も居るんですが、検索ログなんてそうそう見ないのでｗ）
「そこではてブですよ」とか言われても、ブクマされるほどのエントリも無かったりするので。はっはっは。んで、サイドバーにメールフォームくっつけてる blog とか見ていいなぁと思ったけど、メールで飛んでくるよりは bloglines で読みたいなぁと言う事で XML::FeedPP 使って作りました。各エントリの下に一言送るフォームがあります。特に掲載はされないし、そのエントリに関係ない事でも気軽にバンバン送ってください。
で、ソースとか。
エントリーアーカイブ
<script src="<$MTBlogURL$>js/prototype.js" type="text/javascript"></script>
<script src="<$MTBlogURL$>js/scriptaculous.js?load=effects" type="text/javascript"></script>
<script src="<$MTBlogURL$>js/myscripts.js" type="text/javascript"></script>
「MT の検索結果をその場に出す。」と同じく、prototype.js と script.aculo.us を使ってますので、script タグでの読み込みが必要です。js ファイルへのパスは適当に変更してください。
<div id="bullet" class="bullet">
<form action="JavaScript:void(0);" onSubmit="new Bullet(this);return false;">
<input type="text" name="comment" id="comment" class="comment" />
<input type="hidden" name="title" id="title" value="<$MTEntryTitle$>" />
<input type="hidden" name="url" id="url" value="<$MTEntryPermalink$>" />
<input type="submit" value="一言" />
</form>
</div>
エントリーアーカイブにはこんな感じでフォームを表示したいところに上のコードを入れときます。
myscripts.js
var Bullet = Class.create();
Bullet.prototype = {
initialize: function(form) {
this.entry = $('bullet');
var params = Form.serialize(form);
this.entry.innerHTML='<img src="/js/progress_bar.gif" width="200" height="20">';
Element.show(this.entry);
new Ajax.Request("/path/to/bullet.cgi/shot", {
method: 'post',
parameters: params,
onComplete: this.showresult.bind(this)
});
},
showresult: function(res){
Element.hide(this.entry);
this.entry.innerHTML=res.responseText;
Effect.SlideDown(this.entry);
}
};
CGI 側のソース
lib/Bullet.pm の17～28行目付近は設定です。適当に変えてください。
ネーミングセンスの無さからついに目に入った単語をそのまま使ってしまった。いや、弾幕のようなフィードバックがありますようにとかそういう意味合いで（後付け
追記
- 2006/03/17 21:31 ie で内容を送信出来てない不具合がありました。myscripts.js を修正しています。form の内容取得する前に innerHTML で書き換えちゃダメです orz
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■あけましておめでとうございます。
あけましておめでとうございます。
ってことで、名探偵ホームズ。描いてから思ったけど、今年いぬ年で間違いないですよね？('-'；)
犬耳咲夜さんとかも描いてはみたけど面倒になってやめた。やっぱり見て描かないとダメです。何も見ないでは描けないねぇ。
まぁ、今年もこんな調子ですが、よろしくお願いいたします。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■rpm の自動アップデートにやられた。
Red Hat Enterprise Linux ES で、up2date さんが毎日新しい rpm を自動更新してくれるんだけど、気がついたら perl も更新されちゃってて、弱い参照が使えないバージョンだとか何とか言われて動かなくなってるスクリプトががががが。（CGI::Application::Config::General を使ってたんですが、内部で Scalar::Util の weaken を使っててそこでハマってたっぽい。）
RedHat Network の Change Log を見ると、 "Sys::Syslog security vulnerabilities" issues.
なんて単語が見えるから多分コレかなぁなんて思いつつ、rpm -Uvh --oldpackage で前のに戻したり。
というかやっぱり、/usr/local/bin/perl とかに別途いれてそっちを使うべきかなぁとか考えつつ実験中。rpm の perl、あちこちから依存されてて外しずらいし。頑なに /usr/bin/perl 使うことも無いよなと。別個に入れれば新しいバージョンのも使えるしねぇ。とりあえず自動更新のリストからは外しました。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Shibuya.pm テクニカルトーク #6
行ってきました、Shibuya.pm テクニカルトーク #6＠神保町三井ビル 17F 株式会社インターネットイニシアティブ (IIJ) 大会議室
ってことで、サクッと。
- Perl で ICFP（Perlは「最強の言語」か？）（スピーカー: 澤勇太さん）
- 警泥ゲームなサーバ上で各言語で作った警察/泥棒で対決して最強の関数型言語を決める大会 ICFP に参加されたお話でした。
- time limit 72 時間の激戦が再現されるような熱いトークが印象的。
- Haskell 強ぇ
- Six Apart and Perl（スピーカー: 宮川達彦さん）
- Six Apart は創業者のトロット夫妻の誕生日が6日違いなところから名づけられた。だっけ（記憶を元に記載(；ﾟﾛﾟ)メモされてなかった）
- 写真を多用したスライドで雰囲気が良く伝わってた。
- 宮川さんは、TypePad の開発にかかわってるらしい。
- 開発環境とかの話はそのうち資料を出してくれると思うので割愛。というかうまく書けない(；ﾟﾛﾟ)ｽﾋﾞﾊﾞｾﾝ
- Learning Catalyst（スピーカー: 加藤＠おーさかさん）
- 今日のために初めて Catalyst をいじった。
- 実は、Class::DBI も使った事無かった。
- 実は、template-toolkit も使った事無かった。
- でも、3日くらいで管理画面付 Wiki が完成。
- デモができなかったのが残念。
- 特に予習しなかった僕にとっておあつらえ向きな丁寧な説明ヽ(´ー｀)ノバンザイ（はてなの勉強会のデモで雰囲気はわかってるつもりで聞いてた。あっはっは。）
- Catalyst Tips and Traps（スピーカー: 加藤 亮さん）
- 高橋メソッドで Catalyst 説明。
- Ruby on Rails との比較。
- Rails 制約多め、DHH のオレオレルール。
- Catalyst 制約少なめ、使う人がオレオレルールを作る。
- scaffold はデモにしか使えないとのうわさ。
- そんなときはオレオレヘルパースクリプトを作れ。（デモしてた
- 特に予習しなかった僕にとっておあつらえ向きな丁寧な説明ヽ(´ー｀)ノバンザイ
- prototype.js と Perl で Ajax（スピーカー: 伊藤直也さん）
- 最近、Ajax の定義は曖昧。
- prototype.js は、Ajax 用途以外にもいろいろ用意されたライブラリ。
- クリックしたら「ｷﾀ━━━(ﾟ∀ﾟ)━━━━!!」
- クリックしたら「ちょｗｗｗｗおまｗｗｗｗｗｗｗ」
- HTML::Prototype があれば、Javascript わかんなくても Ajax できる。すごくね？
- HTML::Prototype はあちこちで Plugin に組み込まれてたりします。
- 近々、Shibuya.pm なサービス公開！（さっきアクセスしたら、 username と password 聞かれたｗ＜だからまだ公開してないんだってば。）
- Pugs でお手軽 Perl6 入門（スピーカー: 竹迫良範さん）
- Perl6 の言語仕様を軽く説明。
- ネコ演算子とか。
- ネコミミモードとか。
- Damian Conway さんもアニオタ
- Pugs 作った Autrijus Tang ｽｺﾞｽ
- Pugs は、Haskell で作られてる。
- Haskell SUGEEEEEEEEE!!!!!!!（リンク先は会場が目を見張ったアレ）
- そんなわけで、Perl6 は Pugs 使って、現物主義的に仕様を討論されてるよ。
- Windows で、exe で簡単にインストールできるセットがあるから試してみるといいよ。（URL がわからんので資料を待とう）
みなさまお疲れ様でした。次も期待しております！
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■CGI::Application::Dispatch を mod_perl 下で動かした時に warning が出た
タイトル長え('A`)
apache/mod_perl 2系には関係なさげ。
- apache 1.3.33
- mod_perl 1.29
- perl 5.8.0
- CGI::Application::Dispatch 1.04
で、PerlHandler に Apache::Registry 使った環境で動かしたら、error log に以下のような warning が出た。
Dispatch.pm: Use of uninitialized value in numeric eq (==) at /usr/lib/perl5/site_perl/5.8.0/CGI/Application/Dispatch.pm line 12.
httpd.conf に下記の行を設定して回避。
PerlSetEnv MOD_PERL_API_VERSION 1
設定する値は2以外だったらなんでもいいんだと思うけど。
そもそも、PerlHandler に CGI::Application::Dispatch 使えって話かもしれませんが、ちょっと自分の書いたスクリプトに問題があったので。
やっぱり、相対指定は上手く外していこう（←ダメだった部分
ちなみに、CGI::Application::Dispatch の patch 作ってみた。
*** Dispatch.pm.org 2005-09-07 20:11:13.000000000 +0900
--- Dispatch.pm 2005-09-07 20:13:32.000000000 +0900
***************
*** 9,15 ****
BEGIN {
if( $ENV{MOD_PERL} ) {
! $MP2 = $ENV{MOD_PERL_API_VERSION} == 2;
if( $MP2 ) {
require Apache2::Const;
require Apache2::RequestUtil;
--- 9,15 ----
BEGIN {
if( $ENV{MOD_PERL} ) {
! if ( exists $ENV{MOD_PERL_API_VERSION} ) { $MP2 = ( $ENV{MOD_PERL_API_VERSION} == 2 ) }
if( $MP2 ) {
require Apache2::Const;
require Apache2::RequestUtil;
まだ、mod_perl に慣れてないというか知識不足があるんだけども、mod_perl 1 系では、$ENV{MOD_PERL_API_VERSION} がセットされないっぽい。
| パーマリンク
| コメント (1)
| トラックバック (0)
|
■ディレクトリ構成とか
CGI::Application 関係で見つけたおまえさんの blog。よく参考にさせてもらってます。（自分のコメントがきっかけでエントリ一つ起こしてもらったにもかかわらず反応できなくてすいません orz）んで、
CGI::Application::Dispatch勉強中その２ : おまえのログ
どこかに、こういうディレクトリ構成のガイドとか、絶対パス・相対パスどっちできじゅつするのがよいかHowToみたいのはなかろうか…。うろうろ。
迷いますねー。迷ってました。でも僕は、SSI とかで、HTML の部品となる テキストファイルを include させることが好きで、そういう場合、部品側を相対パスで書いておくと呼び出し元によっては狂うので、最近は絶対パスばっかりです。
<a href="/foo/bar">hogehoge</a>
こんな感じです。画像の参照先なんかもそうです。
<img src="/img/hogehoge.jpg">
ちなみに、CGI::Application を使う以前から、テンプレートをまとめることをよくしてたのであまり気になってません('-'；)
最近の自分の作るもののディレクトリ階層はこんな感じ、と晒してみる。
- /home/taro
- conf/
- lib/
- tmpl/
- public_html/
- app.cgi
- img/
- app/
- css/
- js/
- ssi/
- category/
- img/
こんな感じで、テンプレートファイル群は、tmpl ディレクトリ以下にまとめてます。
conf が設定ファイル系（データベースのパスワードとか）、lib が MyApp なモジュール置く場所です。
あー、インスタンス CGI な app.cgi は、
use lib qw (../lib);
って、相対指定してます(；'-')
というか、スクリプトの中身は相対指定が多いかも orz
＃テンプレの在り処とか、設定ファイルの場所とか。
このあたりが上手く処理できたら、MyApp なモジュールを Path が通ってるところにインストールしちまえとか考えてるんですけどねぇ。
というか、html 内の参照指定な話と perl スクリプト内の参照指定な話がごっちゃになってわかりづらいエントリに。スンマセン orz
他の人のディレクトリも見てみたいですねー。
ちなみにこの blog があるディレクトリ階層はめちゃくちゃです。カオスｗ
整理せねばなー。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■CGI::Session::4.00 デタ
いくつかの DEVELOPER RELEASE を経て、CGI::Session::4.00 がリリースされた模様。
Care has been taken to be 100% compatible with applications developed with 3.x.
However, you are encouraged to run regression tests with your own applications
before using this in production.
3.x との100％同じ使い方ができるように注意してるけど、使うときはよくテストしてね（超意訳）、ってことでとりあえず様子見。
3.95 に Patch 充てて、CGI::Session::MySQL の TableName 変更して使ってたりするんだけど、4.00 では、CGI::Session::Driver::DBI がサポートしてくれてるので、このあたりも問題なく使えそう。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■言及リンクのない TrackBack ping を弾くプラグインの不具合
ちょっと、TBPingDSBL をスルーしてくる TrackBack SPAM が増えてきましてうんざりぎみだったので、ハテナオヤ氏作 の Plugin を導入に踏み切りました。
以前はまぁ、関係のある話題だったら TB どーぞって感じだったのですが、これで言及リンクがないと TB 受け付けなくなります。（TB 受けてて弾いてるのに気がついたら、手動でリンク張ってきます。SPAM 削除より手間は少なくてすむだろうｗ）
naoyaのはてなダイアリー - Movable Type で言及リンクのない TrackBack ping を弾くプラグイン
と、いうことで Movable Type でリンクなしトラックバックを受け付けなくするためのプラグイン。mt.cgi で「サイトのURL」に指定した URL が言及元に含まれていなければ弾きます。
http://naoya.dyndns.org/~naoya/lib/mtplugins/mt-ban-norefertb.pl
んで、導入してみて経過を見ていたのですが、配布元エントリのコメントにあるようなエラーが見られて原因を究明してみました。
MT::Plugin::BanNoReferTb v0.01 died with: Can't locate object method "status" via package "HTTP::Headers" at (eval 27) line 1.
ちなみに環境は、こんな感じです。
- Redhat Linux 9
- apache 1.3.33
- perl 5.8.0
- LWP 5.803
- LWP::UserAgent 2.033
- HTTP::Request 1.40
- HTTP::Response 1.52
- HTTP::Headers 1.62
LWP はたまに遊ぶ程度なのでよくわかってないんですが、怒られてるのは、29行目の $res->status っぽいです。
28： my $res = $ua->request(HTTP::Request->new(GET => $tbping->source_url)); 29： return error($app, $tbping, "the server returned " . $res->status) 30： unless ($res->is_success);
$ua->request の戻り値は、HTTP::Response オブジェクトなので、POD を確認すると確かに無いです。多分、$res->status_line かなと。多分。
んで、さくっと修正してたら、上手く動いてるようです。
ちなみに、このエラーは、TB 元のページが無いだとか（404）、タイムアウトしただとかじゃないと出てこないので、こんな修正しなくても使えます。多分。
| パーマリンク
| コメント (9)
| トラックバック (1)
|
■ラクダ本 Vol1 第3版の誤植？
プログラミング perl VOLUME1 第3版に誤植発見。
p394 「12章 オブジェクト」の「12.7.3 オートロードによってアクセサを生成する」に登場する、Person モジュールの24行目。
croak "$self not an object" unless ref ($invocant);
は、
croak "$self not an object" unless ref ($self);
ですよね？細かい話だけど。
オライリー・ジャパン (2002/09)
売り上げランキング: 17,736
CGIを自在にこなす第一歩の書 Perl文法の仕組みを詳細に知りたい人の本 ラクダが踊る以下、モジュール全部。（コメント抜き:p
僕が誤字脱字してたらごめんなさいｗ
package Person;
use Carp;
my %Fields = (
"Person::name" => "unnamed",
"Person::race" => "unknown",
"Person::aliases" => {},
);
use subs qw(name race aliases);
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = { %Fields, @_ };
bless $self, $class;
return $self;
}
sub AUTOLOAD {
my $self = shift;
croak "$self not an object" unless ref ($self);
my $name = our $AUTOLOAD;
return if $name =~ /::DESTROY$/;
unless ( exists $self->{$name} ) {
croak "Can't access `$name' field in $self";
}
if ( @_ ) { return $self->{$name} = shift }
else { return $self->{$name} }
}
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■CGI::Application 4.02 のバグ
刺身☆ブーメラン（金子健介）のはてなダイアリー - 今日のPerlMonks
Changes in Latest Version of CGI::Application (4.02)
結論からいうと、CGI-Application-4.02にはバグがあるのでアップグレードするなら4.03にしようねという話なのはわかったのだが。
肝心のバグってた部分ってのが、よーわからん。$self->mode_param('rm')ってハードコーディングされてるからダメってこと？違う気がするんだよなー。setup()で呼ぶべきとされているものをcgiapp_init()で呼んだらおかしくなったってことだろ。cgiapp_init()はえーとsetup()の前に呼ばれるんだっけあとだっけ。そこをわかってないから挙動がおかしいのかどうかもわからないのだな。ううむ。
自分もちょっとわからなかったので追ってみたメモ。
cgiapp_init() は setup() の前で合ってます。
4.02 は、cgiapp_init() の後に mode_param('rm') を呼んじゃってて、cgiapp_init() でいくら mode_param 変えてもデフォルトに上書きされちゃうよって事だと思う。setup() で呼ぶ分には変わらないんだけど。
$self->start_mode('start') は、定義されたかどうか判定してたのにねぇ。
まぁ、順番を変えた方がスマートだったのかな。
＃ちなみに、4.01 では、setup() 内で start_mode('start') が呼ばれてた。
まー、mode_param() と start_mode() は、setup() 内で呼ぶのが良さげ。
run_mode の切り替えは、cgiapp_prerun() で。
サブクラスの実行の順番とかはこちらが参考になります。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■CGI::Application 4.02 が出てた。
CGI::Application 4.02 が出た。（Changes）
path_info での run_mode 指定方法に、負の数を使って後ろから数えて何番目が run_mode といった使い方ができるようになったみたいです。
#negative value は負の数なのね。
http://www.example.com/index.cgi/hoge/foo/bar
で、
$webapp->mode_param( path_info=> -1 );
と指定すると、run_mode に bar がセットされるのかな。
-2 だと foo ですね。多分。ちょっと、使い道が思い浮かばないけど。
あとは、error_mode() が呼ばれる直前に実行する error フックが追加されたとか、start_mode のデフォルト run_mode がセットされる段階がちょっと遅くなった？とか（’start’ がデフォ）、ドキュメント化したぞとかドキュメント化したぞとか。まー個人的には差し障り無さそう(；'-')
追記
CGI-Application-Plugin-TT 0.07 が、CGI::Application 4.0 の hook システムに対応。そのほか色々、詳しくは Changes で。MFPM様々です。お世話になってますm(_ _)m
Recent Mail 便利！
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Abyss.pm （仮）の SVN リポジトリが公開されてる。
5月に京都に行った時、PIAさんにデモしてもらった、Abyss.pm の SVN リポジトリが公開されてますな。
Abyss ってのは、コードネームみたいなもんっておっしゃってたので、仮称ってつけてるんだろうね。
いつ完成するんだろ～との事ですが、まー気長に静観させていただきますｗ
フレームワークもたくさんありますからね、ちょっとアチコチ手を出しながら(；'-')
＃今は、CGI::Application。多分、Catalyst には手を出しそげ。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■CGI::Session::Driver::flexmysql
ちょっと前に、CGI::Session::MySQL で、使用するテーブルを変更する。ってエントリを書いたんですが、どうも CGI::Session::Driver::flexmysql を使うともっと融通が効く使い方が出来るみたい。
$session = new CGI::Session("driver:flexmysql", undef, {
Handle => $dbh, # Or use DataSource / User / Password
Table => 'custom_table', # You can put your sessions in any table
KeyField => 'id', # and any field for your session ids
DataField => 'a_session', # and any field for your session data
AutoCreate => 1, # even if it doesn't exist yet!
});
まぁ、Table 名さえ変えられれば、そこまで融通利いてもらわなくてもいいんですが。
CGI::Session は、ver4 でそれぞれのドライバに共通の引数を持つみたいなんで、ver4 まではこれを使うか、パッチ充てちゃうかだなー。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■はてブでメモメモ ２
前回、はてなブックマークをサイドバーにリストするスクリプトを公開したんですが、どうやら、タグの取得もできるようになったとのことので、ソース改変。
ソース
TT 側で、ハッシュキーに":"が入ってるとダメって怒られたので、途中にちょっと泥臭い処理をかませた。その場しのぎ。
ちなみに吐き出されるテキストは前回と同じく、SSI で include 用。Javascript 風味にしたければテンプレ変えれば良さげ。
暇が出来たら、libxml2 から、XML::Atom までインストールしよう・・。
改変履歴
- version 0.4:TT のフィルタで unicode 文字列をバイト文字列に戻すようにした。
また、LWP::UserAgent の扱い方を少し変更（UA をセットしました。）
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■perl カテゴリオンリーな RSS を作った。
正直、おまえの日常とか、キモイヲタ話とか興味ないよって人もいるかと思って、perl カテゴリのみの RSS を作った。まぁ、おまえの perl の話もレベル低くて聞きたくないって人も居るかもしれませんが、それはもう見るなよってことで('A`)
http://sky.taro-web.com/perl.rdf
まぁ、日常の話とか無視して頂いてもですね、perl まわりの話ではコメントとか Trackback とか有用な話があれば是非欲しいわけで。RSS リーダに登録しようかなとか思っても、うぇうぇ言ってる意味不明なエントリがたくさん混じってて躊躇したとかあったらもったいなさそうだし。
まー、たいして頻繁に書いてるわけでもないんですが、でもだからこそ、RSS リーダとかで登録してもらったほうがイイカナと。
ちなみに、RSS AutoDiscovery にも対応してるはず。
| パーマリンク
| コメント (2)
| トラックバック (1)
|
■CGI::Application::Plugin::Session で、cookie の名前を変更する。
タイトル長ぇ('A`)
こんな感じで、COOKIE_PARAMS を渡すと、cookie の名前は確かに変わるけど、session が維持されません。実行されるたびに新しい session ID が発行されてしまう。多分、CGI::Session->name がデフォルトのままだからだと思う。（さらっとソース読んだ限りでは。）
$self->session_config(
CGI_SESSION_OPTIONS => [ ("driver:MySQL;", $self->query, {Handle => $self->param('mydbh'), TableName=> 'hoge' }) ],
DEFAULT_EXPIRY => '+1h',
COOKIE_PARAMS => {
-name => 'hoge',
-path => '/hoge'
},
SEND_COOKIE => 1,
);
以下のようにやると、CGI::Session->name も変えてくれます。
$self->session_config(
CGI_SESSION_OPTIONS => [ ("driver:MySQL;", $self->query, {Handle => $self->param('mydbh'), TableName=> 'hoge' }) ],
DEFAULT_EXPIRY => '+1h',
COOKIE_PARAMS => { -path => '/hoge' },
SEND_COOKIE => 1,
);
$self->session_cookie(-name => 'admin');
CGI::Application::Plugin::Session は、0.07。
おかしなこと言っているように見えたら突っ込みください、誰か(；'-')
というか、Changes に載ってるバグって、これのことか('-'；)
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■CGI::Session::MySQL で、使用するテーブルを変更する。
普通に、CGI::Session で、MySQL 使ってるときにデフォルトと違うテーブル名を使いたい場合は、
$CGI::Session::MySQL::TABLE_NAME = 'hoge';
とかやればできるけど、CGI::Application::Plugin::Session 経由で変更できないっぽい。cgiapp_init() でやっても setup() でやってもデフォルトに上書きされる。Plugin の仕組みを追えば分かりそうだけど、とりあえず別な方法を模索。
CGI::Session::PostgreSQL だと、
$session = new CGI::Session("driver:PostgreSQL", undef,
{Handle=>$dbh, TableName=>'my_sessions'});
って指定できるので、CGI::Session::MySQLでもやりたい。
ということで、CGI::Session::MySQL の patch。
*** MySQL.pm.org 2005-06-20 22:27:17.000000000 +0900
--- MySQL.pm 2005-06-20 22:30:56.000000000 +0900
***************
*** 126,131 ****
--- 126,135 ----
}
+ if ( defined $args->{TableName} ) {
+ $TABLE_NAME = $args->{TableName};
+ }
+
require DBI;
$self->{MySQL_dbh} = $args->{Handle} || DBI->connect(
さて、作者さんに patch を送りつけてやりたいけど、英語が不安だ('A`)
| パーマリンク
| コメント (4)
| トラックバック (0)
|
■CGI::Application 4.0
4.0 が出ましたね。3.31 の POD を自分に分かりやすく訳してたところですがー。
Changes 見ると、どうやら、Plugin 機構に hook 機能が登場したとかどうとか。この機能の登場で、plugin として CPAN に上がってるものは近日中にアップデートされると思われますみたいなことも書いてある。相当テストしたみたいですね。
個人的に微妙なタイミング。
plugin のアップデート待つよりかは今は、3.31で事を進めてしまった方がいいかな。
でも、CPAN Auther って、仕事早そうなんだよなぁ。
どうでも良いけど、今までの version でも PATH_INFO から run_mode の判定できたんだね。思いっきり cgiapp_init() で mode の書き換えとかやらかしてた。何で気がつかなかったんだろ。ハフン。（しかも、run_mode の切り替えは、cgiapp_prerun() でやった方が良さげらしい。）
まぁあれだ、過ちを恐れずどんどん使え。考えるな、感じるんだ！って事で('A`)
| パーマリンク
| コメント (6)
| トラックバック (0)
|
■Net::MovableType でテスト投稿
この記事は、Net::MovableType を使って投稿したテストです。
ソース
#!/usr/bin/perl
use strict;
use warnings;
use Net::MovableType;
use Jcode;
my $mt = Net::MovableType->new('http://domain/path/to/mt-xmlrpc.cgi');
$mt->username('username');
$mt->password('password');
$mt->blogId(1);
my $title = 'Net::MovableType でテスト投稿';
my $description = <<'EOF';
<p>この記事は、<a href="http://search.cpan.org/~sherzodr/Net-MovableType-1.73/MovableType.pm">Net::MovableType</a> を使って投稿したテストです。</p>
EOF
my $mt_text_more = <<'EOF';
<p>ソース</p>
<pre class="code">
hogehoge
</pre>
EOF
my $entry = {
title => $title,
description => $description,
mt_text_more => $mt_text_more,
mt_convert_breaks => '0',
};
foreach my $key ( keys %{$entry} ) {
$entry->{$key} = Jcode->new($entry->{$key}, 'euc')->utf8;
}
my $new_id = $mt->newPost($entry, 0) or die $mt->errstr;
$mt->setPostCategories($new_id, "perl") or die $mt->errstr;
$mt->publishPost($new_id) or die $mt->errstr;
| パーマリンク
| コメント (0)
| トラックバック (1)
|
■Authen::TypeKey で、Typekey にサインイン
ちょっと興味があって、Authen::TypeKey を使って、Typekey へのサインインを試してみた。
http://sky.taro-web.com/cgi-bin/typekey/index
サインインすると、Typekey に登録したプロフィールが送られてきて、こちら側ではそれをセッションに格納するってだけのものです。
セッションの期限は一時間に設定してます。Typekey のセッションがどのくらい持続されるのか良く把握してないけど、こっちのセッションが切れても、Typekey のセッションが切れるわけではないので再度サインインする時は Typekey のログイン画面は出ずにサインインできると思う。というかできた。
やってみると仕組み自体は結構簡単なのね。とはいっても Authen::TypeKey 様様ですが。まぁ、実際に書いてみると理解ができるというか。
んで、アウトプット主義ということで恥かき覚悟のソースｗ
ちなみに CGI::Application の Plugin も試すために書いてます。というか、こっちがメインか。ソースコード上で重複した処理をやってたりしますが、その辺は、その、あの、なんというか、まぁどうでもいいやと思っちゃたりしたので。というか、画面ごとに用意すればいいわけだから、動作ごとに組む必要も無かったカモ(；'-')
＃正直に申しますと混乱しました、ハイ。
使ったのは、
- CGI::Application::Plugin::Config::General
- CGI::Application::Plugin::Session
- CGI::Application::Plugin::TT
以上三つ。
ちなみに、やるだけやったらスッキリして、特に Typekey を使ってどうこうってのは考えてないｗ
- 参考
- Six Apart - TypeKey API
- [TypeKey] TypeKeyクライアントサンプルCGI (21:04) - tdiary.ishinao.net
- Perlモジュール/CGI::Application - Perlでの特に簡素なCGIフレームワーク。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■はてなブックマークでメモメモ。
まともなエントリを書くのがお久しぶりになってしまっていました。皆様お元気でしょうか？(；'-')
最近は読むばっかりでまったくアウトプットに至ってなかったわけですが、実はこの blog の右下の方にはてなブックマークでブックマークしたものをリストしてたりします。もうごちゃごちゃしてて、アナウンスされないと誰にも気がついてもらえないなということでエントリしました（笑
てなわけで、はてなブックマークを使ってチョコチョコとコメントつけたりはしてます。簡易アウトプット(；'-')
このはてなブックマーク、「あー、このページ面白ぇｗｗ」とか思って、ブックマーク追加してみると、すでにブックマークした他のユーザのコメントで反応が見れたりして面白いです。自分が最初にブックマークしたものが、続々ブックマークされてたりするとちょっと嬉しかったり。あと、この記事後でゆっくり読み直してみようとか思うけど、ブラウザでブックマークするほどじゃないかなぁと思ったときの使い捨てとか。
さて、サイドバーにはてなブックマーク持ってくるソース。
#!/usr/bin/perl
use strict;
use warnings;
use XML::Simple;
use LWP::UserAgent;
use Template;
my $file = '/path/to/file';
my $username = 'username';
my $req = HTTP::Request->new(GET => "http://b.hatena.ne.jp/$username/atomfeed");
my $res = LWP::UserAgent->new->request($req);
if($res->is_success){
my $data = XMLin(LWP::UserAgent->new->request($req)->content, ForceArray => 1);
my $b_title = $data->{link}->[1]->{title};
my $tt = Template->new({ABSOLUTE => 1}) or die Template->error(), "\n";
my $output;
$tt->process(
\*DATA,
{ data => $data },
\$output,
) or die $tt->error();
utf8::encode($output);
open (TXT, "> $file") or die "Can't open file $file:$!";
print TXT $output;
close(TXT);
}
__DATA__
[% FOREACH d = data.entry %]
[% LAST IF loop.count > 5 %]
<h3><a href="[% d.link.0.href | uri | html %]">[% d.title.0 | html %]</a></h3>
[% IF d.summary.0.content %]
<p>[% d.summary.0.content | html %]</p>
[% ELSE %]
<p>There is no comment.</p>
[% END %]
[% END %]
ホントは、XML::Feed 使いたかったんだけど、XML::LibXMLが入らなくてあきらめた(；'-')
RSS じゃ無くて、Atom 持って来てるのは、コメントつけてなかったときに RSS だと description にブックマークしたページの概要が入っちゃってるから。ちなみに例によって、cron で動かして吐き出されたファイルを SSI で include しています。Javascript にしたければ、テンプレいじるとできると思います。
ソース眺めるとほとんどモジュール任せ。CPAN ヽ(´ー｀)ノﾊﾞﾝｻﾞｲ!
追記：タグ取得 ver 作った。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Parse::AccessLogEntry::Analysis 作った。
今まで、Parse::AccessLogEntry を使って簡単なApache ログ解析とかやってたんだけど、
チョビチョビいじってる間にモジュール化しちめぇって事で作ってみた(ﾟﾛﾟ；)
＃分析の解析とか意味不明ですとか言わない。
＃ネーミングセンス無いので(つД｀)
Parse-AccessLogEntry-Analysis-0.02.tar.gz
md5sum f3c277fa994952e180caa2a492f6e573
せっかくなので、パッケージ化も試みました。
初めて test を書いた。make test で自分の書いたテストが走ってる様はなかなか面白かった。
何がどう面白かったのかは上手く言えない（笑
使い方とかは、下手な日本語で POD 書いてあるので参照してください。
example にサンプルスクリプトも入れてあります。
サンプルスクリプトの実行結果
グラフの長さはかなりいい加減な計算（10掛けてあるだけとかｗ）で導いてるので、めっさ長かったりします(ﾉ∀`)
Parse::AccessLogEntry が必要です。
付属の Parse::AccessLogEntry::Analysis::JP には、もう少し色々必要です。
検索語句解析の参考にさせていただきました。
なぜGoogleではなく、Yahoo! JAPANか? : NDO::Weblog のキーワード抽出コード
数字を丸めるのに四捨五入のコードをお借りしました。
Perlメモ：四捨五入する
追記（2005/07/14）
example コードでサニタイズしきれてい無かったので修正しました。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■WEB+DB PRESS vol.25
買ったの忘れてた(ﾟﾛﾟ；)
お目当ては、CPAN モジュール特集。
技術評論社 (2005/02)
売り上げランキング: 5,169
通常3～4日以内に発送
今回の注目はアーキテクチャ設計P154 のリスト1「CGI.pm を使った例」が「HTML::Parser を使った例」な気がするのは気のせいではない気がするｗ
記事前半は、CPAN モジュールのインストールの仕方とか、定番として使われるモジュールだとか、Perl初学者向けっぽい。もしくは、Perl の宣伝カナ。
個人的には、後半のはてな、ライブドア、six apart の CPAN の活用の仕方とか、Perl Hacker の座談会が面白かったです。
ライブドアのコンサルティング事業部の話で、完全 closed な環境で、CPAN モジュールを CD-ROM に入れて持ってった話とか。
制約がある中でってのは燃えるけどモチベーションがあるときに限るなぁ。
＃というか、そういう発言は使いこなせてる奴が言えΣ(ﾟ口ﾟ；＜自己突っ込み
やっぱり、あれだけの数あると、好き嫌いも出てくるもんですね。
自分は嫌いな CPAN モジュールってなんかあるかなぁ。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■HTML に書かれたメルアドをエンティティ化する。
ちょっと、必要になって書いたスクリプトをまた無駄に公開。
HTMLに書かれたメルアドの
@ を @ に
. を . に変換するスクリプト。
MT みたいに、ツール側がやってくれてれば必要ありません。
＃というか、メルアド収集ロボットってこのくらいで欺けるもんかな＾＾；
#!/usr/bin/perl
#-----------------------------------------------------------#
# 指定したディレクトリにある HTML ファイル内に記述された
# メールアドレスを HTML エンティティ化する。
# $Id: entities.pl,v1.0 2005/02/28 19:46:09 taro Exp $
#-----------------------------------------------------------#
use strict;
use warnings;
use File::Find;
use Storable;
my $cache = 'cache.db';
my @reject = qw(threads thrd maillist mail);
my $path = shift or die "usage: $0 <DIR PATH>";
if ( $path !~ m#/$# ) { $path .= '/'; }
unless ( -d $path ) { die "$path is not directry"; }
my @list;
find sub {
if ( -f && /(.*)\.html$/ ) {
push(@list,$File::Find::name);
}
}, $path;
my $list = read_cache( $cache, \@list );
my $num = @$list;
my ( $i, $success, $err ) = (0, 0, 0);
while ( $i < $num ) {
my $file = $list->[$i];
if ( my $err_msg = entities($file) ) {
print $file . " ... err($err_msg)\n";
$err++;
} else {
print $file . " ... ok\n";
$success++;
}
$i++;
}
write_cache($cache, $list, \@reject);
print <<EOF;
+-----------------------------------+
| * $path
| - total $num files
| - success $success files
| - error $err files
+-----------------------------------+
EOF
#-----------------------------------------------------------#
# エンティティ化する。
#-----------------------------------------------------------#
sub entities {
my $file = shift;
my $data;
if ( open ( HTML, "+< $file" ) ) {
flock(HTML, 2);
my $data;
while( <HTML> ) {
my $line = $_;
$line =~ s/\@/@/g;
$line =~ s/\././g;
$data .= $line;
}
seek(HTML, 0, 0);
print HTML "$data\n";
truncate(HTML, tell(HTML));
close(HTML);
return undef;
} else {
return $!;
}
}
#-----------------------------------------------------------#
# キャッシュ読み取り
#-----------------------------------------------------------#
sub read_cache {
my ($cache, $list) = @_;
if ( -f $cache ) {
my $list_cache = retrieve($cache);
my $new = reject_arrey($list, $list_cache);
return $new;
} else {
return $list;
}
}
#-----------------------------------------------------------#
# キャッシュ書き込み
#-----------------------------------------------------------#
sub write_cache {
my ($cache, $list, $reject) = @_;
my $new = reject_arrey($list, $reject);
if ( -f $cache ) {
my $list_cache = retrieve($cache);
push ( @$list_cache, @$new );
store $list_cache, $cache;
} else {
store $new, $cache;
}
}
#-----------------------------------------------------------#
# 配列から、指定した要素を取り除く
#-----------------------------------------------------------#
sub reject_arrey {
my ($arrey, $reject) = @_;
my $num_reject = @$reject;
my $num = @$arrey;
my ($i, $j, $flag) = (0, 0, 0);
my @new;
if ( !$num_reject ) { return $arrey; }
while ( $i < $num ) {
while ( $j < $num_reject ) {
if ( $arrey->[$i] =~ /$reject->[$j]/g ) {
$flag = 1;
last;
}
$j++;
}
$j = 0;
push(@new, $arrey->[$i]) if !$flag;
$flag = 0;
$i++;
}
return \@new;
}
んで、entities.pl とか名前付けて保存して、
$ ./entities.pl /path/to
って起動すると自動的に指定したディレクトリ以下にある、HTML ファイルを探して一気に変換してくれる。
一度変換したファイル名をキャッシュしてるので、もう一度走らせても、一度変換処理した HTML は無視します。
機能追加修正 2005/02/28
一度しか変換されないと困るファイルがあったので、
15行目の配列にキャッシングしたくないファイル名のキーワードを入れとくとキャッシングしないようにした。（正規表現でマッチ）
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■mixi コミュニティ一覧表示をキャッシュしてみる。
WAY TO GO: WWW::Mixiでサイドバーにコミュニティ一覧を表示
mixiのコミュニティ一覧をサイドバーに表示するスクリプトを書いてみました。
しかし、アクセス毎にいちいちログインしてるので表示まで時間がかかるのが玉にキズです…
そんな時には、Cache::Cache でどーでしょうか？
＃なんか、search.cpan.org 重いような・・(；ﾟﾛﾟ)
#!/usr/bin/perl -w
use strict;
use lib qw(/path/to/perl/lib);
use Jcode;
use WWW::Mixi;
use Cache::FileCache;
my $id = 'your_id';
my $cache = new Cache::FileCache({
cache_root => '/home/taro/mixi/cache',
namespace => "mixi",
default_expires_in => 60 * 60,
});
my $data;
unless ($data = $cache->get($id)) {
my $mixi = WWW::Mixi->new('your_mixi_account', 'your_mixi_password');
$mixi->login;
my $res = $mixi->get("/list_community.pl?id=$id");
my @items = $mixi->parse_list_community();
for my $item (@items) {
my $link = $item->{link};
my $subject = jcode($item->{subject})->utf8;
$subject =~ s/'/\\'/g;
$data .= "document.write('<a href=\"$link\" target=\"_blank\">$subject</a><br />')\n";
}
$cache->set($id => $data);
}
print "Content-Type: text/javascript\n\n";
print $data;
1;
cron が使えるなら、JS ファイルを定期的に自動生成とかもいいと思います( ´∀｀)
＃ウチの公開ディレクトリは、そんなファイルばっかりでゴチャゴチャしてきてる(ﾉ∀`)
| パーマリンク
| コメント (0)
| トラックバック (1)
|
■Image::Magick の UP グレードで失敗
気まぐれにさくらインターネットのセキュリティアドバイザリを見ては update したりしてるんですが、この間やったときに、どうやら ImageMagick のアップデートも含まれてたみたいで、
気がついたら、ウチのサーバに載っかってる blog という blog から、画像の upload が出来なくなってた＿|￣|○
みんなごめんね(´･ω･`)
んで、どうしたかと言うと、前のバージョンに戻した(ﾉ∀`)
| パーマリンク
| コメント (7)
| トラックバック (0)
|
■CPAN お気に入りリストを作ろう
面白そうなものを発見！ヽ( ´∀｀)ノ
このサイトは、CPANに登録されているモジュールをお気に入りリストとしてコメントをつけて登録したり、他人のお気に入りモジュールの一覧を見たりすることが出来ます。
と言うことで、ガリガリ登録してみたテスト。
早速右側にもリストを貼り付けてみたり。
リストしたモジュールのバージョンアップ情報とかも出てくるみたい。
やっぱりアイデアって大切だなぁと思わされマシタ！
作った人に拍手！ヽ( ´∀｀)ノ
| パーマリンク
| コメント (17)
| トラックバック (1)
|
■勝手に記事取得 その2
RSS や Atom などのフィードを取得する際にサーバや帯域に余計な負荷をかけないためには、クライアント側でキャッシュしてやって Last-Modified ヘッダを正しく解釈するとよい、というか今後のフィードクライアントはそのように振舞うべきというのが世の中のコンセサンスです。
なるほどなぁってことで、勝手に記事取得のスクリプトをあえて URI::Fetch は使わずに LWP の mirror 使って作り直してみた。
＃LWP::UserAgent で UA の定義とかしてみたかったのもあるし(ﾟﾛﾟ；)
本体。
#!/usr/bin/perl
# $Id: rss2html.pl,v 0.2 2005/04/25 19:56:29 taro Exp $
use strict;
use warnings;
use Digest::MD5 qw(md5_hex);
use Date::Parse;
use LWP::UserAgent;
use XML::RSS;
use Template;
# キャッシュディレクトリ
my $cache_dir = "/path/to/rss";
# テンプレートファイル
my $tmpl = '/path/to/rss.tmpl';
# 出力先
my $txt = '/path/to/rss.txt';
# 取得する RSS のリスト
my @urls = ('http://sky.taro-web.com/index.rdf');
my $ua = LWP::UserAgent->new;
$ua->agent('Taro RSS Aggregater/0.2');
my %data;
foreach my $url ( @urls ) {
my ($date,$rss) = get_rss($url,$cache_dir,5);
$data{$date} = $rss;
}
my @data;
my $i = 0;
foreach my $key ( reverse sort keys %data ) {
$data[$i] = $data{$key};
$i++;
}
my $tt = Template->new({ABSOLUTE => 1}) or die Template->error(), "\n";
my $output;
$tt->process( $tmpl,
{ data => \@data },
\$output,
) or die $tt->error();
utf8::encode($output);
open (TXT, "> $txt") or die "Can't open file $txt:$!";
print TXT $output;
close(TXT);
sub get_rss {
my ($url,$dir,$max) = @_;
if ( !$max ) { $max = 5; }
my $digest = md5_hex($url);
my $cache = "$dir/$digest.xml";
$ua->mirror($url, $cache);
my $rss = XML::RSS->new();
my $date;
eval {
$rss->parsefile($cache);
};
if ( $@ ) {
$date = '';
return ($date,$rss);
}
if ( $rss->{channel}->{dc}->{date} ) {
$date = Date::Parse::str2time( $rss->{channel}->{dc}->{date} );
} elsif ( $rss->{channel}->{pubDate} ) {
$date = Date::Parse::str2time( $rss->{channel}->{pubDate} );
} elsif ( $rss->{channel}->{lastBuildDate} ) {
$date = Date::Parse::str2time( $rss->{channel}->{lastBuildDate} );
} elsif ( $rss->{items}->[0]->{dc}->{date} ) {
$date = Date::Parse::str2time( $rss->{items}->[0]->{dc}->{date} );
} else {
$date = '0000000000';
}
return ($date,$rss);
}
テンプレート
[% FOREACH d = data %] <h3><a href="[% d.channel.link | uri | html %]" target="you">[% d.channel.title | html %]</a></h3> <p>[% d.channel.description | html %] <ul> [% FOREACH i = d.items %] [% LAST IF loop.count > 5 %] <li><a href="[% i.link | uri | html %]" target="you">[% i.title | html %]</a></li> [% END %] </ul> </p> [% END %]
Date::Parse がかなり便利なことを思い知らされてみたり。
あちこちもっさりしてるのはご愛嬌で。
ウチは SSI で Include してるけど、
テンプレを Javascript 風味にして、.js って拡張子とかで保存すると、
Javascript として本文中に Include できると思う。
Digest::MD5 使って、キャッシュファイル作ったのはこの辺参考にさせていただきました。というか、そのままですが(ﾟﾛﾟ；)
2005/04/25 ちょっと、Versionうｐ
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Class::DBI の PRIMARY KEY の扱い方
__PACKAGE__->columns(ALL => qw(id hogehoge hugahuga) );
ってやったら、怒られちゃいました(´･ω･`)
__PACKAGE__->columns(Primary => qw(id) ); __PACKAGE__->columns(Others => qw( hogehoge hugahuga) );
PRIMARY とその他でちゃんと伝えてくれってさ。
＃ちゃんと POD を読もう(´･ω･`)
| パーマリンク
| コメント (3)
| トラックバック (0)
|
■Shibuya.pm テクニカルトーク #5
時期的にそろそろかしら？と思ってたけど、ついに来たッ！
Shibuya Perl Mongers : Shibuya Perl Mongers テクニカルトーク #5
Shibuya Perl Mongersテクニカルトーク#5 を2004年12月16日に開催します。
日時 - 2004年12月16日 (木) 18:30?21:00
会場 - 株式会社インターネットイニシアティブ (IIJ) 17F 大会議室
料金 - 無料
事前登録 - 2004/12/09 12:00 より開始（定員80名）
参加しますヽ( ´∀｀)ノ
しかと拝聴させていただきます(´ー｀)
| パーマリンク
| コメント (4)
| トラックバック (0)
|
■月刊 DB Magazine 1月号に Class::DBI の記事
Template-Toolkit 周りで調べてて、たまに見かける、Class::DBI。
一体なんぞやと思って放置気味だったんだけど、
DB Magazine 1月号の記事で衝撃(ﾟﾛﾟ；)
DB Magazine
Part３
実践編（2）PerlによるDBアプリ開発
Perlの強力なRDBアクセス機能DBIとそのラッパークラスを使いこなす
伊藤直也
ちょっと、DBI まわりの処理も今まで不安なままだったので、購入して読んでみたら、Class::DBI 凄い(ﾟﾛﾟ；)
O/R マッピングとか意味わかってなかったわけですが、なるほどそういうことか～と電車の中でうなづいてしまった。
今まで、自分で用意した Table に対して、SELECT したり、INSERT したり、UPDATE したりするモジュールを作ったりしてたんだけど、これがあればかなり作業が楽になるね！
SQL 文要らず。
しかも、TT とあわせて使うとまた強力(ﾟﾛﾟ；)
TT 自体、ハッシュのリファレンス放り込みやすいから、相性いいわな。
暇見て何か作ってみよう。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■Template-Toolkit
このモジュールはスゴヒΣ(ﾟ口ﾟ；
今まで、Web ページ取って来て、RSS 自動生成とかするのに、Template::Extract ってサブモジュール使ったりはしてたんだけど、
（参考：Template::Extract + XML::RSS でRSS 生成 : NDO::Weblog）
そもそもの、Template としての機能を使ってみたらすげぇ。
まるで、MT のテンプレいじるみたいにテンプレが作れます(；ﾟﾛﾟ)
DBI とかで、DB から取得したデータがリファレンスだったりするので、それそのままホイって、テンプレに渡したり出来る。すばらすぃ。
ある程度の事なら、テンプレ側の記述しだいなところも（・∀・）ｲｲ!!
format ってフィルタでprintf の書式指定ができたり。
[% d.month | format('%02d') %]
これからドンドン使っていこうと思いますヽ( ´∀｀)ノ
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■Date::Simple が make test でコケた
実験用のサーバ（ Redhat 9 ）に、Date::Simple 3.01 インストールしようとしたら、
make test でコケたので、メモ。
t/date.t の line 105
ok($d->format('%d %b %Y') =~ m/17 \D+ 1972/);
$d->format('%d %b %Y') の戻り値は、
17 1月 1972 なので、マッチしませんΣ(ﾟ口ﾟ；
＃ロケールの問題だぁなｗ
＃17 Jan 1972 と返ってくる環境では問題無し。
くだらないけどメモｗ
| パーマリンク
| コメント (2)
| トラックバック (1)
|
■Becky でエクスポートした eml ファイルを一斉 rename する
SpamAssassin をすり抜けた spam メールを再学習させるため、
Becky からエクスポートして UP、sa-learn --spam してるんだけど、
たまにファイル名が原因で読めなかったりするんで、
チョコっとプログラム。
#!/usr/bin/perl
# .eml な拡張子のファイル一斉 rename
use File::Find;
my $path = '/home/taro/spam/';
my @list;
find sub {
if ( -f && /(.*)\.eml$/ ) {
push(@list,$File::Find::name);
}
}, $path;
my $cnt;
foreach my $eml ( @list ) {
my $new = $path . $cnt;
rename $eml,$new;
$cnt++;
}
指定したディレクトリにファイル放り込んで、実行するだけ。
思い出したかのような my 関数呼び出しは見逃してｗ
File::Find の使い方はこれでいいんかな～。
ちょっと不安(ﾟﾛﾟ；)
| パーマリンク
| コメント (12)
| トラックバック (0)
|
■Apache のログ解析2
自分で書いた、Apache のログ解析を試験的にこのサイトのみに導入してみた。
やっぱり、どう解析されたものが欲しいのかというのは重要だと思った。
とりあえず、ログのローテーションが、1週間おきだったのを1日おきに変更。
ちょっと、都合悪かった＾＾；＜一日ごとの解析を書いた。
これでしばらく様子見るとして、
現存のログを自分で一日おきに切り出して解析結果を出してみたところ、
検索語句堂々の第一位は、”杉崎美香”さんだったｗ
何もなくてごめんなさい＿|￣|○
| パーマリンク
| コメント (10)
| トラックバック (1)
|
■GD 関係の Perl モジュール
たろうぇぶに入らないー（キィィー
GD::Text が失敗してもうイヤになった（；゜〇゜）
ダメぽ＿|￣|○
やっぱり、gd の Version を上げてやら無いとどうにもこうにも解決しないな。
rpm でアンインストールする時、依存関係無視してしまうか。ふ～む。
最初から入ってる必要なんかないんですって＿|￣|○
＃ソースから入れたいのよー！
まぁ、今の仕事でたろうぇぶ使ってるし、GD も古い Version でも使っちゃってるから、
これが終わらない事にはなんとも出来ないな。
うー、他のモジュールはサクサク入るのに！
＃PurePerl なモジュールはほとんどコケないよな～。＜まぁまずコケない、というか、当たり前？
<追記>
決めた。
gd や、libjepg や、libpng や、freetype を
別途インストールする。
/usr/local 以下にはないのを確認したので大丈夫だろう。
デフォルトだし。＜ /usr/local 以下
＃rpm な奴らは、/usr を prefix に、ヘッダファイルなんかも直下にあるっぽい。
＃っつーか、依存関係調べると、X Window 系のが多いんだけど、イラネェ～
＃サーバなのに(ﾟﾛﾟ;)
- 今までの挑戦履歴＿|￣|○
-
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■Apache のログ解析
先日、apache のログを各ユーザ配下においてみたんだけど、
そろそろ解析してみるかと思い、いろいろ探してみるとこんなのがあった。
Apache::ParseLog - Apache のログファイルを解析するためのオブジェクト指向 Perl 拡張
Apache::ParseLog は、オブジェクト指向の構成を利用して Apache のログファイルを簡単に解析する一つの方法を提供するものである。
やっぱりあるもんだなぁ・・・。
僕は日本語しか分からないので、perldoc.jp にお世話になりっぱなしだけど、普通にCPANで漁ればもっといろいろあるかも。
Apache 系はさすがにいろいろあるようだしねぇ。
これなんか、お手軽でいいかも。
Parse::AccessLogEntry - Apacheアクセス・ログの1行を解析します
読み込んだら、ループでまわすって感じなのかしら？
＃ちなみに、Analog とか、Webalizer とかは
＃いまいち自分が欲しい形に解析されてるとは思えないので、自作の方向で考えてるんです。
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■勝手に記事取得 - RSS 取得スクリプト
ココで使ってる、"勝手に記事取得"は、一部を除いてほとんど RSS を取り込んで表示しているわけですが、
今までサイトタイトルを決め打ちにしていたので、
修正ついでに description も表示して、更新された順で表示するように変更してみました。
つたないスクリプトだけど、公開しておけば誰か使ってくれるかもしれないと思い、
つたない文章を加えて公開しました。
勝手に記事取得 - たろうぇぶツール
RSS を取り込んだら、テキストファイルを指定した場所に吐き出します。
吐き出されたテキストファイルを SSI などで取り込んでください。
ちなみに、 RSS を取り込んで表示したいだけだったら、こういうサービスもあります。
procfeed
procfeed はBlog/ニュースのヘッドラインを貼り付けるサービスです。
ココ使えば、勝手に記事取得スクリプト必要ないですな（汗
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■勝手に記事取得
遅ればせながら、勝手に記事取得させて頂いておりますｗ
bills.flipflap.net / 地下潜伏失敗(うそ)
たろさんには「勝手に記事取得」までしていただいて…うーんRDFのtitleから日付は外したほうがいいかな。
勝手に記事取得は、RDF から title 取得してるわけではないんですよね＾＾；
直に設定ファイルに書いてます。僕がｗ
─追記──────────
文章よく読め＿|￣|○＜自分
サイトの title じゃ無くて、記事の title だよ（トホホ
bills.taro-web.comで引けているのがほとんどのようですね。dnsの設定をのぞいてみる…(ごそごそ)…なるほど。
一応、bills.flipflap.net でリンクしてます。
ドメイン名をサイト名に持ってくるのも結構格好いいと思いますけどね。
＃でも、 flipflap.net がちょっとアレですか( ；´Д)
dns は、ドメインの数だけ additional が返って来ますが気にしないでくださいｗ
Answer が512byte超える前に何とかしなくちゃなぁ＾＾；
ついでに、
サイトβサービスとして大変重宝しており感謝いたします
もうすぐ、サービスインします。決めた！
Apache の mod_ssl 組み込みもその後にしますｗ
そんなわけで、いろいろ決めたらあっちでアナウンスしますよ。
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■またGDでコケタ＿|￣|○
Local で十分なテストして、たろうぇぶにアップして動かしたら、GDまわりで Error 頻発･ﾟ･(ﾉД`)･ﾟ･｡
どうやら、以前GDモジュール入れた際に、古いGDを入れたのがまずかったらしい。
僕ト云フ事: GDモジュールで詰まった
＃というか今読むと、gd 1.8.4 が入ってるのになんで、 GD.pm は、 1.41 入れてるんだろう？ｗ
＃オボエテナイｗ
$Image = GD::Image->newFromJpeg($Filename,1);
としたところ、引数が多いと Apache のログに書置きされ、
man GD を読むと、 1.41 には、 trueColor メソッドが無いそうで＾＾；
＃use CGI::Carp qw(fatalsToBrowser);してるけど、
＃こういうエラーってたいがい、 Internal Server Error で済まされるな＾＾；
＃できれば、 Apache のエラーログは読みたくないんだよな。
＃目をつぶりたいからｗ
やられた＿|￣|○
仕方ないので、テスト用（たろうぇぶ上）では、truecolorは気にしない方向でｗ
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■日付を扱うモジュール
( ..)φメモメモってことで。
個人的には、 Date::Simple が良さ気。
このあたり、求めてる感じ＾＾；＜日付の差分どうしようか考えてたんよね＾＾；
Date::Simple - Date::Simple - 簡単な日付オブジェクト。
# Difference in days between two dates:
$diff = date('2001-08-27') - date('1977-10-05');
あと必要なのは、例の TToolkit （たろ用ユーティリティ混ぜ合わせ）に組み込んじゃったもんなぁ･ﾟ･(ﾉД`)･ﾟ･｡
（思いっきり再発明というか、「あるんだろうなぁ」とは思ってたんだけど＾＾；）
あと、参考～（例によって、Ktatさんのところから＾＾；）
Time::Piece - オブジェクト指向な時間オブジェクト
Time::Seconds - 他の日付の値を秒に変換する簡単なAPI
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■設定ファイルをより簡単に
かぁ～、今になって、こんな便利そうなもの発見しちゃった！；；
設定ファイル、いつもどうしようって悩むんだけど、
コレなら設定ファイルもオブジェクト指向でいけるじゃない＿|￣|○
何かの拍子に乗り換えていこう・・
当分、＿|￣|○な事多そうだｗ
| パーマリンク
| コメント (17)
| トラックバック (0)
|
■オブジェクト指向万歳！
どし～Σ(ﾟ口ﾟ；
回りくどいし、面倒な分、楽になるトコは非常に楽だｗ
メインが非常に読みやすくなった。
コメントもういらねぇ＜後で困るのは自分ですｗ
継承とか、多重継承とか使ってない分、
オブジェクト指向といえるものかどうかは分かりませんがｗ
あれよあれよという間に、ログイン/アウトなCGIが完成しちまったです。
CGI::Sessionはスバラシイ！
CPAN万歳！
びるずさんに命名してもらったモジュールを使ったときはこんな感じ（ぉ
my $tt = TToolKit->new;
$tt->Output($html);
あぁ、Outputするんだな、と言う感じですっきりしていて、分かりやすい。
＃なんでいちいち、Outputなんてメソッド用意したかは聞かないでくださいｗ
＃printすればいいじゃんとかｗ
＃HTML::Template使えよとか。CGIモジュールは出力には使わねぇのかよ、とか。
＃ん？メソッド？インスタンス？（混乱ｗ
あー、こんなこと書いてる間に、
もう少し上手い方法見つけたΣ(ﾟ口ﾟ；
# ログインチェック
my ($login_flag,$error) = $login->check($q,$session,$dbh);
これ、戻り値二つも必要ないなΣ(ﾟ口ﾟ；
エラーがあるかないかだけで判別すりゃいいじゃん＿|￣|○
そんなこんなで、もう少し楽しみます～ｗ
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■初めてのオブジェクト指向
久々に（ぉ、ガリガリとプログラミング開始しましたｗ
ちょっと、腕鳴らしに、今まで作ったライブラリをオブジェクト指向化してみてます。
＃今回の仕事で使うやつね＾＾；
というか、メール送信用のサブルーチンライブラリ作っておいたやつを、
モジュール化しただけで、いきなり再発明の匂いぷんぷんですがｗ
＃CPAN（しーぱん）にたくさんあるしねｗ＞mailモジュール
でもいいんです。
とりあえず、腕慣らしとオブジェクト指向でも自分は組めるという自信の為ですｗ
この調子で、ガンガン組んでいこうかと思っていますが、
さて、メール送信用モジュールもそうだけど、
大体、”自分に使いやすい”物をかき集めて、モジュール化しようって話で、
モジュール名、ちょっと考えちゃいますｗ
既存のものとかぶっても仕方ないし、
ForTaro.pmとかってモジュールあったら怒られるかな＾＾；
＃取引先に・・・ｗ＜怒られる
まぁ、そこまでは見ないと思うけど＾＾；
楽しくなってきたところ、勢い落とさないよう頑張っていきたいと思います。
ちなみに、メッセで、ぴかさんと話したんだけど、
オブジェクト指向は回りくどいね＾＾；
ひとりで作ってる奴には要らないんじゃないかと指摘されたりｗ
参考にさせていただいたページ
Perlオブジェクト指向プログラミング
初心者のためのオブジェクト指向チュートリアル
| パーマリンク
| コメント (7)
| トラックバック (0)
|
■MyMSNの動向
WAY TO GO: MSNPによるエージェント
ページの更新は滞ってますが、水面下で着々と作成中…
MyMSN - Now Encoding
以前、Blogの方にトラックバックしたら、コメントいただけたので、再び記事書いてみるテスト＾＾；
Blogの方でだいぶ忙しくなりそうなことが書いてあったので、止まってるもんだとばかり思ってました＾＾；
プラグイン用ベースクラス群を見ただけでも、僕にはとてもお手伝いできそうに無いと感じたので、ただひたすら、気長に完成を待ちますｗ
＃それしか言えませんｗ
一応、以前UPしたMSNメッセステータス表示CGIはまだ動いてたりします。
MSNメッセのステータス表示
UTF-8は、まいったねぇ。
Jcodeは非効率だし（らしい）、
Encodeの使い方は良く把握してないし＾＾；
| パーマリンク
| コメント (0)
| トラックバック (0)
|
■MSNステータス表示2
暇見てはいろいろ探して歩いてみた結果、やっぱりやってる人はいますなｗ
WAY TO GO: 最近のコト・趣味的なコト・技術的な話
それに、MSNからIRCに繋げられたり、勝手に指定したニュース巡回してくれたり、Webで自分のMSNアカウントのオンライン表示なんかできちゃったらスバラシイでしょ？しかも自力で(これが重要ｗ)。
暇さえあればコーディング＆調べ物してるんですが、まぁなかなかややこしい上に情報が少ない感じ。
まともに公開出来る日が来るのはいつになることやら。
こっち（MyMSN - Now Encoding）へ足跡残してきたけど、期待しながら、僕は自分の仕事してようｗ
自分には出来そうも無いしね:-p
ステータス表示だけなら、こんな重装備はいらないように思えるけど、動いてるところを見てみたいと言う気持ちもｗ
| パーマリンク
| コメント (2)
| トラックバック (0)
|
■MSNメッセのステータス表示
ずぅ～っと、やりたくて考えていたんだけど、
自分のメッセの状態をWebサイトに載せたいと思って暇見ては、調べてきたが、
やっとこさそれっぽいのを発見。
MSN メッセンジャの状態表示にある、MSN.pmはどうも、プロトコルが古いらしい。
使ってみたけどよくわからんかったｗ
＃MSNプロトコルを調べた方が早いΣ(ﾟ口ﾟ;
これが今まで、で今日見つけたのは、
これ。
＃技術的なことを調べていると2chは良く引っかかるｗ
んで、前スレ725氏が後悔していたソースに手を加えたら、
サインインして、自分の状態確認でｷﾀ━━━(ﾟ∀ﾟ)━━━━!!
んだけど、呼び出されるたびに、こちら側で「taro_serverがサインインしました」とか言われるのもなんなので、どうしたものかとｗ
FLN（オフライン）を投げたら、確かにサインインしましたとか言われなくなったけど、
こちらの状態も取得できません(ﾟ∀ﾟ)
手を加えて、（状態表示のためだけに）サーバにしちまうか、
MyMSN.pmを待ちたいと思います。
＃というか、プロトコル調べれよｗ
まぁ、なかなか遊べたって話しΣ(ﾟ口ﾟ;
─さらに追記─────────────
出来た出来たｗ
オフラインはFLNじゃ無かった＾＾；
HDNを投げると見事に、こっち側にはINしたように見えずに、
こちら側の状態を取得して表示しましたｗ
って事で、テスト！
（ここをクリックすると、僕のサインイン状況が見えます）
| パーマリンク
| コメント (0)
| トラックバック (0)
|
