Run any Perl applications on Heroku
I made a simple heroku-buildpack for perl. With using this buildpack you can run any perl application from Procfile.
github: https://github.com/kazeburo/heroku-buildpack-perl-procfile
Sample and Usage
This sample runs a PSGI server and a worker in 1 Dyno (It's free).
$ ls cpanfile Procfile server.pl lib/ $ cat cpanfile requires 'HTTP::Tiny','0.043'; requires 'Getopt::Long'; requires 'Proclet'; requires 'Plack'; requires 'Starlet'; $ cat Procfile web: ./server.pl --port $PORT $ heroku create yourappname --buildpack https://github.com/kazeburo/heroku-buildpack-perl-procfile.git $ git push heroku master ... -----> Heroku receiving push -----> Fetching custom buildpack -----> Perl/Procfile app detected -----> Installing dependencies
And server.pl
#!/usr/bin/env perl use strict; use warnings; use FindBin; use lib "$FindBin::Bin/lib"; use Proclet; use Plack::Loader; use Getopt::Long; use HTTP::Tiny; my $port = 5000; Getopt::Long::Configure ("no_ignore_case"); GetOptions( "p|port=s" => \$port, ); $proclet->service( tag => 'worker', code => sub { my $worker = MyWorker->new; $worker->run }, ); my $app = MyWeb->to_psgi; $proclet->service( code => sub { my $loader = Plack::Loader->load( 'Starlet', port => $port, host => 0, max_workers => 5, ); $loader->run($app); }, tag => 'web', ); $proclet->run;
In some cases, adding a worker to access the Web server periodically might be good.
$proclet->service( every => '*/30 * * * *', tag => 'ping', code => sub { my $ua = HTTP::Tiny->new; $ua->get("http://${yourservicename}.herokuapp.com/"); } );
Proclet is minimalistic Supervisor. it also supports cron like jobs. it's very useful!
At the last, don't forget to add exec permission to server.pl
chmod +x server.pl
Web::Module::CoreList
I created Web::Module::CoreList. This site provides Web interface of Module::CoreList. You can know what modules shipped with versions of perl through this web site.
Web::Module::CoreList is created based on tokuhirom's one. His site is currently unavailable.
(解決済み) DBIx::TransactionManager + File::RotateLogsで意図せずトランザクションが終了してしまう件
DBIx::TransactionManager 1.13で子プロセスでrollbackを実行しないような変更が入っています。
https://metacpan.org/release/NEKOKAK/DBIx-TransactionManager-1.13
TengやDBIx::Sunnyなどでトランザクションを使用し、File::RotateLogsでログを書き出している場合はバージョンアップをお勧めします。
経緯など
某サービスにおいて、DBIx::TransactionManagerを使ってトランザクションを実行している箇所で9時にトランザクションが意図せず終了するという問題がありました。
コードにするとこんな感じ
my $rotatelogs = File::RotateLogs->new( logfile => '/path/to/access_log.%Y%m%d%H%M', linkname => '/path/to/access_log', rotationtime => 86400, maxage => 86400*14, ); my $tm = DBIx::TransactionManager->new($dbh); my $txn = $tm->txn_scope; $dbh->do("insert into foo (id, var) values (1,'baz')"); $rotatelogs->print("log! log! log!"); $dbh->do("update foo set var='woody' where id=1"); $txn->commit;
DBIx::TransactionManager->txn_scopeすると、トランザクションを開始し、guardオブジェクトが返ります。commitせずに途中で終了した場合は、guradオブジェクトが破棄され、自動でrollbackがかかる仕組みになっています。
このトランザクション中にログを書くだけなら問題なさそうですが、File::RotateLogsはrotationtimeで設定した時間ごとにファイルを切り替え、maxageよりも古いログがあればProc::Daemonモジュール使い、削除用プロセスをデーモンとして起動して、古いログを削除します。
この際、Proc::Daemonはforkを2回して、プロセスを元のプロセスから切り離しますが、1回目にforkされた子プロセスは孫プロセスをforkしたあとすぐにexit()します。そこで、global destructionが走り、$txn も破棄されるので、なんとrollbackが走ってしまいます。
File::RotateLogsのprintとProc::Daemonを展開するとこんな感じ
$fh->print($log); if ( 削除するファイルがある ) { my $pid = fork; #1回目のfork if ( $pid == 0 ) { #子プロセス $pid = fork; #2回目のfork if ( $pid == 0 ) { #孫プロセス unlink .. #削除 POSIX::_exit(); #ここはglobal destructionを防いでいた } exit; ここでrollback } waitpid($pid,0); }
トランザクション中にforkなんて普通はしないと思いますが、今回はDBIx::TransactionManagerの方で対策をいれてもらい、guardオブジェクトのDESTROYの中で、トランザクション開始時のpidと現在のpidが異なっていたらrollbackせずにそのまま終了するようになりました。
nekokakさんありがとうございます
参考
DBIとforkの関係 - heboi blog
http://nihen.hatenablog.com/entry/2011/11/17/102557
Router::BoomとRouter::Simpleの文字列エンコードまわりの動作
昨日気付いた。
Router::Simpleはいわゆるutf8 flaggedな内部文字列を渡すと、キャプチャしたテキストも内部文字列として得られるけど、Router::Boomはバイナリ列となる。
use Router::Boom; use Router::Simple; use Encode; use Test::More; use utf8; subtest 'boom' => sub { my $path = '/foobarです'; my $router = Router::Boom->new(); $router->add('/:user', 'dispatch_user'); my @args = $router->match($path); is $args[1]->{user}, 'foobarです', 'match'; ok Encode::is_utf8($args[1]->{user}),'utf8'; }; subtest 'simple' => sub { my $path = '/foobarです'; my $router = Router::Simple->new(); $router->connect('/:user', {action=>'dispatch_user'}); my $args = $router->match($path); is $args->{user}, 'foobarです', 'match'; ok Encode::is_utf8($args->{user}),'utf8'; }; done_testing;
結果
% perl -MTest::Pretty ./boom.pl
boom
✖ match
# Failed test 'match'
# at /path/to/boom.pl line 12.
# got: 'foobarã§ã'
# expected: 'foobarです'
✖ utf8
# Failed test 'utf8'
# at /path/to/boom.pl line 13.
simple
✓ match
✓ utf8KossyはRouter::Boom使っているので、得られたテキストをdecodeするようにした
通信先が明確な内部APIなどのURIを構築するときはURI.pmを使わなくても良いんじゃないかな
通信先が明確な内部APIなどのURIを構築するときはURI.pmを使わなくても良いというかURI.pmはあまり速くないので、文字列連結だけで十分だと思います
#!/usr/bin/perl use strict; use warnings; use Benchmark qw/:all/; use URI; use URI::Escape; use URL::Encode::XS qw/url_encode/; my $base = q!http://api.example.com!; my $path = q!/path/to/endpoint!; my %param = ( token => 'bar', message => 'foo bar baz hoge hogehoge hogehoghoge', ); cmpthese(timethese(-2, { 'uri' => sub { my $uri = URI->new($base . $path); $uri->query_form( s_id => 1, type => 'foo', %param ); $uri->as_string; }, 'concat' => sub { my @qs = ( s_id => 1, type => 'foo', %param ); my $uri = $base . $path . '?'; while ( @qs ) { $uri .= shift(@qs) . '='. uri_escape(shift(@qs)) . '&' } substr($uri,-1,1,""); $uri; }, 'concat_xs' => sub { my @qs = ( s_id => 1, type => 'foo', %param ); my $uri = $base . $path . '?'; while ( @qs ) { $uri .= shift(@qs) . '='. url_encode(shift(@qs)) . '&' } substr($uri,-1,1,""); $uri; }, })); __END__ Benchmark: running concat, concat_xs, uri for at least 2 CPU seconds... concat: 2 wallclock secs ( 2.04 usr + 0.00 sys = 2.04 CPU) @ 81818.63/s (n=166910) concat_xs: 2 wallclock secs ( 2.17 usr + 0.00 sys = 2.17 CPU) @ 277470.51/s (n=602111) uri: 2 wallclock secs ( 2.20 usr + 0.00 sys = 2.20 CPU) @ 25653.18/s (n=56437) Rate uri concat concat_xs uri 25653/s -- -69% -91% concat 81819/s 219% -- -71% concat_xs 277471/s 982% 239% --
application/x-www-form-urlencoded パーサーの動作を決める
深淵な理由があって2014年に application/x-www-form-urlencoded のパーサーを作ることになるとして仕様を考える
基本はW3CのSPECを参考にしつつ、これまでのアプリケーションとの互換性を保つことを目標とする
- application/x-www-form-urlencoded ペイロードを "&" (U+0026) または ";" (U+003B) を使って分割する
- name-valueを格納する配列を用意
- 分割された文字列を次のように処理する
- 文字列の最初の文字が " " (U+0020) であればそれを削除
- 文字列に"="が含まれていれば、最初の"="までの文字をnameとし、残りの文字をvalueとする。最初の"="以降に文字がなければvalueは空文字。"="が文字列の最初の文字であればkeyを空文字とする。文字列に"="が含まれていない場合、文字列のすべてをnameとし、valueは空文字列とする。
- 全ての "+" (U+002B) を " " (U+0020) に入れ替える
- nameとvalueをunescapeし、配列に格納(push)する
- 配列を返す
テストデータはこんな感じになるかな
'a=b&c=d' => ["a","b","c","d"] 'a=b;c=d' => ["a","b","c","d"] 'a=1&b=2;c=3' => ["a","1","b","2","c","3"] 'a==b&c==d' => ["a","=b","c","=d"] 'a=b& c=d' => ["a","b","c","d"] 'a=b; c=d' => ["a","b","c","d"] 'a=b; c =d' => ["a","b","c ","d"] 'a=b;c= d ' => ["a","b","c"," d "] 'a=b&+c=d' => ["a","b"," c","d"] 'a=b&+c+=d' => ["a","b"," c ","d"] 'a=b&c=+d+' => ["a","b","c"," d "] 'a=b&%20c=d' => ["a","b"," c","d"] 'a=b&%20c%20=d' => ["a","b"," c ","d"] 'a=b&c=%20d%20' => ["a","b","c"," d "] 'a&c=d' => ["a","","c","d"] 'a=b&=d' => ["a","b","","d"] 'a=b&=' => ["a","b","",""] '&' => ["","","",""] '=' => ["",""] '' => []
