The attached patch moves the common elements of loose_embedding[]
and strict_embedding[] to a macro so they can be maintained in
one place.  As Tom Lane noticed, ::_plperl_to_pg_array was missing
from strict_embedding[], which appears to be a bug.

http://archives.postgresql.org/pgsql-bugs/2005-08/msg00189.php

I'm not sure this patch meets Tom's request to avoid "too much
violence to the readability," mostly because of the added backslashes
at the end of the macro's lines.  Opinions?

-- 
Michael Fuhr
Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.89
diff -c -r1.89 plperl.c
*** plperl.c    12 Aug 2005 21:26:32 -0000      1.89
--- plperl.c    20 Aug 2005 19:23:19 -0000
***************
*** 189,230 ****
  static void
  plperl_init_interp(void)
  {
        static char        *loose_embedding[3] = {
                "", "-e",
                /* all one string follows (no commas please) */
!               "SPI::bootstrap(); use vars qw(%_SHARED);"
!               "sub ::plperl_warn { my $msg = shift; &elog(&NOTICE, $msg); } "
!               "$SIG{__WARN__} = \\&::plperl_warn; "
                "sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
-               "sub ::_plperl_to_pg_array"
-               "{"
-               "  my $arg = shift; ref $arg eq 'ARRAY' || return $arg; "
-               "  my $res = ''; my $first = 1; "
-               "  foreach my $elem (@$arg) "
-               "  { "
-               "    $res .= ', ' unless $first; $first = undef; "
-               "    if (ref $elem) "
-               "    { "
-               "      $res .= _plperl_to_pg_array($elem); "
-               "    } "
-               "    else "
-               "    { "
-               "      my $str = qq($elem); "
-               "      $str =~ s/([\"\\\\])/\\\\$1/g; "
-               "      $res .= qq(\"$str\"); "
-               "    } "
-               "  } "
-               "  return qq({$res}); "
-               "} "
        };
  
- 
        static char        *strict_embedding[3] = {
                "", "-e",
                /* all one string follows (no commas please) */
!               "SPI::bootstrap(); use vars qw(%_SHARED);"
!               "sub ::plperl_warn { my $msg = shift; &elog(&NOTICE, $msg); } "
!               "$SIG{__WARN__} = \\&::plperl_warn; "
                "sub ::mkunsafefunc {return eval("
                "qq[ sub { use strict; $_[0] $_[1] } ]); }"
        };
--- 189,230 ----
  static void
  plperl_init_interp(void)
  {
+ #define COMMON_EMBEDDING \
+               "SPI::bootstrap(); use vars qw(%_SHARED);" \
+               "sub ::plperl_warn { my $msg = shift; &elog(&NOTICE, $msg); } " 
\
+               "$SIG{__WARN__} = \\&::plperl_warn; " \
+               "sub ::_plperl_to_pg_array" \
+               "{" \
+               "  my $arg = shift; ref $arg eq 'ARRAY' || return $arg; " \
+               "  my $res = ''; my $first = 1; " \
+               "  foreach my $elem (@$arg) " \
+               "  { " \
+               "    $res .= ', ' unless $first; $first = undef; " \
+               "    if (ref $elem) " \
+               "    { " \
+               "      $res .= _plperl_to_pg_array($elem); " \
+               "    } " \
+               "    else " \
+               "    { " \
+               "      my $str = qq($elem); " \
+               "      $str =~ s/([\"\\\\])/\\\\$1/g; " \
+               "      $res .= qq(\"$str\"); " \
+               "    } " \
+               "  } " \
+               "  return qq({$res}); " \
+               "} "
+ 
        static char        *loose_embedding[3] = {
                "", "-e",
                /* all one string follows (no commas please) */
!               COMMON_EMBEDDING
                "sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
        };
  
        static char        *strict_embedding[3] = {
                "", "-e",
                /* all one string follows (no commas please) */
!               COMMON_EMBEDDING
                "sub ::mkunsafefunc {return eval("
                "qq[ sub { use strict; $_[0] $_[1] } ]); }"
        };
---------------------------(end of broadcast)---------------------------
TIP 6: explain analyze is your friend

Reply via email to