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 funcname + + PL/Perl also supports inline functions called with the + + statement: + + + DO $$ + # PL/Perl function body + $$ LANGUAGE plperl; + + 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;