File Coverage

lib/Lingua/JA/Romaji/Valid.pm

Criterion	Covered	Total	%
statement	51	53	96.2
branch	21	30	70.0
condition	2	2	100.0
subroutine	8	8	100.0
pod	6	6	100.0
total	88	99	88.8

package Lingua::JA::Romaji::Valid;

use strict;
use warnings;

our $VERSION = '0.03';

my %aliases = (
  loose         => 'ISO3602Loose',
  liberal       => 'Liberal',
  kunrei        => 'ISO3602',
  japanese      => 'ISO3602Strict',
  passport      => 'HepburnPassport',
  railway       => 'HepburnRailway',
  traditional   => 'Hepburn',
  hepburn       => 'HepburnRevised',
  international => 'HepburnRevisedInternational',
);

sub new {
  my ($class, $rule) = @_;
  my $self  = bless {}, $class;

  $rule ||= 'ISO3602Loose';
  $rule = $aliases{$rule} if exists $aliases{$rule};

  my $package = 'Lingua::JA::Romaji::Valid::Rule::'.$rule;
  eval "require $package"; die $@ if $@;
  $self->{rule} = $package->new;

  $self;
}

sub aliases { sort keys %aliases }
sub verbose { shift->{rule}->verbose(@_) }

sub as_romaji {
  my ($self, $word, @extra_filters) = @_;

  return unless defined $word;

  $word = quotemeta lc $word;

  return unless $self->{rule}->_prepare( \$word, @extra_filters );

  my @kanas  = $word =~ /((?:[^aeiou]*)(?:[aeioun]))/g;
  my $got    = join '', @kanas;
  my ($rest) = $word =~ /^$got(.+)/;

  if ( $rest ) {
    # always prohibit consonant ending but 'n'
    warn "consonant ending: $rest" if $self->verbose;
    return;
  }

  foreach my $kana ( @kanas ) {
    return unless $self->{rule}->is_valid( $kana, @extra_filters );
  }
  return 1;
}

sub as_name {
  my ($self, $word, @extra_filters) = @_;

  return unless defined $word;

  $word = quotemeta lc $word;

  push @extra_filters, qw(
    prohibit_initial_n
    prohibit_initial_wo
    prohibit_foreign_kanas
  );
  return unless $self->{rule}->_prepare( \$word, @extra_filters );

  my @kanas  = $word =~ /((?:[^aeiou]*)(?:[aeioun]))/g;
  my $got    = join '', @kanas;
  my ($rest) = $word =~ /^$got(.+)/;

  if ( $rest ) {
    # always prohibit consonant ending but 'n'
    warn "consonant ending: $rest" if $self->verbose;
    return;
  }

  foreach my $kana ( @kanas ) {
    return unless $self->{rule}->is_valid( $kana, @extra_filters );
  }
  return 1;
}

sub as_fullname {
  my ($self, $word, @extra_filters) = @_;

  return unless defined $word;

  $word = quotemeta lc $word;

  # XXX: allow comma separated name: should this be optional?
  my $rule = qr/(?:\\?\s)+|(?:\\?\s)*(?:\\?,)(?:\\?\s)*/;
  my @parts = split $rule, $word;

  # Japanese full name should have both first and last names
  # but not a middle name
  return unless @parts == 2;

  foreach my $part ( @parts ) {
    return unless $self->as_name( $part, @extra_filters );
  }
  return 1;
}

1;

__END__