Permalink
Browse files

02-element.t, initial bugfixes

  • Loading branch information...
1 parent a6721a4 commit 587722d705417ee8b92b781005f76b1303336091 @sorear committed Mar 9, 2013
Showing with 140 additions and 5 deletions.
  1. +5 −3 lib/X12/Schema/Element.pm
  2. +2 −2 lib/X12/Schema/TokenSink.pm
  3. +133 −0 t/02-element.t
@@ -1,5 +1,7 @@
package X12::Schema::Element;
+use DateTime;
+
use Moose;
use namespace::autoclean;
@@ -28,7 +30,7 @@ sub BUILD {
$self->{type} = $1;
$self->{scale} = $2 || 0;
$self->{min_length} = $3;
- $self->{min_length} = $4;
+ $self->{max_length} = $4;
$self->{contract} = $self->expand && { reverse %{ $self->expand } };
}
@@ -82,7 +84,7 @@ sub encode {
}
if ($type eq 'ID') {
- $value = ($self->contract->{$value} || die "Value $value is for ".$self->name." is not contained in: ".join(', ',sort keys %{$self->contract})."\n");
+ $value = ($self->contract->{$value} || die "Value $value not contained in ".join(', ',sort keys %{$self->contract})." for ".$self->name."\n");
$type = "AN";
# deliberate fall through
@@ -93,7 +95,7 @@ sub encode {
$string =~ s/ *$//;
length($string) > $maxp and die "Value $value does not fit in $maxp characters for ".$self->name."\n";
- length($string) < $minp and $string .= (" " x ($maxp - length($string)));
+ length($string) < $minp and $string .= (" " x ($minp - length($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
@@ -7,8 +7,8 @@ has delim_re => (is => 'ro', isa => 'RegexpRef', init_arg => undef);
has [qw( segment_term element_sep repeat_sep component_sep )] => (is => 'ro', isa => 'Str', required => 1);
-has output => (is => 'ro', isa => 'Str', default => '', init_arg => undef);
-has output_func => (is => 'ro', isa => 'CodeRef');
+has output => (is => 'rw', isa => 'Str', default => '', init_arg => undef);
+has output_func => (is => 'rw', isa => 'CodeRef');
# DIVERSITY: this will need to include flags to control the output in other ways, such as UN/EDIFACT mode, whether to use exponential notation, etc
View
@@ -0,0 +1,133 @@
+use strict;
+use warnings;
+use Test::More tests => 114;
+use Test::Exception;
+
+BEGIN { use_ok 'X12::Schema::Element'; }
+use X12::Schema::TokenSink;
+
+my $sink = X12::Schema::TokenSink->new( element_sep => '*', segment_term => "~\n", component_sep => '\\', repeat_sep => '^' );
+
+my $el;
+
+throws_ok { X12::Schema::Element->new(name => 'Foo') } qr/type.*required/;
+throws_ok { X12::Schema::Element->new(type => 'N 3/3') } qr/name.*required/;
+
+throws_ok { X12::Schema::Element->new(name => 'Foo', type => 'X 2/3') } qr/type at BUILD must look like/;
+throws_ok { X12::Schema::Element->new(name => 'Foo', type => 'ID 2/3') } qr/expand required/;
+throws_ok { X12::Schema::Element->new(name => 'Foo', type => 'R3 2/3') } qr/numeric postfix/;
+
+sub elem_test {
+ my $type = shift;
+ my $expand = ($type =~ /^ID/) ? shift : undef;
+
+ my ($el, $real);
+ lives_ok { $el = X12::Schema::Element->new(name => 'EL', type => $type, $expand ? (expand => $expand) : ()) } "can parse $type" or return;
+
+ while (@_) {
+ my ($flag, $in, $out) = splice @_, 0, 3;
+ my ($pin, $pout) = ($in, $out);
+ s/[^ -~]//g for $pin, $pout;
+
+ if ($flag eq 'encode') {
+ if (ref($out)) {
+ throws_ok { $el->encode($sink, $in) } qr/$out EL\n/, "encode fails ($type) ($pin) ($out)";
+ } else {
+ lives_ok { $real = $el->encode($sink, $in) } "encode succeeds ($type) ($pin)";
+ is $real, $out, "result is ($pout)";
+ }
+ }
+ }
+}
+
+elem_test('R 1/5',
+ encode => 0, '0',
+ encode => 9, '9',
+ encode => 9.5, '9.5',
+ encode => 12.444, '12.444',
+ encode => 12.4444, '12.444',
+ encode => -12.444, '-12.444',
+ encode => 0.25, '0.25',
+ encode => 99999.2, '99999',
+ encode => 99999.6, qr/Value 99999.6 cannot fit in 5 digits for/,
+ encode => 9999.96, '10000',
+ encode => -9999.96, '-10000',
+ encode => -99999.6, qr/Value -99999.6 cannot fit in 5 digits for/,
+);
+
+elem_test('R 3/5',
+ encode => 0, '000',
+ encode => 95, '095',
+ encode => 1.2, '01.2',
+ encode => -1.2, '-01.2',
+ encode => 3999, '3999',
+ encode => -100000, qr/Value -100000 cannot fit in 5 digits for/,
+);
+
+elem_test('N0 3/5',
+ encode => 32.2, '032',
+ encode => -995, '-995',
+ encode => 99995, '99995',
+ encode => -99995, '-99995',
+ encode => 99999.9, qr/Value 99999.9 cannot fit in 3 digits for/,
+ encode => -99999.9, qr/Value -99999.9 cannot fit in 3 digits for/,
+);
+
+elem_test('N2 4/6',
+ encode => 0, '0000',
+ encode => -2, '-0200',
+ encode => 0.02, '0002',
+);
+
+elem_test('N 3/5',
+ encode => 0, '000',
+ encode => -2.4, '-002',
+);
+
+elem_test('ID 2/3', { A => 'SingleA', AA => 'DoubleA', AAA => 'TripleA' },
+ encode => SingleA => 'A ',
+ encode => DoubleA => 'AA',
+ 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/,
+);
+
+elem_test('AN 2/4',
+ encode => 'F' => 'F ',
+ encode => 'FF' => 'FF',
+ encode => 'FFFF' => 'FFFF',
+ encode => 'FFFFF' => qr/Value FFFFF does not fit in 4 characters for/,
+ encode => 'F^' => qr/Value F\^ after encoding would contain a prohibited delimiter.*/,
+);
+
+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/,
+);
+
+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/,
+);
+
+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',
+);
+
+elem_test('TM 4/6',
+ encode => DateTime->new(year => 1970, hour => 0, minute => 2, second => 3), '000203',
+ encode => DateTime->new(time_zone => 'UTC', year => 1972, month => 12, day => 31, hour => 23, minute => 59, second => 60), '235959',
+);
+
+elem_test('TM 4/8',
+ encode => DateTime->new(year => 1970, hour => 0, minute => 2, second => 3, nanosecond => 34e7), '00020334',
+);
+
+elem_test('B 0/0',
+ encode => join('',map chr, 0..255), join('',map chr, 0..255),
+);

0 comments on commit 587722d

Please sign in to comment.