Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add sequence parser

  • Loading branch information...
commit 67d9d04609f79407dcf1f3e0a6355d770f0c2465 1 parent 2bda955
sorear authored
2  lib/X12/Schema/SegmentUse.pm
@@ -3,7 +3,7 @@ package X12::Schema::SegmentUse;
3 3
 use Moose;
4 4
 use namespace::autoclean;
5 5
 
6  
-has def => (is => 'ro', isa => 'X12::Schema::Segment', required => 1, handles => ['encode']);
  6
+has def => (is => 'ro', isa => 'X12::Schema::Segment', required => 1, handles => ['encode','decode']);
7 7
 
8 8
 with 'X12::Schema::Sequencable';
9 9
 
2  lib/X12/Schema/Sequencable.pm
@@ -12,6 +12,6 @@ has _can_be_empty => (isa => 'Bool', is => 'rw', init_arg => undef);
12 12
 has _initial_tags => (isa => 'HashRef', is => 'rw', init_arg => undef);
13 13
 has _ambiguous_end_tags => (isa => 'HashRef', is => 'rw', init_arg => undef);
14 14
 
15  
-requires qw( encode );
  15
+requires qw( encode decode );
16 16
 
17 17
 1;
63  lib/X12/Schema/Sequence.pm
@@ -8,6 +8,10 @@ with 'X12::Schema::Sequencable';
8 8
 
9 9
 has children => (isa => 'ArrayRef[X12::Schema::Sequencable]', is => 'ro', required => 1);
10 10
 
  11
+has _cooked_begin    => (isa => 'ArrayRef[HashRef]', is => 'bare');
  12
+has _cooked_nofollow => (isa => 'ArrayRef[HashRef]', is => 'bare');
  13
+has _cooked_empty    => (isa => 'ArrayRef[Bool]', is => 'bare');
  14
+
11 15
 # DIVERSITY: These loop rules are much looser than prescribed by X12.6
12 16
 # DIVERSITY: may need to handle UN/EDIFACT's explicit nesting indicators
13 17
 
@@ -32,14 +36,65 @@ sub encode {
32 36
             $elem->encode($sink, $_) for @$passed;
33 37
         }
34 38
         else {
35  
-            die "Segment or loop ".$elem->name." is required" if $elem->required && !$passed;
36  
-            $elem->encode($sink, $passed);
  39
+            die "Segment or loop ".$elem->name." is required" if $elem->required && !defined($passed);
  40
+            $elem->encode($sink, $passed) if defined($passed);
37 41
         }
38 42
     }
39 43
 
40 44
     die "Unused children passed to ".$self->name.": ".join(', ',sort keys %tmp) if %tmp;
41 45
 }
42 46
 
  47
+sub decode {
  48
+    my ($self, $src, $exit_cont) = @_;
  49
+
  50
+    my $kids = $self->{children};
  51
+    my @internal_cont;
  52
+    my %data;
  53
+
  54
+    $internal_cont[ @$kids ] = $exit_cont;
  55
+
  56
+    for my $i ( $#$kids .. 0 ) {
  57
+        $internal_cont[$i] = $self->{_cooked_empty}[$i] ?
  58
+            { %{ $self->{_cooked_begin}[$i] }, %{ $internal_cont[$i+1] } } :
  59
+            $self->{_cooked_begin}[$i];
  60
+    }
  61
+
  62
+    for my $i ( 0 .. $#$kids ) {
  63
+        if ($src->peek_code && !$internal_cont[$i]{$src->peek_code}) {
  64
+            $src->get;
  65
+            die "Unexpected segment at ".$src->segment_counter."\n";
  66
+        }
  67
+
  68
+        my $kid = $kids->[$i];
  69
+
  70
+        if (defined($kid->max_use) && $kid->max_use == 1) {
  71
+            if ($kid->_initial_tags->{ $src->peek_code }) {
  72
+                $data{ $kid->name } = $kid->decode( $src, $internal_cont[$i+1] );
  73
+            } elsif ($kid->required) {
  74
+                die $kid->name." is required at ".$src->segment_counter."\n";
  75
+            }
  76
+        }
  77
+        else {
  78
+            my @accum;
  79
+            while ($kid->_initial_tags->{ $src->peek_code }) {
  80
+                if (defined($kid->max_use) && @accum >= $kid->max_use) {
  81
+                    die $kid->name." exceeds ".$kid->max_use." occurrences at ".$src->segment_counter."\n";
  82
+                }
  83
+
  84
+                push @accum, $kid->decode( $src, $internal_cont[$i] ); # deliberately $i - we'll loop back
  85
+            }
  86
+
  87
+            if ($kid->required && !@accum) {
  88
+                die $kid->name."is required at ".$src->segment_counter."\n";
  89
+            }
  90
+
  91
+            $data{$kid->name} = \@accum;
  92
+        }
  93
+    }
  94
+
  95
+    return \%data;
  96
+}
  97
+
43 98
 sub BUILD {
44 99
     my ($self) = @_;
45 100
 
@@ -71,6 +126,10 @@ sub BUILD {
71 126
         }
72 127
     }
73 128
 
  129
+    $self->{_cooked_empty} = \@empty;
  130
+    $self->{_cooked_nofollow} = \@nofollow;
  131
+    $self->{_cooked_begin} = \@begin;
  132
+
74 133
     # get initial
75 134
     my %initial;
76 135
     my $can_be_empty = 1;

0 notes on commit 67d9d04

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