Perl CGI でフォームからの絵文字入力を制限する方法

絵文字が含まれるかをチェックする Perl のサブルーチン

ということで、絵文字の入力をチェックするサブルーチンは以下のようになります。

#絵文字が含まれていない場合、1を返す。含まれていれば 0を返す
sub check_emoji{
    my $str = shift;
    $str or return 1;

    #Shift_JIS体系におけるコード
    my $ascii = '[\x00-\x7f]'; #ASCIIと制御文字
    my $two_bytes = '[\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc]'; #漢字
    my $h_katakana = '[\xa0-\xdf]'; # 半角カタカナ

    #絵文字コード
    my $docomo = '(?:(?:\xf8[\x9f-\xfc])|(?:\xf9[\x40-\x49\x50-\x52\x55-\x57\x5b-\x5e\x72-\xfb]))';
    my $ez = '(?:(?:[\xf3\xf6\xf7][\x40-\xfc])|(?:\xf4[\x40-\x8d]))';
    my $voda = '\x1b\x24[GEFOPQ][\x21-\x7a]*\x0f'; #少々簡略

    #引数が長すぎた時のために分割(パフォーマンスの問題)
    my @vals = split(/\s+/, $str);
    foreach (@vals){
        #絵文字が出現すればその場で戻る
        m/^(?:$ascii|$two_bytes|$h_katakana)*?(?:$docomo|$ez|$voda)/ and return 0;
    }
    return 1; #最後まで絵文字が出現しなければ1を返す
}

絵文字チェック サブルーチン 使用例

if (&check_emoji($input{content})){
    &print_confirm(%input);
} else {
    &print_erro(%input);
}