LINE::Bot::APIとIRKitで部屋の家電を制御するサンプルコード。

解説書いてる時間がなかったのでサンプルコードだけ貼っておきます。そのうち書く。

LINEのmessage apiを使おうと思ってuse LWP::UserAgentとuse JSONでゴリゴリ書いてたら普通にPerlのSDKがあったときの顔をしていました。SDK充実しててすごい。
line/line-bot-sdk-perl: LINE: :API – SDK of the LINE Messaging API for Perl

私はWebhookのcallback先を自宅サーバ(Raspberry Pi 2)に設置してるのでIRKit Device HTTP APIを使用できます。というかInternet HTTP API使うのめんどくさいから自宅サーバをcallback先にしたというのもあります。
IBM BluemixとかHerokuとか使ってる人はInternet HTTP APIを使ってください。
アプリはhypnotoadとMojolicious::Liteで動かしていて、リバースプロキシに(無駄に)h2oを使ってるのですが、あまり意味は無いですね。

#!/usr/bin/perl

# 2017/01/26 ちょっと書き直した

use utf8;
use strict;
use warnings;

use LINE::Bot::API;
use LINE::Bot::API::Builder::SendMessage;
use LINE::Bot::API::Builder::TemplateMessage;
use LWP::UserAgent;
use Mojolicious::Lite;

my $ua = new LWP::UserAgent();

my $CHANNEL_ACCCESS_TOKEN = "xxx"; 
my $CHANNEL_SECRET="xxx";

# API認証情報
my $bot = LINE::Bot::API->new(
    channel_secret       => $CHANNEL_SECRET,
    channel_access_token => $CHANNEL_ACCCESS_TOKEN,
    );

app->config(
    hypnotoad => {
    listen => ['http://*:8092'],
    },
     );

# 当初いろんなリクエストを送る予定だった
sub call_api(){
  my $url = shift;
  my $method = shift;
  my $headers = shift;
  my $content = shift;

  my $req = HTTP::Request->new($method, $url);
  while (my ($key, $value) = each(%$headers)){
    $req->header($key => $value);
  }
  $req->content($content);
  return $ua->request($req);
}

# IRKitのAPIを呼び出す
sub call_irkit(){
  my $content = shift;
  my $IRKIT = "http://192.168.10.150/messages";
  my %IRKIT_H = ("X-Requested-With" => "curl");
  return &call_api($IRKIT, "POST", \%IRKIT_H, $content);
}

get '/' => sub {
  my $self = shift;
  return $self->render(template => 'index', format => 'html');
} => 'index'; #別になくても良い

post '/callback' => sub {
  my $self = shift;

  # LINEから受信したリクエストボディ
  my $source = $self->req->body;
  # シグネチャ検証
  unless ($bot->validate_signature($source, $self->req->headers->header('X-Line-Signature')) ) {
    return $self->render(json => {'status' => "failed to validate signature"});
  }

  my $events = $bot->parse_events_from_json($source);
  my $event = ${ $events }[0]; #多分先頭のイベントしか使わないので
  unless($event->is_message_event && $event->is_text_message){
    return $self->render(json => {'status' => "not text event"});
  }

  # 自分以外の人が操作できないようにする
  unless($event->user_id eq "my LINE ID"){
    return $self->render(json => {'status' => "You are not me."});
  }

  my $reply_text = $event->text;
  if($reply_text eq "コマンド教えて"){ # carouselの動作確認も兼ねてヘルプ

    my $carousel = LINE::Bot::API::Builder::TemplateMessage->new_carousel(
      alt_text => 'コマンドを教えます',
    );

    my @commands = ("電気つけて", "電気消して", "エアコンつけて", "エアコン消して");
    for my $i (@commands) { #carouselは5つまで
      my $column = LINE::Bot::API::Builder::TemplateMessage::Column->new(
        title     => "commands",
        text      => "利用頻度の高いコマンドです",
      )->add_message_action(
        label => $i,
        text  => $i,
      );
      $carousel->add_column($column->build);
    }
    my $messages = LINE::Bot::API::Builder::SendMessage->new()->add_template($carousel->build);
    $bot->reply_message($event->reply_token, $messages->build);
    return $self->render(json => {'status' => "200OK"});
  }
  my $messages = LINE::Bot::API::Builder::SendMessage->new;
  $messages->add_text( text => "命令を実行します!" );
  $messages->add_text( text => $reply_text );

  my $commands = {
    "電気つけて" => '{"format":"raw","freq":38,"data":[18031,...]}',
    "電気消して" => ...,
    #etc...,
  };
  # 受け取ったメッセージに対応するJSONをIRKitに送信する
  my $command = $commands->{$reply_text};
  if ($command){
    &call_irkit($command);
  } else { # ここの挙動をヘルプにするのもありだと思います
    $messages->add_text( text => "その命令は受け付けられません!" );
  }

  $bot->reply_message($event->reply_token, $messages->build);
  return $self->render(json => {'status' => "200OK"});
} => 'callback';

app->start;

LWP::UserAgentでイカリング(ニンテンドーネットワーク)の認証を突破する。

イカリングまでの認証をWWW::Mechanizeでやっていたのですが、ページ構成変わった時に対応できないよなーと思ったので、LWP::UserAgentで認証が突破できるようにしました。
参考にしたのは以下のサイトです。
<mini> Miiverse が楽しすぎて… – モノトーンの伝説日記
セッション管理をcookieでやってるようですが、ヘッダにトークンを指定してアクセスとかそういうのはできないものでしょうか。MiiverseもそうだけどAPI公開してくれると楽しいのになぁ。

手順としては以下のことをやっています。

  1. ログイン用のURLにアクセスして認証用のURLを取得
  2. 認証用のURLに認証に必要なパラメータを付与。アクセス。
  3. 返ってきたコールバックURLにアクセス

セッション管理をcookieでやっているので、cookie_jarを設定してクッキーをぱくぱくもぐもぐできるようにしています。クッキー容器っていう名称いいですね。

#!/usr/bin/perl

use warnings;
use strict;
 
use LWP::UserAgent;

my $ua = LWP::UserAgent->new;
$ua->cookie_jar({file =>"cookie.txt", autosave=>1});

my $res = $ua->post("https://splatoon.nintendo.net/users/auth/nintendo");
# 認証用のURLとパラメータを取得
my $location = $res->header("location");

# 認証に必要なパラメータの組み立て
my $dummy_url = URI->new;
$dummy_url->query_form(
"nintendo_authenticate" => "",
"nintendo_authorize" => "",
"scope" => "",
"lang" => "ja-JP" ,
"username" => "ニンテンドーネットワークのid",
"password" => "ニンテンドーネットワークのパスワード"
);

# 認証用のURLにパラメータをくっつける
my $url = URI->new($location.$dummy_url->query);
# 認証用URLにアクセスしてコールバックURLを取得
my $res_auth = $ua->post($url);
my $location_auth = $res_auth->header("location");

# コールバックURLにアクセス
$ua->get($location_auth);

# 目当てのページにアクセス
my $res_login = $ua->get("https://splatoon.nintendo.net/ranking");
print $res_login->content;

Mojoliciousのプレースホルダでドットを含むパスをキャプチャしたくない時の話。

全然別のタイトルで記事書いたのですが、内容が間違いまくってたのと愚痴っぽくてひどかったので消しました。30分位で消したから多分誰も見てないんじゃないでしょうか。

Mojoliciousの通常のプレースホルダはドットとスラッシュをキャプチャせず、含んでいた場合はルーティングに失敗します。が、その挙動を期待していたのに、ルーティングに失敗せずに200OKを返してしまうパターンがあってはまりました。
具体的に言うと、/standard/:nameのようなルートを設定していた場合、/standard/hello.htmlとか、hello.jsonのようなパスを設定されると、普通に200OKが返ってしまいます。
タチが悪いことに、param(‘name’)の値はhelloを返すので、paramの値で分岐するようなコードにしてると、意図しないルートをガード出来てないことになかなか気づきません。
具体例は以下。Perlはv5.16.3、Mojoliciousはv7.05です。

#!/usr/bin/perl

use strict;
use warnings;
use utf8;

use Mojolicious::Lite;

# リラックスプレースホルダ
get '/relax/#name' => sub{
        my $self = shift;
        return $self->render(json =>{param => $self->param('name'), format => $self->stash('format')});
} => 'r';
# /relax/hello.json:
# {"param":"hello.json","format":null}

# 普通のプレースホルダ
get '/standard/:name' => sub{
        my $self = shift;
        return $self->render(json =>{param => $self->param('name'), format => $self->stash('format')});
} => 's';
# /standard/hello.json: 
# {"format":"json","param":"hello"}

# 普通のプレースホルダ+format無効化
get '/standard_disable_format/:name' => [format => 0] => sub{
        my $self = shift;
        return $self->render(json =>{param => $self->param('name'), format => $self->stash('format')});
} => 'sd';
# /standard_disable_format/hello.json:
# status:404

普通のプレースホルダでドットを含んだ値を絶対キャプチャしたくない場合は、[format => 0]を指定しようと思いました。
MojoliciousとかMojolicious::Lite側の仕様は以下。
Mojolicious::Guides::Routing – Routing requests
Mojolicious::Lite – search.cpan.org

splapiはいろいろあってこのルートはガードする必要があるので、v1.12で修正しています。

DateTime::Format::DateManipインストール時にテストでこける。

cpanでDateTime::Format::DateManipをインストールするとテストでコケる。

Running Build test
t/00load.t ......... ok
t/01conversions.t .. WARNING: the TZ Date::Manip config variable is deprecated
         and will be removed in March 2016.  Please use
         the SetDate or ForceDate config variables instead.
Use of uninitialized value $mod in concatenation (.) or string at /usr/local/share/perl5/Date/Manip/TZ.pm line 181.
Use of uninitialized value $mod in concatenation (.) or string at /usr/local/share/perl5/Date/Manip/TZ.pm line 182.
Use of uninitialized value $mod in concatenation (.) or string at /usr/local/share/perl5/Date/Manip/TZ.pm line 183.
ERROR: [config_var] invalid zone in SetDate:
t/01conversions.t .. 1/6
#   Failed test 'Parse Date 'March 23, 2003''
#   at t/01conversions.t line 67.
#          got: '2003-03-23T00:00:00.000000000 JST
# '
#     expected: '2003-03-23T00:00:00.000000000 EST
# '
t/01conversions.t .. 2/6
#   Failed test 'Format Date '2003-03-23T00:00:00''
#   at t/01conversions.t line 73.
#          got: '2003032317:00:00'
#     expected: '2003032303:00:00'

#   Failed test 'Format Date '2003-03-23T12:00:00''
#   at t/01conversions.t line 73.
#          got: '2003032405:00:00'
#     expected: '2003032315:00:00'
# Looks like you failed 3 tests of 6.
t/01conversions.t .. Dubious, test returned 3 (wstat 768, 0x300)
Failed 3/6 subtests

対策

テスト時のタイムゾーンがAsia/Tokyoになってるのが原因なので、環境変数TZ=US/Easternをセットしてテストを実施する。
これは…テストの作り方がまずい気がするんだけどどうなんだろう…。

イカリングからブキ情報をスクレイピングする。

イカリングからブキ情報がスクレイピングできることに昨日初めて気づいたので、スクレイピングしてみました。
毎度ですがWWW::MechanizeとWeb::Scraperを使用します。
どうでもいいけど、一回NokogiriとかYasuri使おうと思ったのに結局RubyでWebスクレイピングしないで今年終わりました。
イカAPIのweaponsエンドポイントはver1.10で追加済みです。
#実はmapsとかgachi/rulesとかも追加してます。
それと、apiary.ioがgithubと連携できるのを昨日始めて知ったのですが、便利すぎてびっくりしました。絶対ローカルで編集してpushしたほうが楽ですね。

my $mech = WWW::Mechanize->new();

#ログイン
$mech->get('https://splatoon.nintendo.net/');
$mech->follow_link( url_regex => qr/auth/i );
$mech->submit_form(
    fields => {
        username => xxx,
        password => xxx
    }
);

#scraper本体
my $scraper = scraper {
    process '#user_intention_weapon option', 'weapons_list[]' => "TEXT";
};

my $spla = $scraper->scrape( $mech->content );
my $weapons_list = $spla->{weapons_list};

my %cnt;
for my $elem(@{$weapons_list}){ #user_intention_weaponが2つあるので多重カウントされる
    $cnt{$elem}++;
}

foreach my $key (sort(keys(%cnt))){
    print $key;
}

来年はネット繋げたいです。それでは良いお年を!