#!/usr/bin/perl use strict; use warnings; use Encode; use CGI; use HTML::Template; use URI::Escape; use utf8; use MeCab; binmode STDOUT, ":utf8"; $| = 1; my $SITE_URL = "https://yapi.ta2o.net/wara/wr-simple.cgi"; my $q = new CGI; my $key = $q->param('key') || ""; $key =~ s{<.+?>}{}gsm; my $dkey = decode('utf-8', $key); print $q->header(-charset => 'UTF-8'); my $wara_str = ""; if ($key !~ /^\s*$/) { my $str_ec = encode('utf-8', $dkey); my $m_ref = do_mecab($str_ec); my $pre_is_noun = 0; my @words = (); for (my $i = 0; $i < @$m_ref; $i++) { my $m = $m_ref->[$i]; my $ms = decode('utf-8', $m->{surface}); my $mf = decode('utf-8', $m->{feature}); if ($mf =~ /^名詞/ or $m->{surface} =~ /^[^\x80-\xff]+$/) { $pre_is_noun = 1; } else { push @words, "(笑)" if ($pre_is_noun); $pre_is_noun = 0; } push @words, " " if (length($m->{surface}) < $m->{rlength}); push @words, $ms; } push @words, "(笑)" if ($pre_is_noun); $wara_str = join("", @words); } my $template = join("", ); my $t = HTML::Template->new(scalarref => \$template, loop_context_vars => 1, global_vars => 1, die_on_bad_params => 0); $t->param(key => $dkey); $t->param(site_url => $SITE_URL); $t->param(convstr => $wara_str) if $wara_str; my $out = $t->output(); print $out; sub do_mecab { my ($str_euc) = @_; my $m = new MeCab::Tagger(""); my $n = $m->parseToNode($str_euc); my @words = (); while ($n = $n->{next}) { next if $n->{surface} eq ""; push @words, {surface => $n->{surface}, feature => $n->{feature}, rlength => $n->{rlength}, }; } return \@words; } __DATA__ テキスト変換(笑) 簡易版

テキスト変換(笑) 簡易版

ソースコード