# hl7_conv use strict; use warnings; my $input = q(AB\T\F\S\CD\E\E\E\R\R\R); my $gen_out = ''; my $exp_out = q(AB&F^CD\\E\\R~R); my %convs = ( E => '\\', F => '|', R => '~', S => '^', T => '&', ); $gen_out = hl7_replace($input); print "INPUT: $input\n"; print "GEN_OUT: $gen_out\n"; print "EXP_OUT: $exp_out\n"; print $0, ': ', $gen_out eq $exp_out ? 'SUCCESS!' : ' Z z . c8o, ', "\n"; exit 0; sub hl7_replace { my $in = shift; my @input = split //, $in; my @output = (); for (my $i = 0; $i <= $#input; ++$i) { if ($input[$i] eq "\\" && ($i + 2) <= $#input && $convs{$input[$i + 1]} && $input[$i + 2] eq "\\") { push @output, $convs{$input[$i + 1]}; $i += 2; } else { push @output, $input[$i]; } } return join '', @output; } #### [ ~/tmp ] $ perl hl7_conv INPUT: AB\T\F\S\CD\E\E\E\R\R\R GEN_OUT: AB&F^CD\E\E~R\R EXP_OUT: AB&F^CD\E\R~R hl7_conv: Z z . c8o, [ ~/tmp ] $ perl hl7_conv INPUT: AB\T\F\S\CD\E\E\E\R\R\R GEN_OUT: AB&F^CD\E\R~R EXP_OUT: AB&F^CD\E\R~R hl7_conv: SUCCESS! #### # hl7_conv use strict; use warnings; my $input = q(AB\T\F\S\CD\E\E\E\R\R\R); my $gen_out = ''; my $exp_out = q(AB&F^CD\\E\\R~R); my $rx_hl7_ctrl_chars = qr/\\([EFRST])\\/; my %convs = ( E => '\\', F => '|', R => '~', S => '^', T => '&', ); $gen_out = hl7_replace($input); print "INPUT: $input\n"; print "GEN_OUT: $gen_out\n"; print "EXP_OUT: $exp_out\n"; print $0, ': ', $gen_out eq $exp_out ? 'SUCCESS!' : ' Z z . c8o, ', "\n"; exit 0; sub hl7_replace { my $in = shift; $in =~ s/$rx_hl7_ctrl_chars/$convs{$1}/g; return $in; } #### # hl7_conv use strict; use warnings; my $input = q(AB\T\F\S\CD); my $gen_out = ''; my $exp_out = q(AB&F^CD); my %convs = ( '|' => qr/\\F\\/, '^' => qr/\\S\\/, '&' => qr/\\T\\/, '~' => qr/\\R\\/, '\\' => qr/\\E\\/, ); $gen_out = hl7_replace($input); print "INPUT: $input\n"; print "GEN_OUT: $gen_out\n"; print "EXP_OUT: $exp_out\n"; print $0, ': ', $gen_out eq $exp_out ? 'SUCCESS!' : ' Z z . c8o, ', "\n"; exit 0; sub hl7_replace { my $in = shift; foreach my $key (keys %convs) { $in =~ s/$convs{$key}/$key/g; } return $in; } #### [ ~/tmp ] $ perl hl7_conv INPUT: AB\T\F\S\CD GEN_OUT: AB&F^CD EXP_OUT: AB&F^CD hl7_conv: SUCCESS! [ ~/tmp ] $