NeverBlog::Likk::Unexistable;

見なかったことにして下さい

String::Slack でっちあげた

github.com

使い方は簡単で

say String::Slack->new("message")->bold->italics->stringify; #_*message*_

となる。


きっちりとslack.com に投げるところまで書く場合のsampleコードもつけた。

use strict;
use warnings;
use Furl;
use JSON::XS              qw/encode_json/;
use HTTP::Request::Common qw/POST/;
use String::Slack;

my $message = 'hoge';
my $url     = 'https://slack.com/api/chat.postMessage';
my $token   = 'xxxxx-XXXX-XXXX';
my $channel = 'XXXXXXX';

my $data = {
    channel => $channel,
    text    => String::Slack->new($message)->bold->italics->stringify,
    as_user => 1,
};

my $request = POST($url,
    Content_Type => 'form-data',
    Content      => [
        token => $token,
        %$data,
    ]
);

my $res = Furl->new->request($request);

こんな感じで簡単にslackに投げる文字に装飾をつけることが出きる。

DBIx::Skinnyのトランザクション観測したい。

実装書いてるうちに、どのタイミングでcommit/rollback が発行されるのか確認したくなったんだ。
そしたら。


正確にはBEGIN/COMMIT/ROLLBACK

txn_scope を使わずに、search_named() を使うと BEGIN/COMMIT/ROLLBACK はきちんとDBIx::QueryLogのログに吐かれる。かと言ってトランザクション自前管理はしたくない。どうにかDBIx::Skinny::Transactionを観測する方法はないだろうか。普通にwarnするか。



蛇足。
ソースコード見てるうちにちょっとイタズラしたくなった。



#下書きのまま放置していたので公開。
#結局 Test::Mock::Guard 辺りで観測する事に落ち着いた。

コマンドラインからslackチャット

slackを使い始めたのでコマンドラインからslackの閲覧と発言が出きるツール書いたのでgistに上げた。

これは下記エントリ id:mihyaeru21 が作ってくれたライブラリWebService::Slack::WebApiを使ってるので、APIとの疎通周りをほとんど気にせず書くことができた。mihyaeru21.hatenablog.com

煩わしいチャンネル移動も不要だし、$SAVE_FILE_PATHを有効にすればログを手元に保存するのでログ上限とかも気にしなくて済む。
ただslackの便利なコマンド補完ができないので普通にwebかクライアント使うほうがどう考えても楽なので、お気楽にログを眺めていたい程度の時に立ち上げておくといい感じになるかもしれない。

実行は簡単で単にコマンドを叩いて初回に聞かれるAPI-TOKENを入力するだけ。Config::Pit を使ってるので二回目以降の立ち上げはそれも不要。
発言したい時は

#channel_name hoge

とか入れるとそのチャンネルにpostされる。
これも2回目以降はチャンネル名は不要で本文だけ入れればpostできる。
別のチャンネルに発言したくなったら、改めてチャンネル名を入れればいい。

実行時のイメージは下記な感じ。
f:id:likk:20150508145353j:plain

Perl で undef を含むものをsortについて考えてみた。

blog.likk.jp
で切り捨てた undefについて考えてみた。undef sortした時に最大値ととるか最小値ととるかによって違うけど、最小値として考えるなら以下のとおりにの書き方になる。

use strict;
use warnings;
use Clone qw/clone/;
use YAML;

my $list = [
    { name => 'aaa', hoge => 10,    fuga => 1 },
    { name => 'bbb', hoge => 11,    fuga => 2 },
    { name => 'ccc', hoge => 11,    fuga => 1 },
    { name => 'ddd', hoge => 12,    fuga => 1 },
    { name => 'eee', hoge => undef, fuga => undef },
    { name => 'fff', hoge => undef, fuga => 1 },
    { name => 'ggg', hoge => 10,    fuga => undef },
    { name => 'hhh', }
];

my $sorted_list = [
    map  { sprintf("%s, hoge:%s fuga:%s", $_->{name} || '' , $_->{hoge} || '', $_->{fuga} ||'') }
    sort {
      (defined($a->{hoge} and $b->{hoge}) ? $a->{hoge} <=> $b->{hoge}
        : defined($a->{hoge}) ? +1
        : defined($b->{hoge}) ? -1 : 0
      )
      or
      (defined($a->{fuga} and $b->{fuga}) ? $a->{fuga} <=> $b->{fuga}
        : defined($a->{fuga}) ? +1
        : defined($b->{fuga}) ? -1 : 0
      )
    }
    map {
        $_->{hoge} //=undef;
        $_->{fuga} //=undef;
        $_;
    } @{ clone($list) }
];

warn YAML::Dump $sorted_list;
#---
#- 'eee, hoge: fuga:'
#- 'hhh, hoge: fuga:'
#- 'fff, hoge: fuga:1'
#- 'ggg, hoge:10 fuga:'
#- 'aaa, hoge:10 fuga:1'
#- 'ccc, hoge:11 fuga:1'
#- 'bbb, hoge:11 fuga:2'
#- 'ddd, hoge:12 fuga:1'

ちなみに、defind とかしなくて普通に <=> してもwarning 吐きながらではあるが同じ結果にはなる。
昇順だけど、undef は最後に出したいとかなら上記の例の符号を逆にすればいい。

そもそもsortしたいカラムならNOT NULL制約かけろよとかデフォルト値設けろという話はとりあえず置いておく。


ところで、同じことしてくれるCPANモジュールあると思うんですが、誰か知りませんか。

Perl で複数条件sort

業務で10年近くperl触ってるのに、普通にやる機会がなかった。
大体DBのorder by で済ましてる気がする。
ちなみに、ソート対象がundefのものが表にでては具合がわるい仕様なので出さないようにしている。order by のように昇順ではundefのものを最初に、降順では最後にもってくるにはもう一工夫が必要。(mysqlの話です。oracleは昇順だと最後に、降順だと最初だと記憶してます。)

use strict;
use warnings;
use YAML;

my $list = [
    { name => 'aaa', hoge => 10,    fuga => 1 },
    { name => 'bbb', hoge => 11,    fuga => 2 },
    { name => 'ccc', hoge => 11,    fuga => 1 },
    { name => 'ddd', hoge => 12,    fuga => 1 },
    { name => 'eee', hoge => undef, fuga => 1 },
];

my $sorted_list = [
    map  { $_->{name} }
    sort {
        $a->{hoge} <=> $b->{hoge} or
        $a->{fuga} <=> $b->{fuga}
    }
    grep { defined $_->{hoge} and  defined $_->{fuga} } @$list
];

warn YAML::Dump $sorted_list;
#---
#- aaa
#- ccc
#- bbb
#- ddd

<=> は両方の値が等価の場合は0が返るので、or で次の条件似つなぐ。条件が増えた場合は更にorでなげば良い。


ところで、件名に悩んだんだけど、どういう言い方をするのが適切なんだろうか。
複数条件ソート？複数指定ソート？

Perl から任意のログインシェルでsystemや``を実行する方法

perl から シェルを実行したいときは system か `` (qx//) で代替済むのですが、それらから呼び出すのが素のsh でどうしても実行環境のzshrc を読み込んだ上でzsh を実行したいことが出てきた。

でも `zsh hoge`; とか system("zsh && hoge"); やってもダメなんですよね。
んで、良い方法も特に思い浮かばなくてローカルに鍵通して `ssh localhost -t "hoge"` にした。

ログインシェルがzsh なので zsh で実行されるし、source .zshrc や source .zprofile すればパスとかも通る。


やったこと、まとめ

`qq{ssh localhost -t "source .zprofile; source .zshrc; cd ~/path/to/;hoge --option"}`

え？最初から zsh で叩けばいいじゃんって？
その反応は多分正しいのですが、黒い画面触りたくない人向けとか、やんごとなき事情で、perlのWAFから zsh 実行したい時があるんですよ。

何か良い方法あったら教えてください。

追記

zsh -c で行けるのでは？と言われたので直した、

`qq{zsc -c "source .zprofile; source .zshrc; cd ~/path/to/;hoge --option"}`

あと

!#/bin/zsh
cd ~/;
source .zprofile;
source .zshrc;
cd ~/path/to/;
hoge --option;

を実行するzshスクリプトをhoge.zsh というファイルに保存して、perlからは `zsh -c hoge,zsh` だけするようにすると考えること少なくて良さそうというコメントも頂きました。
有難うございます。

普段は宣言できないサブルーチン名の作り方

perl のサブルーチン名は数字で始まったり、アンダスコア以外の記号を使ったサブルーチンは宣言できない。

use strict;
use warnings;

sub 0 {
  print '0'
}

&0;

実行すると下記の様に怒られる。

$ perl ./hoge.pl
Illegal declaration of subroutine main::a at ./hoge.pl line 4.

しかし下記のようにパッケージのシンボルテーブルをcoderef上書きすると実行できる。

use strict;
use warnings;

{
    no strict 'refs';
    *{__PACKAGE__ . '::0';} = sub {
            print 0;
    };
    &0;
    use strict;
}

$ perl ./hoge.pl
0

もう何でもありである。というムダ知識を得たんだ。

use strict;
use warnings;

{
    no strict 'refs';
    *{__PACKAGE__ . '::1-1'} = sub { say "1-1" };
    *{__PACKAGE__ . '::&'}   = sub { say "&" };
    *{__PACKAGE__ . ':: '}   = sub { say " " };
    &{"1-1"};
    &{&};
    &{' '};
    use strict;
}


追記:という話をperl界隈の人に言ったら、「それ去年のYAPCで…」と言われたので帰ろうと思う。

さらに追記:クラス定義も出来るという話を聞いた。そりゃそうだ。

package main;
use strict;
use warnings;

{
    no strict 'refs';
    *{'&::&'}                  = sub { shift; say '&::&'};
    *{'&::new'}                = sub { return bless {}, '&' };
    my $method = '&';
    "&::new"->()->$method; #なんかもうちょっと良い呼び出し方ありそう。
    use strict;
}

$ perl ./hoge.pl
&::&