2013-07-07

直前の発言を置換する IRC bot

irc perl

タイポして投稿した時に

handlename: 毛根な時間
handlename: s/毛根/もうこん/

みたいな感じで発言を訂正することがある。

Skype だと実際に自分の発言が修正されるので、IRC でもやってみた。過去の発言を修正することはできないので、修正版の発言を再投稿するだけ。 ~~メタ文字とかオプションとかの判別は面倒なのでやってない。~~ evalすればいいんや！

#!/usr/bin/env perl

use strict;
use warnings;

use AnySan;
use AnySan::Provider::IRC;
use Log::Minimal;

use App::Options(
    option => {
        host    => { type => 'string', required => 1 },
        port    => { type => 'string', default  => '6666' },
        ssl     => { type => 'bool',   default  => 0 },
        nick    => { type => 'string', required => 1 },
        channel => { type => 'string', required => 1 },
    },
);
my %opts = %App::options;

my $password = password();

my $messages = {};

my $irc = irc(
    $opts{host},
    port       => $opts{port},
    enable_ssl => $opts{ssl},
    password   => $password,
    key        => $opts{host},
    nickname   => $opts{nick},
    channels   => { $opts{channel} => {} },
);

AnySan->register_listener(
    replace => {
        cb => sub {
            my ($receive) = @_;

            if ($receive->message =~ qr!(s/[^/]+/[^/]*/[gi]*)! &&
                defined $messages->{$receive->from_nickname})
            {
                my $regex   = $1;
                my $message = $messages->{$receive->from_nickname};
                eval "\$message =~ $regex";
                $receive->send_replay($message);

                infof '%s: %s, %s -> %s',
                    $receive->from_nickname,
                    $receive->message,
                    $messages->{$receive->from_nickname},
                    $message;
            }
            else {
                $messages->{$receive->from_nickname} = $receive->message;
            }
        },
    },
);

AnySan->run();

sub password {
    print 'password []:';

    system 'stty -echo';
    my $password = <STDIN>;
    system 'stty echo';
    print "\n";

    chomp $password;

    return $password;
}```

AnySan を使ってみたかっただけだから、役にはたたない感じする。
https://github.com/handlename/p5-replace-irc-bot

2013-06-12

IRC に issue 番号に反応する bot がいると捗る

irc perl

IRC bot のはなし。 #123 みたいな文字列に反応して、

github の issue のタイトル
github の issue の URL

を返してくれる bot をつくったら思いの外便利だった。

f:id:handlename:20130612233939p:plain

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

use AnyEvent::IRC::Client;
use AnyEvent;
use Config::Pit;
use Encode;
use Furl;
use HTTP::Request;
use JSON::XS;
use Log::Minimal;

use App::Options(
    option => {
        nick         => { type => 'string', default => 'issue-bot' },
        channel      => { type => 'string' },
        join_message => { type => 'string', default => '' },
        org_name     => { type => 'string' },
        project_name => { type => 'string' },
    },
);
my %opts = %App::options;

$Log::Minimal::PRINT = sub {
    my ($time, $type, $message, $trace, $raw_message) = @_;
    print STDERR "$time [$type] $message at $trace\n";
};

my $github = pit_get('github', require => {
    username => 'github username',
    password => 'github password',
});

my $irc_conf = pit_get('irc', require => {
    host     => 'irc host',
    port     => 'irc port',
    password => 'irc password',
});

my $json = JSON::XS->new->utf8;
my $furl = Furl->new();
my $cv   = AnyEvent->condvar;
my $con  = AnyEvent::IRC::Client->new();

$con->reg_cb( connect => sub {
    my ($con, $err) = @_;

    if (defined $err) {
        warnf "connection error: %s", $err;
        $cv->send();
    }
    else {
        infof 'connected';
    }
} );

$con->reg_cb( registered => sub {
    infof 'registered';

    if ($opts{join_message}) {
        $con->send_chan(
            $opts{channel},
            'PRIVMSG',
            $opts{channel},
            $opts{join_message},
        );
    }
} );

$con->reg_cb( disconnect => sub {
    infof 'disconnected';
    $cv->broadcast();
} );

$con->reg_cb( publicmsg => sub {
    my ($con, $channel, $irc_message) = @_;

    return unless $irc_message->{command} eq 'PRIVMSG';

    my @issue_nums = $irc_message->{params}[1] =~ /#([0-9]+)/g;
    return unless @issue_nums;

    for my $issue_num (@issue_nums) {
        my $message = retrieve_issue_info($issue_num);
        next unless $message;

        infof $message;

        send_message($con, $message);
    }
} );

$con->enable_ssl();

$con->connect($irc_conf->{host}, $irc_conf->{port}, {
    nick     => $opts{nick},
    password => $irc_conf->{password},
});

$con->send_srv('JOIN', $opts{channel});

$cv->recv();

$con->disconnect();

sub retrieve_issue_info {
    my ($issue_num) = @_;

    my $url = sprintf 'https://api.github.com/repos/%s/%s/issues/%d',
                      $opts{org_name},
                      $opts{project_name},
                      $issue_num;
    my $req = HTTP::Request->new( GET => $url );
    $req->authorization_basic(
        $github->{username},
        $github->{password},
    );

    my $res = $furl->request($req);

    if ($res->status != 200) {
        warnf '#%d %s', $issue_num, $res->content;
        return;
    }

    my $issue = $json->decode($res->content);

    return encode_utf8(sprintf(
        '#%d %s %s',
        $issue->{number},
        $issue->{title},
        $issue->{html_url},
    ));
}

sub send_message {
    my ($con, $message) = @_;

    $con->send_chan(
        $opts{channel},
        'NOTICE',
        $opts{channel},
        $message,
    );
}

2013-05-21

emacs から git diff を開く

git emacs tmux

emacs 24.2.1
git 1.8.2
tmux 1.7
iTerm 1.0.0.20130319

emacs から tig blame を開く - handlename's blog の派生。

diff も見れたら便利なんじゃないかということで追加してみた。ついでにリファクタリング。

tmux にコマンド送るのは他にも色々応用できそう。

2013-05-17

emacs から tig blame を開く

git tig emacs tmux

emacs 24.2.1
tmux 1.7
iTerm 1.0.0.20130319

tig blame が便利らしいということで、emacs からさくっと開けるようにしてみた。

git-project-p はこちらから拝借。関数名は変えてある。 http://shibayu36.hatenablog.com/entry/2013/01/18/211428

べんり〜

2013-03-22

マージ済みのブランチをまとめて削除する便利スクリプト書いた

git perl

git 1.8.1.1
perl 5.16.2

マージ済みのブランチを消したい。リモートリポジトリにあるのもいっしょに消したい。

というのを叶えるために簡単なスクリプトを書いた。perl。

https://github.com/handlename/bin/blob/master/delete-merged-branches

ドライラン

delete-merged-branches --dryrun

リモートのブランチも消す

delete-merged-branches --remote

特定のブランチは残す

delete-merged-branches --ignore 'important-branch'

カレントディレクトリが git リポジトリなのかどうかの判別はしていないし、 master にいるのかどうかもチェックしていないけど、必要になったら追加する。

2013-03-21

tmux で直前の window に戻りたいとき

tmux

tmux 1.7

last-window にキーバインドを設定しておくと捗る。むしろなんで今まで設定しておかなかったのか…。

bind-key C-t last-window

自分の場合プレフィックスキーを C-t にしてあるので、 C-t C-t とすれば直前の window に切り替えられる。

大量に window を開いている時に、特定の window 間を行ったり来たりするのに便利。

2013-03-21

大量のJSONをデコードする場合

perl

全てつなげて一つのJSONにしたほうが速くなるんじゃないかと思ったんだけどそんなことなかった。

#!/usr/bin/env perl

use strict;
use warnings;

use Benchmark qw/timethese cmpthese/;
use JSON::XS;

my @jsons = map { encode_json({ hoge => 'huga' }) } 1..1000;

my $result = timethese(1000, {
    each => sub {
        my $decoded;

        for my $index (0..$#jsons) {
            $decoded->{$index} = decode_json($jsons[$index]);
        }
    },
    joined => sub {
        my $index = 0;
        my $joined = '{';
        $joined .= join ',', map { $index++; qq!"${index}":${_}! } @jsons;
        $joined .= '}';

        my $decoded = decode_json($joined);
    }
});

cmpthese($result);

Benchmark: timing 1000 iterations of each, joined...
      each:  1 wallclock secs ( 1.35 usr +  0.00 sys =  1.35 CPU) @ 740.74/s (n=1000)
    joined:  2 wallclock secs ( 1.55 usr +  0.00 sys =  1.55 CPU) @ 645.16/s (n=1000)
        Rate joined   each
joined 645/s     --   -13%
each   741/s    15%     --
perl benchmark_decode_json.pl  2.99s user 0.02s system 99% cpu 3.019 total