Multi Replace Perl

Library Snippets

Replace multiple strings in a single pass

Works with PostgreSQL

Any version

Written in

PL/Perl

Depends on

Nothing

/*
  Substitute strings by other strings within a larger string, with
  Perl s// operator, in a single pass.
  Each element in @orig is replaced by the element at the same index
  in @repl
  If multiple strings in the array match simultaneously, the longest
  match wins.
*/
CREATE FUNCTION multi_replace(string text, orig text[], repl text[])
RETURNS text
AS $BODY$

  my ($string, $orig, $repl) = @_;
  my %subs;
  my $i=0;
  if (@$orig != @$repl) {
     elog(ERROR, "array sizes mismatch");
  }
  if (ref @$orig[0] eq 'ARRAY' || ref @$repl[0] eq 'ARRAY') {
     elog(ERROR, "array dimensions mismatch");
  }

  # Each element of $orig is a key in %subs to the element at the same
  # index in $repl
  @subs{@$orig} = @$repl;

  # Build a regexp of the form (s1|s2|...)
  # with the substrings sorted to prioritize the longest match
  my $re = join "|", map quotemeta,
     sort { length($b) <=> length($a) } keys %subs;
  $re = qr/($re)/;

  # The order will be used in the matching because (from perlre):
  # "Alternatives are tried from left to right, so the first alternative
  # found for which the entire expression matches, is the one that is
  # chosen"

  $string =~ s/$re/$subs{$1}/g;
  return $string;

$BODY$ language plperl strict immutable;