$App::HL7::Compare::Parser::MessageConfig::VERSION
=
'0.004'
;
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;