File Coverage

blib/lib/Data/Validate/Japanese.pm

Criterion	Covered	Total	%
statement	30	34	88.2
branch			n/a
condition	1	2	50.0
subroutine	10	12	83.3
pod	7	7	100.0
total	48	55	87.2

# $Id: /mirror/perl/Data-Validate-Japanese/trunk/lib/Data/Validate/Japanese.pm 2553 2007-09-19T01:14:58.848056Z daisuke  $
#
# Copyright (c) 2007 Daisuke Maki
# All rights reserved.

package Data::Validate::Japanese;
use strict;
use warnings;
use 5.008;
use vars qw($VERSION);

$VERSION = '0.01001';

my %regexps = (
    katakana => qr(\p{InKatakana}),
    hiragana => qr(\p{InHiragana}),
    kanji    => qr(\p{InCJKUnifiedIdeographs}),
    h_katakana => qr(\p{InHalfwidthAndFullwidthForms}),
    ascii      => qr([[:ascii]])
);

sub new
{
    bless {}, shift;
}

{
    foreach my $type (keys %regexps) {
        eval <<"        EOSUB";
            sub is_$type {
                my (\$self, \$value, \$opts) = \@_;
                \$self->contains_only(\$value, { $type => 1 });
            }
        EOSUB
        die if $@;
    }
}

sub contains_only
{
    my ($self, $value, $opts) = @_;
    $opts ||= {};

    my $re = do {
        my $str = sprintf(
            '^(?:%s)$',
            join('|', map { "$regexps{$_}+" } grep { $opts->{$_} } keys %regexps)
        );
        qr($str);
    };

    return $value =~ /$re/;
}

1;

__END__