plperl handler for nonfatal warnings - Mailing list pgsql-patches

Currently, nonfatal warnings are not trapped (as they should be) by
plperl - the attached small patch remedies that omission, and adds a
small regression test for error and warning output - the new regression
input and expected output are in separate attached files.


cheers

andrew
Index: GNUmakefile
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/GNUmakefile,v
retrieving revision 1.22
diff -c -r1.22 GNUmakefile
*** GNUmakefile    24 May 2005 17:07:41 -0000    1.22
--- GNUmakefile    13 Jun 2005 20:24:50 -0000
***************
*** 37,43 ****
  SHLIB_LINK = $(perl_embed_ldflags) $(BE_DLLLIBS)

  REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl
! REGRESS = plperl plperl_trigger plperl_shared

  include $(top_srcdir)/src/Makefile.shlib

--- 37,43 ----
  SHLIB_LINK = $(perl_embed_ldflags) $(BE_DLLLIBS)

  REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl
! REGRESS = plperl plperl_trigger plperl_shared plperl_elog

  include $(top_srcdir)/src/Makefile.shlib

Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.76
diff -c -r1.76 plperl.c
*** plperl.c    5 Jun 2005 03:16:35 -0000    1.76
--- plperl.c    13 Jun 2005 20:24:51 -0000
***************
*** 188,193 ****
--- 188,195 ----
          "", "-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] } ]); }"
      };

***************
*** 195,200 ****
--- 197,204 ----
          "", "-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] } ]); }"
      };
-- test warnings and errors from plperl
create or replace function perl_elog(text) returns void language plperl as $$

  my $msg = shift;
  elog(NOTICE,$msg);

$$;
select perl_elog('explicit elog');
NOTICE:  explicit elog
 perl_elog
-----------

(1 row)

create or replace function perl_warn(text) returns void language plperl as $$

  my $msg = shift;
  warn($msg);

$$;
select perl_warn('implicit elog via warn');
NOTICE:  implicit elog via warn at (eval 7) line 4.

 perl_warn
-----------

(1 row)

-- test warnings and errors from plperl

create or replace function perl_elog(text) returns void language plperl as $$

  my $msg = shift;
  elog(NOTICE,$msg);

$$;

select perl_elog('explicit elog');

create or replace function perl_warn(text) returns void language plperl as $$

  my $msg = shift;
  warn($msg);

$$;

select perl_warn('implicit elog via warn');