Skip to content

Commit

Permalink
Add and test datatype parsers
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Mar 18, 2013
1 parent b486a99 commit 1b0f0dd
Show file tree
Hide file tree
Showing 2 changed files with 170 additions and 4 deletions.
99 changes: 97 additions & 2 deletions lib/X12/Schema/Element.pm
View file
Expand Up @@ -3,6 +3,7 @@ package X12::Schema::Element;
use DateTime;

use Moose;
use Try::Tiny;
use namespace::autoclean;

has name => (is => 'ro', isa => 'Str', required => 1);
Expand Down Expand Up @@ -51,6 +52,22 @@ sub encode {
return $string;
}

sub decode {
my ($self, $src, $text) = @_;

my $type = $self->{type};
my $method = "_decode_$type";

my ($code, $len, $value) = $self->$method( $src, $text );

unless ($code) {
$code = 'elem_too_long' if $len > $self->{max_length};
$code = 'elem_too_short' if $len < $self->{min_length};
}

return ($code, $value);
}

# can't just use sprintf for these two because field widths are in _digits_. sign magnitude hoy!
sub _encode_R {
my ($self, $minp, $maxp, $sink, $value) = @_;
Expand Down Expand Up @@ -79,6 +96,17 @@ sub _encode_R {
}
}

sub _decode_R {
my ($self, $src, $text) = @_;

# all the x12.6 restrictions are in that regex
return 'elem_bad_syntax' if $text !~ /^ -? (?: [0-9]+ | \.[0-9]+ | [0-9]+\.[0-9]* ) (?: E -? [0-9]+ )? $/x;

# x12.6 reals are a subset of perl reals, yay

return undef, ($text =~ tr/0-9//), 0+$text;
}

sub _encode_N {
my ($self, $minp, $maxp, $sink, $value) = @_;
my $string;
Expand All @@ -90,6 +118,14 @@ sub _encode_N {
return sprintf "%0*d", ($munge < 0 ? $minp + 1 : $minp), $munge;
}

sub _decode_N {
my ($self, $src, $text) = @_;

return 'elem_bad_syntax' if $text !~ /^-?[0-9]+$/;

return undef, ($text =~ tr/0-9//), $text * (10 ** -$self->{scale});
}

sub _encode_ID {
my ($self, $minp, $maxp, $sink, $value) = @_;
my $string;
Expand All @@ -100,6 +136,19 @@ sub _encode_ID {
return $self->_encode_AN( $minp, $maxp, $sink, $value );
}

sub _decode_ID {
my ($self, $src, $text) = @_;

my ($err, $len, $val) = $self->_decode_AN($src, $text);

if ($self->expand) {
$val = defined($val) ? $self->expand->{$val} : undef;
$err ||= 'elem_bad_code' unless $val;
}

return ($err, $len, $val);
}

sub _encode_AN {
my ($self, $minp, $maxp, $sink, $value) = @_;
my $string;
Expand All @@ -116,8 +165,18 @@ sub _encode_AN {
return $string;
}

# on input, dates and times are not meaningfully associated (with each other, or with a time zone) so we have to generate isolated dates
# (floating, 00:00 time) and isolated times (floating DateTime for 2000-01-01 - gross)
sub _decode_AN {
my ($self, $src, $text) = @_;

my $tcopy = $text;
$tcopy =~ s/ *$//;

return 'elem_bad_syntax' if $tcopy =~ /\P{Print}/ || $tcopy eq '';
return undef, length($text), $tcopy;
}

# on input, dates and times are not meaningfully associated (with each other, or with a time zone) so we have to generate isolated dates
# (floating, 00:00 time) and isolated times (floating DateTime for 2000-01-01 - gross)
sub _encode_DT {
my ($self, $minp, $maxp, $sink, $value) = @_;

Expand All @@ -136,6 +195,27 @@ sub _encode_DT {
}
}

sub _decode_DT {
my ($self, $src, $text) = @_;

my ($y, $m, $d) = $text =~ /^([0-9]{2}(?:[0-9]{2})?)([0-9]{2})([0-9]{2})$/
or return 'elem_bad_syntax';

if (length $y == 2) {
my $cy = DateTime->now->year;

$y += 100 * sprintf "%.0f", ($cy - $y) / 100;
}

my @ret;
try {
@ret = (undef, length($text), DateTime->new( year => $y, month => $m, day => $d ));
} catch {
@ret = 'elem_bad_date';
};
@ret;
}

sub _encode_TM {
my ($self, $minp, $maxp, $sink, $value) = @_;

Expand All @@ -153,9 +233,24 @@ sub _encode_TM {
return $value->format_cldr($fmt);
}

sub _decode_TM {
my ($self, $src, $text) = @_;

my ($h,$m,$s,$ns) = ($text . '0'x11) =~ /^([0-9]{2})([0-9]{2})([0-9]{2})([0-9]{9})[0-9]*$/
or return 'elem_bad_syntax';

return 'elem_bad_time' unless $h < 24 && $m < 60 && $s < 60;
return undef, length($text), DateTime->new( year => 0, hour => $h, minute => $m, second => $s, nanosecond => $ns );
}

sub _encode_B {
my ($self, $minp, $maxp, $sink, $value) = @_;
return $value;
}

sub _decode_B {
my ($self, $src, $text) = @_;
return undef, length($text), $text;
}

__PACKAGE__->meta->make_immutable;
75 changes: 73 additions & 2 deletions t/03-element.t
View file
@@ -1,12 +1,14 @@
use strict;
use warnings;
use Test::More tests => 121;
use Test::More tests => 192;
use Test::Exception;

BEGIN { use_ok 'X12::Schema::Element'; }
use X12::Schema::TokenSink;
use X12::Schema::TokenSource;

my $sink = X12::Schema::TokenSink->new( element_sep => '*', segment_term => "~\n", component_sep => '\\', repeat_sep => '^', non_charset_re => qr/[^\x00-\xFF]/ );
my $src = X12::Schema::TokenSource->new( );

my $el;

Expand Down Expand Up @@ -37,6 +39,15 @@ sub elem_test {
is $real, $out, "result is ($pout)";
}
}
elsif ($flag eq 'decode') {
my ($err, $parsed) = $el->decode($src, $in);
if ($out =~ /^elem/) {
is $err, $out, "decode fails ($type) ($pin) ($pout)";
} else {
is_deeply $err, undef, "decode succeeds ($type) ($pin)";
is_deeply $parsed, $out, "result is ($pout)";
}
}
}
}

Expand All @@ -53,6 +64,18 @@ elem_test('R 1/5',
encode => 9999.96, '10000',
encode => -9999.96, '-10000',
encode => -99999.6, qr/Value -99999.6 cannot fit in 5 digits for/,

decode => '4', 4,
decode => '4.', 4,
decode => '4.2', 4.2,
decode => '.4', .4,
decode => '-.4', -.4,
decode => '10E-1', 1,
decode => '10E1', 100,
decode => chr(0x663), 'elem_bad_syntax', # ARABIC-INDIC DIGIT THREE, matches \d (!)
decode => '.', 'elem_bad_syntax',
decode => '+4', 'elem_bad_syntax',
decode => '1E+4', 'elem_bad_syntax',
);

elem_test('R 3/5',
Expand All @@ -62,6 +85,12 @@ elem_test('R 3/5',
encode => -1.2, '-01.2',
encode => 3999, '3999',
encode => -100000, qr/Value -100000 cannot fit in 5 digits for/,

decode => '23', 'elem_too_short',
decode => '-2.E-3', 'elem_too_short',
decode => '230', 230,
decode => '-230.0E-1', -23,
decode => '123456', 'elem_too_long',
);

elem_test('N0 3/5',
Expand All @@ -71,12 +100,19 @@ elem_test('N0 3/5',
encode => -99995, '-99995',
encode => 99999.9, qr/Value 99999.9 cannot fit in 5 digits for/,
encode => -99999.9, qr/Value -99999.9 cannot fit in 5 digits for/,

decode => '032', 32,
decode => '-02', 'elem_too_short',
decode => '123456', 'elem_too_long',
decode => '-12345', -12345,
);

elem_test('N2 4/6',
encode => 0, '0000',
encode => -2, '-0200',
encode => 0.02, '0002',

decode => '-1234', -12.34,
);

elem_test('N 3/5',
Expand All @@ -90,6 +126,15 @@ elem_test('ID 2/3', { A => 'SingleA', AA => 'DoubleA', AAA => 'TripleA' },
encode => TripleA => 'AAA',
encode => TetraA => qr/Value TetraA not contained in DoubleA, SingleA, TripleA for/,
encode => A => qr/Value A not contained in DoubleA, SingleA, TripleA for/,

decode => 'A ' => 'SingleA',
decode => AA => 'DoubleA',
decode => AAA => 'TripleA',
decode => 'AAA ' => 'elem_too_long',
decode => AAAA => 'elem_bad_code',
decode => "\n" => 'elem_bad_syntax',
decode => A => 'elem_too_short',
decode => ABC => 'elem_bad_code',
);

elem_test('AN 2/4',
Expand All @@ -103,25 +148,45 @@ elem_test('AN 2/4',
encode => ' ' => qr/one non-space.*/,
encode => "\r" => qr/non-print.*/,
encode => "\x{3BB}" => qr/charset.*/,

decode => "\r" => 'elem_bad_syntax',
decode => 'F ' => 'F',
decode => 'FFFF' => 'FFFF',
decode => 'ABCD ' => 'elem_too_long',
decode => 'X' => 'elem_too_short',
decode => ' ' => 'elem_bad_syntax',
);

elem_test('DT 6/6',
encode => DateTime->new(year => 1995, day => 23, month => 11), '951123',
encode => DateTime->new(year => 2009, day => 7, month => 3), '090307',
encode => DateTime->new(year => -1, day => 1, month => 1), qr/Value.*is out of range for/,

decode => '19951123' => 'elem_too_long',
# 2-digit year parse tests will start to fail in 2045
decode => '951123' => DateTime->new(year => 1995, day => 23, month => 11),
decode => '451123' => DateTime->new(year => 2045, day => 23, month => 11),
decode => '45112' => 'elem_bad_syntax',
decode => '4511234' => 'elem_bad_syntax',
decode => '951323' => 'elem_bad_date',
decode => '001131' => 'elem_bad_date',
);

elem_test('DT 6/8',
encode => DateTime->new(year => 1995, day => 23, month => 11), '19951123',
encode => DateTime->new(year => 2009, day => 7, month => 3), '20090307',
encode => DateTime->new(year => -1, day => 1, month => 1), qr/Value.*is out of range for/,

decode => '19951123' => DateTime->new(year => 1995, day => 23, month => 11),
);

elem_test('TM 4/4',
encode => DateTime->new(year => 1970, hour => 0, minute => 2, second => 3), '0002',
encode => DateTime->new(year => 1970, hour => 11, minute => 2, second => 3), '1102',
encode => DateTime->new(year => 1970, hour => 12, minute => 2, second => 3), '1202',
encode => DateTime->new(year => 1970, hour => 23, minute => 2, second => 3), '2302',

decode => '123456' => 'elem_too_long',
);

elem_test('TM 4/6',
Expand All @@ -131,8 +196,14 @@ elem_test('TM 4/6',

elem_test('TM 4/8',
encode => DateTime->new(year => 1970, hour => 0, minute => 2, second => 3, nanosecond => 34e7), '00020334',

decode => '00020334' => DateTime->new(year => 0, hour => 0, minute => 2, second => 3, nanosecond => 34e7),
decode => '00026034' => 'elem_bad_time',
decode => '00600334' => 'elem_bad_time',
decode => '24020334' => 'elem_bad_time',
);

elem_test('B 0/0',
elem_test('B 0/256',
encode => join('',map chr, 0..255), join('',map chr, 0..255),
decode => join('',map chr, 0..255), join('',map chr, 0..255),
);

0 comments on commit 1b0f0dd

Please sign in to comment.