Perl入学式 Advent Calendar 2016 第23日目 「Perlで替え歌エンジンをつくる」

cpanfile

requires 'JSON';
requires 'LWP::UserAgent';
requires 'LWP::Protocol::https';

kaeuta.pl

use strict;
use warnings;

### 日本語を取り扱うので、内部文字コードはぜんぶutf8とみなす
use utf8;

### 日本語を出力するため、標準出力のモードをバイナリモードにする
binmode STDOUT, ":utf8";

### 今回使うモジュールたち
use JSON;
use URI;
use LWP::UserAgent;

### 差し替えに使う単語たち
my @nouns = qw(
    インフラ エンジニア 企画 権力 賃金 
    残業 休日出勤 障害 技術負債 レポジトリ
);

### ここで替え歌をつくる
kaeuta('真っ赤なお鼻のトナカイさんはいつもみんなの笑い物');

### 替え歌作成関数
sub kaeuta {
    my $lyric = shift;
    my $agent = LWP::UserAgent->new;
    my $uri   = URI->new('https://ytnobody-mecab.arukascloud.io/');
    $uri->query_form(text => $lyric);
    my $res   = $agent->get($uri->as_string);
    if ($res->is_success) {
        my $data  = decode_json($res->content);
        printf "%s\n", join("", map {change_item($_)} grep {$_->{surface}} @{$data->{nodes}});
    }
}

### ランダムに差し替え単語をチョイスする関数
sub get_noun_rand {
    my $i = int(rand(scalar(@nouns)));
    return $nouns[$i];
}

### 差し替え対象となる「名詞/一般」の単語であるかをチェックする関数
sub is_general_noun {
    my $item = shift;
    $item->{feature}[0] eq '名詞' && $item->{feature}[1] eq '一般';
}

### 差し替え対象の単語を高確率で差し替える関数
sub change_item {
    my $item = shift;
    return $item->{surface} if rand(10) > 7;
    is_general_noun($item) ? get_noun_rand() : $item->{surface};
}