plperl-inline.patch

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/plperl.c b/src/pl/plperl/plperl.c
index 4ed4f59..90b27fc 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,964 ----
  	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;
+     HeapTuple	langTup;
+     Form_pg_language langStruct;
+ 	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.