Perlで現ブランチのPull RequestのURLを取得するtig用のスクリプトを書いた

f:id:bobchan1915:20181202105045p:plain

本記事

私は、これまでtigでpushをするとブラウザでプルリク作成に飛ぶスクリプトを使っていましたが、現在のブランチのプルリクをみたい時があります。

今回はperlを使って、その機能を実装するスクリプトを書ければなと思います。

また、スクリプトはすべてfishスクリプトなので注意をしてください。

実装

1. HTTPリクエストを試す

パッケージとしてHTTP::Request、クライアントにLWPを使いました。

HTTP::RequestはHTTPリクエストをパッケージ化するものです。

まず、適当にYahoo!のトップページを取得します。

#!/usr/bin/env perl

use LWP::UserAgent;
use Data::Dumper;
require HTTP::Request;

my $url = 'http://yahoo.co.jp';
my $request = HTTP::Request->new(GET => $url);
my $user_agent = 'Mozilla/5.0';

my $ua = LWP::UserAgent->new;
$ua->agent($user_agent);

my $response = $ua->request($request);
my $data_ref = decode_json($response->content);
print Dumper $data_ref;

また、GithubAPIはJSONでやりとりをするのでJSONをパースしなければなりません。JSONパッケージを使って簡単にできます。

sudo cpan JSON

my $data_ref = decode_json($response->content);

2. GithubAPIへのリクエストを実装

GitHubAPIのアクセストークンをHeaderにつけないといけません。

リクエストを作るときに以下のようなコンストラクタがあります。

$r = HTTP::Request->new( $method, $uri )
$r = HTTP::Request->new( $method, $uri, $header )
$r = HTTP::Request->new( $method, $uri, $header, $content )

公式ドキュメントには

オプションの $header 引数は HTTP::Headers オブジェクトへのリファレンスか、キー/値のペアの配列へのリファレンスでなければなりません

と書いてあるので、今回はHeadersオブジェクトで渡そうとおもいます。

 $h->header('Content-Type' => 'text/plain');  # set

また、GithubAPIにアクセスするようにします。

my $url = https://api.github.com

GithubAPIのアクセストークンを取得します。

f:id:bobchan1915:20181130235638p:plain

それを環境変数に設定して、スクリプトで読み取ります。

my $url = 'https://api.github.com';
my $token = $ENV{GITHUB_ACCESS_TOKEN};
my $header = HTTP::Headers->new('Authorization' => "token $token");
my $request = HTTP::Request->new(GET => $url, $header);

3. tig用にスクリプトの準備

引数は配列@ARGVの中に順番に入っています。

tigで以下のようなバインドであると想定すると

bind generic B @perl hogehoge.pr %(branch)

バックグラウンド実行なので@を付けています。

最初の引数はbranchなので

my $branch = $ARGV[0];

にしました。

4. Pull RequestをAPIから取得

GitHubのPull RequestのURL仕様は以下のようになっています。

https://github.com/KeisukeYamashita/dotfiles/pull/84

つまり

どのリポジトリなのか
オーナーは誰なのか
プルリク番号

が必要です。プルリク番号はローカル環境からわからない、gitというオープンソースのものにサービスとしてGithubが作った機能なので、取得する必要があります。

まず、オープンなすべてのプルリクエストを取得します。

GET /repos/:owner/:repo/pulls

大体の情報は.git/configに書いてあるので、そこから取得します。sedとgrepを駆使して

my $owner = `cat .git/config | grep -m 1 "url" | sed -e 's/\(.*\)\/\(.*\)\/\(.*\).git/\2/g'`
my $repo = `cat .git/config | grep -m 1 "url" | sed -e 's/\(.*\)\/\(.*\)\/\(.*\).git/\3/g'`

のように取得します。

そして$base_urlを組み立てます。

my $list_pr_api_url = $base_url.'/repos/'.$owner.'/'.$repo.'/pulls?state=open';

そして現在のプルリク番号を取得します。

my $number;

foreach my $pr (@$data_ref) {
    if ($pr->{head}->{ref} eq $branch){
        $number = $pr->{number};
        last;
    }
}

print $number;

そして、これに対するURLを組み立てれば終わりです。

my $pr_page_url = 'https://github.com/'.$owner.'/'.$repo.'/pull/'."$number";

`open $pr_page_url`;


exit();

実際に~/.tigrcに書いてみます。

bind generic 5 @perl hogehoge.pr %(branch)

これで5を押すと対応するPull Requestが開かれるようになりました。

エラー処理を追加

HTTPリクエストや、ブラウザを開く処理はエラーになる可能性があります。

簡単にevalで包んでprintしましょう。

my $response;

eval {
    $response = $ua->request($request);
};

if ($@){
    print "Error when requesting to github api";
}

あとは実際に失敗してみてから追加してみようと思います。

まとめ

Perlを久しぶりに書いたのですが、テキスト処理周りが扱いやすく、かつ、APIを叩いたり、機能性としてはかなり使い勝手がいいと感じました。

よりよい実装があれば、コメントよろしくお願いいたします。

Kekeの日記

エンジニア、読書なんでも