make world

Yahoo Web API の返り値を JSON で受け取って Perl で処理をする

Perl JSON

JSON は JavaScript での処理を前提にしたものが多く、Perl などほかの言語で処理をする場合のサンプルがなかったので、記しておく。

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Encode;
use JSON;
use LWP::UserAgent;
use Data::Dumper;
use URI::Escape;

my $yahoo_app_id = 'your_app_id';
my $agent        = 'Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)';
my $apibaseuri   = 'http://jlp.yahooapis.jp/KeyphraseService/V1/extract';
my $referrer     = 'http://developer.yahoo.co.jp/';

my $text = <<'EOS';
第1条（はじめに）
この利用規約は、株式会社はてな（以下「当社」）が本サイト上で提供する全てのサービス（以下「本サービス」）における利用条件を定めるものです。ユーザーのみなさま（以下「ユーザー」）には、本規約に従い本サービスをご利用いただきます。
本サービス内には、本規約以外に「ヘルプ」や各種ガイドラインにおいて、本サービスの利用方法や注意書きが提示されています。これらも本規約の一部を実質的に構成するものですので、合わせてお読みください。
EOS

# 文字列は URL エンコードしておく
my $escaped = uri_escape(encode('utf-8', $text));
my $url = sprintf('%s?output=json&appid=%s&sentence=%s', $apibaseuri, $yahoo_app_id, $escaped);

my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new('GET', $url);
$ua->agent($agent);
$req->referer($referrer);
my $response = $ua->request($req);

unless ($response->is_success) {
    print 'Request: ' . $url, "\n";
    warn 'Failed to request to WEB API.', "\n";
} else {
    # 返り値の JSON の文字列の状態を含めて内容を確認する
    #print $response->content, "\n";

    # decode_utf8
    # See at http://blog.livedoor.jp/dankogai/archives/51290188.html
    # JSON モジュールで utf8 を扱う方法
    # See at http://kawa.at.webry.info/200801/article_6.html
    my $result = JSON->new->utf8(0)->decode(decode_utf8($response->content));
    if ($result->{Error}) {
        warn encode('utf-8', $result->{Error}{Message}), "\n";
    } else {
        foreach my $key (keys %{$result}) {
            my $depth = $result->{$key};
            print encode('utf-8', $key) . ': ' . $depth . "\n";
        }
        print Dumper($result), "\n";
    }
}

正常終了した場合の出力例

各種ガイドライン: 75
注意書き: 66
本規約以外: 42
ヘルプ: 50
本サービス: 82
ご利用: 43
はじめ: 37
提示: 43
定義: 43
お読み: 50
本規約: 78
みなさま: 49
利用条件: 41
本サービス内: 41
これら: 46
株式会社はてな: 63
ユーザー: 100
以下: 60
当社: 42
利用規約: 43

Data::Dumper 出力内容

print Dumper($result), "\n";
$VAR1 = {
          "\x{5404}\x{7a2e}\x{30ac}\x{30a4}\x{30c9}\x{30e9}\x{30a4}\x{30f3}" => 75,
          "\x{6ce8}\x{610f}\x{66f8}\x{304d}" => 66,
          "\x{672c}\x{898f}\x{7d04}\x{4ee5}\x{5916}" => 42,
          "\x{30d8}\x{30eb}\x{30d7}" => 50,
          "\x{672c}\x{30b5}\x{30fc}\x{30d3}\x{30b9}" => 82,
          "\x{3054}\x{5229}\x{7528}" => 43,
          "\x{306f}\x{3058}\x{3081}" => 37,
          "\x{63d0}\x{793a}" => 43,
          "\x{5b9a}\x{7fa9}" => 43,
          "\x{304a}\x{8aad}\x{307f}" => 50,
          "\x{672c}\x{898f}\x{7d04}" => 78,
          "\x{307f}\x{306a}\x{3055}\x{307e}" => 49,
          "\x{5229}\x{7528}\x{6761}\x{4ef6}" => 41,
          "\x{672c}\x{30b5}\x{30fc}\x{30d3}\x{30b9}\x{5185}" => 41,
          "\x{3053}\x{308c}\x{3089}" => 46,
          "\x{682a}\x{5f0f}\x{4f1a}\x{793e}\x{306f}\x{3066}\x{306a}" => 63,
          "\x{30e6}\x{30fc}\x{30b6}\x{30fc}" => 100,
          "\x{4ee5}\x{4e0b}" => 60,
          "\x{5f53}\x{793e}" => 42,
          "\x{5229}\x{7528}\x{898f}\x{7d04}" => 43
        };

別の記述方法

my $result = JSON->new->utf8(0)->decode(decode_utf8($response->content)); から別の記述方法もある。

(前略)
    # 下記の一行から utf::decode の処理を省いている
    my $result = JSON->new->utf8(0)->decode($response->content);
    if ($result->{Error}) {
        warn encode('utf-8', $result->{Error}{Message}), "\n";
    } else {
        foreach my $key (keys %{$result}) {
            my $depth = $result->{$key};
            # 下記の一行を追加
            $key =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
            print encode('utf-8', $key) . ': ' . $depth . "\n";
        }
        print Dumper($result), "\n";
    }
}

参考