File Coverage

blib/lib/App/HL7/Compare/Parser/MessageConfig.pm

Criterion	Covered	Total	%
statement	35	37	94.5
branch	3	6	50.0
condition			n/a
subroutine	9	9	100.0
pod	0	1	0.0
total	47	53	88.6

package App::HL7::Compare::Parser::MessageConfig;
$App::HL7::Compare::Parser::MessageConfig::VERSION = '0.004';
use v5.10;
use strict;
use warnings;

use Moo;
use Mooish::AttributeBuilder -standard;
use Types::Common::String qw(StrLength);
use Carp qw(carp croak);

use constant DEFAULT_SEPARATORS => '|^~\&';

has param 'segment_separator' => (
	isa => StrLength [1, 2],
	writer => 1,
	default => sub { "\n" },
);

has option 'field_separator' => (
	isa => StrLength [1, 1],
	writer => 1,
);

has option 'component_separator' => (
	isa => StrLength [1, 1],
	writer => 1,
);

has option 'repetition_separator' => (
	isa => StrLength [1, 1],
	writer => 1,
);

has option 'escape_character' => (
	isa => StrLength [1, 1],
	writer => 1,
);

has option 'subcomponent_separator' => (
	isa => StrLength [1, 1],
	writer => 1,
);

sub from_MSH
{
	my ($self, $input) = @_;
	my $has_msh = $input =~ s/\AMSH//;

	if (!$has_msh) {
		$input = DEFAULT_SEPARATORS;
		carp "no MSH segment found - using default separators ($input)";
	}

	my @order = qw(
		field_separator
		component_separator
		repetition_separator
		escape_character
		subcomponent_separator
	);

	croak 'Not enough input to read message control characters'
		unless length $input >= @order;

	my @characters = split //, substr $input, 0, scalar @order;
	foreach my $field (@order) {
		my $setter = "set_$field";
		my $predicate = "has_$field";

		my $character = shift @characters;
		next if $self->$predicate;
		$self->$setter($character);
	}
}

1;