Log::LTSV::Instance 作った
Log-LTSV-Instance-0.01 - LTSV logger - metacpan.org リリースしました。
my $logger = Log::LTSV::Instance->new( logger => sub { print @_ }, level => 'DEBUG', ); $logger->crit(msg => 'hungup'); # time:2015-03-06T22:27:40 log_level:CRITICAL msg:hungup
PODにある通りだけども、こんな感じで使えます。
my $logger = Log::LTSV::Instance->new( logfile => $filename, );
見たくすると、 File::RotateLogs で動きます。
あー全部のログにuser_id(session_id)付けたいわーとかいう人はsticksを使いましょう。
$logger->sticks( session_id => sub { $c->session_id } ); $logger->crit(msg => 'hungup'); # time:2015-03-06T22:27:40 log_level:CRITICAL session_id:1 msg:hungup $logger->info(msg => 'hungup'); # time:2015-03-06T22:27:40 log_level:INFO session_id:1 msg:hungup
こんな感じにsticksというメソッドを使うことで、必ず吐き出されるログも入れることができるので、ご活用下さい。
ちなみに、HASHREF や ARRAYREF、Object を渡したとしてもよしなに AutoDump してくれますので、ご安心下さい。
my $obj = bless { cval => 1 }, 'TEST'; $logger->crit( class => $obj, hashref => { hval => 1 }, arrayref => [ 'a', 'b' ], ); # time:2015-03-07T22:51:19 log_level:CRITICAL class.cval:1 hashref.hval:1 arrayref.0:a arrayref.1:b
TODO
- AutoDumpしていいの？
- caller情報を自動で吐き出すべき？
どうしよっかなーって思ったけど、とりあえずバージョン１を上げたのでした！
subで参照カウンタが増える。そして意図しない動作
考えてみればそのとおりだけど、subの中にオブジェクトの名前を書いちゃうと参照カウンタが増える。 これによってDESTORY実行のフェーズが変わってしまってしばらくはまってしまったって話。
そのままsay
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Devel::Peek qw/SvREFCNT/; my $obj = "obj"; say $obj; say SvREFCNT($obj); # obj # 1
ちょっと使いやすくしちゃったわー系
#!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use Devel::Peek qw/SvREFCNT/; my $obj = "obj"; sub say_obj { say $obj; } say_obj; say SvREFCNT($obj); # obj # 2
後者のほうではsay_objとか定義しちゃってるせいで、参照カウンタが増えてしまってます。
…で何が問題なのかというと、例えば
- scopeから抜けた時に、Test::Objectをcleanしてから終わってくれ
- setupメソッドを叩くと基礎データを入れてくれる
みたいなコードを書いちゃったとします。 なんかよくテストコードとかで使ったりしますよね。
#!/usr/bin/env perl use strict; use warnings; { package Test::Object; sub new { my ($self, $args) = @_; bless { obj => $args, }, $self; } sub clean { #TODO implementation clean } } { package Test::Array; sub new { my $self = shift; bless { array => [], }, $self; } sub add { my ($self, $obj) = @_; push @{$self->{array}}, $obj; } sub DESTROY { my $self = shift; $_->clean for @{$self->{array}}; } } package main; my $obj = Test::Array->new; sub setup { $obj->add(Test::Object->new(1)); $obj->add(Test::Object->new(1)); $obj->add(Test::Object->new(1)); } setup(); xxxx.....
こういう風に書いちゃうと、上手く動かない時があるんです。 というのも、Perlを実行する時のフェーズには色々種類があって、ここに影響を与えちゃう。
はじめのサンプルコードで示すと、前者の方はRUNフェーズでdestoryが呼ばれ、後者の方はDESTRUCTフェーズでdestoryが呼ばれるのです。 DESTRUCTフェーズですが、この場合はもう、「全オブジェクト破棄してやるぜー」ってPerlさんがなってるので、順序を問わず、実行されてしまいます。
…となると、
sub DESTROY { my $self = shift; $_->clean for @{$self->{array}}; }
のcleanを実行しようとしているオブジェクトが既に破棄されてしまってる可能性があるわけです。 なので、実際にはcleanを実行できずアボン！
あんまり影響あるときは無いのですが、例えば、テストで立ち上げたmysqldのデータをクリーンアップするコードがDESTORYで定義されていた場合には、 それらが実行されずに次のテストが走ってテストが全落ちする…とかそういうこともあります。
ハマった。
ちなみに、以下のように書くだけでなおる。 テストコードの一部なのでこれで良いかなーとか思ったり。
my $obj = Test::Array->new; sub setup { my $obj = shift; $obj->add(Test::Object->new(1)); $obj->add(Test::Object->new(1)); $obj->add(Test::Object->new(1)); } setup($obj);
未リリース Test::Clear 作ってる
Test::Clear hixi-hyi/p5-Test-Clear · GitHub っていうのを作ってる。
case "{name} case" => { name => 'hixi' }, sub { my $dataset = shift; my $ret = $module->get_person($dataset->{name}); is $ret, xxxxx; }; # Subtest: basically name:hixi
subtestの何が嫌って、ユニットテストを書く時に、明確にスコープを分けようとすると、 以下のように書かないといけない。
{
my $name = 'hixi';
subtest "$name case" => sub {
ok $module->get_person($name), xxx;
};
}
{
my $name = undef;
subtest "$name case" => sub {
ok !$module->get_person($name), xxx;
};
}
一応Test::Simple(1.001006)以降だったら以下のようにかける。
が、subtestには変数を入れれなくなってしまって、何のテストをしているのかを明確に記述できない。
また、最後の行まで見ないと、何の変数のテストをしているのかがわからない。
(通常テストを見たり書くときには、前提データが何なのかを知りたい/定義したい)
subtest "case" => sub { ok $module->get_person($_[0]->{name}), xxx; }, { name => 'name' };
なので、文頭で書いたように、データセットを明確に記述出来るようなものを書いてる。
2つ目の引数は、coderefの場合は実行するようになってるので、こんなふうに書くことも出来る。
この場合はテストケースである、uriを明確に定義できるし、データセットが明確にわかりやすいんじゃないかな。
case 'request person data uri:{uri}' => sub { my $user_id = 1; my $uri = 'http://example.com/person/' . $user_id; return { uri => $uri, user_id => $user_id, } }, sub { my $dataset = shift; my $ret = $module->request($dataset->{uri}); is $ret->{person}->{id}, $dataset->{user_id}; }; # Subtest: request person data uri:http://example.com/person/1
ってことで、こんなの作ってます。
未リリース。
Test::Clearとかそんな一等地を取っていいのかも分からない！
※ ちなみに、TODOの改善もしてる こんな感じ。コードブロックにするとインデントとかちょっと嫌じゃないですかー的な。Clear
subtest 'optional case' => sub { my $guard = todo_scope 'not yet implementated'; fail; }; # Subtest: optional case not ok 1 # TODO not yet implementated
URLエンコーディングしたらどうなるかを調べる
ぱっとプログラムが思いつかなかったので、メモっておく
どれがエンコードされるかとかちゃんと把握してないんだよなぁ。
#!/usr/bin/env perl use strict; use warnings; use URI::Escape; sub print_escape { my $code = shift; my $char = sprintf("%c", sprintf("%X", hex $code)); print $code . ' to '. $char. ' to '. uri_escape($char)."\n" } my $start_num = 33; my $end_num = 127; for my $code ($start_num..$end_num) { print_escape($code); }
33 to ! to %21
34 to " to %22
35 to # to %23
36 to $ to %24
37 to % to %25
38 to & to %26
39 to ' to %27
40 to ( to %28
41 to ) to %29
42 to * to %2A
43 to + to %2B
44 to , to %2C
45 to - to -
46 to . to .
47 to / to %2F
48 to 0 to 0
49 to 1 to 1
50 to 2 to 2
51 to 3 to 3
52 to 4 to 4
53 to 5 to 5
54 to 6 to 6
55 to 7 to 7
56 to 8 to 8
57 to 9 to 9
58 to : to %3A
59 to ; to %3B
60 to < to %3C
61 to = to %3D
62 to > to %3E
63 to ? to %3F
64 to @ to %40
65 to A to A
66 to B to B
67 to C to C
68 to D to D
69 to E to E
70 to F to F
71 to G to G
72 to H to H
73 to I to I
74 to J to J
75 to K to K
76 to L to L
77 to M to M
78 to N to N
79 to O to O
80 to P to P
81 to Q to Q
82 to R to R
83 to S to S
84 to T to T
85 to U to U
86 to V to V
87 to W to W
88 to X to X
89 to Y to Y
90 to Z to Z
91 to [ to %5B
92 to \ to %5C
93 to ] to %5D
94 to ^ to %5E
95 to _ to _
96 to ` to %60
97 to a to a
98 to b to b
99 to c to c
100 to d to d
101 to e to e
102 to f to f
103 to g to g
104 to h to h
105 to i to i
106 to j to j
107 to k to k
108 to l to l
109 to m to m
110 to n to n
111 to o to o
112 to p to p
113 to q to q
114 to r to r
115 to s to s
116 to t to t
117 to u to u
118 to v to v
119 to w to w
120 to x to x
121 to y to y
122 to z to z
123 to { to %7B
124 to | to %7C
125 to } to %7D
126 to ~ to ~
127 to to %7F
PerlのVersionにおけるNVとかPVとかの取り扱いの違い
こう書けばNVとPV混じったものが出来ると思っている時期がありました。
#!/usr/bin/env perl use strict; use warnings; use Devel::Peek; use JSON::XS qw(encode_json); print "$] \n"; { no warnings 'void'; my $value = ~0 + 1; $value . ''; Devel::Peek::Dump($value); print encode_json({ value => $value }). "\n"; }
5.008008
SV = PVNV(0x7f86e1849fa0) at 0x7f86e182a100
REFCNT = 1
FLAGS = (PADBUSY,PADMY,NOK,POK,pNOK,pPOK)
IV = 0
NV = 1.84467440737096e+19
PV = 0x7f86e146a740 "1.84467440737096e+19"\0
CUR = 20
LEN = 40
{"value":"1.84467440737096e+19"}
5.018002
SV = PVNV(0x7f91d38afad0) at 0x7f91d383bab0
REFCNT = 1
FLAGS = (PADMY,NOK,POK,pNOK,pPOK)
IV = 0
NV = 1.84467440737096e+19
PV = 0x7f91d340b020 "1.84467440737096e+19"\0
CUR = 20
LEN = 48
{"value":"1.84467440737096e+19"}
5.020000
SV = PVNV(0x7f8c01823ed0) at 0x7f8c0183d1b8
REFCNT = 1
FLAGS = (PADMY,NOK,pNOK)
IV = 0
NV = 1.84467440737096e+19
PV = 0x7f8c0140b2b0 "1.84467440737096e+19"\0
CUR = 20
LEN = 48
{"value":1.84467440737096e+19}
5.20だとちゃんとNVだと認識してくれるのねー Bモジュールの機能に依存して実装されてるモジュールのメンテナンスは大変そう。 そして、そういったモジュール(JSON系)を使ってる人も皆意識していかないとですね。
Devel::Peek::Dumpの信用できるところと信用出来ないところ
Devel::Peek::Dumpは同じアドレス空間の変数に対して、IV/NV/PVとかここの要素は更新しないっぽい。 (最後のundefをdumpした時にもIV/NVが存在しているし、SV=XXの部分も更新されない)
#!/usr/bin/env perl use 5.10.0; use strict; use warnings; use Devel::Peek; Test::Devel::dump(2); Test::Devel::dump(1.1); Test::Devel::dump(undef); Test::Devel::dump('a'); Test::Devel::dump(undef); package Test::Devel; sub dump { my $value = shift; Devel::Peek::Dump($value); }
SV = IV(0x7f82d304e458) at 0x7f82d304e468 REFCNT = 1 FLAGS = (PADMY,IOK,pIOK) IV = 2 SV = PVNV(0x7f82d3004a30) at 0x7f82d304e468 REFCNT = 1 FLAGS = (PADMY,NOK,pNOK) IV = 2 NV = 1.1 PV = 0 SV = PVNV(0x7f82d3004a30) at 0x7f82d304e468 REFCNT = 1 FLAGS = (PADMY) IV = 2 NV = 1.1 PV = 0 SV = PVNV(0x7f82d3004a30) at 0x7f82d304e468 REFCNT = 1 FLAGS = (PADMY,POK,IsCOW,pPOK) IV = 2 NV = 1.1 PV = 0x7f82d2c0f0f0 "a"\0 CUR = 1 LEN = 16 COW_REFCNT = 1 SV = PVNV(0x7f82d3004a30) at 0x7f82d304e468 REFCNT = 1 FLAGS = (PADMY) IV = 2 NV = 1.1 PV = 0
ちなみに、Cloneとか使ってこうやればIV/NVあたりは初期化される。 が、typeは更新されない。
#!/usr/bin/env perl use 5.10.0; use strict; use warnings; use Devel::Peek; use Clone qw(clone); Test::Devel::dump(2); Test::Devel::dump(1.1); Test::Devel::dump(undef); Test::Devel::dump('a'); Test::Devel::dump(undef); package Test::Devel; sub dump { my $value = shift; Devel::Peek::Dump(Clone::clone($value)); }
SV = IV(0x7fdcea805dd8) at 0x7fdcea805de8 REFCNT = 1 FLAGS = (TEMP,IOK,pIOK) IV = 2 SV = PVNV(0x7fdcea804a50) at 0x7fdcea805c38 REFCNT = 1 FLAGS = (TEMP,NOK,pNOK) IV = 0 NV = 1.1 PV = 0 SV = PVNV(0x7fdcea804a50) at 0x7fdcea805de8 REFCNT = 1 FLAGS = (TEMP) IV = 0 NV = 0 PV = 0 SV = PVNV(0x7fdcea804a50) at 0x7fdcea805c38 REFCNT = 1 FLAGS = (TEMP,POK,pPOK) IV = 0 NV = 0 PV = 0x7fdcea4160d0 "a"\0 CUR = 1 LEN = 16 SV = PVNV(0x7fdcea804a50) at 0x7fdcea805de8 REFCNT = 1 FLAGS = (TEMP) IV = 0 NV = 0 PV = 0
ってことで、素直にIV/SVとか見たいときは、 FLAGSを見るとか、 以下の様にB::svref_2objectで作ったオブジェクトの中からFLAGSを持って来る必要があるっぽい
B::svref_2object(\$value)->FLAGS;
そして普通に書いてあった！！ https://metacpan.org/pod/Devel::Peek#A-simple-scalar-string
rackhubでWebサーバを公開したい(nginx)
rackhubのnginxを使ってWebサーバを公開してみましょう．
ってことで，前回の記事に元にrackhubを借ります．
ログインまでは出来ましたね．
Webサーバを立てるには
$ sudo /etc/init.d/nginx start
で出来ます．
…終わりです．
http://www.名前.rackhub.net/
に接続すればサーバが公開されてることがわかります．
rackhubで設定されている標準の公開ディレクトリは
/rhb/nginx-1.0.11/html
なので，ここに新しいファイルを書いていきましょう！
(書き込み/編集をする場合はroot権限が必要なので
$ sudo vim index.html
などのコマンドを使って管理者権限で編集しましょう）
ってことで簡単になり過ぎちゃいましたが，以上です．
一応
http://twitter.com/#!/keikubo/status/187621247197261827
との事なので公開用ディレクトリとかも弄らない方向で書きましたm(_ _)m
