jmblog.jp » webdev

Google::Chart を使って QRコードを生成する

Yoshihide — Fri, 12 Mar 2010 05:50:45 +0000

仕事でQRコードを生成しなくちゃならなくなり、「Google が API とか公開してたりして」と思って軽い気持ちで調べてみたら、本当に公開していてビックリ。Google Chart API で QRコードが作れる！

» QR Codes – Google Chart Tools / Image Charts (aka Chart API) – Google Code

で、Perl から使うには、Google::Chart がとてもお手軽で簡単でした。

#!/usr/bin/perl
use strict;
use warnings;
use Google::Chart;

my $url = 'http://jmblog.jp';
my $size = '160x160';

my $chart = Google::Chart->new(
type => {
module => 'QRcode',
args => {
text => $url,
encoding => 'shift_jis',
},
},
size => $size,
);
print $chart->as_uri,"\n";
$chart->render_to_file( filename => 'qr-code.png' );

まったく、なんて便利な世の中なんでしょ！

TheSchwartzで関連するジョブをグルーピングしてまとめて実行する

Yoshihide — Tue, 19 Jan 2010 10:34:22 +0000

TheSchwartz では、関連するジョブをグルーピングしてまとめて実行することができるとドキュメントに書いてあったので、試しにやってみました。（参考にしたのは、Movable Type のソースコード。）

グルーピングしない場合

まずは、普通に処理する場合。キューにジョブを追加する client.pl はこんな感じ。

#!/usr/bin/perl
use strict;
use warnings;
use TheSchwartz;
use DateTime;

my $client = TheSchwartz->new(
databases => [
{
dsn => 'dbi:mysql:TheSchwartz',
user => 'db_user',
pass => 'db_password',
}
],
);
$client->insert( 'SampleWorker1', { datetime => DateTime->now( time_zone => 'local') } );
print "added a job\n";

続いて、溜まったジョブを実行する worker.pl はこんな感じ。

package SampleWorker1;
use strict;
use warnings;
use base qw( TheSchwartz::Worker );
use TheSchwartz::Job;

sub work {
my $class = shift;
my TheSchwartz::Job $job = shift;
printf("[%s] %s\n", $job->arg->{datetime}->hms(), $job->funcname);
$job->completed();
}

package main;
use strict;
use warnings;
use TheSchwartz;

my $client = TheSchwartz->new(
databases => [
{
dsn => 'dbi:mysql:TheSchwartz',
user => 'db_user',
pass => 'db_password',
}
],
);
$client->can_do('SampleWorker1');
$client->work();

worker.pl を実行すると監視状態になるので、client.pl を何度か叩いてみます。すると、以下のような結果が返ってきます。

[18:43:48] SampleWorker1
[18:43:49] SampleWorker1
[18:43:51] SampleWorker1
[18:43:54] SampleWorker1
[18:43:53] SampleWorker1
[18:43:52] SampleWorker1
[18:43:56] SampleWorker1
[18:43:58] SampleWorker1
[18:43:57] SampleWorker1
[18:43:59] SampleWorker1

グルーピングする場合

では、本題。まず client.pl です。ジョブをグルーピングするには、TheSchwartz::Job のインスタンスを生成して、coalesce というプロパティに値をセットします。

#!/usr/bin/perl
use strict;
use warnings;
use TheSchwartz;
use DateTime;

my $database_info = [
{
dsn => 'dbi:mysql:TheSchwartz',
user => 'db_user',
pass => 'db_password',
}
];

my $client = TheSchwartz->new( databases => $database_info );

### Group A ###
my $job = TheSchwartz::Job->new(
funcname => 'SampleWorker2',
coalesce => 'group_A',
arg => {
datetime => DateTime->now( time_zone => 'local' ),
},
);
$client->insert( $job );
print "added a job to Group A\n";

### Group B ###
$job = TheSchwartz::Job->new(
funcname => 'SampleWorker2',
coalesce => 'group_B',
arg => {
datetime => DateTime->now( time_zone => 'local' ),
},
);
$client->insert( $job );
print "added a job to Group B\n";

### Non grouped job ###
$client->insert('SampleWorker2', { datetime => DateTime->now( time_zone => 'local') });
print "added a job\n";

続いて worker.pl ですが、こちらはちょっとだけ工夫が要ります。work() メソッドが受け取ったジョブに coalesce がセットされていれば、TheSchwartz の find_job_with_coalescing_value() メソッドを利用して、同じ値がセットされているジョブを見つけて、まとめて実行します。

package SampleWorker2;
use strict;
use base qw( TheSchwartz::Worker );
use TheSchwartz::Job;

sub work {
my $class = shift;
my TheSchwartz::Job $job = shift;
my @jobs = ();
push @jobs, $job;

if (my $key = $job->coalesce) {
print "work for ", $job->coalesce, "\n";
my $client = TheSchwartz->new(
databases => [
{
dsn => 'dbi:mysql:TheSchwartz',
user => 'db_user',
pass => 'db_password',
}
],
);
while (my $coalesced_job = $client->find_job_with_coalescing_value($class, $key)) {
push @jobs, $coalesced_job;
}
}

foreach my $j (@jobs) {
printf("[%s] %s %s\n", $j->arg->{datetime}->hms(), $j->funcname, $j->coalesce);
$j->completed();
}
print "---------\n";
}

package main;
use strict;
use warnings;
use TheSchwartz;

my $client = TheSchwartz->new(
databases => [
{
dsn => 'dbi:mysql:TheSchwartz',
user => 'db_user',
pass => 'db_password',
}
],
);
$client->can_do('SampleWorker2');
$client->work();

client.pl を何度か叩いた後、worker.pl を実行すると、以下のような結果が得られました。group_A および group_B のジョブが一度の処理でまとめて実行されていることがわかります。

work for group_A
[19:10:01] SampleWorker2 group_A
[19:10:03] SampleWorker2 group_A
[19:10:02] SampleWorker2 group_A
---------
[19:10:01] SampleWorker2
---------
work for group_B
[19:10:02] SampleWorker2 group_B
[19:10:03] SampleWorker2 group_B
[19:10:01] SampleWorker2 group_B
---------
[19:10:02] SampleWorker2
---------
[19:10:03] SampleWorker2
---------

以上！

Coroの初歩的なハマリどころ

Yoshihide — Mon, 14 Dec 2009 08:06:22 +0000

時代は、Coroだ！AnyEventだ！ということで、

あたりを読みながらお勉強しているときに、ちょいハマった。

use strict;
use warnings;
use Coro;
use Perl6::Say;

async {
say 'hello';
}
cede;

このスクリプトを動かすと、

hello

と出力されるはず、なのに何も表示されない。こんな単純なコードなのに、なぜだー！と思ってよく見たら、 async の最後のセミコロンが抜けてた・・・

これなら動く。

use strict;
use warnings;
use Coro;
use Perl6::Say;

async {
say 'hello';
};
cede;

でも何で構文エラーにならないんでしょう？async は

async {
print "@_\n";
} 1,2,3,4;

というように、引数を受け取ることができるので、もしかして cede が引数として渡されてる？と思ったけど、

async {
say @_;
}
cede;
cede;

とやっても

cede

とは出力されない。Coroのコードを読んでも良くわからなかった。何で・・・？？

YAPC::Asia 2009 の感想

Yoshihide — Mon, 14 Sep 2009 12:54:17 +0000

Perl を使って早10年。はじめて YAPC::Asia に行ってきました。あまりエントリーを書く時間がないので、簡単に感想とかメモとか。（あんまりまとまってないです。）

1日目

「モダンPerl入門」の入門

ちょうど今やってるプロジェクトと同じ状況（初めて Catalyst ＋モダンPerl に挑戦）なので、共感できるところが多かった。
Catalyst::Model::Adaptor をいちいち書くのは確かにめんどくさい。でも Catalyst::Model::MultiAdaptor を使えばラクチンらしい。
自分のプロジェクトでは、API（Service と呼んでるけど）は CRUD もビジネスロジックも一つになってるけど、レプリケーションとかに対応するなら、確かにAPIをLogicとDataに分けた方が管理しやすそう。

PSGI – Perl Server Gateway Interface

ちがうセッションを聞いていたので聞けず・・・なんだか評判がよかったみたいなので、あとから資料追いたい。今年は PSGI が熱いらしい。

シックス・アパート・フレームワーク

my $entry = MT::Entry->new;

って書き方は古くって、今は

my $entry = MT->model('entry')->new;

と書くそうな。思いっきり前者で書いた。
アメリカと日本との開発体制はいろいろと大変そう。離れているとどうしても伝わらないことってあるからなぁ。

modern Catalyst

スライド：http://www.slideshare.net/hidek/modern-catalyst

Moose な Catalyst の話。断片的な知識が整理できてよかった。
“Sugar Syntax” というキーワードが出てきたけど、どういう意味なんだろう？？
Moose もっと勉強しなければ。

Event programming fun with AnyEvent and Coro

miyagawa 氏のトーク。すごくわかりやすい。さすが。
AnyEvent と Coro が熱いらしい。

ペパボでの Perl のつかいかた

このセッションもそうだけど、「コーポレートトラック」は実際の業務に使えそうな話がたくさん聞けてよかった。コーポレートトラックを設けたのは初めての試みだったそうだけど、とてもよいと思います。仕事に使えるのって大事。
Perlbal 試してみたい。

Corporate Perl in Recruit, OpenSocial and Emoji

身内の話なのでコメントは特にないですが、Recruit が Perl を長年採用してきたのは本当。私もPerl エンジニアの一人です。

Lightning Talks (1)

yusukebe 氏の miyagawanize 最高！！

2日目

FormValidator::LazyWay で検証ルールをまとめよう

正直、FormValidator::Simple との違い（どっちがよいのか）がわかっていない。今度実際に試してみよう。

スケールするウェブアプリケーションを20分で作る方法

難しい・・・全然ついていけなかった・・・
シャーディングって何？

kamaitachi – perl flash media server

Flash とか ActionScript はどうしても敬遠してしまうのはなぜなんだろう。
でもこんなの作れたらかっこいいなぁー

perl hacks on vim

スライド：http://www.slideshare.net/c9s/perlhacksonvim

もっと Vim を使いこなせるようにならねば。
:set equalprg=perltidy
perlprove.vim

大規模画像配信を支えるPerl

mixi の中の話。
この規模のインフラとかアーキテクチャって、すごいよ、本当に。
富豪プログラミングを改めて、もっとパフォーマンスにシビアになったほうがいいかな。

Perlbal Tutorial

スライド：http://www.slideshare.net/comewalk/perlbal-tutorial

めっちゃ役に立った。
今すぐ業務で試したい。

Asynchronous Programming for (A)synchronous Communication

40分で内容盛りだくさん。
AnyEvent とか Coro とか PubSubHubbub とか今年ブレークしそうな話題ですごく刺激を受けた。
非同期処理ってとっつきにくかったけど、やってみようと言う気にさせてくれるセッションでした。

Perl? Which Perl?

Dan Kogai 氏のトーク。わかりやすかった。
Perl 6 を業務で使うのはまだちょっと先になりそうだけど、楽しみ。
Perl 5.8.x はコンサバティブで、Perl 5.10.x がナウでモダンな Perl だそうです。
ちなみに、Snow Leopard にはどっちも入ってます。

Remedie: Building a desktop app using Perl, SQLite and jQuery

miyagawa 氏のトーク。
ここでも AnyEvent と Coro の話題が。
デスクトップアプリでは SQLite の選択肢は確かにありですね。バックアップも簡単だし、Dropbox を使えばいろんなパソコンで共有できるし。

Lightning Talks (2)‎

miyagawa 氏の話はやっぱ安定してるなーと思ってたら、そんな miyagawa 氏を前振りに使ってしまう yusukebe の才能に嫉妬。

全体を通して

会場の東工大は家からすぐ近くなので楽でした。来年もぜひ。
電源タップが全然なくて、そこが唯一残念でした。
何はともあれ、スタッフの皆さん、どうもありがとうございました。

とりあえず、AnyEvent と Coro と Perlbal を試してみようと思います！

DBIx::Class + Oracle でプライマリーキーを auto increment する方法

Yoshihide — Tue, 28 Jul 2009 14:13:20 +0000

Oracle には、MySQL の auto_increment 属性に該当する機能がありません。実現するには、次のサイトで紹介されているように、SEQUENCE と TRIGGER を組み合わせるというのが常套手段のようです。

でも、Perl の DBIx::Class を使えばラクチンです！例えば、次のようなクラスを作ったとします。

MyApp/Schema/Result/Post.pm

package MyApp::Schema::Result::Post;

use strict;
use warnings;

use base 'DBIx::Class';

__PACKAGE__->load_components( "Core" );
__PACKAGE__->table("post");
__PACKAGE__->add_columns(
id => {
data_type => 'NUMBER',
size => 11,
is_nullable => 0,
is_auto_increment => 1,
},
title => {
data_type => 'VARCHAR2',
size => 500,
},
);
__PACKAGE__->set_primary_key("id");

1;

15行目で is_auto_increment => 1 という指定をしています。この状態で、DBIx::Class::Schema の deploy メソッドを実行すると、次のように TABLE と同時に SEQUENCE と TRIGGER を自動的に作成してくれます。

CREATE SEQUENCE sq_post_id;

CREATE TABLE post (
id number(11) NOT NULL,
title varchar2(500),
PRIMARY KEY (id)
);

CREATE OR REPLACE TRIGGER ai_post_id
BEFORE INSERT ON post
FOR EACH ROW WHEN (
new.id IS NULL OR new.id = 0
)
BEGIN
SELECT sq_post_id.NEXTVAL
INTO :new.id
FROM dual;
END;

実際の処理は、SQL::Translator::Producer::Oracle が担当しているようです。

ちなみに、add_columns() でカラムを定義する時に、data_type => ‘timestamp’ とすると、同様に次のような TRIGGER が作成され、レコードの追加および更新時に自動的に SYSDATE をセットしてくれます。

CREATE OR REPLACE TRIGGER ts_post_updated_at
BEFORE INSERT OR UPDATE ON post
FOR EACH ROW WHEN (new.updated_at IS NULL)
BEGIN
SELECT sysdate INTO :new.updated_at FROM dual;
END;

仕事で Oracle を使うことになり、「えー！auto_increment ないのー！」と困っていたのですが、おかげで楽に実装できました。欲を言えば、作成する SEQUENCE の START WITH を指定できたり、レコードの追加のときだけ SYSDATE をセットしてくれる TRIGGER が自動生成できれば、もっとありがたいんだけどなぁ。