本を読む

読書やコンピュータなどに関するメモ

Acme::Bouで謎めき系

 会話や文章の中で、「某~」を多用すると謎めき系っぽくなります。そこで、自動的に「某~」を多用した文章に変換するPerlモジュールを試作してみます。

$ cat bou.pl
use strict;
use warnings;
use utf8;
use Acme::Bou;

my $text = '佐川急便の田中さんと話した。';

my $bou = Acme::Bou->new();
my $out = $bou->translate($text);

binmode STDOUT, ':utf8';
print "$text\n-> $out\n";
$ perl bou.pl
佐川急便の田中さんと話した。
-> 某企業の某氏と話した。

 Acme/Bou.pmはこんな感じ。モジュール名からわかるように、Acme::Louの劣化インスパイヤです。

package Acme::Bou;

use strict;
use warnings;
use utf8;
use Encode;
use Text::MeCab;

our $VERSION = '0.000001';

my @FEATURES = qw( class class2 class3 class4 form type original yomi pron );

sub new {
    my $class = shift;
    my %opt = @_;

    my $self = {
        mecab => Text::MeCab->new(),
        mecab_code => $opt{mecab_code} || 'euc-jp',
    };
    bless $self, $class;
}

sub translate {
    my ($self, $text) = @_;

    my $text_enc = encode($self->{mecab_code}, $text);
    my $node = do { no utf8; $self->{mecab}->parse($text_enc); };

    my @words;
    my $feature = $self->parse_feature($node);
    while ($node) {
	my $next_feature = $self->parse_feature($node->next);
	if ($node->surface) {
	    my $surface = decode($self->{mecab_code}, $node->surface);
	    push @words, $self->apply_bou($surface, $feature, $next_feature);
	}
	$node = $node->next;
	$feature = $next_feature;
    }

    join('', @words);
}

sub parse_feature {
    my ($self, $node) = @_;
    return unless $node;
    my %f;
    @f{@FEATURES} = split(/,/, decode($self->{mecab_code}, $node->feature));
    \%f;
}

sub apply_bou {
    my ($self, $str, $feature, $next_feature) = @_;

    if ($feature->{class3} eq '人名') {
        ($next_feature->{class3} eq '人名') ? '' : '某氏';
    } elsif ($feature->{class3} eq '地域') {
        ($next_feature->{class3} eq '地域') ? '' : '某所';
    } elsif ($feature->{class3} eq '組織') {
        ($next_feature->{class3} eq '組織') ? '' : '某企業';
    } else {
        $str;
    }
}

1;

__END__


=head1 NAME

Acme::Bou - 某企業の某氏と話した

=head1 SYNOPSIS

  use utf8;
  use Acme::Bou

  my $text = '佐川急便の田中さんと話した。';
  my $bou = Acme::Bou->new();
  my $out = $bou->translate($text);

=head1 DESCTIPTION

文章中の固有名詞を「某~」と言い換えることで、謎めき系っぽい文章にします。

=head1 METHODS

=over 4

=item $bou = Acme::Bou->new([ \%options ])

Creates an Acme::Bou object.

I<%options> can take...

=over 4 

=item * mecab_code

Your MeCab dictionary charset. Default is C<euc-jp>. If you compiled 
mecab with C<utf-8>,

    my $bou = Acme::Bou->new( mecab_code => 'utf-8' );

=back

=item $bou->translate($text)

Return translated text in Nazomeki style. C<translate()> expect 
utf-8 byte or utf-8 flagged text, and it return utf-8 flaged text.

=head1 AUTHOR

emasaka

=cut

コメント

コメントの投稿

管理者にだけ表示を許可する

トラックバック

http://emasaka.blog65.fc2.com/tb.php/415-7f579f17

 | HOME | 

Categories

Recent Entries

Recent Comments

Recent Trackbacks

Appendix

emasaka

emasaka

フリーター。
連絡先はこのへん

Monthly


FC2Ad