Permalink
Browse files

Add and test datatype parsers

  • Loading branch information...
1 parent b486a99 commit 1b0f0dd868911eb2ebd817bf6122fbfd57f53038 @sorear committed Mar 18, 2013
Showing with 170 additions and 4 deletions.
  1. +97 −2 lib/X12/Schema/Element.pm
  2. +73 −2 t/03-element.t
View
@@ -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);
@@ -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) = @_;
@@ -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;
@@ -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;
@@ -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;
@@ -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) = @_;
@@ -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) = @_;
@@ -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;
View
@@ -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;
@@ -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)";
+ }
+ }
}
}
@@ -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',
@@ -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',
@@ -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',
@@ -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',
@@ -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',
@@ -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.