Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Segment parser

  • Loading branch information...
commit 2bda955639684c30b527bfa026a52ddf1589fcab 1 parent 3f3eb04
sorear authored
42  lib/X12/Schema/Segment.pm
@@ -45,11 +45,53 @@ sub encode {
45 45
     $sink->segment( join($sink->element_sep, $self->tag, @bits) . $sink->segment_term );
46 46
 }
47 47
 
  48
+# DIVERSITY: log errors for 997/999/CONTROL, compound elements, repeated elements
  49
+
48 50
 # assumes that the lookahead tag has already been validated
49 51
 sub decode {
50 52
     my ($self, $src) = @_;
51 53
 
52 54
     my $tokens = $src->get;
  55
+
  56
+    my $i = $src->segment_counter;
  57
+    die "Malformed segment tag at $i\n" if @{$tokens->[0]} != 1 or @{$tokens->[0][0]} != 1;
  58
+    die "Segment with nothing but a terminator at $i\n" if @$tokens == 1;
  59
+
  60
+    my %data;
  61
+
  62
+    my $j = 1;
  63
+
  64
+    for my $el (@{ $self->elements }) {
  65
+        my $inp = $j < @$tokens ? $tokens->[$j] : [['']];
  66
+        my $name = $el->name;
  67
+
  68
+        die "Element repetition unsupported at $i\n" if @$inp != 1;
  69
+        die "Composite elements unsupported at $i\n" if @{$inp->[0]} != 1;
  70
+
  71
+        $inp = $inp->[0][0];
  72
+
  73
+        if ($inp eq '') {
  74
+            die "Required element $name is missing at $i\n" if $el->required;
  75
+            $data{ $name } = undef;
  76
+        } else {
  77
+            my ($err, $parsed) = $el->decode($src, $inp);
  78
+
  79
+            die "Element $name is invalid ($err) at $i\n" if $err;
  80
+            $data{ $name } = $parsed;
  81
+        }
  82
+
  83
+        $j++;
  84
+    }
  85
+
  86
+    if ($tokens->[-1][0][0] eq '') {
  87
+        die "Illegal trailing empty element at $i\n";
  88
+    }
  89
+
  90
+    if ($j < @$tokens) {
  91
+        die "Too many data elements at $i\n";
  92
+    }
  93
+
  94
+    return \%data;
53 95
 }
54 96
 
55 97
 __PACKAGE__->meta->make_immutable;
6  lib/X12/Schema/TokenSource.pm
@@ -54,9 +54,9 @@ sub _parse {
54 54
 
55 55
     return [
56 56
         map [
57  
-            map [ split /\Q$csep/, $_ ],
58  
-            (defined($rsep) ? split /\Q$rsep/, $_ : $_)
59  
-        ], split /\Q$esep/, $segment
  57
+            map [ $_ ne '' ? split /\Q$csep/, $_, -1 : $_ ],
  58
+            ((defined($rsep) && $_ ne '') ? split /\Q$rsep/, $_, -1 : $_)
  59
+        ], split /\Q$esep/, $segment, -1
60 60
     ];
61 61
 }
62 62
 
26  t/05-segment.t
... ...
@@ -1,18 +1,26 @@
1 1
 use strict;
2 2
 use warnings;
3  
-use Test::More tests => 15;
  3
+use Test::More tests => 28;
4 4
 use Test::Exception;
5 5
 
6 6
 use X12::Schema::Element;
7 7
 BEGIN { use_ok('X12::Schema::Segment') or die }
8 8
 use X12::Schema::TokenSink;
  9
+use X12::Schema::TokenSource;
9 10
 
10 11
 # TODO: constraints will be redesigned for the parser, so don't test those
11 12
 
12 13
 my $sink = X12::Schema::TokenSink->new( element_sep => '*', segment_term => '~', component_sep => ':' );
13 14
 
14 15
 my $seg;
  16
+my $src;
15 17
 
  18
+sub decode {
  19
+    $src = X12::Schema::TokenSource->new( buffer => $_[0] );
  20
+    $src->set_delims('/', '^', '*', '~', '');
  21
+
  22
+    return $seg->decode($src);
  23
+}
16 24
 
17 25
 $seg = new_ok 'X12::Schema::Segment', [ tag => 'FOO', friendly => 'Foo', elements => [
18 26
     X12::Schema::Element->new( name => 'A', type => 'AN 5/5'),
@@ -34,6 +42,18 @@ lives_ok { $seg->encode($sink, { B => 'dog' }) } 'partial encode without suppres
34 42
 is $sink->output, 'FOO**dog  ~', 'partial encode without suppressed sep right result';
35 43
 
36 44
 
  45
+throws_ok { decode('FOO^X~') } qr/Malformed segment tag/;
  46
+throws_ok { decode('FOO/X~') } qr/Malformed segment tag/;
  47
+throws_ok { decode('FOO~') } qr/Segment with nothing but a terminator/;
  48
+throws_ok { decode('FOO*X^X~') } qr/unsupported/;
  49
+throws_ok { decode('FOO*X/X~') } qr/unsupported/;
  50
+throws_ok { decode('FOO*ABCD~') } qr/too_short/;
  51
+throws_ok { decode('FOO*ABCDE*~') } qr/trailing empty/;
  52
+throws_ok { decode('FOO*ABCDE*FGHIJ*KLMNO~') } qr/Too many/;
  53
+
  54
+is_deeply decode('FOO**ABCDE~'), { A => undef, B => 'ABCDE' }, 'correct optional parse 1';
  55
+is_deeply decode('FOO*ABCDE~'), { B => undef, A => 'ABCDE' }, 'correct optional parse 2';
  56
+
37 57
 $seg = new_ok 'X12::Schema::Segment', [ tag => 'FOO', friendly => 'Foo', elements => [
38 58
     X12::Schema::Element->new( name => 'A', type => 'AN 5/5', required => 1 ),
39 59
     X12::Schema::Element->new( name => 'B', type => 'AN 5/5', required => 1 ),
@@ -45,3 +65,7 @@ $sink->output('');
45 65
 lives_ok { $seg->encode($sink, { A => 'cow', B => 'dog' }) } 'encode with required fields';
46 66
 is $sink->output, 'FOO*cow  *dog  ~', '... right result';
47 67
 
  68
+throws_ok { decode('FOO*ABCDE~') } qr/Required/;
  69
+throws_ok { decode('FOO**ABCDE~') } qr/Required/;
  70
+is_deeply decode('FOO*ABCDE*FGHIJ~'), { B => 'FGHIJ', A => 'ABCDE' }, 'correct mandatory parse';
  71
+

0 notes on commit 2bda955

Please sign in to comment.
Something went wrong with that request. Please try again.