File Coverage

blib/lib/Lingua/JA/Dakuon.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	28	28	100.0
condition	12	15	80.0
subroutine	11	11	100.0
pod	6	6	100.0
total	111	114	97.3

package Lingua::JA::Dakuon;
use 5.008005;
use strict;
use warnings;
use utf8;
use Exporter 'import';

our $VERSION = "0.01";

our @EXPORT_OK = qw{
  dakuon handakuon seion
  dakuon_normalize
  handakuon_normalize
  all_dakuon_normalize
};
our %EXPORT_TAGS = (
    all => \@EXPORT_OK,
);

our $EnableCombining = 0;
our $PreferCombining = 0;

my %Dakuon = map { split // } qw{
  かが きぎ くぐ けげ こご
  さざ しじ すず せぜ そぞ
  ただ ちぢ つづ てで とど
  はば ひび ふぶ へべ ほぼ
  うゔ ゝゞ
  カガ キギ クグ ケゲ コゴ
  サザ シジ スズ セゼ ソゾ
  タダ チヂ ツヅ テデ トド
  ハバ ヒビ フブ ヘベ ホボ
  ウヴ ワヷ ヰヸ ヱヹ ヲヺ
  ヽヾ
};
my %DakuonRev = reverse %Dakuon;
my $DakuonRE = '[' . join('', keys %DakuonRev) . ']';
my %Handakuon = map { split // } qw{
  はぱ ひぴ ふぷ へぺ ほぽ
  ハパ ヒピ フプ ヘペ ホポ
};
my %HandakuonRev = reverse %Handakuon;
my $HandakuonRE = '[' . join('', keys %HandakuonRev) . ']';

my $HankakuKatakanaRE = '[ｦ-ﾝ]';

our $AllDakuonRE = "(?:$DakuonRE|.[゛\x{3099}]|$HankakuKatakanaRE\ﾞ)";
our $AllHandakuonRE = "(?:$HandakuonRE|.[゜\x{309a}]|$HankakuKatakanaRE\ﾟ)";

sub dakuon {
    my ($c) = @_;
    return if length($c) != 1; # Expected argument is a single char

    my $dc = $PreferCombining ? undef : $Dakuon{$c};
    if (!$dc) {
        if ($c =~ /^$HankakuKatakanaRE$/) {
            $dc = "$c\ﾞ";
        } else {
            $dc = ($EnableCombining || $PreferCombining) ? "$c\x{3099}" : $c;
        }
    }
    $dc;
}

sub handakuon {
    my ($c) = @_;
    return if length($c) != 1; # Expected argument is a single char

    my $dc = $PreferCombining ? undef : $Handakuon{$c};
    if (!$dc) {
        if ($c =~ /^$HankakuKatakanaRE$/) {
            $dc = "$c\ﾟ";
        } else {
            $dc = ($EnableCombining || $PreferCombining) ? "$c\x{309a}" : $c;
        }
    }
    $dc;
}

sub seion {
    my ($c) = @_;
    my $len = length($c);
    # Expected argument is a single char or single char followed by combining char
    return unless $len == 1 ||
        $len == 2 && $c =~ /[゛゜\x{3099}\x{309a}ﾞﾟ]$/;

    $DakuonRev{$c} || $HandakuonRev{$c} || substr($c, 0, 1);
}

sub dakuon_normalize {
    my ($s) = @_;

    if ($PreferCombining) {
        $s =~ s{($DakuonRE)}{"$DakuonRev{$1}\x{3099}"}ge;
        $s =~ s{゛}{\x{3099}}g;
    } else {
        $s =~ s{(.)[゛\x{3099}]}{dakuon($1)}ge;
    }
    $s =~ s{($HankakuKatakanaRE)[゛\x{3099}]}{$1ﾞ}g;
    $s;
}

sub handakuon_normalize {
    my ($s) = @_;

    if ($PreferCombining) {
        $s =~ s{($HandakuonRE)}{"$HandakuonRev{$1}\x{309a}"}ge;
        $s =~ s{゜}{\x{309a}}g;
    } else {
        $s =~ s{(.)[゜\x{309a}]}{handakuon($1)}ge;
    }
    $s =~ s{($HankakuKatakanaRE)[゜\x{309a}]}{$1ﾟ}g;
    $s;
}

sub all_dakuon_normalize {
    handakuon_normalize dakuon_normalize @_;
}

1;
__END__