File Coverage

blib/lib/App/HL7/Compare/Parser/MessageConfig.pm
Criterion Covered Total %
statement 31 31 100.0
branch 2 4 50.0
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 41 44 93.1


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