File Coverage

blib/lib/Parse/Number/ID.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	11	12	91.6
condition	2	2	100.0
subroutine	7	7	100.0
pod	1	1	100.0
total	51	52	98.0

package Parse::Number::ID;

our $DATE = '2015-09-03'; # DATE
our $VERSION = '0.08'; # VERSION

use 5.010001;
use strict;
use warnings;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(parse_number_id $Pat);

our %SPEC;

#our $Pat = qr/(?:
#                  [+-]?
#                  (?:
#                      \d{1,2}(?:[.]\d{3})*(?:[,]\d*)? | # indo
#                      \d{1,2}(?:[,]\d{3})*(?:[.]\d*)? | # english
#                      [,.]\d+ |
#                      \d+
#                  )
#                  (?:[Ee][+-]?\d+)?
#              )/x;

# non /x version
our $Pat = '(?:[+-]?(?:\d{1,2}(?:[.]\d{3})*(?:[,]\d*)?|\d{1,2}(?:[,]\d{3})*(?:[.]\d*)?|[,.]\d+|\d+)(?:[Ee][+-]?\d+)?)';

sub _clean_nd {
    my $n = shift;
    $n =~ s/\D//;
    $n;
}

sub _parse_mantissa {
    my $n = shift;
    if ($n =~ /^([+-]?)([\d,.]*)\.(\d{0,2})$/) {
        return (_clean_nd($2 || 0) + "0.$3")*
            ($1 eq '-' ? -1 : 1);
    } else {
        $n =~ s/\.//g;
        $n =~ s/,/./g;
        no warnings;
        return $n+0;
    }
}

$SPEC{parse_number_id} = {
    v => 1.1,
    summary => 'Parse number from Indonesian text',
    args    => {
        text => {
            summary => 'The input text that contains number',
            schema => 'str*',
            pos => 0,
            req => 1,
        },
    },
    result_naked => 1,
};
sub parse_number_id {
    my %args = @_;
    my $text = $args{text};

    $text =~ s/^\s+//s;
    return undef unless length($text);

    $text =~ s/^([+-]?[0-9,.]+)// or return undef;
    my $n = _parse_mantissa($1);
    return undef unless defined $n;
    if ($text =~ /[Ee]([+-]?\d+)/) {
        $n *= 10**$1;
    }
    $n;
}

1;
# ABSTRACT: Parse number from Indonesian text

__END__