On Fri, Nov 06, 2009 at 09:53:20PM -0500, Andrew Dunstan wrote:
>
>
> Joshua Tolley wrote:
>> I looked through the
>> regression tests and didn't find any that used plperl -- should we add one
>> for
>> this (or for this and all kinds of other stuff)? Is there some way to make
>> running the regression test conditional on having built --with-perl in the
>> first place?
>>
>>
>
> Look in src/pl/plperl/{sql,expected}Ok, updated patch attached. As far as I know, this completes all outstanding issues: 1) weird comment in plperl.c is corrected and formatted decently 2) plperlu vs. plperl actually works (thanks again, Andrew) 3) docs included 4) regression tests included Some items of note include that this makes the regression tests add not only plperl to the test database but also plperlu, which is a new thing. I can't see why this might cause problems, but thought I'd mention it. The tests specifically try to verify that plperl doesn't allow 'use Data::Dumper', and plperlu does. Since Data::Dumper is part of perl core, that seemed safe, but it is another dependency, and perhaps we don't want to do that. If not, is there some other useful way of testing plperlu vs. plperl, and does it really matter? -- Joshua Tolley / eggyknap End Point Corporation http://www.endpoint.com
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 49631f2..d4b2816 100644
*** a/doc/src/sgml/plperl.sgml
--- b/doc/src/sgml/plperl.sgml
*************** CREATE FUNCTION <replaceable>funcname</r
*** 59,64 ****
--- 59,75 ----
# PL/Perl function body
$$ LANGUAGE plperl;
</programlisting>
+
+ PL/Perl also supports inline functions called with the
+ <xref linkend="sql-do" endterm="sql-do-title">
+ statement:
+
+ <programlisting>
+ DO $$
+ # PL/Perl function body
+ $$ LANGUAGE plperl;
+ </programlisting>
+
The body of the function is ordinary Perl code. In fact, the PL/Perl
glue code wraps it inside a Perl subroutine. A PL/Perl function must
always return a scalar value. You can return more complex structures
diff --git a/src/include/catalog/pg_pltemplate.h b/src/include/catalog/pg_pltemplate.h
index 5ef97df..8cdedb4 100644
*** a/src/include/catalog/pg_pltemplate.h
--- b/src/include/catalog/pg_pltemplate.h
*************** typedef FormData_pg_pltemplate *Form_pg_
*** 70,77 ****
DATA(insert ( "plpgsql" t t "plpgsql_call_handler" "plpgsql_inline_handler" "plpgsql_validator" "$libdir/plpgsql" _null_ ));
DATA(insert ( "pltcl" t t "pltcl_call_handler" _null_ _null_ "$libdir/pltcl" _null_ ));
DATA(insert ( "pltclu" f f "pltclu_call_handler" _null_ _null_ "$libdir/pltcl" _null_ ));
! DATA(insert ( "plperl" t t "plperl_call_handler" _null_ "plperl_validator" "$libdir/plperl" _null_ ));
! DATA(insert ( "plperlu" f f "plperl_call_handler" _null_ "plperl_validator" "$libdir/plperl" _null_ ));
DATA(insert ( "plpythonu" f f "plpython_call_handler" _null_ _null_ "$libdir/plpython" _null_ ));
#endif /* PG_PLTEMPLATE_H */
--- 70,77 ----
DATA(insert ( "plpgsql" t t "plpgsql_call_handler" "plpgsql_inline_handler" "plpgsql_validator" "$libdir/plpgsql" _null_ ));
DATA(insert ( "pltcl" t t "pltcl_call_handler" _null_ _null_ "$libdir/pltcl" _null_ ));
DATA(insert ( "pltclu" f f "pltclu_call_handler" _null_ _null_ "$libdir/pltcl" _null_ ));
! DATA(insert ( "plperl" t t "plperl_call_handler" "plperl_inline_handler" "plperl_validator" "$libdir/plperl" _null_ ));
! DATA(insert ( "plperlu" f f "plperl_call_handler" "plperl_inline_handler" "plperl_validator" "$libdir/plperl" _null_ ));
DATA(insert ( "plpythonu" f f "plpython_call_handler" _null_ _null_ "$libdir/plpython" _null_ ));
#endif /* PG_PLTEMPLATE_H */
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index a3c3495..2c32850 100644
*** a/src/pl/plperl/GNUmakefile
--- b/src/pl/plperl/GNUmakefile
*************** OBJS = plperl.o spi_internal.o SPI.o
*** 38,45 ****
SHLIB_LINK = $(perl_embed_ldflags)
! REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl
! REGRESS = plperl plperl_trigger plperl_shared plperl_elog
# where to find psql for running the tests
PSQLDIR = $(bindir)
--- 38,45 ----
SHLIB_LINK = $(perl_embed_ldflags)
! REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
! REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_do
# where to find psql for running the tests
PSQLDIR = $(bindir)
diff --git a/src/pl/plperl/expected/plperl_do.out b/src/pl/plperl/expected/plperl_do.out
index ...3706018 .
*** a/src/pl/plperl/expected/plperl_do.out
--- b/src/pl/plperl/expected/plperl_do.out
***************
*** 0 ****
--- 1,10 ----
+ DO $$
+ $a = 'This is a test';
+ elog(NOTICE, $a);
+ $$ LANGUAGE plperl;
+ NOTICE: This is a test
+ DO $$ elog(NOTICE, "This is plperlu"); $$ LANGUAGE plperlu;
+ NOTICE: This is plperlu
+ DO $$ use Data::Dumper; $$ LANGUAGE plperl;
+ ERROR: 'require' trapped by operation mask at line 1.
+ DO $$ use Data::Dumper; $$ LANGUAGE plperlu;
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 4ed4f59..3ff8441 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** static plperl_call_data *current_call_da
*** 144,149 ****
--- 144,150 ----
* Forward declarations
**********************************************************************/
Datum plperl_call_handler(PG_FUNCTION_ARGS);
+ Datum plperl_inline_handler(PG_FUNCTION_ARGS);
Datum plperl_validator(PG_FUNCTION_ARGS);
void _PG_init(void);
*************** plperl_modify_tuple(HV *hvTD, TriggerDat
*** 862,871 ****
/*
! * This is the only externally-visible part of the plperl call interface.
! * The Postgres function and trigger managers call it to execute a
! * perl function.
*/
PG_FUNCTION_INFO_V1(plperl_call_handler);
Datum
--- 863,877 ----
/*
! * There are three externally visible pieces to plperl: plperl_call_handler,
! * plperl_inline_handler, and plperl_validator. The first gets called to run
! * typical functions stored in pg_proc and created with CREATE FUNCTION as
! * schema objects. The second handles one-time, "inline" functions called with
! * the DO statement. Finally, the third validates a newly-created function at
! * the time of the CREATE FUNCTION call. The precise behavior of the validator
! * function may be modified by the check_function_bodies GUC.
*/
+
PG_FUNCTION_INFO_V1(plperl_call_handler);
Datum
*************** plperl_call_handler(PG_FUNCTION_ARGS)
*** 895,900 ****
--- 901,962 ----
return retval;
}
+ PG_FUNCTION_INFO_V1(plperl_inline_handler);
+
+ Datum
+ plperl_inline_handler(PG_FUNCTION_ARGS)
+ {
+ InlineCodeBlock *codeblock = (InlineCodeBlock *) DatumGetPointer(PG_GETARG_DATUM(0));
+ FunctionCallInfoData fake_fcinfo;
+ FmgrInfo flinfo;
+ plperl_proc_desc desc;
+ plperl_call_data *save_call_data = current_call_data;
+ bool oldcontext = trusted_context;
+
+ MemSet(&fake_fcinfo, 0, sizeof(fake_fcinfo));
+ MemSet(&flinfo, 0, sizeof(flinfo));
+ MemSet(&desc, 0, sizeof(desc));
+ fake_fcinfo.flinfo = &flinfo;
+ flinfo.fn_oid = InvalidOid;
+ flinfo.fn_mcxt = CurrentMemoryContext;
+
+ desc.proname = "Do Inline Block";
+ desc.fn_readonly = false;
+
+ desc.lanpltrusted = codeblock->langIsTrusted;
+
+ check_interp(desc.lanpltrusted);
+
+
+ desc.fn_retistuple = false;
+ desc.fn_retisset = false;
+ desc.fn_retisarray = false;
+ desc.result_oid = VOIDOID;
+ desc.nargs = 0;
+
+ PG_TRY();
+ {
+
+ desc.reference = plperl_create_sub("DO Inline Block",
+ codeblock->source_text,
+ desc.lanpltrusted);
+
+ plperl_call_perl_func(&desc, &fake_fcinfo);
+ }
+ PG_CATCH();
+ {
+ current_call_data = save_call_data;
+ restore_context(oldcontext);
+ PG_RE_THROW();
+ }
+ PG_END_TRY();
+
+ current_call_data = save_call_data;
+ restore_context(oldcontext);
+
+ PG_RETURN_VOID();
+ }
+
/*
* This is the other externally visible function - it is called when CREATE
* FUNCTION is issued to validate the function being created/replaced.
diff --git a/src/pl/plperl/sql/plperl_do.sql b/src/pl/plperl/sql/plperl_do.sql
index ...4d02f97 .
*** a/src/pl/plperl/sql/plperl_do.sql
--- b/src/pl/plperl/sql/plperl_do.sql
***************
*** 0 ****
--- 1,10 ----
+ DO $$
+ $a = 'This is a test';
+ elog(NOTICE, $a);
+ $$ LANGUAGE plperl;
+
+ DO $$ elog(NOTICE, "This is plperlu"); $$ LANGUAGE plperlu;
+
+ DO $$ use Data::Dumper; $$ LANGUAGE plperl;
+
+ DO $$ use Data::Dumper; $$ LANGUAGE plperlu;
signature.asc
Description: Digital signature
