File Coverage

lib/In/Korean/Numbers/SinoKorean.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	28	32	87.5
condition	9	9	100.0
subroutine	10	10	100.0
pod	3	7	42.8
total	113	121	93.3

package In::Korean::Numbers::SinoKorean;

use POSIX;
use strict;
use warnings;

our $VERSION = '0.04'; # Also update POD version below

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

# Map Hangul to integer
my %int_to_char_map = (
  0 => "\x{C601}",
  1 => "\x{C77C}",
  2 => "\x{C774}",
  3 => "\x{C0BC}",
  4 => "\x{C0AC}",
  5 => "\x{C624}",
  6 => "\x{C721}",
  7 => "\x{CE60}",
  8 => "\x{D314}",
  9 => "\x{AD6C}",
  10 => "\x{C2ED}",
  100 => "\x{BC31}",
  1000 =>"\x{CC9C}",
  10000 => "\x{B9CC}",
);

my %char_to_int_map; # Lazily created from %int_to_char_map

# All numbers are expressed as a combination of the following units
my @units = (10000, 1000, 100, 10, 1);

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub new {
  my $class = shift;
  return bless {}, $class;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub getHangul {

  my( $self, $num ) = get_args( @_ );

  return undef if not defined $num;

  # Must be positive integer
  return undef if not is_positive_int_or_zero( $num );

  my @hangul = ();

  my $remaining = $num;

  foreach my $unit ( @units ) {

    last if $remaining == 0; # Performance reasons only

    # Find the mutiple for the current unit.
    # E.g., 502,217 for key=10,000, then multiple = 52
    my $multiple = floor( $remaining / $unit );

    next if $multiple < 1;

    $remaining %= $unit;

    # Recursively call to get value greater than 10
    my $multiple_str = $multiple >= 10 ? getHangul( $self, $multiple ) : int_to_char( $multiple );

    # Don't push Hangul value for 1 unless currently handling 1 unit
    push @hangul, $multiple_str unless $multiple == 1 && $unit != 1;
    push @hangul, int_to_char( $unit ) if $unit != 1;
  }

  return join( '', @hangul ) if @hangul;

  return "\x{C601}";
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub getInt {

  my( $self, $hangul ) = get_args( @_ );

  return undef if not defined $hangul;

  # Tokenize so process each character separately
  my @tokens = split( //,  $hangul );

  my $total = 0;

  while( @tokens ) {
    my $char_char = shift @tokens;
    my $char_int = char_to_int( $char_char );

    # If invalid input, return undef
    return undef if ! defined( $char_int );

    # If 만,  multiply everything by 10,000
    if ( $char_char eq "\x{B9CC}") {
      if ( $total ) {
        $total *= 10000;
      } else {
        $total = 10000;
      }
      next;
    }

    # If:
    #   (1) char value is greater than 9,
    #   (2) no more characters left
    #   (3) next character is 만
    # Then add value
    elsif ( $char_int > 9 || ! @tokens || $tokens[0] eq "\x{B9CC}" ) {
      $total += $char_int;
    }

    # If char 0-9 and not final, get next char (units)
    else {
      my $unit_char = shift @tokens;
      my $unit_int = char_to_int( $unit_char );
      $total += ( $char_int * $unit_int );
    }
  }

  return $total;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Returns $self and $val values from arguments. Handles
# presence of $self (if o-o) and absence of $self (if
# procedural).
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_args {
  my( $self, $val );

  if ( @_ >= 2 ) {
    ( $self, $val ) = @_;
  } elsif ( @_ == 1 ) {
    ( $val ) = @_;
  }

  return ( $self, $val );
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Converts integer (e.g., 1) to Hangul block (e.g., 일) using
# %int_to_char_map.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub int_to_char {
  my $int = shift;
  return $int_to_char_map{ $int };
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Converts hangul block (e.g., 일) to integer (e.g., 1) using
# %char_to_int_map.
#
# Note that %char_to_int_map is lazily created from
# %int_to_char_map.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub char_to_int {
  my $char = shift;

  if (! %char_to_int_map ) {
    %char_to_int_map = ();

    for my $int ( keys %int_to_char_map ) {
      my $hangul = $int_to_char_map{ $int };
      $char_to_int_map{ $hangul } = $int; # Inverse of int_to_char_map
    }
  }

  my $int = $char_to_int_map{ $char };

  return $int;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Returns true if value is a positive integer or zero.
#
# Source: http://www.perlmonks.org/?node_id=614452
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub is_positive_int_or_zero {
  my $val = shift;
  $val =~ s/^\s+//;          # leading whitespace
  $val =~ s/\s+$//;          # trailing whitespace
  return $val =~ /^[+]?\d+$/;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1;
__END__