| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::HL7::Compare::Parser::MessageConfig; | 
| 2 |  |  |  |  |  |  | $App::HL7::Compare::Parser::MessageConfig::VERSION = '0.002'; | 
| 3 | 4 |  |  | 4 |  | 55 | use v5.10; | 
|  | 4 |  |  |  |  | 14 |  | 
| 4 | 4 |  |  | 4 |  | 20 | use strict; | 
|  | 4 |  |  |  |  | 9 |  | 
|  | 4 |  |  |  |  | 98 |  | 
| 5 | 4 |  |  | 4 |  | 20 | use warnings; | 
|  | 4 |  |  |  |  | 8 |  | 
|  | 4 |  |  |  |  | 104 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 4 |  |  | 4 |  | 21 | use Moo; | 
|  | 4 |  |  |  |  | 9 |  | 
|  | 4 |  |  |  |  | 20 |  | 
| 8 | 4 |  |  | 4 |  | 1385 | use Mooish::AttributeBuilder -standard; | 
|  | 4 |  |  |  |  | 17 |  | 
|  | 4 |  |  |  |  | 35 |  | 
| 9 | 4 |  |  | 4 |  | 2579 | use Types::Common::String qw(StrLength); | 
|  | 4 |  |  |  |  | 233128 |  | 
|  | 4 |  |  |  |  | 35 |  | 
| 10 | 4 |  |  | 4 |  | 4362 | use Carp qw(croak); | 
|  | 4 |  |  |  |  | 13 |  | 
|  | 4 |  |  |  |  | 1466 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | has param 'segment_separator' => ( | 
| 13 |  |  |  |  |  |  | isa => StrLength [1, 2], | 
| 14 |  |  |  |  |  |  | writer => 1, | 
| 15 |  |  |  |  |  |  | default => sub { "\n" }, | 
| 16 |  |  |  |  |  |  | ); | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | has option 'field_separator' => ( | 
| 19 |  |  |  |  |  |  | isa => StrLength [1, 1], | 
| 20 |  |  |  |  |  |  | writer => 1, | 
| 21 |  |  |  |  |  |  | ); | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | has option 'component_separator' => ( | 
| 24 |  |  |  |  |  |  | isa => StrLength [1, 1], | 
| 25 |  |  |  |  |  |  | writer => 1, | 
| 26 |  |  |  |  |  |  | ); | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | has option 'repetition_separator' => ( | 
| 29 |  |  |  |  |  |  | isa => StrLength [1, 1], | 
| 30 |  |  |  |  |  |  | writer => 1, | 
| 31 |  |  |  |  |  |  | ); | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | has option 'escape_character' => ( | 
| 34 |  |  |  |  |  |  | isa => StrLength [1, 1], | 
| 35 |  |  |  |  |  |  | writer => 1, | 
| 36 |  |  |  |  |  |  | ); | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | has option 'subcomponent_separator' => ( | 
| 39 |  |  |  |  |  |  | isa => StrLength [1, 1], | 
| 40 |  |  |  |  |  |  | writer => 1, | 
| 41 |  |  |  |  |  |  | ); | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | sub from_MSH | 
| 44 |  |  |  |  |  |  | { | 
| 45 | 10 |  |  | 10 | 0 | 28 | my ($self, $input) = @_; | 
| 46 | 10 |  |  |  |  | 109 | $input =~ s/\AMSH//; | 
| 47 |  |  |  |  |  |  |  | 
| 48 | 10 |  |  |  |  | 40 | my @order = qw( | 
| 49 |  |  |  |  |  |  | field_separator | 
| 50 |  |  |  |  |  |  | component_separator | 
| 51 |  |  |  |  |  |  | repetition_separator | 
| 52 |  |  |  |  |  |  | escape_character | 
| 53 |  |  |  |  |  |  | subcomponent_separator | 
| 54 |  |  |  |  |  |  | ); | 
| 55 |  |  |  |  |  |  |  | 
| 56 | 10 | 50 |  |  |  | 42 | croak 'Not enough input to read message control characters' | 
| 57 |  |  |  |  |  |  | unless length $input >= @order; | 
| 58 |  |  |  |  |  |  |  | 
| 59 | 10 |  |  |  |  | 52 | my @characters = split //, substr $input, 0, scalar @order; | 
| 60 | 10 |  |  |  |  | 29 | foreach my $field (@order) { | 
| 61 | 50 |  |  |  |  | 1240 | my $setter = "set_$field"; | 
| 62 | 50 |  |  |  |  | 89 | my $predicate = "has_$field"; | 
| 63 |  |  |  |  |  |  |  | 
| 64 | 50 |  |  |  |  | 87 | my $character = shift @characters; | 
| 65 | 50 | 50 |  |  |  | 183 | next if $self->$predicate; | 
| 66 | 50 |  |  |  |  | 942 | $self->$setter($character); | 
| 67 |  |  |  |  |  |  | } | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | 1; | 
| 71 |  |  |  |  |  |  |  |