gistfile1.pl

sub text_boxing {
    my %opt = @_;
    my $m = $opt{message};
    my $ngwords = $opt{ngwords};
    
    return if (grep {my $ngword = $_; $m =~ /$ngword/} @$ngwords);

    $m =~ s/(\@[^\s]+\s+)+//;
    my @arms = qw/= ≡ - - - - -=≡ ≡=- 〜/;
    push @arms, '';
    my $arm = $arms[int(rand(scalar(@arms)))];

    my $lnp = $arm.'o';
    my @lpunches = ($lnp, $lnp, $lnp, $lnp, $lnp, '∂', '9', '９', 'o=o');
    my $lpunch = $lpunches[int(rand(scalar(@lpunches)))];

    my $rnp = 'o'.$arm;
    my @rpunches = ($rnp, $rnp, $rnp, $rnp, $rnp, '6', '６', 'o=o');
    my $rpunch = $rpunches[int(rand(scalar(@rpunches)))];

    my @lfaces = map {"(o'-')"} (0..6);
    push @lfaces, "o'-')";
    push @lfaces, "ｲｪｲ! o'-')";
    my $lface = $lfaces[int(rand(scalar(@lfaces)))];

    my @rfaces = map {"('-'o)"} (0..6);
    push @rfaces, "('-'o";
    push @rfaces, "('-'o ｲｪｲ!";
    my $rface = $rfaces[int(rand(scalar(@rfaces)))];
    
    my $result = {
        is_boxer => 0,
        dump_message => '',
    };

    # rinkaku & cheek are charactor class
    # \\{ -> \{
    my $rinkaku_common = "\|｜人";
    my $rinkaku_left_charset = "${rinkaku_common}\\[(（（\\(\>\\{";
    my $rinkaku_right_charset = "${rinkaku_common}\})）^)）\\}\\)\\]";
    
    my $rinkaku_left = "[${rinkaku_left_charset}]";
    my $rinkaku_right = "[${rinkaku_right_charset}]";
    
    my $not_rinkaku_left = "[^${rinkaku_left_charset}]";
    my $not_rinkaku_right = "[^${rinkaku_right_charset}]";
    
    my $cheek_common = "[\\*|＊|｡|●|\\+|▰|╬|\=|๑|o]";
    my $cheek_left = $cheek_common;
    my $cheek_right = $cheek_common;
    
    # eyes are pattern
    my $eyebrow_left = "[`´]";
    my $eyebrow_right = "[`´]";
    my $eye_common = "ŏ|கு|◔ิ";
    my $eye_common_charset = "[￣\'／☉_♡＿⊙ا\ு◜｀☻`♪ω◞◟𝄐˘꒪´◕･☂丷◎◜ﾟ\^＾・◠╹◎©]";
    my $eye_left = ${eye_common}."|".${eye_common_charset}."|[。著≧\>＞╯]";
    my $eye_right = ${eye_common}."|".${eye_common_charset}."|[権≦\<＜╰]";
    
    if ($m =~ s/^${not_rinkaku_left}*?${rinkaku_left}+\s*(?:${cheek_left})?\s*(?:${eyebrow_left})?\s*(?:${eye_left})/${lface}${lpunch})ﾟ/) {
        $result->{dump_message} = $m;
        $result->{is_boxer} = 1;
        return $result if (int(rand(6)));
    }
    
    if ($m =~ s/(?:${eye_right})\s*(?:${eyebrow_right})?\s*(?:${cheek_right})?\s*${rinkaku_right}+${not_rinkaku_right}*?$/ﾟ(${rpunch}${rface}/) {
        $result->{dump_message} = $m;
        $result->{is_boxer} = 1;
    }
    
    if ($result->{is_boxer}) {
        return $result;
    }
    
    return;
}