JDBな人生  専門的なことから日常的なことまで~ まぁ自由きままに書いていきます。
2017年11月 / 10月<< 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 >>12月

アクセスランキング

[ジャンルランキング]
コンピュータ
261位
アクセスランキングを見る>>

[サブジャンルランキング]
プログラミング
37位
アクセスランキングを見る>>

LINE BOT API に Mojolicious::Lite & LWP::UserAgent で接続してみる

今朝Qiitaでみて知ったのですが、いまLINEがこんなサービスを試験しているようです。

BOT API Trial Accountのご紹介 | LINE BUSINESS CENTER
https://business.line.me/services/products/4/introduction

JSONベースのAPIを使ってBOTを実装することで、(いまのところ)50名までのユーザと、任意のタイミングでメッセージを送受信することができるというものです。 実装自体は非常に簡単で、実用化されればメールに代わる通知の手段としても使えそうです。

具体的には、
(1) ユーザからのコンタクト受諾時、ブロック時、およびメッセージ受信時のコールバックの実装
(2) ユーザへメッセージを返信するためのUserAgentの実装
という具合です。

ということで、Mojolicious::Liteで簡単に実装してみました。とは言ってみたものの、DB接続を頻繁に行うということなどがなければ、ただの一枚CGIでも十分に実装可能な内容です。
use strict;
use warnings;
use utf8;

use Mojolicious::Lite;
use JSON qw(decode_json encode_json);
use Digest::SHA qw(hmac_sha256_base64);

use LWP::UserAgent;

use Data::Dumper;

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

#アカウントの管理画面から取得
my $channel_id = 'CHANNEL ID';
my $channel_secret = 'CHANNEL SECRET';
my $bot_mid = 'BOT MID';

sub generate_msg_json_text {
    my ($mids_to_arrayref, $body) = @_;
    return {
        to => $mids_to_arrayref, 
        toChannel => 1383378250, #FIXED
        eventType => '138311608800106203', #FIXED
        content => {
            contentType => '1', #FIXED
            toType => '1', #FIXED
            text => $body
        }
    };
}

sub post_msg_json {
    my ($channel_id, $channel_secret, $bot_mid, $body) = @_;
    my $ua = LWP::UserAgent->new;
    my $res = $ua->post(
        'https://trialbot-api.line.me/v1/events', 
        'Content' => $body, 
        'Content-Type' => 'application/json', 
        'X-Line-ChannelID' => $channel_id, 
        'X-Line-ChannelSecret' => $channel_secret, 
        'X-Line-Trusted-User-With-ACL' => $bot_mid
    );
    #ToDo: think what to do
}

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

    my $key = $channel_secret;
    my $request_body = $self->req->body;
    my $signature_should_be = hmac_sha256_base64($request_body, $key);

    my $signature_got = $self->req->headers->header('x-line-channelsignature') || "";
    $signature_got =~ s/=//g;

    if ($signature_should_be ne $signature_got) {
        $self->render(json => {}, status => 470);
        return;
    }

    my $json = decode_json($request_body);
    my $results = $json->{'result'};
    foreach my $result (@$results) {
        my $content = $result->{'content'};  
        my $op_type = $content->{'opType'};
        my $new_msg_json = undef;

        #コンタクト受諾時・ブロック時
        if (defined $op_type) {
            my $msg_from = $content->{'params'}->[0];
            if ($op_type == 4) {
                $new_msg_json = generate_msg_json_text([$msg_from], 'The tutorial to enable LINE notifications is available at: http://--');
            } elsif ($op_type == 8) {
                #GOOD BYE
            }
        } else {
            my $msg_body = $content->{'text'};
            my $msg_from = $content->{'from'};
            #やまびこ
            $new_msg_json = generate_msg_json_text([$msg_from], 'hello. this is what you said: ' . $msg_body);
        }

        app->log->debug(Dumper($result));

        if (defined $new_msg_json) {
            post_msg_json($channel_id, $channel_secret, $bot_mid, encode_json($new_msg_json));
        }
    }

    $self->render(json => {});
};

app->start;


運用中のサービスへの実装はまだ検討中ですが、料金によっては(おそらくユーザ数ごとに課金される形になるかと思います)利用していきたいと考えています。
スポンサーサイト
   Perl    TB(0)    CM(0)    EDIT    ページ↑

オブジェクトのリファレンスにまとめてUTF8フラグを付加する

久々に技術系の記事です。

先日、JSONモジュールで出力するオブジェクトに、utf-8 fraggedな文字列と、そうでない文字列が混ざっているという事態が発生しました。
その理由というのが、利用しているサーバのDBIモジュールのバージョンが古く、データを読みだす際にUTF8フラグを付加してくれていなかったというもの。サーバ側の事情ともなれば、こちらとしてはどうしようもないので、出力時に一括変換することにしました。といっても、コードは簡単な再帰関数です。
#簡単な再帰関数なのですが、書くのが面倒でググり続けた結果数時間を無駄にしてしまいました…

ということで、参考までに。

use utf8;
use Encode;

sub decode_utf8c{
    my $txt = shift;
    unless (utf8::is_utf8($txt)){
        $txt = Encode::decode_utf8($txt);
    }
    return $txt;
}

sub add_utf8_flag{
    my $data = shift;
    if (ref($data) eq "HASH"){
        my %hash = %$data;
        foreach my $key (keys(%hash)){
            if (ref($hash{$key}) eq ""){
                $data->{$key} = decode_utf8c($data->{$key});
            } else {
                add_utf8_flag($data->{$key});
            }
        }
    } elsif (ref($data) eq "ARRAY"){
        my @array = @$data;
        my $i;
        for($i=0; $i<=$#array; $i++){
            if (ref($array[$i]) eq ""){
                $data->[$i] = decode_utf8c($data->[$i]);
            } else {
                add_utf8_flag($data->[$i]);
            }
        }
    }
    return $data;
}


デリファレンスしたオブジェクトへの変更は、もとのリファレンスには反映されない、というのが要注意です。
   Perl    TB(0)    CM(0)    EDIT    ページ↑

IMAPでサーバからメールを取得する : Perl

久々にPerlの記事です。

現在、メールの配信・受信機能をもつ、WEBアプリケーションを開発しています。
これまでは、メール関連の処理にはSMTP/POP3を使っていましたが、今回はIMAPを用いることにしました。

受信(メールの取得)について、覚書的に記事を書こうと思います

以下からどうぞ。
   Perl    TB(0)    CM(0)    EDIT    ページ↑

Twitterの某BOTとのやりとり

先日、TwitterのとあるBOT(知らないうちにフォローされていた)と、くだらないやりとりを数往復したので、その内容を紹介したいと思います。

※多少文を変えてあります。
自分:ただいまの体温は約37℃、少し高め

BOT:おかえりなさい!寂しかったですよ~><

自分:ただいまじゃなくて「ただいま(now)」

BOT:おかえりなさい、マスター

自分:だからただいまじゃなくて「ただいま(now)」

BOT:おかえりなさいませ、ご主人様

まあこうなることは予想がついていたんですが、さすがBOT、という感じです。挨拶の「ただいま」と、今現在の「ただいま」の認識が、きちんとできていないようです。


とりあえず、「ただいま」が含まれていたら、自動で返信する、という感じでしょうか。
あまり字数が多いと返信されないようですが、そのことを除いて考えて、コードはシンプルで、こんな感じだと思います。(Perlの場合)
if ($txt =~ /ただいま/){
    #返信
}


改良するとしたら、こんな感じなら、誤った返信は減るのでは、と思います。
(複数の一致の組み合わせがある正規表現を書くのは慣れていないので、無駄&間違いがあるかもしれません)
if (($txt !~ /帰(.+?)しました/) && ($txt =~ /((ただいま|只今)[をにのお、])|((ただいま|只今)(.+?)(です|ます|しました))/)){
    #now
} elsif ($txt =~ /(ただいま$)|(ただいま\s)|((ただいま|只今)([帰。ー~]|です))|((ただいま|只今)(.+?)ました)/){
    #返信
} elsif ($txt =~ /ただいま/){
    #どうしよう
}


何が書きたいのかよくわからない記事になってしまいましたが、まあ、面白いBOTもいますよーって話です。
「ただいま」判定のサンプルコードは、もし参考になれば、ご自由に使ってください。
   Perl    TB(0)    CM(1)    EDIT    ページ↑

暴風警報の情報をチェックしてメールで送信するスクリプト

昨日・今日と、名古屋も雨・風が強く、暴風警報も発令されたんですが、今回、暴風警報が発令されているかをチェックして、発令された/解除された場合に、メールでその皆を送信するスクリプトを書いてみました。

おそらくこれは次の台風でも使いまわせると思うので、公開しておきます。

ソースはこちらです。
http://blog-imgs-34.fc2.com/j/a/b/jabnz/keiho.txt

仕組みは簡単で、気象庁のサイトからHTMLを取得し、要らないところを切る、というものです。

53行目の部分
my $data = $csp5[3];
$csp5[]のインデックスは、1が大雨、2が洪水、3が暴風、4が暴風雪、5が大雪、6が波浪警報となっています。

あとは、ソースの中の埋めるところを埋めれば動きます。

自分は、Cronを設定して、20分おきに自動で実行させました。
結果、5:40と17:20にきちんとメールが届きました。

実際には、内容はもう少し丁寧で、朝早い&夜遅いときはメッセージが少し変わったりします。
簡単にカスタマイズできるので、ぜひ使ってみてください。

※設置する場合は、新しいディレクトリを作成してその中に設置してください。「bou」がかぶったら面倒なので。(bouは暴風のbouです)

---

台風15号の被害に遭われた皆さまに、心よりお見舞い申し上げます。
   Perl    TB(0)    CM(0)    EDIT    ページ↑

プロフィール

JDB Luigi

Author:JDB Luigi
どこにでもいるようなありふれた人間・・・という訳でもなく、かと言って怪しい宗教を信仰する変人という訳でも無い。

基本的に掲載しているコード等は煮ていただいても焼いていただいても結構ですが、利用は自己責任にてお願いいします。
また、バグ・アドバイス等もしあればよろしくお願いします。

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。