File Coverage

blib/lib/Data/EDI/X12.pm
Criterion Covered Total %
statement 276 292 94.5
branch 106 160 66.2
condition 54 93 58.0
subroutine 12 13 92.3
pod 3 4 75.0
total 451 562 80.2


line stmt bran cond sub pod time code
1             package Data::EDI::X12;
2 2     2   137009 use strict;
  2         12  
  2         70  
3              
4 2     2   1065 use YAML qw(LoadFile Load);
  2         18923  
  2         132  
5 2     2   1069 use IO::File;
  2         17880  
  2         7070  
6              
7             our $VERSION = '0.10';
8              
9             =head1 NAME
10              
11             Data::EDI::X12 - EDI X12 Processing for Perl
12              
13             =cut
14              
15             =head1 SYNOPSIS
16              
17             my $x12 = Data::EDI::X12->new({ spec_file => 'edi.yaml', new_lines => 1, truncate_null => 1, hide_empty_sections => 1 });
18             my $data = $x12->read_record(...);
19             print $x12->write_record($data);
20            
21             =head1 METHODS
22              
23             =cut
24              
25 0     0 0 0 sub debug { shift->{debug} }
26              
27             my $DEFAULT_CONFIG = {
28             ISA => {
29             definition => [
30             {
31             type => 'text',
32             name => 'authorization_information_qualifier',
33             value => '00',
34             bytes => 2,
35             },
36             {
37             type => 'filler',
38             bytes => 10,
39             value => ' ',
40             },
41             {
42             type => 'text',
43             name => 'security_information_qualifier',
44             value => '00',
45             bytes => 2,
46             },
47             {
48             type => 'filler',
49             bytes => 10,
50             value => ' ',
51             },
52             {
53             type => 'text',
54             name => 'interchange_id_qualifier_1',
55             value => '00',
56             bytes => 2,
57             },
58             {
59             type => 'text',
60             name => 'interchange_id_1',
61             value => '00',
62             bytes => 15,
63             },
64             {
65             type => 'text',
66             name => 'interchange_id_qualifier_2',
67             value => '00',
68             bytes => 2,
69             },
70             {
71             type => 'text',
72             name => 'interchange_id_2',
73             value => '00',
74             bytes => 15,
75             },
76             {
77             type => 'text',
78             name => 'date',
79             value => '',
80             bytes => 6,
81             },
82             {
83             type => 'text',
84             name => 'time',
85             value => '',
86             bytes => 4,
87             },
88             {
89             type => 'text',
90             name => 'repetition_separator',
91             value => 'U',
92             bytes => 1,
93             },
94             {
95             type => 'text',
96             name => 'control_version_number',
97             bytes => 5,
98             },
99             {
100             type => 'text',
101             name => 'control_number',
102             bytes => 9,
103             format => '%09i',
104             },
105             {
106             type => 'text',
107             name => 'acknowledgment_requested',
108             bytes => 1,
109             },
110             {
111             type => 'text',
112             name => 'usage_indicator',
113             bytes => 1,
114             value => 'P',
115             },
116             {
117             type => 'text',
118             bytes => 1,
119             value => '>',
120             }
121             ],
122             },
123             IEA => {
124             definition => [
125             {
126             name => 'total',
127             min => 1,
128             max => 10,
129             },
130             {
131             name => 'control_number',
132             min => 4,
133             max => 9,
134             format => '%09i',
135             },
136             ],
137             },
138             GS => {
139             definition => [
140             {
141             type => 'text',
142             name => 'type',
143             value => '00',
144             bytes => 2,
145             },
146             {
147             type => 'text',
148             name => 'sender_code',
149             bytes => 9,
150             },
151             {
152             type => 'text',
153             name => 'receiver_code',
154             bytes => 9,
155             },
156             {
157             type => 'text',
158             name => 'date',
159             value => '',
160             bytes => 8,
161             },
162             {
163             type => 'text',
164             name => 'time',
165             value => '',
166             bytes => 4,
167             },
168             {
169             type => 'text',
170             name => 'control_number',
171             bytes => 9,
172             format => '%09i',
173             },
174             {
175             type => 'text',
176             name => 'agency_code',
177             bytes => 1,
178             value => 'X',
179             },
180             {
181             type => 'text',
182             name => 'version_number',
183             bytes => 6,
184             },
185             ],
186             },
187             ST => {
188             definition => [
189             {
190             name => 'identifier_code',
191             min => 3,
192             max => 3,
193             },
194             {
195             name => 'control_number',
196             min => 4,
197             max => 9,
198             format => '%04i',
199             },
200             ],
201             },
202             SE => {
203             definition => [
204             {
205             name => 'total',
206             min => 1,
207             max => 10,
208             },
209             {
210             name => 'control_number',
211             min => 4,
212             max => 9,
213             format => '%04i',
214             },
215             ],
216             },
217             GE => {
218             definition => [
219             {
220             name => 'total',
221             min => 1,
222             max => 10,
223             },
224             {
225             name => 'control_number',
226             min => 4,
227             max => 9,
228             format => '%09i',
229             },
230             ],
231             },
232             };
233              
234             =head2 new
235              
236             my $x12 = Data::EDI::X12->new({ spec_file => 'edi.yaml', new_lines => 1, truncate_null => 1 });
237              
238             =cut
239              
240             sub new
241             {
242 2     2 1 173 my ($class, $args) = @_;
243              
244 2         5 my $yaml_spec;
245 2 50       10 if ($args->{spec})
    50          
    50          
246             {
247 0         0 $yaml_spec = $args->{spec};
248             }
249             elsif ($args->{yaml_spec})
250             {
251 0         0 $yaml_spec = Load($args->{spec});
252             }
253             elsif ($args->{spec_file})
254             {
255 2         10 $yaml_spec = LoadFile($args->{spec_file});
256             }
257             else
258             {
259 0         0 die sprintf("[%s] args spec or spec_file must be specified", __PACKAGE__);
260             }
261              
262 2         141781 my $spec = {
263             %$DEFAULT_CONFIG,
264             %$yaml_spec,
265             };
266              
267 2         6 my $config_terminator;
268             $config_terminator = $spec->{config}{config_terminator}
269 2 0 33     10 if $spec->{config} and $spec->{config}{config_terminator};
270              
271 2         5 my $config_separator;
272             $config_separator = $spec->{config}{config_separator}
273 2 0 33     7 if $spec->{config} and $spec->{config}{config_separator};
274              
275 2         4 my $config_strict_ascii = $args->{strict_ascii};
276             $config_strict_ascii = $spec->{config}{strict_ascii}
277 2 0 33     6 if $spec->{config} and exists($spec->{config}{strict_ascii});
278              
279 2         6 my $config_truncate_null = $args->{truncate_null};
280             $config_truncate_null = $spec->{config}{truncate_null}
281 2 0 33     7 if $spec->{config} and exists($spec->{config}{truncate_null});
282              
283 2         4 my $config_hide_empty_sections = $args->{hide_empty_sections};
284             $config_hide_empty_sections = $spec->{config}{hide_empty_sections}
285 2 0 33     5 if $spec->{config} and exists($spec->{config}{hide_empty_sections});
286            
287              
288             my $self = {
289             spec => $spec,
290             debug => $args->{debug},
291             terminator => $config_terminator || $args->{terminator} || '~',
292             separator => $config_separator || $args->{separator} || '*',
293             error => '',
294             new_lines => $args->{new_lines},
295 2   50     58 truncate_null => $config_truncate_null || 0,
      50        
      50        
      50        
      50        
296             hide_empty_sections => $config_hide_empty_sections || 0,
297             strict_ascii => $config_strict_ascii || 0,
298             };
299 2         5 bless($self);
300              
301 2         9 return $self;
302             }
303              
304             =head2 read_record
305              
306             my $record = $x12->read_record($string);
307              
308             =cut
309              
310             sub read_record
311             {
312 2     2 1 17 my ($self, $string) = @_;
313              
314 2         6 my $record = { };
315              
316             # strip newlines if applicable
317             $string =~ s/[\r\n]//g
318 2 50       41 unless $self->{terminator} =~ /[\r\n]/;
319              
320 2     2   14 open(my $fh, "<", \$string);
  2         4  
  2         12  
  2         80  
321              
322             #$self->_parse_transaction_set({
323 2         1622 $self->_parse_edi({
324             fh => $fh,
325             string => $string,
326             record => $record,
327             });
328            
329 2         22 return $record;
330             }
331              
332             =head2 write_record
333              
334             my $string = $x12->write_record($record);
335              
336             =cut
337              
338             sub write_record
339             {
340 2     2 1 29 my ($self, $record) = @_;
341              
342 2         6 my $string = '';
343 2         30 open(my $fh, ">", \$string);
344 2         15 $self->_write_edi({
345             fh => $fh,
346             string => $string,
347             record => $record,
348             });
349            
350 2         16 return $string;
351             }
352              
353             sub _split_string
354             {
355 2     2   5 my ($self, $string) = @_;
356 2         12 my $term_val = quotemeta($self->{terminator});
357 2         5 my $sep_val = quotemeta($self->{separator});
358              
359 2         4 my @records;
360             push @records, [ split(/$sep_val/, $_) ]
361 2         182 for split(/$term_val/, $string);
362              
363 2         14 return @records;
364             }
365              
366             sub _parse_definition
367             {
368 32     32   61 my ($self, $params) = @_;
369              
370 32         55 my $record = { };
371              
372 32         51 my $definition = $params->{definition};
373              
374 32         38 my $segments = $params->{segments};
375 32         48 my $type = $params->{type};
376              
377 32 50       40 for my $def (@{ $definition || [ ] })
  32         78  
378             {
379 154         216 my $segment = shift(@$segments);
380 154         273 $segment =~ s/\s+$//g;
381            
382             $record->{$def->{name}} = $segment
383 154 100       483 if $def->{name};
384             }
385              
386 32         130 return $record;
387             }
388              
389             sub _parse_edi
390             {
391 2     2   7 my ($self, $params) = @_;
392              
393 2         5 my $fh = $params->{fh};
394 2         4 my $record = $params->{record};
395 2         4 my $definition = $params->{definition};
396 2         4 my $string = $params->{string};
397              
398 2         3 my $IN_ISA = 0;
399 2         4 my $IN_GS = 0;
400 2         3 my $IN_ST = 0;
401 2         14 my $IN_DETAIL = 0;
402 2         4 my $IN_FOOTER = 0;
403              
404 2         6 my $IN_LOOP;
405             my $LOOP_SECTION;
406 2         0 my %LOOP_SEGMENTS;
407              
408 2         0 my ($current_group, $current_set, $current_record);
409              
410             $record->{GROUPS} = [ ]
411 2 50       11 unless exists $record->{GROUPS};
412              
413 2         7 for my $segments ($self->_split_string($string))
414             {
415 38         94 my $type = uc(shift(@$segments));
416              
417 38 100       144 if ($type eq 'ISA')
    100          
    100          
    100          
    100          
    100          
418             {
419             $record->{ISA} = $self->_parse_definition({
420             definition => $self->{spec}->{ISA}->{definition},
421 2         17 segments => $segments,
422             type => $type,
423             });
424 2         6 $IN_ISA = 1;
425              
426 2         3 %LOOP_SEGMENTS = ();
427 2         3 $LOOP_SECTION = undef;
428 2         13 $IN_LOOP = undef;
429              
430 2         13 $IN_DETAIL = 0;
431 2         5 $IN_FOOTER = 0;
432             }
433             elsif ($type eq 'IEA')
434             {
435 2         4 $IN_ISA = 0;
436              
437 2         5 %LOOP_SEGMENTS = ();
438 2         3 $LOOP_SECTION = undef;
439 2         3 $IN_LOOP = undef;
440              
441 2         3 $IN_DETAIL = 0;
442 2         44 $IN_FOOTER = 0;
443             }
444             elsif ($type eq 'GS')
445             {
446             my $new_group = $self->_parse_definition({
447             definition => $self->{spec}->{GS}->{definition},
448 2         30 segments => $segments,
449             type => $type,
450             });
451              
452 2         6 $new_group->{SETS} = [ ];
453              
454 2         4 $IN_GS = 1;
455              
456 2         5 %LOOP_SEGMENTS = ();
457 2         4 $LOOP_SECTION = undef;
458 2         2 $IN_LOOP = undef;
459              
460 2         4 $IN_DETAIL = 0;
461 2         4 $IN_FOOTER = 0;
462              
463 2         4 $current_group = $new_group;
464             }
465             elsif ($type eq 'GE')
466             {
467 2         3 push @{ $record->{GROUPS} }, \%$current_group;
  2         5  
468              
469 2         3 %LOOP_SEGMENTS = ();
470 2         4 $LOOP_SECTION = undef;
471 2         2 $IN_LOOP = undef;
472              
473 2         3 $IN_DETAIL = 0;
474 2         3 $IN_FOOTER = 0;
475              
476 2         4 $IN_GS = 0;
477             }
478             elsif ($type eq 'ST')
479             {
480             my $new_set = $self->_parse_definition({
481             definition => $self->{spec}->{ST}->{definition},
482 2         10 segments => $segments,
483             type => $type,
484             });
485              
486 2         5 $IN_ST = 1;
487              
488 2         3 %LOOP_SEGMENTS = ();
489 2         4 $LOOP_SECTION = undef;
490 2         3 $IN_LOOP = undef;
491              
492 2         4 $IN_DETAIL = 0;
493 2         3 $IN_FOOTER = 0;
494              
495 2         3 $current_set = $new_set;
496 2         3 $current_record = $new_set;
497             }
498             elsif ($type eq 'SE')
499             {
500 2         4 push @{ $current_group->{SETS} }, \%$current_set;
  2         7  
501              
502 2         6 %LOOP_SEGMENTS = ();
503 2         14 $LOOP_SECTION = undef;
504 2         3 $IN_LOOP = undef;
505              
506 2         4 $IN_GS = 0;
507 2         3 $IN_DETAIL = 0;
508 2         4 $IN_FOOTER = 0;
509             }
510             else
511             {
512 26         36 my $doc_id = $current_set->{identifier_code};
513 26         37 my $spec = $self->{spec}->{$doc_id};
514              
515             # parse a record
516 26         37 my %segment_to_section;
517             my %loop_def;
518              
519 26         39 for my $section (qw(footer detail header))
520             {
521 78 50       134 for my $segment (@{ $spec->{structure}{$section} || [ ] })
  78         178  
522             {
523 216 100 66     451 if (ref($segment) and ref($segment) eq 'HASH')
524             {
525 34         66 for my $key (keys(%$segment))
526             {
527 34         80 $loop_def{$key} = $segment->{$key};
528 34         85 $segment_to_section{$key} = uc($section);
529             }
530             }
531             else
532             {
533 182         360 $segment_to_section{$segment} = uc($section);
534             }
535             }
536             }
537              
538             # state machine bingo!
539 26         42 my $section = $segment_to_section{$type};
540              
541 26 100 66     100 if ($section eq 'DETAIL')
    50 33        
    100          
    50          
542             {
543 10         12 $IN_DETAIL = 1;
544             }
545             elsif ($section eq 'HEADER' and $IN_DETAIL)
546             {
547 0         0 $section = 'DETAIL';
548             }
549             elsif ($section eq 'FOOTER')
550             {
551 3         7 $IN_FOOTER = 1;
552             }
553             elsif ($section eq 'DETAIL' and $IN_FOOTER)
554             {
555 0         0 $section = 'FOOTER';
556             }
557              
558 26         30 my $mod_record;
559              
560             # track tree depth
561             # and dump results in loop portion?
562             {
563 26 50       33 if (my $type_def = $spec->{segments}{uc($type)})
  26         63  
564             {
565 26 100 100     72 if ($section eq 'DETAIL' or $LOOP_SECTION eq 'DETAIL')
566             {
567             $current_record->{DETAIL} = [{}]
568 12 100       28 unless exists $current_record->{DETAIL};
569              
570             # START THE LOOPING
571 12 100 100     31 if ($loop_def{$type} and not $IN_LOOP)
572             {
573 1         2 $IN_LOOP = $type;
574 1         1 $LOOP_SECTION = $section;
575 1 50       1 %LOOP_SEGMENTS = map { $_ => 1 } @{ $loop_def{$type} || [] };
  2         6  
  1         4  
576             }
577              
578             # END THE LOOPING
579 12 100 100     29 if ($IN_LOOP and not $LOOP_SEGMENTS{$type})
580             {
581 1         2 %LOOP_SEGMENTS = ();
582 1         2 $LOOP_SECTION = undef;
583 1         2 $IN_LOOP = undef;
584             }
585              
586 12 100       23 if ($IN_LOOP)
587             {
588             $current_record->{DETAIL}->[-1]->{$IN_LOOP} = [{}]
589 4 100       20 unless exists $current_record->{DETAIL}->[-1]->{$IN_LOOP};
590              
591 1         3 push @{ $current_record->{DETAIL}->[-1]->{$IN_LOOP} }, {}
592 4 100       15 if exists($current_record->{DETAIL}->[-1]->{$IN_LOOP}->[-1]->{$type});
593              
594             $current_record->{DETAIL}->[-1]->{$IN_LOOP}->[-1]->{$type} = $self->_parse_definition({
595             definition => $type_def->{definition},
596 4         16 segments => $segments,
597             type => $type,
598             });
599             }
600             else
601             {
602 2         5 push @{ $current_record->{DETAIL} }, {}
603 8 100       23 if exists($current_record->{DETAIL}->[-1]->{$type});
604              
605             $current_record->{DETAIL}->[-1]->{$type} = $self->_parse_definition({
606             definition => $type_def->{definition},
607 8         29 segments => $segments,
608             type => $type,
609             });
610             }
611             }
612             else
613             {
614             $current_record->{$section} = {}
615 14 100       29 unless exists $current_record->{$section};
616              
617 14         32 my $structure = $spec->{structure}{lc($section)};
618              
619             # END THE LOOPING
620 14 100 100     52 if ($IN_LOOP and not $LOOP_SEGMENTS{$type})
621             {
622 1         2 %LOOP_SEGMENTS = ();
623 1         2 $LOOP_SECTION = undef;
624 1         1 $IN_LOOP = undef;
625             }
626              
627             # START THE LOOPING
628 14 100 100     48 if ($loop_def{$type} and not $IN_LOOP)
629             {
630 1         3 $IN_LOOP = $type;
631 1         2 $LOOP_SECTION = $section;
632 1 50       2 %LOOP_SEGMENTS = map { $_ => 1 } @{ $loop_def{$type} || [] };
  2         8  
  1         5  
633              
634             }
635              
636 14 100       25 if ($IN_LOOP)
637             {
638             $current_record->{$LOOP_SECTION}->{$IN_LOOP} = [{}]
639 4 100       11 unless exists $current_record->{$LOOP_SECTION}->{$IN_LOOP};
640              
641 1         3 push @{ $current_record->{$LOOP_SECTION}{$IN_LOOP} }, {}
642 4 100       11 if exists($current_record->{$LOOP_SECTION}->{$IN_LOOP}->[-1]->{$type});
643              
644             $current_record->{$LOOP_SECTION}->{$IN_LOOP}->[-1]->{$type} = $self->_parse_definition({
645             definition => $type_def->{definition},
646 4         24 segments => $segments,
647             type => $type,
648             });
649             }
650             else
651             {
652             $current_record->{$section}->{$type} = $self->_parse_definition({
653             definition => $type_def->{definition},
654 10         38 segments => $segments,
655             type => $type,
656             });
657             }
658             }
659             }
660             }
661             }
662             }
663             }
664              
665             sub _write_spec
666             {
667 38     38   115 my ($self, %params) = @_;
668 38         91 my $type_def = $params{type_def};
669 38         53 my $record = $params{record};
670 38         80 my @line = ($params{type});
671 38         58 my $term_val = $self->{terminator};
672 38         54 my $sep_val = $self->{separator};
673              
674 38 50       47 for my $def (@{ $type_def->{definition} || [ ] })
  38         96  
675             {
676 166 50       345 next unless ref($record) eq 'HASH';
677              
678             my $value = ($def->{name} and exists($record->{$def->{name}})) ?
679 166 100 66     576 $record->{$def->{name}} : $def->{value};
680              
681 166 100       276 $value = '' unless defined $value;
682              
683 166   100     500 $def->{bytes} ||= '';
684              
685             # deal with minimum
686             $def->{bytes} = $def->{min}
687 166 50 100     599 if $value ne '' and not($def->{bytes}) and $def->{min} and length($value) < $def->{min};
      100        
      66        
688              
689             $def->{bytes} = '-' . $def->{bytes}
690 166 100       297 if $def->{bytes};
691              
692 166   66     425 my $format = $def->{format} || "\%$def->{bytes}s";
693            
694             # deal with maximum limits
695             $value = substr($value, 0, $def->{max})
696 166 100       296 if $def->{max};
697              
698             # stop stupidity
699 166 100       399 $value =~ s/\Q$term_val\E//g if $value;
700 166 100       337 $value =~ s/\Q$sep_val\E//g if $value;
701              
702             # strip all non-ascii
703 166 50       288 $value =~ s/[^[:ascii:]]//g if $self->{strict_ascii};
704              
705 166         423 push @line, sprintf($format, $value);
706             }
707              
708            
709 38 50       83 if ($self->{truncate_null})
710             {
711 38         58 for my $val (reverse @line)
712             {
713 41 100       85 last if $val ne '';
714              
715 3         5 pop(@line);
716             }
717             }
718            
719 38         92 my $string = join($sep_val, @line);
720 38         71 $string .= $term_val;
721 38 50       91 $string .= "\n" if $self->{new_lines};
722              
723 38         202 return $string;
724             }
725              
726             sub _write_edi
727             {
728 2     2   5 my ($self, $params) = @_;
729              
730 2         5 my $fh = $params->{fh};
731 2         3 my $record = $params->{record};
732 2         4 my $definition = $params->{definition};
733 2         4 my $string = $params->{string};
734              
735 2         5 my $buffer = '';
736              
737 2         3 my $term_val = $self->{terminator};
738 2         13 my $sep_val = $self->{separator};
739              
740 2         4 my $hide_empty_sections = $self->{hide_empty_sections};
741              
742             $record->{ISA}{control_number} = 1
743 2 50       7 unless exists $record->{ISA}{control_number};
744              
745             # write ISA header
746             print $fh $self->_write_spec(
747             type => 'ISA',
748             type_def => $self->{spec}->{ISA},
749             record => $record->{ISA},
750 2         9 );
751              
752 2         6 my $group_count = 0;
753             # iterate through document structure
754 2 50       4 for my $group (@{ $record->{GROUPS} || [ ] })
  2         10  
755             {
756 2         4 $group_count++;
757              
758 2 50       6 $group->{control_number} = $group_count unless exists $group->{control_number};
759              
760             # process GS line
761             print $fh $self->_write_spec(
762             type => 'GS',
763             type_def => $self->{spec}->{GS},
764 2         9 record => $group,
765             );
766              
767 2         5 my $set_count = 0;
768              
769 2 50       3 for my $set (@{ $group->{SETS} || [ ] })
  2         7  
770             {
771 2         4 my $record_count = 1;
772              
773             # you don't want to know why this exists...
774 2 50       23 if ($self->{spec}->{RECORD_OFFSET_COUNT})
775             {
776 0         0 $record_count = $record_count + $self->{spec}->{RECORD_OFFSET_COUNT};
777             }
778              
779 2         8 $set_count++;
780              
781             $set->{control_number} = $set_count
782 2 50       8 unless exists $set->{control_number};
783              
784             # process ST line
785             print $fh $self->_write_spec(
786             type => 'ST',
787             type_def => $self->{spec}->{ST},
788 2         8 record => $set,
789             );
790              
791             ######
792             # process actual set
793 2         5 my $doc_id = $set->{identifier_code};
794 2         7 my $spec = $self->{spec}->{$doc_id};
795              
796 2 50       5 die "cannot find spec for $doc_id"
797             unless $spec;
798              
799             # process set header
800 2 50       7 for my $section (@{ $spec->{structure}{header} || [ ] })
  2         7  
801             {
802 8 100 66     35 if (ref($section) and ref($section) eq 'HASH')
803             {
804 1         3 my ($loop_name) = keys(%$section);
805 1         3 my $loop_structure = $section->{$loop_name};
806              
807 1 50       2 for my $record (@{ $set->{HEADER}{$loop_name} || [] })
  1         3  
808             {
809 2 50       13 for my $structure (@{ $loop_structure || []})
  2         8  
810             {
811 4 50 33     14 next if $hide_empty_sections and not exists $record->{$structure};
812              
813 4         6 $record_count++;
814              
815             print $fh $self->_write_spec(
816             type => $structure,
817             type_def => $spec->{segments}{$structure},
818 4         14 record => $record->{$structure},
819             );
820             }
821             }
822             }
823             else
824             {
825 7 50 33     26 next if $hide_empty_sections and not exists $set->{HEADER}{$section};
826              
827 7         10 $record_count++;
828             print $fh $self->_write_spec(
829             type => $section,
830             type_def => $spec->{segments}{$section},
831 7         26 record => $set->{HEADER}{$section},
832             );
833             }
834             }
835              
836             # process set details
837 2 50       4 for my $detail (@{ $set->{DETAIL} || [ ] })
  2         10  
838             {
839 4 50       6 for my $section (@{ $spec->{structure}{detail} || [ ] })
  4         25  
840             {
841 10 100 66     37 if (ref($section) and ref($section) eq 'HASH')
842             {
843 2         6 my ($loop_name) = keys(%$section);
844 2         5 my $loop_structure = $section->{$loop_name};
845              
846 2 100       3 for my $sub_record (@{ $detail->{$loop_name} || [] })
  2         9  
847             {
848 2 50       3 for my $structure (@{ $loop_structure || []})
  2         6  
849             {
850 4 50 33     8 next if $hide_empty_sections and not exists $sub_record->{$structure};
851              
852 4         7 $record_count++;
853             print $fh $self->_write_spec(
854             type => $structure,
855             type_def => $spec->{segments}{$structure},
856 4         12 record => $sub_record->{$structure},
857             );
858             }
859             }
860             }
861             else
862             {
863 8 50 33     21 next if $hide_empty_sections and not exists $detail->{$section};
864              
865 8         12 $record_count++;
866             print $fh $self->_write_spec(
867             type => $section,
868             type_def => $spec->{segments}{$section},
869 8         28 record => $detail->{$section},
870             );
871             }
872             }
873             }
874            
875              
876             # process set footer
877 2 50       5 for my $section (@{ $spec->{structure}{footer} || [ ] })
  2         10  
878             {
879 3 50 33     11 if (ref($section) and ref($section) eq 'HASH')
880             {
881 0         0 my ($loop_name) = keys(%$section);
882 0         0 my $loop_structure = $section->{$loop_name};
883              
884 0 0       0 for my $record (@{ $set->{FOOTER}{$loop_name} || [] })
  0         0  
885             {
886 0 0       0 for my $structure (@{ $loop_structure || []})
  0         0  
887             {
888 0 0 0     0 next if $hide_empty_sections and not exists $record->{$structure};
889              
890 0         0 $record_count++;
891             print $fh $self->_write_spec(
892             type => $structure,
893             type_def => $spec->{segments}{$structure},
894 0         0 record => $record->{$structure},
895             );
896             }
897             }
898             }
899             else
900             {
901 3 50 33     23 next if $hide_empty_sections and not exists $set->{FOOTER}{$section};
902              
903 3         4 $record_count++;
904             print $fh $self->_write_spec(
905             type => $section,
906             type_def => $spec->{segments}{$section},
907 3         14 record => $set->{FOOTER}{$section},
908             );
909             }
910             }
911              
912             ######
913              
914             # process SE line
915 2         4 $record_count++;
916             print $fh $self->_write_spec(
917             type => 'SE',
918             type_def => $self->{spec}->{SE},
919             record => {
920             total => $record_count,
921             control_number => $set->{control_number},
922             },
923 2         9 );
924             }
925              
926             # process GE line
927             print $fh $self->_write_spec(
928             type => 'GE',
929             type_def => $self->{spec}->{GE},
930             record => {
931             control_number => $group->{control_number},
932 2         13 total => $set_count,
933             },
934             );
935             }
936              
937             # write IEA header
938             print $fh $self->_write_spec(
939             type => 'IEA',
940             type_def => $self->{spec}->{IEA},
941             record => {
942             control_number => $record->{ISA}{control_number},
943 2         12 total => $group_count,
944             },
945             );
946             }
947              
948             =head1 EXAMPLES
949              
950             =head2 SPEC FILE EXAMPLE
951              
952             850:
953             structure:
954             header:
955             - BEG
956             - DTM
957             - N9
958             - N1
959             detail:
960             - PO1
961             - PID
962             footer:
963             - CTT
964             segments:
965             BEG:
966             definition:
967             - name: purpose_codse
968             min: 2
969             max: 2
970             - name: type_code
971             min: 2
972             max: 2
973             - name: order_number
974             min: 1
975             max: 22
976             - type: filler
977             - name: date
978             min: 8
979             max: 8
980             DTM:
981             definition:
982             - name: qualifier
983             min: 3
984             max: 3
985             - name: date
986             min: 8
987             max: 8
988             N9:
989             definition:
990             - name: qualifier
991             min: 2
992             max: 3
993             - name: identification
994             min: 1
995             max: 50
996             N1:
997             definition:
998             - name: identifier
999             min: 2
1000             max: 3
1001             - name: name
1002             min: 1
1003             max: 60
1004             - name: identification_code_qualifier
1005             min: 1
1006             max: 2
1007             - name: identification_code
1008             min: 2
1009             max: 80
1010             PO1:
1011             definition:
1012             - type: filler
1013             - name: quantity
1014             min: 1
1015             max: 15
1016             - name: unit_of_measure
1017             min: 2
1018             max: 2
1019             - name: unit_price
1020             min: 1
1021             max: 17
1022             - type: filler
1023             - name: id_qualifier
1024             min: 2
1025             max: 2
1026             - name: product_id
1027             min: 1
1028             max: 48
1029             - name: id_qualifier_2
1030             min: 2
1031             max: 2
1032             - name: product_id_2
1033             min: 1
1034             max: 48
1035             - name: id_qualifier_3
1036             min: 2
1037             max: 2
1038             - name: product_id_3
1039             min: 1
1040             max: 48
1041             PID:
1042             definition:
1043             - name: type
1044             - type: filler
1045             - type: filler
1046             - type: filler
1047             - name: description
1048             min: 1
1049             max: 80
1050             CTT:
1051             definition:
1052             - name: total_items
1053             min: 1
1054             max: 6
1055             - name: hash_total
1056             min: 1
1057             max: 10
1058              
1059             =head2 PERL EXAMPLE
1060              
1061             use Data::EDI::X12;
1062            
1063             my $string = q[ISA*00* *00* *01*012345675 *01*987654321 *140220*1100*^*00501*000000001*0*P*>~
1064             GS*PO*012345675*987654321*20140220*1100*000000001*X*005010~
1065             ST*850*0001~
1066             BEG*00*KN*1136064**20140220~
1067             DTM*002*20140220~
1068             N9*ZA*0000010555~
1069             N1*ST*U997*92*U997~
1070             PO1**1*EA*1.11**UC*000000000007*PI*000000000000000004*VN*113~
1071             PID*F****Test Product 1~
1072             PO1**1*EA*2.22**UC*000000000008*PI*000000000000000005*VN*114~
1073             PID*F****Test Product 2~
1074             CTT*4*4~
1075             SE*12*0001~
1076             GE*1*000000001~
1077             IEA*1*000000001~
1078             ];
1079            
1080             my $x12 = Data::EDI::X12->new({ spec_file => 't/spec.yaml', new_lines => 1, truncate_null => 1 });
1081            
1082             my $record = $x12->read_record($string);
1083             my $out = $x12->write_record($record);
1084              
1085             =head2 LOOPS
1086              
1087             Both implicit and explicit loop segments are also supported by this module. Please review the loops test for an example.
1088              
1089             =head1 HISTORY
1090              
1091             This module was authored for L.
1092              
1093             =head1 AUTHOR
1094              
1095             Bizowie
1096              
1097             =head1 COPYRIGHT AND LICENSE
1098              
1099             Copyright (C) 2014, 2015, 2016 Bizowie
1100              
1101             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.14.2 or, at your option, any later version of Perl 5 you may have available.
1102              
1103             =cut
1104              
1105             1;