2000-01-20 06:08:58 +01:00
|
|
|
/**********************************************************************
|
|
|
|
* plperl.c - perl as a procedural language for PostgreSQL
|
|
|
|
*
|
2010-09-20 22:08:53 +02:00
|
|
|
* src/pl/plperl/plperl.c
|
2000-05-28 19:56:29 +02:00
|
|
|
*
|
2000-01-20 06:08:58 +01:00
|
|
|
**********************************************************************/
|
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
#include "postgres.h"
|
2005-02-22 05:43:23 +01:00
|
|
|
/* Defined by Perl */
|
2005-02-23 05:34:21 +01:00
|
|
|
#undef _
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
/* system stuff */
|
2004-11-20 20:07:40 +01:00
|
|
|
#include <ctype.h>
|
2000-01-20 06:08:58 +01:00
|
|
|
#include <fcntl.h>
|
Widen query numbers-of-tuples-processed counters to uint64.
This patch widens SPI_processed, EState's es_processed field, PortalData's
portalPos field, FuncCallContext's call_cntr and max_calls fields,
ExecutorRun's count argument, PortalRunFetch's result, and the max number
of rows in a SPITupleTable to uint64, and deals with (I hope) all the
ensuing fallout. Some of these values were declared uint32 before, and
others "long".
I also removed PortalData's posOverflow field, since that logic seems
pretty useless given that portalPos is now always 64 bits.
The user-visible results are that command tags for SELECT etc will
correctly report tuple counts larger than 4G, as will plpgsql's GET
GET DIAGNOSTICS ... ROW_COUNT command. Queries processing more tuples
than that are still not exactly the norm, but they're becoming more
common.
Most values associated with FETCH/MOVE distances, such as PortalRun's count
argument and the count argument of most SPI functions that have one, remain
declared as "long". It's not clear whether it would be worth promoting
those to int64; but it would definitely be a large dollop of additional
API churn on top of this, and it would only help 32-bit platforms which
seem relatively less likely to see any benefit.
Andreas Scherbaum, reviewed by Christian Ullrich, additional hacking by me
2016-03-12 22:05:10 +01:00
|
|
|
#include <limits.h>
|
|
|
|
#include <unistd.h>
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
/* postgreSQL stuff */
|
2012-08-30 22:15:44 +02:00
|
|
|
#include "access/htup_details.h"
|
2009-01-07 14:44:37 +01:00
|
|
|
#include "access/xact.h"
|
|
|
|
#include "catalog/pg_language.h"
|
|
|
|
#include "catalog/pg_proc.h"
|
2015-04-26 16:33:14 +02:00
|
|
|
#include "catalog/pg_proc_fn.h"
|
2009-01-07 14:44:37 +01:00
|
|
|
#include "catalog/pg_type.h"
|
2013-12-11 14:11:59 +01:00
|
|
|
#include "commands/event_trigger.h"
|
2004-04-01 23:28:47 +02:00
|
|
|
#include "commands/trigger.h"
|
|
|
|
#include "executor/spi.h"
|
2004-11-23 01:21:24 +01:00
|
|
|
#include "funcapi.h"
|
2006-03-14 23:48:25 +01:00
|
|
|
#include "mb/pg_wchar.h"
|
|
|
|
#include "miscadmin.h"
|
|
|
|
#include "nodes/makefuncs.h"
|
|
|
|
#include "parser/parse_type.h"
|
2010-01-30 02:46:57 +01:00
|
|
|
#include "storage/ipc.h"
|
2012-09-05 22:43:37 +02:00
|
|
|
#include "tcop/tcopprot.h"
|
2009-01-07 14:44:37 +01:00
|
|
|
#include "utils/builtins.h"
|
2007-12-01 18:58:42 +01:00
|
|
|
#include "utils/fmgroids.h"
|
2006-10-19 20:32:48 +02:00
|
|
|
#include "utils/guc.h"
|
2009-01-07 14:44:37 +01:00
|
|
|
#include "utils/hsearch.h"
|
2004-09-13 22:10:13 +02:00
|
|
|
#include "utils/lsyscache.h"
|
2005-05-06 19:24:55 +02:00
|
|
|
#include "utils/memutils.h"
|
2011-02-23 18:18:09 +01:00
|
|
|
#include "utils/rel.h"
|
2009-01-07 14:44:37 +01:00
|
|
|
#include "utils/syscache.h"
|
2004-04-01 23:28:47 +02:00
|
|
|
#include "utils/typcache.h"
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2008-10-09 19:24:05 +02:00
|
|
|
/* define our text domain for translations */
|
|
|
|
#undef TEXTDOMAIN
|
2008-12-11 08:34:09 +01:00
|
|
|
#define TEXTDOMAIN PG_TEXTDOMAIN("plperl")
|
2008-10-09 19:24:05 +02:00
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
/* perl stuff */
|
2006-01-08 23:27:52 +01:00
|
|
|
#include "plperl.h"
|
2011-02-06 23:29:26 +01:00
|
|
|
#include "plperl_helpers.h"
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2010-01-09 03:40:50 +01:00
|
|
|
/* string literal macros defining chunks of perl code */
|
|
|
|
#include "perlchunks.h"
|
2010-05-13 18:39:43 +02:00
|
|
|
/* defines PLPERL_SET_OPMASK */
|
|
|
|
#include "plperl_opmask.h"
|
2010-01-09 03:40:50 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
|
|
|
|
EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *cv);
|
|
|
|
EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *cv);
|
|
|
|
|
2006-05-31 00:12:16 +02:00
|
|
|
PG_MODULE_MAGIC;
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/**********************************************************************
|
2014-05-06 18:12:18 +02:00
|
|
|
* Information associated with a Perl interpreter. We have one interpreter
|
|
|
|
* that is used for all plperlu (untrusted) functions. For plperl (trusted)
|
2010-09-30 23:18:51 +02:00
|
|
|
* functions, there is a separate interpreter for each effective SQL userid.
|
|
|
|
* (This is needed to ensure that an unprivileged user can't inject Perl code
|
|
|
|
* that'll be executed with the privileges of some other SQL user.)
|
|
|
|
*
|
|
|
|
* The plperl_interp_desc structs are kept in a Postgres hash table indexed
|
|
|
|
* by userid OID, with OID 0 used for the single untrusted interpreter.
|
2012-09-10 02:32:54 +02:00
|
|
|
* Once created, an interpreter is kept for the life of the process.
|
2010-09-30 23:18:51 +02:00
|
|
|
*
|
|
|
|
* We start out by creating a "held" interpreter, which we initialize
|
|
|
|
* only as far as we can do without deciding if it will be trusted or
|
|
|
|
* untrusted. Later, when we first need to run a plperl or plperlu
|
|
|
|
* function, we complete the initialization appropriately and move the
|
|
|
|
* PerlInterpreter pointer into the plperl_interp_hash hashtable. If after
|
|
|
|
* that we need more interpreters, we create them as needed if we can, or
|
|
|
|
* fail if the Perl build doesn't support multiple interpreters.
|
|
|
|
*
|
|
|
|
* The reason for all the dancing about with a held interpreter is to make
|
|
|
|
* it possible for people to preload a lot of Perl code at postmaster startup
|
|
|
|
* (using plperl.on_init) and then use that code in backends. Of course this
|
|
|
|
* will only work for the first interpreter created in any backend, but it's
|
|
|
|
* still useful with that restriction.
|
|
|
|
**********************************************************************/
|
|
|
|
typedef struct plperl_interp_desc
|
|
|
|
{
|
2011-02-17 20:40:13 +01:00
|
|
|
Oid user_id; /* Hash key (must be first!) */
|
|
|
|
PerlInterpreter *interp; /* The interpreter */
|
|
|
|
HTAB *query_hash; /* plperl_query_entry structs */
|
2010-09-30 23:18:51 +02:00
|
|
|
} plperl_interp_desc;
|
|
|
|
|
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
/**********************************************************************
|
|
|
|
* The information we cache about loaded procedures
|
2012-09-10 02:32:54 +02:00
|
|
|
*
|
2016-09-01 01:54:58 +02:00
|
|
|
* The fn_refcount field counts the struct's reference from the hash table
|
|
|
|
* shown below, plus one reference for each function call level that is using
|
|
|
|
* the struct. We can release the struct, and the associated Perl sub, when
|
|
|
|
* the fn_refcount goes to zero. Releasing the struct itself is done by
|
|
|
|
* deleting the fn_cxt, which also gets rid of all subsidiary data.
|
2000-01-20 06:08:58 +01:00
|
|
|
**********************************************************************/
|
|
|
|
typedef struct plperl_proc_desc
|
|
|
|
{
|
2007-10-05 19:06:11 +02:00
|
|
|
char *proname; /* user name of procedure */
|
2016-09-01 01:54:58 +02:00
|
|
|
MemoryContext fn_cxt; /* memory context for this procedure */
|
|
|
|
unsigned long fn_refcount; /* number of active references */
|
2012-09-10 02:32:54 +02:00
|
|
|
TransactionId fn_xmin; /* xmin/TID of procedure's pg_proc tuple */
|
2007-02-09 04:35:35 +01:00
|
|
|
ItemPointerData fn_tid;
|
2012-09-10 02:32:54 +02:00
|
|
|
SV *reference; /* CODE reference for Perl sub */
|
2011-02-17 20:40:13 +01:00
|
|
|
plperl_interp_desc *interp; /* interpreter it's created in */
|
2012-09-10 02:32:54 +02:00
|
|
|
bool fn_readonly; /* is function readonly (not volatile)? */
|
2015-04-26 16:33:14 +02:00
|
|
|
Oid lang_oid;
|
|
|
|
List *trftypes;
|
2012-09-10 02:32:54 +02:00
|
|
|
bool lanpltrusted; /* is it plperl, rather than plperlu? */
|
2004-07-01 22:50:22 +02:00
|
|
|
bool fn_retistuple; /* true, if function returns tuple */
|
2004-08-29 07:07:03 +02:00
|
|
|
bool fn_retisset; /* true, if function returns set */
|
2005-10-15 04:49:52 +02:00
|
|
|
bool fn_retisarray; /* true if function returns array */
|
2012-09-10 02:32:54 +02:00
|
|
|
/* Conversion info for function's result type: */
|
2004-11-22 21:31:53 +01:00
|
|
|
Oid result_oid; /* Oid of result type */
|
2005-10-15 04:49:52 +02:00
|
|
|
FmgrInfo result_in_func; /* I/O function and arg for result type */
|
2004-06-06 02:41:28 +02:00
|
|
|
Oid result_typioparam;
|
2016-09-01 01:54:58 +02:00
|
|
|
/* Per-argument info for function's argument types: */
|
2000-01-20 06:08:58 +01:00
|
|
|
int nargs;
|
2016-09-01 01:54:58 +02:00
|
|
|
FmgrInfo *arg_out_func; /* output fns for arg types */
|
|
|
|
bool *arg_is_rowtype; /* is each arg composite? */
|
|
|
|
Oid *arg_arraytype; /* InvalidOid if not an array */
|
2005-11-22 19:17:34 +01:00
|
|
|
} plperl_proc_desc;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2012-09-10 02:32:54 +02:00
|
|
|
#define increment_prodesc_refcount(prodesc) \
|
2016-09-01 01:54:58 +02:00
|
|
|
((prodesc)->fn_refcount++)
|
2012-09-10 02:32:54 +02:00
|
|
|
#define decrement_prodesc_refcount(prodesc) \
|
|
|
|
do { \
|
2016-09-01 01:54:58 +02:00
|
|
|
Assert((prodesc)->fn_refcount > 0); \
|
|
|
|
if (--((prodesc)->fn_refcount) == 0) \
|
2012-09-10 02:32:54 +02:00
|
|
|
free_plperl_function(prodesc); \
|
|
|
|
} while(0)
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/**********************************************************************
|
|
|
|
* For speedy lookup, we maintain a hash table mapping from
|
2010-10-31 16:42:51 +01:00
|
|
|
* function OID + trigger flag + user OID to plperl_proc_desc pointers.
|
2010-09-30 23:18:51 +02:00
|
|
|
* The reason the plperl_proc_desc struct isn't directly part of the hash
|
|
|
|
* entry is to simplify recovery from errors during compile_plperl_function.
|
|
|
|
*
|
|
|
|
* Note: if the same function is called by multiple userIDs within a session,
|
|
|
|
* there will be a separate plperl_proc_desc entry for each userID in the case
|
|
|
|
* of plperl functions, but only one entry for plperlu functions, because we
|
|
|
|
* set user_id = 0 for that case. If the user redeclares the same function
|
|
|
|
* from plperl to plperlu or vice versa, there might be multiple
|
|
|
|
* plperl_proc_ptr entries in the hashtable, but only one is valid.
|
|
|
|
**********************************************************************/
|
|
|
|
typedef struct plperl_proc_key
|
|
|
|
{
|
2011-02-17 20:40:13 +01:00
|
|
|
Oid proc_id; /* Function OID */
|
|
|
|
|
2010-10-31 16:42:51 +01:00
|
|
|
/*
|
|
|
|
* is_trigger is really a bool, but declare as Oid to ensure this struct
|
|
|
|
* contains no padding
|
|
|
|
*/
|
2011-02-17 20:40:13 +01:00
|
|
|
Oid is_trigger; /* is it a trigger function? */
|
|
|
|
Oid user_id; /* User calling the function, or 0 */
|
2010-09-30 23:18:51 +02:00
|
|
|
} plperl_proc_key;
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
typedef struct plperl_proc_ptr
|
2006-11-13 18:13:57 +01:00
|
|
|
{
|
2011-02-17 20:40:13 +01:00
|
|
|
plperl_proc_key proc_key; /* Hash key (must be first!) */
|
2010-09-30 23:18:51 +02:00
|
|
|
plperl_proc_desc *proc_ptr;
|
|
|
|
} plperl_proc_ptr;
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
/*
|
|
|
|
* The information we cache for the duration of a single call to a
|
|
|
|
* function.
|
|
|
|
*/
|
|
|
|
typedef struct plperl_call_data
|
|
|
|
{
|
|
|
|
plperl_proc_desc *prodesc;
|
2006-10-04 02:30:14 +02:00
|
|
|
FunctionCallInfo fcinfo;
|
|
|
|
Tuplestorestate *tuple_store;
|
|
|
|
TupleDesc ret_tdesc;
|
|
|
|
MemoryContext tmp_cxt;
|
2006-01-28 04:28:15 +01:00
|
|
|
} plperl_call_data;
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
/**********************************************************************
|
|
|
|
* The information we cache about prepared and saved plans
|
|
|
|
**********************************************************************/
|
|
|
|
typedef struct plperl_query_desc
|
|
|
|
{
|
2010-09-30 23:18:51 +02:00
|
|
|
char qname[24];
|
2013-03-02 03:33:34 +01:00
|
|
|
MemoryContext plan_cxt; /* context holding this struct */
|
2011-09-16 06:42:53 +02:00
|
|
|
SPIPlanPtr plan;
|
2006-03-05 17:40:51 +01:00
|
|
|
int nargs;
|
|
|
|
Oid *argtypes;
|
|
|
|
FmgrInfo *arginfuncs;
|
|
|
|
Oid *argtypioparams;
|
|
|
|
} plperl_query_desc;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2007-11-15 22:14:46 +01:00
|
|
|
/* hash table entry for query desc */
|
2006-11-13 18:13:57 +01:00
|
|
|
|
|
|
|
typedef struct plperl_query_entry
|
|
|
|
{
|
2007-11-15 22:14:46 +01:00
|
|
|
char query_name[NAMEDATALEN];
|
2006-11-13 18:13:57 +01:00
|
|
|
plperl_query_desc *query_data;
|
2007-11-15 23:25:18 +01:00
|
|
|
} plperl_query_entry;
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/**********************************************************************
|
|
|
|
* Information for PostgreSQL - Perl array conversion.
|
|
|
|
**********************************************************************/
|
|
|
|
typedef struct plperl_array_info
|
|
|
|
{
|
|
|
|
int ndims;
|
|
|
|
bool elem_is_rowtype; /* 't' if element type is a rowtype */
|
|
|
|
Datum *elements;
|
|
|
|
bool *nulls;
|
|
|
|
int *nelems;
|
|
|
|
FmgrInfo proc;
|
2015-04-26 16:33:14 +02:00
|
|
|
FmgrInfo transform_proc;
|
2011-02-18 02:11:50 +01:00
|
|
|
} plperl_array_info;
|
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
/**********************************************************************
|
|
|
|
* Global data
|
|
|
|
**********************************************************************/
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
static HTAB *plperl_interp_hash = NULL;
|
2007-11-15 22:14:46 +01:00
|
|
|
static HTAB *plperl_proc_hash = NULL;
|
2010-09-30 23:18:51 +02:00
|
|
|
static plperl_interp_desc *plperl_active_interp = NULL;
|
2011-02-17 20:40:13 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/* If we have an unassigned "held" interpreter, it's stored here */
|
|
|
|
static PerlInterpreter *plperl_held_interp = NULL;
|
2000-04-12 19:17:23 +02:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/* GUC variables */
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
static bool plperl_use_strict = false;
|
2010-02-12 20:35:25 +01:00
|
|
|
static char *plperl_on_init = NULL;
|
|
|
|
static char *plperl_on_plperl_init = NULL;
|
|
|
|
static char *plperl_on_plperlu_init = NULL;
|
2010-09-30 23:18:51 +02:00
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
static bool plperl_ending = false;
|
2010-09-30 23:18:51 +02:00
|
|
|
static OP *(*pp_require_orig) (pTHX) = NULL;
|
2010-05-13 18:39:43 +02:00
|
|
|
static char plperl_opmask[MAXO];
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
/* this is saved and restored by plperl_call_handler */
|
|
|
|
static plperl_call_data *current_call_data = NULL;
|
2004-09-13 22:10:13 +02:00
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
/**********************************************************************
|
|
|
|
* Forward declarations
|
|
|
|
**********************************************************************/
|
2006-08-08 21:15:09 +02:00
|
|
|
void _PG_init(void);
|
|
|
|
|
2010-01-09 03:40:50 +01:00
|
|
|
static PerlInterpreter *plperl_init_interp(void);
|
2010-01-30 02:46:57 +01:00
|
|
|
static void plperl_destroy_interp(PerlInterpreter **);
|
|
|
|
static void plperl_fini(int code, Datum arg);
|
2010-09-30 23:18:51 +02:00
|
|
|
static void set_interp_require(bool trusted);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2000-05-28 19:56:29 +02:00
|
|
|
static Datum plperl_func_handler(PG_FUNCTION_ARGS);
|
2004-07-01 22:50:22 +02:00
|
|
|
static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
|
2013-12-11 14:11:59 +01:00
|
|
|
static void plperl_event_trigger_handler(PG_FUNCTION_ARGS);
|
2009-10-31 19:11:59 +01:00
|
|
|
|
2012-09-10 02:32:54 +02:00
|
|
|
static void free_plperl_function(plperl_proc_desc *prodesc);
|
|
|
|
|
2013-12-11 14:11:59 +01:00
|
|
|
static plperl_proc_desc *compile_plperl_function(Oid fn_oid,
|
2014-05-06 18:12:18 +02:00
|
|
|
bool is_trigger,
|
|
|
|
bool is_event_trigger);
|
2001-10-20 00:43:49 +02:00
|
|
|
|
2004-11-23 01:21:24 +01:00
|
|
|
static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
|
2011-02-18 02:11:50 +01:00
|
|
|
static SV *plperl_hash_from_datum(Datum attr);
|
|
|
|
static SV *plperl_ref_from_pg_array(Datum arg, Oid typid);
|
|
|
|
static SV *split_array(plperl_array_info *info, int first, int last, int nest);
|
|
|
|
static SV *make_array_ref(plperl_array_info *info, int first, int last);
|
|
|
|
static SV *get_perl_array_ref(SV *sv);
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
|
|
|
|
FunctionCallInfo fcinfo,
|
|
|
|
FmgrInfo *finfo, Oid typioparam,
|
|
|
|
bool *isnull);
|
|
|
|
static void _sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam);
|
|
|
|
static Datum plperl_array_to_datum(SV *src, Oid typid, int32 typmod);
|
2014-11-25 18:21:22 +01:00
|
|
|
static void array_to_datum_internal(AV *av, ArrayBuildState *astate,
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
int *ndims, int *dims, int cur_depth,
|
|
|
|
Oid arraytypid, Oid elemtypid, int32 typmod,
|
|
|
|
FmgrInfo *finfo, Oid typioparam);
|
2011-02-18 02:11:50 +01:00
|
|
|
static Datum plperl_hash_to_datum(SV *src, TupleDesc td);
|
|
|
|
|
2002-01-24 22:40:44 +01:00
|
|
|
static void plperl_init_shared_libs(pTHX);
|
2010-02-12 20:35:25 +01:00
|
|
|
static void plperl_trusted_init(void);
|
|
|
|
static void plperl_untrusted_init(void);
|
Widen query numbers-of-tuples-processed counters to uint64.
This patch widens SPI_processed, EState's es_processed field, PortalData's
portalPos field, FuncCallContext's call_cntr and max_calls fields,
ExecutorRun's count argument, PortalRunFetch's result, and the max number
of rows in a SPITupleTable to uint64, and deals with (I hope) all the
ensuing fallout. Some of these values were declared uint32 before, and
others "long".
I also removed PortalData's posOverflow field, since that logic seems
pretty useless given that portalPos is now always 64 bits.
The user-visible results are that command tags for SELECT etc will
correctly report tuple counts larger than 4G, as will plpgsql's GET
GET DIAGNOSTICS ... ROW_COUNT command. Queries processing more tuples
than that are still not exactly the norm, but they're becoming more
common.
Most values associated with FETCH/MOVE distances, such as PortalRun's count
argument and the count argument of most SPI functions that have one, remain
declared as "long". It's not clear whether it would be worth promoting
those to int64; but it would definitely be a large dollop of additional
API churn on top of this, and it would only help 32-bit platforms which
seem relatively less likely to see any benefit.
Andreas Scherbaum, reviewed by Christian Ullrich, additional hacking by me
2016-03-12 22:05:10 +01:00
|
|
|
static HV *plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int);
|
2011-02-06 23:29:26 +01:00
|
|
|
static char *hek2cstr(HE *he);
|
2006-10-15 20:56:39 +02:00
|
|
|
static SV **hv_store_string(HV *hv, const char *key, SV *val);
|
|
|
|
static SV **hv_fetch_string(HV *hv, const char *key);
|
2010-01-27 00:11:56 +01:00
|
|
|
static void plperl_create_sub(plperl_proc_desc *desc, char *s, Oid fn_oid);
|
2011-02-17 20:40:13 +01:00
|
|
|
static SV *plperl_call_perl_func(plperl_proc_desc *desc,
|
|
|
|
FunctionCallInfo fcinfo);
|
2009-09-16 08:06:12 +02:00
|
|
|
static void plperl_compile_callback(void *arg);
|
|
|
|
static void plperl_exec_callback(void *arg);
|
2009-11-29 04:02:27 +01:00
|
|
|
static void plperl_inline_callback(void *arg);
|
2010-01-27 00:11:56 +01:00
|
|
|
static char *strip_trailing_ws(const char *msg);
|
2010-02-26 03:01:40 +01:00
|
|
|
static OP *pp_require_safe(pTHX);
|
2010-09-30 23:18:51 +02:00
|
|
|
static void activate_interpreter(plperl_interp_desc *interp_desc);
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef WIN32
|
|
|
|
static char *setlocale_perl(int category, char *locale);
|
|
|
|
#endif
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2010-01-09 03:40:50 +01:00
|
|
|
/*
|
2011-02-06 23:29:26 +01:00
|
|
|
* convert a HE (hash entry) key to a cstr in the current database encoding
|
2010-01-09 03:40:50 +01:00
|
|
|
*/
|
2011-02-06 23:29:26 +01:00
|
|
|
static char *
|
|
|
|
hek2cstr(HE *he)
|
2010-01-09 03:40:50 +01:00
|
|
|
{
|
2014-05-06 18:12:18 +02:00
|
|
|
char *ret;
|
|
|
|
SV *sv;
|
2014-03-17 03:22:21 +01:00
|
|
|
|
|
|
|
/*
|
|
|
|
* HeSVKEY_force will return a temporary mortal SV*, so we need to make
|
|
|
|
* sure to free it with ENTER/SAVE/FREE/LEAVE
|
|
|
|
*/
|
|
|
|
ENTER;
|
|
|
|
SAVETMPS;
|
|
|
|
|
2011-02-17 20:40:13 +01:00
|
|
|
/*-------------------------
|
|
|
|
* Unfortunately, while HeUTF8 is true for most things > 256, for values
|
|
|
|
* 128..255 it's not, but perl will treat them as unicode code points if
|
|
|
|
* the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode
|
|
|
|
* for more)
|
2011-02-06 23:29:26 +01:00
|
|
|
*
|
|
|
|
* So if we did the expected:
|
2011-02-17 20:40:13 +01:00
|
|
|
* if (HeUTF8(he))
|
|
|
|
* utf_u2e(key...);
|
|
|
|
* else // must be ascii
|
|
|
|
* return HePV(he);
|
2011-02-06 23:29:26 +01:00
|
|
|
* we won't match columns with codepoints from 128..255
|
|
|
|
*
|
2011-02-17 20:40:13 +01:00
|
|
|
* For a more concrete example given a column with the name of the unicode
|
|
|
|
* codepoint U+00ae (registered sign) and a UTF8 database and the perl
|
|
|
|
* return_next { "\N{U+00ae}=>'text } would always fail as heUTF8 returns
|
|
|
|
* 0 and HePV() would give us a char * with 1 byte contains the decimal
|
|
|
|
* value 174
|
2011-02-06 23:29:26 +01:00
|
|
|
*
|
2011-02-17 20:40:13 +01:00
|
|
|
* Perl has the brains to know when it should utf8 encode 174 properly, so
|
|
|
|
* here we force it into an SV so that perl will figure it out and do the
|
|
|
|
* right thing
|
|
|
|
*-------------------------
|
2010-01-09 03:40:50 +01:00
|
|
|
*/
|
2011-02-17 20:40:13 +01:00
|
|
|
|
2014-03-17 03:22:21 +01:00
|
|
|
sv = HeSVKEY_force(he);
|
2011-02-06 23:29:26 +01:00
|
|
|
if (HeUTF8(he))
|
|
|
|
SvUTF8_on(sv);
|
2014-03-17 03:22:21 +01:00
|
|
|
ret = sv2cstr(sv);
|
|
|
|
|
|
|
|
/* free sv */
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
|
|
|
|
|
|
|
return ret;
|
2010-01-09 03:40:50 +01:00
|
|
|
}
|
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2006-08-08 21:15:09 +02:00
|
|
|
/*
|
|
|
|
* _PG_init() - library load-time initialization
|
|
|
|
*
|
|
|
|
* DO NOT make this static nor change its name!
|
|
|
|
*/
|
2003-07-31 20:36:46 +02:00
|
|
|
void
|
2006-08-08 21:15:09 +02:00
|
|
|
_PG_init(void)
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
2010-05-13 18:39:43 +02:00
|
|
|
/*
|
|
|
|
* Be sure we do initialization only once.
|
|
|
|
*
|
|
|
|
* If initialization fails due to, e.g., plperl_init_interp() throwing an
|
|
|
|
* exception, then we'll return here on the next usage and the user will
|
2010-07-06 21:19:02 +02:00
|
|
|
* get a rather cryptic: ERROR: attempt to redefine parameter
|
|
|
|
* "plperl.use_strict"
|
2010-05-13 18:39:43 +02:00
|
|
|
*/
|
2006-08-08 21:15:09 +02:00
|
|
|
static bool inited = false;
|
2007-11-15 22:14:46 +01:00
|
|
|
HASHCTL hash_ctl;
|
2006-08-08 21:15:09 +02:00
|
|
|
|
|
|
|
if (inited)
|
2000-01-20 06:08:58 +01:00
|
|
|
return;
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Support localized messages.
|
|
|
|
*/
|
2008-12-11 08:34:09 +01:00
|
|
|
pg_bindtextdomain(TEXTDOMAIN);
|
2008-10-09 19:24:05 +02:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Initialize plperl's GUCs.
|
|
|
|
*/
|
2006-08-08 21:15:09 +02:00
|
|
|
DefineCustomBoolVariable("plperl.use_strict",
|
2009-06-11 16:49:15 +02:00
|
|
|
gettext_noop("If true, trusted and untrusted Perl code will be compiled in strict mode."),
|
2005-10-15 04:49:52 +02:00
|
|
|
NULL,
|
|
|
|
&plperl_use_strict,
|
2008-11-19 02:10:24 +01:00
|
|
|
false,
|
|
|
|
PGC_USERSET, 0,
|
2011-04-07 06:11:01 +02:00
|
|
|
NULL, NULL, NULL);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* plperl.on_init is marked PGC_SIGHUP to support the idea that it might
|
|
|
|
* be executed in the postmaster (if plperl is loaded into the postmaster
|
|
|
|
* via shared_preload_libraries). This isn't really right either way,
|
|
|
|
* though.
|
|
|
|
*/
|
2010-02-12 20:35:25 +01:00
|
|
|
DefineCustomStringVariable("plperl.on_init",
|
2010-03-17 22:31:17 +01:00
|
|
|
gettext_noop("Perl initialization code to execute when a Perl interpreter is initialized."),
|
2010-02-26 03:01:40 +01:00
|
|
|
NULL,
|
|
|
|
&plperl_on_init,
|
|
|
|
NULL,
|
|
|
|
PGC_SIGHUP, 0,
|
2011-04-07 06:11:01 +02:00
|
|
|
NULL, NULL, NULL);
|
2010-01-30 02:46:57 +01:00
|
|
|
|
2010-02-12 20:35:25 +01:00
|
|
|
/*
|
2010-09-30 23:18:51 +02:00
|
|
|
* plperl.on_plperl_init is marked PGC_SUSET to avoid issues whereby a
|
|
|
|
* user who might not even have USAGE privilege on the plperl language
|
|
|
|
* could nonetheless use SET plperl.on_plperl_init='...' to influence the
|
|
|
|
* behaviour of any existing plperl function that they can execute (which
|
|
|
|
* might be SECURITY DEFINER, leading to a privilege escalation). See
|
2010-02-26 03:01:40 +01:00
|
|
|
* http://archives.postgresql.org/pgsql-hackers/2010-02/msg00281.php and
|
|
|
|
* the overall thread.
|
2010-09-30 23:18:51 +02:00
|
|
|
*
|
|
|
|
* Note that because plperl.use_strict is USERSET, a nefarious user could
|
|
|
|
* set it to be applied against other people's functions. This is judged
|
|
|
|
* OK since the worst result would be an error. Your code oughta pass
|
|
|
|
* use_strict anyway ;-)
|
2010-02-12 20:35:25 +01:00
|
|
|
*/
|
|
|
|
DefineCustomStringVariable("plperl.on_plperl_init",
|
2010-02-26 03:01:40 +01:00
|
|
|
gettext_noop("Perl initialization code to execute once when plperl is first used."),
|
|
|
|
NULL,
|
|
|
|
&plperl_on_plperl_init,
|
|
|
|
NULL,
|
|
|
|
PGC_SUSET, 0,
|
2011-04-07 06:11:01 +02:00
|
|
|
NULL, NULL, NULL);
|
2010-02-12 20:35:25 +01:00
|
|
|
|
|
|
|
DefineCustomStringVariable("plperl.on_plperlu_init",
|
2010-02-26 03:01:40 +01:00
|
|
|
gettext_noop("Perl initialization code to execute once when plperlu is first used."),
|
|
|
|
NULL,
|
|
|
|
&plperl_on_plperlu_init,
|
|
|
|
NULL,
|
|
|
|
PGC_SUSET, 0,
|
2011-04-07 06:11:01 +02:00
|
|
|
NULL, NULL, NULL);
|
2010-02-12 20:35:25 +01:00
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
EmitWarningsOnPlaceholders("plperl");
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Create hash tables.
|
|
|
|
*/
|
|
|
|
memset(&hash_ctl, 0, sizeof(hash_ctl));
|
|
|
|
hash_ctl.keysize = sizeof(Oid);
|
|
|
|
hash_ctl.entrysize = sizeof(plperl_interp_desc);
|
|
|
|
plperl_interp_hash = hash_create("PL/Perl interpreters",
|
|
|
|
8,
|
|
|
|
&hash_ctl,
|
Improve hash_create's API for selecting simple-binary-key hash functions.
Previously, if you wanted anything besides C-string hash keys, you had to
specify a custom hashing function to hash_create(). Nearly all such
callers were specifying tag_hash or oid_hash; which is tedious, and rather
error-prone, since a caller could easily miss the opportunity to optimize
by using hash_uint32 when appropriate. Replace this with a design whereby
callers using simple binary-data keys just specify HASH_BLOBS and don't
need to mess with specific support functions. hash_create() itself will
take care of optimizing when the key size is four bytes.
This nets out saving a few hundred bytes of code space, and offers
a measurable performance improvement in tidbitmap.c (which was not
exploiting the opportunity to use hash_uint32 for its 4-byte keys).
There might be some wins elsewhere too, I didn't analyze closely.
In future we could look into offering a similar optimized hashing function
for 8-byte keys. Under this design that could be done in a centralized
and machine-independent fashion, whereas getting it right for keys of
platform-dependent sizes would've been notationally painful before.
For the moment, the old way still works fine, so as not to break source
code compatibility for loadable modules. Eventually we might want to
remove tag_hash and friends from the exported API altogether, since there's
no real need for them to be explicitly referenced from outside dynahash.c.
Teodor Sigaev and Tom Lane
2014-12-18 19:36:29 +01:00
|
|
|
HASH_ELEM | HASH_BLOBS);
|
2010-09-30 23:18:51 +02:00
|
|
|
|
|
|
|
memset(&hash_ctl, 0, sizeof(hash_ctl));
|
|
|
|
hash_ctl.keysize = sizeof(plperl_proc_key);
|
|
|
|
hash_ctl.entrysize = sizeof(plperl_proc_ptr);
|
|
|
|
plperl_proc_hash = hash_create("PL/Perl procedures",
|
2006-11-13 18:13:57 +01:00
|
|
|
32,
|
|
|
|
&hash_ctl,
|
Improve hash_create's API for selecting simple-binary-key hash functions.
Previously, if you wanted anything besides C-string hash keys, you had to
specify a custom hashing function to hash_create(). Nearly all such
callers were specifying tag_hash or oid_hash; which is tedious, and rather
error-prone, since a caller could easily miss the opportunity to optimize
by using hash_uint32 when appropriate. Replace this with a design whereby
callers using simple binary-data keys just specify HASH_BLOBS and don't
need to mess with specific support functions. hash_create() itself will
take care of optimizing when the key size is four bytes.
This nets out saving a few hundred bytes of code space, and offers
a measurable performance improvement in tidbitmap.c (which was not
exploiting the opportunity to use hash_uint32 for its 4-byte keys).
There might be some wins elsewhere too, I didn't analyze closely.
In future we could look into offering a similar optimized hashing function
for 8-byte keys. Under this design that could be done in a centralized
and machine-independent fashion, whereas getting it right for keys of
platform-dependent sizes would've been notationally painful before.
For the moment, the old way still works fine, so as not to break source
code compatibility for loadable modules. Eventually we might want to
remove tag_hash and friends from the exported API altogether, since there's
no real need for them to be explicitly referenced from outside dynahash.c.
Teodor Sigaev and Tom Lane
2014-12-18 19:36:29 +01:00
|
|
|
HASH_ELEM | HASH_BLOBS);
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Save the default opmask.
|
|
|
|
*/
|
2010-05-13 18:39:43 +02:00
|
|
|
PLPERL_SET_OPMASK(plperl_opmask);
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Create the first Perl interpreter, but only partially initialize it.
|
|
|
|
*/
|
2010-01-09 03:40:50 +01:00
|
|
|
plperl_held_interp = plperl_init_interp();
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2006-08-08 21:15:09 +02:00
|
|
|
inited = true;
|
2003-07-31 20:36:46 +02:00
|
|
|
}
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
static void
|
2010-09-30 23:18:51 +02:00
|
|
|
set_interp_require(bool trusted)
|
2010-05-13 18:39:43 +02:00
|
|
|
{
|
2010-09-30 23:18:51 +02:00
|
|
|
if (trusted)
|
2010-05-13 18:39:43 +02:00
|
|
|
{
|
|
|
|
PL_ppaddr[OP_REQUIRE] = pp_require_safe;
|
|
|
|
PL_ppaddr[OP_DOFILE] = pp_require_safe;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
PL_ppaddr[OP_REQUIRE] = pp_require_orig;
|
|
|
|
PL_ppaddr[OP_DOFILE] = pp_require_orig;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
/*
|
|
|
|
* Cleanup perl interpreters, including running END blocks.
|
|
|
|
* Does not fully undo the actions of _PG_init() nor make it callable again.
|
|
|
|
*/
|
|
|
|
static void
|
|
|
|
plperl_fini(int code, Datum arg)
|
|
|
|
{
|
2010-09-30 23:18:51 +02:00
|
|
|
HASH_SEQ_STATUS hash_seq;
|
|
|
|
plperl_interp_desc *interp_desc;
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
elog(DEBUG3, "plperl_fini");
|
|
|
|
|
|
|
|
/*
|
2010-02-26 03:01:40 +01:00
|
|
|
* Indicate that perl is terminating. Disables use of spi_* functions when
|
|
|
|
* running END/DESTROY code. See check_spi_usage_allowed(). Could be
|
|
|
|
* enabled in future, with care, using a transaction
|
2010-01-30 02:46:57 +01:00
|
|
|
* http://archives.postgresql.org/pgsql-hackers/2010-01/msg02743.php
|
|
|
|
*/
|
|
|
|
plperl_ending = true;
|
|
|
|
|
|
|
|
/* Only perform perl cleanup if we're exiting cleanly */
|
2010-02-26 03:01:40 +01:00
|
|
|
if (code)
|
|
|
|
{
|
2010-01-30 02:46:57 +01:00
|
|
|
elog(DEBUG3, "plperl_fini: skipped");
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/* Zap the "held" interpreter, if we still have it */
|
2010-01-30 02:46:57 +01:00
|
|
|
plperl_destroy_interp(&plperl_held_interp);
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/* Zap any fully-initialized interpreters */
|
|
|
|
hash_seq_init(&hash_seq, plperl_interp_hash);
|
|
|
|
while ((interp_desc = hash_seq_search(&hash_seq)) != NULL)
|
|
|
|
{
|
|
|
|
if (interp_desc->interp)
|
|
|
|
{
|
|
|
|
activate_interpreter(interp_desc);
|
|
|
|
plperl_destroy_interp(&interp_desc->interp);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
elog(DEBUG3, "plperl_fini: done");
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Select and activate an appropriate Perl interpreter.
|
2006-11-13 18:13:57 +01:00
|
|
|
*/
|
2007-02-09 04:35:35 +01:00
|
|
|
static void
|
2010-01-27 00:11:56 +01:00
|
|
|
select_perl_context(bool trusted)
|
2006-11-13 18:13:57 +01:00
|
|
|
{
|
2010-09-30 23:18:51 +02:00
|
|
|
Oid user_id;
|
|
|
|
plperl_interp_desc *interp_desc;
|
|
|
|
bool found;
|
|
|
|
PerlInterpreter *interp = NULL;
|
|
|
|
|
|
|
|
/* Find or create the interpreter hashtable entry for this userid */
|
|
|
|
if (trusted)
|
|
|
|
user_id = GetUserId();
|
|
|
|
else
|
|
|
|
user_id = InvalidOid;
|
|
|
|
|
|
|
|
interp_desc = hash_search(plperl_interp_hash, &user_id,
|
|
|
|
HASH_ENTER,
|
|
|
|
&found);
|
|
|
|
if (!found)
|
|
|
|
{
|
|
|
|
/* Initialize newly-created hashtable entry */
|
|
|
|
interp_desc->interp = NULL;
|
|
|
|
interp_desc->query_hash = NULL;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Make sure we have a query_hash for this interpreter */
|
|
|
|
if (interp_desc->query_hash == NULL)
|
|
|
|
{
|
|
|
|
HASHCTL hash_ctl;
|
|
|
|
|
|
|
|
memset(&hash_ctl, 0, sizeof(hash_ctl));
|
|
|
|
hash_ctl.keysize = NAMEDATALEN;
|
|
|
|
hash_ctl.entrysize = sizeof(plperl_query_entry);
|
|
|
|
interp_desc->query_hash = hash_create("PL/Perl queries",
|
|
|
|
32,
|
|
|
|
&hash_ctl,
|
|
|
|
HASH_ELEM);
|
|
|
|
}
|
2010-01-30 02:46:57 +01:00
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
/*
|
2010-09-30 23:18:51 +02:00
|
|
|
* Quick exit if already have an interpreter
|
2010-01-27 00:11:56 +01:00
|
|
|
*/
|
2010-09-30 23:18:51 +02:00
|
|
|
if (interp_desc->interp)
|
|
|
|
{
|
|
|
|
activate_interpreter(interp_desc);
|
2010-01-27 00:11:56 +01:00
|
|
|
return;
|
2010-09-30 23:18:51 +02:00
|
|
|
}
|
2010-01-27 00:11:56 +01:00
|
|
|
|
|
|
|
/*
|
|
|
|
* adopt held interp if free, else create new one if possible
|
|
|
|
*/
|
2010-09-30 23:18:51 +02:00
|
|
|
if (plperl_held_interp != NULL)
|
2006-11-13 18:13:57 +01:00
|
|
|
{
|
2010-01-30 02:46:57 +01:00
|
|
|
/* first actual use of a perl interpreter */
|
2010-09-30 23:18:51 +02:00
|
|
|
interp = plperl_held_interp;
|
|
|
|
|
|
|
|
/*
|
|
|
|
* Reset the plperl_held_interp pointer first; if we fail during init
|
|
|
|
* we don't want to try again with the partially-initialized interp.
|
|
|
|
*/
|
|
|
|
plperl_held_interp = NULL;
|
2010-01-30 02:46:57 +01:00
|
|
|
|
2006-11-13 18:13:57 +01:00
|
|
|
if (trusted)
|
2010-02-12 20:35:25 +01:00
|
|
|
plperl_trusted_init();
|
2006-11-13 18:13:57 +01:00
|
|
|
else
|
2010-02-12 20:35:25 +01:00
|
|
|
plperl_untrusted_init();
|
2010-02-16 22:39:52 +01:00
|
|
|
|
|
|
|
/* successfully initialized, so arrange for cleanup */
|
|
|
|
on_proc_exit(plperl_fini, 0);
|
2006-11-13 18:13:57 +01:00
|
|
|
}
|
2010-01-09 03:40:50 +01:00
|
|
|
else
|
2006-11-13 18:13:57 +01:00
|
|
|
{
|
2010-01-09 03:40:50 +01:00
|
|
|
#ifdef MULTIPLICITY
|
2011-02-17 20:40:13 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* plperl_init_interp will change Perl's idea of the active
|
|
|
|
* interpreter. Reset plperl_active_interp temporarily, so that if we
|
|
|
|
* hit an error partway through here, we'll make sure to switch back
|
|
|
|
* to a non-broken interpreter before running any other Perl
|
|
|
|
* functions.
|
|
|
|
*/
|
|
|
|
plperl_active_interp = NULL;
|
|
|
|
|
|
|
|
/* Now build the new interpreter */
|
|
|
|
interp = plperl_init_interp();
|
2010-02-26 03:01:40 +01:00
|
|
|
|
|
|
|
if (trusted)
|
2010-02-12 20:35:25 +01:00
|
|
|
plperl_trusted_init();
|
2010-02-26 03:01:40 +01:00
|
|
|
else
|
2010-02-12 20:35:25 +01:00
|
|
|
plperl_untrusted_init();
|
2010-01-09 03:40:50 +01:00
|
|
|
#else
|
2015-11-19 20:16:39 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
|
|
|
errmsg("cannot allocate multiple Perl interpreters on this platform")));
|
2010-01-09 03:40:50 +01:00
|
|
|
#endif
|
2006-11-13 18:13:57 +01:00
|
|
|
}
|
2010-09-30 23:18:51 +02:00
|
|
|
|
|
|
|
set_interp_require(trusted);
|
2010-01-27 00:11:56 +01:00
|
|
|
|
|
|
|
/*
|
2010-02-26 03:01:40 +01:00
|
|
|
* Since the timing of first use of PL/Perl can't be predicted, any
|
|
|
|
* database interaction during initialization is problematic. Including,
|
|
|
|
* but not limited to, security definer issues. So we only enable access
|
|
|
|
* to the database AFTER on_*_init code has run. See
|
2010-09-30 23:18:51 +02:00
|
|
|
* http://archives.postgresql.org/pgsql-hackers/2010-01/msg02669.php
|
2010-01-30 02:46:57 +01:00
|
|
|
*/
|
|
|
|
newXS("PostgreSQL::InServer::SPI::bootstrap",
|
2010-02-26 03:01:40 +01:00
|
|
|
boot_PostgreSQL__InServer__SPI, __FILE__);
|
2010-01-30 02:46:57 +01:00
|
|
|
|
|
|
|
eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE);
|
|
|
|
if (SvTRUE(ERRSV))
|
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
|
2010-03-17 22:31:17 +01:00
|
|
|
errcontext("while executing PostgreSQL::InServer::SPI::bootstrap")));
|
2010-09-30 23:18:51 +02:00
|
|
|
|
|
|
|
/* Fully initialized, so mark the hashtable entry valid */
|
|
|
|
interp_desc->interp = interp;
|
|
|
|
|
|
|
|
/* And mark this as the active interpreter */
|
|
|
|
plperl_active_interp = interp_desc;
|
2006-11-13 18:13:57 +01:00
|
|
|
}
|
|
|
|
|
2009-10-31 19:11:59 +01:00
|
|
|
/*
|
2010-09-30 23:18:51 +02:00
|
|
|
* Make the specified interpreter the active one
|
|
|
|
*
|
|
|
|
* A call with NULL does nothing. This is so that "restoring" to a previously
|
|
|
|
* null state of plperl_active_interp doesn't result in useless thrashing.
|
2009-10-31 19:11:59 +01:00
|
|
|
*/
|
2010-09-30 23:18:51 +02:00
|
|
|
static void
|
|
|
|
activate_interpreter(plperl_interp_desc *interp_desc)
|
2006-11-13 18:13:57 +01:00
|
|
|
{
|
2010-09-30 23:18:51 +02:00
|
|
|
if (interp_desc && plperl_active_interp != interp_desc)
|
2006-11-13 18:13:57 +01:00
|
|
|
{
|
2010-09-30 23:18:51 +02:00
|
|
|
Assert(interp_desc->interp);
|
|
|
|
PERL_SET_CONTEXT(interp_desc->interp);
|
|
|
|
/* trusted iff user_id isn't InvalidOid */
|
|
|
|
set_interp_require(OidIsValid(interp_desc->user_id));
|
|
|
|
plperl_active_interp = interp_desc;
|
2006-11-13 18:13:57 +01:00
|
|
|
}
|
|
|
|
}
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Create a new Perl interpreter.
|
|
|
|
*
|
|
|
|
* We initialize the interpreter as far as we can without knowing whether
|
|
|
|
* it will become a trusted or untrusted interpreter; in particular, the
|
|
|
|
* plperl.on_init code will get executed. Later, either plperl_trusted_init
|
|
|
|
* or plperl_untrusted_init must be called to complete the initialization.
|
|
|
|
*/
|
2010-01-09 03:40:50 +01:00
|
|
|
static PerlInterpreter *
|
Well, after persuading cvsup and cvs that it _is_ possible to have local
modifiable repositories, I have a clean untrusted plperl patch to offer
you :)
Highlights:
* There's one perl interpreter used for both trusted and untrusted
procedures. I do think its unnecessary to keep two perl
interpreters around. If someone can break out from trusted "Safe" perl
mode, well, they can do what they want already. If someone disagrees, I
can change this.
* Opcode is not statically loaded anymore. Instead, we load Dynaloader,
which then can grab Opcode (and anything else you can 'use') on its own.
* Checked to work on FreeBSD 4.3 + perl 5.5.3 , OpenBSD 2.8 + perl5.6.1,
RedHat 6.2 + perl 5.5.3
* Uses ExtUtils::Embed to find what options are necessary to link with
perl shared libraries
* createlang is also updated, it can create untrusted perl using 'plperlu'
* Example script (assuming you have Mail::Sendmail installed):
create function foo() returns text as '
use Mail::Sendmail;
%mail = ( To => q(you@yourname.com),
From => q(me@here.com),
Message => "This is a very short message"
);
sendmail(%mail) or die $Mail::Sendmail::error;
return "OK. Log says:\n", $Mail::Sendmail::log;
' language 'plperlu';
Alex Pilosov
2001-06-18 23:40:06 +02:00
|
|
|
plperl_init_interp(void)
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
2010-01-09 03:40:50 +01:00
|
|
|
PerlInterpreter *plperl;
|
|
|
|
|
2010-02-26 03:01:40 +01:00
|
|
|
static char *embedding[3 + 2] = {
|
2010-01-09 03:40:50 +01:00
|
|
|
"", "-e", PLC_PERLBOOT
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
};
|
2009-06-11 16:49:15 +02:00
|
|
|
int nargs = 3;
|
2009-06-04 17:59:55 +02:00
|
|
|
|
2006-01-28 17:20:31 +01:00
|
|
|
#ifdef WIN32
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2006-10-04 02:30:14 +02:00
|
|
|
/*
|
2006-01-28 17:20:31 +01:00
|
|
|
* The perl library on startup does horrible things like call
|
2006-10-04 02:30:14 +02:00
|
|
|
* setlocale(LC_ALL,""). We have protected against that on most platforms
|
|
|
|
* by setting the environment appropriately. However, on Windows,
|
|
|
|
* setlocale() does not consult the environment, so we need to save the
|
|
|
|
* existing locale settings before perl has a chance to mangle them and
|
|
|
|
* restore them after its dirty deeds are done.
|
2006-01-28 17:20:31 +01:00
|
|
|
*
|
|
|
|
* MSDN ref:
|
|
|
|
* http://msdn.microsoft.com/library/en-us/vclib/html/_crt_locale.asp
|
|
|
|
*
|
|
|
|
* It appears that we only need to do this on interpreter startup, and
|
|
|
|
* subsequent calls to the interpreter don't mess with the locale
|
|
|
|
* settings.
|
|
|
|
*
|
2010-05-13 18:39:43 +02:00
|
|
|
* We restore them using setlocale_perl(), defined below, so that Perl
|
2006-10-04 02:30:14 +02:00
|
|
|
* doesn't have a different idea of the locale from Postgres.
|
2006-01-28 17:20:31 +01:00
|
|
|
*
|
|
|
|
*/
|
|
|
|
|
2006-10-04 02:30:14 +02:00
|
|
|
char *loc;
|
|
|
|
char *save_collate,
|
|
|
|
*save_ctype,
|
|
|
|
*save_monetary,
|
|
|
|
*save_numeric,
|
|
|
|
*save_time;
|
2006-01-28 17:20:31 +01:00
|
|
|
|
2006-10-04 02:30:14 +02:00
|
|
|
loc = setlocale(LC_COLLATE, NULL);
|
2006-01-28 17:20:31 +01:00
|
|
|
save_collate = loc ? pstrdup(loc) : NULL;
|
2006-10-04 02:30:14 +02:00
|
|
|
loc = setlocale(LC_CTYPE, NULL);
|
2006-01-28 17:20:31 +01:00
|
|
|
save_ctype = loc ? pstrdup(loc) : NULL;
|
2006-10-04 02:30:14 +02:00
|
|
|
loc = setlocale(LC_MONETARY, NULL);
|
2006-01-28 17:20:31 +01:00
|
|
|
save_monetary = loc ? pstrdup(loc) : NULL;
|
2006-10-04 02:30:14 +02:00
|
|
|
loc = setlocale(LC_NUMERIC, NULL);
|
2006-01-28 17:20:31 +01:00
|
|
|
save_numeric = loc ? pstrdup(loc) : NULL;
|
2006-10-04 02:30:14 +02:00
|
|
|
loc = setlocale(LC_TIME, NULL);
|
2006-01-28 17:20:31 +01:00
|
|
|
save_time = loc ? pstrdup(loc) : NULL;
|
2010-05-13 18:39:43 +02:00
|
|
|
|
|
|
|
#define PLPERL_RESTORE_LOCALE(name, saved) \
|
|
|
|
STMT_START { \
|
|
|
|
if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \
|
|
|
|
} STMT_END
|
2011-02-17 20:40:13 +01:00
|
|
|
#endif /* WIN32 */
|
2006-01-28 17:20:31 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
if (plperl_on_init && *plperl_on_init)
|
2010-01-30 02:46:57 +01:00
|
|
|
{
|
|
|
|
embedding[nargs++] = "-e";
|
2010-02-12 20:35:25 +01:00
|
|
|
embedding[nargs++] = plperl_on_init;
|
2010-01-30 02:46:57 +01:00
|
|
|
}
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
2009-06-05 22:32:00 +02:00
|
|
|
* The perl API docs state that PERL_SYS_INIT3 should be called before
|
2011-02-17 20:40:13 +01:00
|
|
|
* allocating interpreters. Unfortunately, on some platforms this fails in
|
|
|
|
* the Perl_do_taint() routine, which is called when the platform is using
|
|
|
|
* the system's malloc() instead of perl's own. Other platforms, notably
|
|
|
|
* Windows, fail if PERL_SYS_INIT3 is not called. So we call it if it's
|
|
|
|
* available, unless perl is using the system malloc(), which is true when
|
|
|
|
* MYMALLOC is set.
|
2009-06-05 22:32:00 +02:00
|
|
|
*/
|
|
|
|
#if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
|
2009-06-06 05:45:36 +02:00
|
|
|
{
|
2011-02-06 23:29:26 +01:00
|
|
|
static int perl_sys_init_done;
|
2009-06-06 05:45:36 +02:00
|
|
|
|
2011-02-06 23:29:26 +01:00
|
|
|
/* only call this the first time through, as per perlembed man page */
|
|
|
|
if (!perl_sys_init_done)
|
|
|
|
{
|
|
|
|
char *dummy_env[1] = {NULL};
|
|
|
|
|
|
|
|
PERL_SYS_INIT3(&nargs, (char ***) &embedding, (char ***) &dummy_env);
|
2012-09-05 22:43:37 +02:00
|
|
|
|
|
|
|
/*
|
|
|
|
* For unclear reasons, PERL_SYS_INIT3 sets the SIGFPE handler to
|
|
|
|
* SIG_IGN. Aside from being extremely unfriendly behavior for a
|
|
|
|
* library, this is dumb on the grounds that the results of a
|
|
|
|
* SIGFPE in this state are undefined according to POSIX, and in
|
|
|
|
* fact you get a forced process kill at least on Linux. Hence,
|
|
|
|
* restore the SIGFPE handler to the backend's standard setting.
|
|
|
|
* (See Perl bug 114574 for more information.)
|
|
|
|
*/
|
|
|
|
pqsignal(SIGFPE, FloatExceptionHandler);
|
|
|
|
|
2011-02-06 23:29:26 +01:00
|
|
|
perl_sys_init_done = 1;
|
|
|
|
/* quiet warning if PERL_SYS_INIT3 doesn't use the third argument */
|
|
|
|
dummy_env[0] = NULL;
|
|
|
|
}
|
2009-06-06 05:45:36 +02:00
|
|
|
}
|
2009-06-04 17:59:55 +02:00
|
|
|
#endif
|
|
|
|
|
2010-01-09 03:40:50 +01:00
|
|
|
plperl = perl_alloc();
|
|
|
|
if (!plperl)
|
2004-11-29 21:11:06 +01:00
|
|
|
elog(ERROR, "could not allocate Perl interpreter");
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2010-01-09 03:40:50 +01:00
|
|
|
PERL_SET_CONTEXT(plperl);
|
|
|
|
perl_construct(plperl);
|
2010-01-27 00:11:56 +01:00
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
/* run END blocks in perl_destruct instead of perl_run */
|
|
|
|
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
|
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
/*
|
2010-05-13 18:39:43 +02:00
|
|
|
* Record the original function for the 'require' and 'dofile' opcodes.
|
2010-07-06 21:19:02 +02:00
|
|
|
* (They share the same implementation.) Ensure it's used for new
|
|
|
|
* interpreters.
|
2010-01-27 00:11:56 +01:00
|
|
|
*/
|
|
|
|
if (!pp_require_orig)
|
|
|
|
pp_require_orig = PL_ppaddr[OP_REQUIRE];
|
2010-07-06 21:19:02 +02:00
|
|
|
else
|
2010-05-13 18:39:43 +02:00
|
|
|
{
|
2010-01-27 00:11:56 +01:00
|
|
|
PL_ppaddr[OP_REQUIRE] = pp_require_orig;
|
2010-07-06 21:19:02 +02:00
|
|
|
PL_ppaddr[OP_DOFILE] = pp_require_orig;
|
2010-05-13 18:39:43 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
#ifdef PLPERL_ENABLE_OPMASK_EARLY
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
/*
|
|
|
|
* For regression testing to prove that the PLC_PERLBOOT and PLC_TRUSTED
|
|
|
|
* code doesn't even compile any unsafe ops. In future there may be a
|
|
|
|
* valid need for them to do so, in which case this could be softened
|
|
|
|
* (perhaps moved to plperl_trusted_init()) or removed.
|
|
|
|
*/
|
|
|
|
PL_op_mask = plperl_opmask;
|
|
|
|
#endif
|
2010-01-27 00:11:56 +01:00
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
if (perl_parse(plperl, plperl_init_shared_libs,
|
2010-02-26 03:01:40 +01:00
|
|
|
nargs, embedding, NULL) != 0)
|
2010-01-30 02:46:57 +01:00
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
|
2010-03-17 22:31:17 +01:00
|
|
|
errcontext("while parsing Perl initialization")));
|
2010-01-30 02:46:57 +01:00
|
|
|
|
|
|
|
if (perl_run(plperl) != 0)
|
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
|
2010-03-17 22:31:17 +01:00
|
|
|
errcontext("while running Perl initialization")));
|
2006-01-28 17:20:31 +01:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef PLPERL_RESTORE_LOCALE
|
2010-07-06 21:19:02 +02:00
|
|
|
PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate);
|
|
|
|
PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype);
|
2010-05-13 18:39:43 +02:00
|
|
|
PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary);
|
2010-07-06 21:19:02 +02:00
|
|
|
PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric);
|
|
|
|
PLPERL_RESTORE_LOCALE(LC_TIME, save_time);
|
2006-01-28 17:20:31 +01:00
|
|
|
#endif
|
|
|
|
|
2010-01-09 03:40:50 +01:00
|
|
|
return plperl;
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
|
|
|
|
The attached patch, which incorporates the previous one sent and
currently unapplied regarding spi_internal.c, makes some additional
fixes relating to return types, and also contains the fix for
preventing the use of insecure versions of Safe.pm.
There is one remaing return case that does not appear to work, namely
return of a composite directly in a select, i.e. if foo returns some
composite type, 'select * from foo()' works but 'select foo()' doesn't.
We will either fix that or document it as a limitation.
The function plperl_func_handler is a mess - I will try to get it
cleaned up (and split up) in a subsequent patch, time permitting.
Also, reiterating previous advice - this changes slightly the API for
spi_exec_query - the returned object has either 2 or 3 members: 'status'
(string) and 'proceesed' (int,- number of rows) and, if rows are
returned, 'rows' (array of tuple hashes).
Andrew Dunstan
2004-07-12 16:31:04 +02:00
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
/*
|
|
|
|
* Our safe implementation of the require opcode.
|
|
|
|
* This is safe because it's completely unable to load any code.
|
|
|
|
* If the requested file/module has already been loaded it'll return true.
|
|
|
|
* If not, it'll die.
|
|
|
|
* So now "use Foo;" will work iff Foo has already been loaded.
|
|
|
|
*/
|
2010-02-26 03:01:40 +01:00
|
|
|
static OP *
|
2010-01-27 00:11:56 +01:00
|
|
|
pp_require_safe(pTHX)
|
|
|
|
{
|
2010-02-26 03:01:40 +01:00
|
|
|
dVAR;
|
|
|
|
dSP;
|
|
|
|
SV *sv,
|
|
|
|
**svp;
|
|
|
|
char *name;
|
|
|
|
STRLEN len;
|
2010-01-27 00:11:56 +01:00
|
|
|
|
2010-02-26 03:01:40 +01:00
|
|
|
sv = POPs;
|
|
|
|
name = SvPV(sv, len);
|
|
|
|
if (!(name && len > 0 && *name))
|
|
|
|
RETPUSHNO;
|
2010-01-27 00:11:56 +01:00
|
|
|
|
|
|
|
svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
|
|
|
|
if (svp && *svp != &PL_sv_undef)
|
|
|
|
RETPUSHYES;
|
|
|
|
|
|
|
|
DIE(aTHX_ "Unable to load %s into plperl", name);
|
2013-05-29 22:58:43 +02:00
|
|
|
|
2012-07-16 21:08:04 +02:00
|
|
|
/*
|
|
|
|
* In most Perl versions, DIE() expands to a return statement, so the next
|
2013-05-29 22:58:43 +02:00
|
|
|
* line is not necessary. But in versions between but not including
|
|
|
|
* 5.11.1 and 5.13.3 it does not, so the next line is necessary to avoid a
|
2012-07-16 21:08:04 +02:00
|
|
|
* "control reaches end of non-void function" warning from gcc. Other
|
|
|
|
* compilers such as Solaris Studio will, however, issue a "statement not
|
|
|
|
* reached" warning instead.
|
|
|
|
*/
|
|
|
|
return NULL;
|
2010-01-27 00:11:56 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Destroy one Perl interpreter ... actually we just run END blocks.
|
|
|
|
*
|
|
|
|
* Caller must have ensured this interpreter is the active one.
|
|
|
|
*/
|
2010-01-30 02:46:57 +01:00
|
|
|
static void
|
|
|
|
plperl_destroy_interp(PerlInterpreter **interp)
|
|
|
|
{
|
|
|
|
if (interp && *interp)
|
|
|
|
{
|
|
|
|
/*
|
2010-02-26 03:01:40 +01:00
|
|
|
* Only a very minimal destruction is performed: - just call END
|
|
|
|
* blocks.
|
2010-01-30 02:46:57 +01:00
|
|
|
*
|
2010-02-26 03:01:40 +01:00
|
|
|
* We could call perl_destruct() but we'd need to audit its actions
|
|
|
|
* very carefully and work-around any that impact us. (Calling
|
|
|
|
* sv_clean_objs() isn't an option because it's not part of perl's
|
|
|
|
* public API so isn't portably available.) Meanwhile END blocks can
|
|
|
|
* be used to perform manual cleanup.
|
2010-01-30 02:46:57 +01:00
|
|
|
*/
|
|
|
|
|
|
|
|
/* Run END blocks - based on perl's perl_destruct() */
|
2010-02-26 03:01:40 +01:00
|
|
|
if (PL_exit_flags & PERL_EXIT_DESTRUCT_END)
|
|
|
|
{
|
2010-01-30 02:46:57 +01:00
|
|
|
dJMPENV;
|
2010-02-26 03:01:40 +01:00
|
|
|
int x = 0;
|
2010-01-30 02:46:57 +01:00
|
|
|
|
|
|
|
JMPENV_PUSH(x);
|
|
|
|
PERL_UNUSED_VAR(x);
|
|
|
|
if (PL_endav && !PL_minus_c)
|
|
|
|
call_list(PL_scopestack_ix, PL_endav);
|
|
|
|
JMPENV_POP;
|
|
|
|
}
|
|
|
|
LEAVE;
|
|
|
|
FREETMPS;
|
|
|
|
|
|
|
|
*interp = NULL;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Initialize the current Perl interpreter as a trusted interp
|
|
|
|
*/
|
The attached patch, which incorporates the previous one sent and
currently unapplied regarding spi_internal.c, makes some additional
fixes relating to return types, and also contains the fix for
preventing the use of insecure versions of Safe.pm.
There is one remaing return case that does not appear to work, namely
return of a composite directly in a select, i.e. if foo returns some
composite type, 'select * from foo()' works but 'select foo()' doesn't.
We will either fix that or document it as a limitation.
The function plperl_func_handler is a mess - I will try to get it
cleaned up (and split up) in a subsequent patch, time permitting.
Also, reiterating previous advice - this changes slightly the API for
spi_exec_query - the returned object has either 2 or 3 members: 'status'
(string) and 'proceesed' (int,- number of rows) and, if rows are
returned, 'rows' (array of tuple hashes).
Andrew Dunstan
2004-07-12 16:31:04 +02:00
|
|
|
static void
|
2010-02-12 20:35:25 +01:00
|
|
|
plperl_trusted_init(void)
|
The attached patch, which incorporates the previous one sent and
currently unapplied regarding spi_internal.c, makes some additional
fixes relating to return types, and also contains the fix for
preventing the use of insecure versions of Safe.pm.
There is one remaing return case that does not appear to work, namely
return of a composite directly in a select, i.e. if foo returns some
composite type, 'select * from foo()' works but 'select foo()' doesn't.
We will either fix that or document it as a limitation.
The function plperl_func_handler is a mess - I will try to get it
cleaned up (and split up) in a subsequent patch, time permitting.
Also, reiterating previous advice - this changes slightly the API for
spi_exec_query - the returned object has either 2 or 3 members: 'status'
(string) and 'proceesed' (int,- number of rows) and, if rows are
returned, 'rows' (array of tuple hashes).
Andrew Dunstan
2004-07-12 16:31:04 +02:00
|
|
|
{
|
2010-07-06 21:19:02 +02:00
|
|
|
HV *stash;
|
|
|
|
SV *sv;
|
|
|
|
char *key;
|
|
|
|
I32 klen;
|
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
/* use original require while we set up */
|
|
|
|
PL_ppaddr[OP_REQUIRE] = pp_require_orig;
|
|
|
|
PL_ppaddr[OP_DOFILE] = pp_require_orig;
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
eval_pv(PLC_TRUSTED, FALSE);
|
|
|
|
if (SvTRUE(ERRSV))
|
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
|
2010-05-17 21:43:04 +02:00
|
|
|
errcontext("while executing PLC_TRUSTED")));
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2011-02-06 23:29:26 +01:00
|
|
|
/*
|
2011-02-17 20:40:13 +01:00
|
|
|
* Force loading of utf8 module now to prevent errors that can arise from
|
|
|
|
* the regex code later trying to load utf8 modules. See
|
2011-02-06 23:29:26 +01:00
|
|
|
* http://rt.perl.org/rt3/Ticket/Display.html?id=47576
|
|
|
|
*/
|
|
|
|
eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
|
|
|
|
if (SvTRUE(ERRSV))
|
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
|
2011-02-06 23:29:26 +01:00
|
|
|
errcontext("while executing utf8fix")));
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
/*
|
|
|
|
* Lock down the interpreter
|
|
|
|
*/
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
/* switch to the safe require/dofile opcode for future code */
|
|
|
|
PL_ppaddr[OP_REQUIRE] = pp_require_safe;
|
2010-07-06 21:19:02 +02:00
|
|
|
PL_ppaddr[OP_DOFILE] = pp_require_safe;
|
|
|
|
|
|
|
|
/*
|
|
|
|
* prevent (any more) unsafe opcodes being compiled PL_op_mask is per
|
|
|
|
* interpreter, so this only needs to be set once
|
2010-05-13 18:39:43 +02:00
|
|
|
*/
|
|
|
|
PL_op_mask = plperl_opmask;
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
/* delete the DynaLoader:: namespace so extensions can't be loaded */
|
|
|
|
stash = gv_stashpv("DynaLoader", GV_ADDWARN);
|
|
|
|
hv_iterinit(stash);
|
2010-07-06 21:19:02 +02:00
|
|
|
while ((sv = hv_iternextsv(stash, &key, &klen)))
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
{
|
2010-05-13 18:39:43 +02:00
|
|
|
if (!isGV_with_GP(sv) || !GvCV(sv))
|
|
|
|
continue;
|
|
|
|
SvREFCNT_dec(GvCV(sv)); /* free the CV */
|
2011-06-05 01:32:10 +02:00
|
|
|
GvCV_set(sv, NULL); /* prevent call via GV */
|
2010-05-13 18:39:43 +02:00
|
|
|
}
|
|
|
|
hv_clear(stash);
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
/* invalidate assorted caches */
|
|
|
|
++PL_sub_generation;
|
|
|
|
hv_clear(PL_stashcache);
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
/*
|
|
|
|
* Execute plperl.on_plperl_init in the locked-down interpreter
|
|
|
|
*/
|
|
|
|
if (plperl_on_plperl_init && *plperl_on_plperl_init)
|
|
|
|
{
|
|
|
|
eval_pv(plperl_on_plperl_init, FALSE);
|
2015-08-03 05:49:19 +02:00
|
|
|
/* XXX need to find a way to determine a better errcode here */
|
2010-01-27 00:11:56 +01:00
|
|
|
if (SvTRUE(ERRSV))
|
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
|
2010-05-17 21:43:04 +02:00
|
|
|
errcontext("while executing plperl.on_plperl_init")));
|
2010-02-12 20:35:25 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Initialize the current Perl interpreter as an untrusted interp
|
|
|
|
*/
|
2010-02-12 20:35:25 +01:00
|
|
|
static void
|
|
|
|
plperl_untrusted_init(void)
|
|
|
|
{
|
2010-09-30 23:18:51 +02:00
|
|
|
/*
|
|
|
|
* Nothing to do except execute plperl.on_plperlu_init
|
|
|
|
*/
|
2010-02-12 20:35:25 +01:00
|
|
|
if (plperl_on_plperlu_init && *plperl_on_plperlu_init)
|
|
|
|
{
|
|
|
|
eval_pv(plperl_on_plperlu_init, FALSE);
|
|
|
|
if (SvTRUE(ERRSV))
|
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
|
2010-03-17 22:31:17 +01:00
|
|
|
errcontext("while executing plperl.on_plperlu_init")));
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
}
|
The attached patch, which incorporates the previous one sent and
currently unapplied regarding spi_internal.c, makes some additional
fixes relating to return types, and also contains the fix for
preventing the use of insecure versions of Safe.pm.
There is one remaing return case that does not appear to work, namely
return of a composite directly in a select, i.e. if foo returns some
composite type, 'select * from foo()' works but 'select foo()' doesn't.
We will either fix that or document it as a limitation.
The function plperl_func_handler is a mess - I will try to get it
cleaned up (and split up) in a subsequent patch, time permitting.
Also, reiterating previous advice - this changes slightly the API for
spi_exec_query - the returned object has either 2 or 3 members: 'status'
(string) and 'proceesed' (int,- number of rows) and, if rows are
returned, 'rows' (array of tuple hashes).
Andrew Dunstan
2004-07-12 16:31:04 +02:00
|
|
|
}
|
|
|
|
|
2010-02-12 20:35:25 +01:00
|
|
|
|
2004-11-20 20:07:40 +01:00
|
|
|
/*
|
|
|
|
* Perl likes to put a newline after its error messages; clean up such
|
|
|
|
*/
|
|
|
|
static char *
|
|
|
|
strip_trailing_ws(const char *msg)
|
|
|
|
{
|
2005-10-15 04:49:52 +02:00
|
|
|
char *res = pstrdup(msg);
|
|
|
|
int len = strlen(res);
|
2004-11-20 20:07:40 +01:00
|
|
|
|
2005-10-15 04:49:52 +02:00
|
|
|
while (len > 0 && isspace((unsigned char) res[len - 1]))
|
2004-11-20 20:07:40 +01:00
|
|
|
res[--len] = '\0';
|
|
|
|
return res;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
/* Build a tuple from a hash. */
|
|
|
|
|
2004-11-23 01:21:24 +01:00
|
|
|
static HeapTuple
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
plperl_build_tuple_result(HV *perlhash, TupleDesc td)
|
2004-10-15 19:08:26 +02:00
|
|
|
{
|
2011-02-18 02:11:50 +01:00
|
|
|
Datum *values;
|
|
|
|
bool *nulls;
|
2011-02-17 20:40:13 +01:00
|
|
|
HE *he;
|
2004-11-23 01:21:24 +01:00
|
|
|
HeapTuple tup;
|
2004-10-15 19:08:26 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
values = palloc0(sizeof(Datum) * td->natts);
|
|
|
|
nulls = palloc(sizeof(bool) * td->natts);
|
|
|
|
memset(nulls, true, sizeof(bool) * td->natts);
|
2004-10-15 19:08:26 +02:00
|
|
|
|
2004-11-23 01:21:24 +01:00
|
|
|
hv_iterinit(perlhash);
|
2011-02-06 23:29:26 +01:00
|
|
|
while ((he = hv_iternext(perlhash)))
|
2004-11-23 01:21:24 +01:00
|
|
|
{
|
2011-02-17 20:40:13 +01:00
|
|
|
SV *val = HeVAL(he);
|
|
|
|
char *key = hek2cstr(he);
|
|
|
|
int attn = SPI_fnumber(td, key);
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2016-11-08 19:11:15 +01:00
|
|
|
if (attn == SPI_ERROR_NOATTRIBUTE)
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_UNDEFINED_COLUMN),
|
|
|
|
errmsg("Perl hash contains nonexistent column \"%s\"",
|
|
|
|
key)));
|
2016-11-08 19:11:15 +01:00
|
|
|
if (attn <= 0)
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
|
|
|
errmsg("cannot set system attribute \"%s\"",
|
|
|
|
key)));
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
values[attn - 1] = plperl_sv_to_datum(val,
|
|
|
|
td->attrs[attn - 1]->atttypid,
|
|
|
|
td->attrs[attn - 1]->atttypmod,
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
NULL,
|
|
|
|
NULL,
|
|
|
|
InvalidOid,
|
|
|
|
&nulls[attn - 1]);
|
2011-02-06 23:29:26 +01:00
|
|
|
|
|
|
|
pfree(key);
|
2004-10-15 19:08:26 +02:00
|
|
|
}
|
2004-11-23 01:21:24 +01:00
|
|
|
hv_iterinit(perlhash);
|
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
tup = heap_form_tuple(td, values, nulls);
|
|
|
|
pfree(values);
|
|
|
|
pfree(nulls);
|
|
|
|
return tup;
|
|
|
|
}
|
2011-02-06 23:29:26 +01:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/* convert a hash reference to a datum */
|
|
|
|
static Datum
|
|
|
|
plperl_hash_to_datum(SV *src, TupleDesc td)
|
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
HeapTuple tup = plperl_build_tuple_result((HV *) SvRV(src), td);
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
return HeapTupleGetDatum(tup);
|
|
|
|
}
|
|
|
|
|
|
|
|
/*
|
|
|
|
* if we are an array ref return the reference. this is special in that if we
|
|
|
|
* are a PostgreSQL::InServer::ARRAY object we will return the 'magic' array.
|
|
|
|
*/
|
|
|
|
static SV *
|
|
|
|
get_perl_array_ref(SV *sv)
|
|
|
|
{
|
|
|
|
if (SvOK(sv) && SvROK(sv))
|
2011-02-06 23:29:26 +01:00
|
|
|
{
|
2011-02-18 02:11:50 +01:00
|
|
|
if (SvTYPE(SvRV(sv)) == SVt_PVAV)
|
|
|
|
return sv;
|
|
|
|
else if (sv_isa(sv, "PostgreSQL::InServer::ARRAY"))
|
|
|
|
{
|
|
|
|
HV *hv = (HV *) SvRV(sv);
|
|
|
|
SV **sav = hv_fetch_string(hv, "array");
|
|
|
|
|
|
|
|
if (*sav && SvOK(*sav) && SvROK(*sav) &&
|
|
|
|
SvTYPE(SvRV(*sav)) == SVt_PVAV)
|
|
|
|
return *sav;
|
|
|
|
|
|
|
|
elog(ERROR, "could not get array reference from PostgreSQL::InServer::ARRAY object");
|
|
|
|
}
|
2011-02-06 23:29:26 +01:00
|
|
|
}
|
2011-02-18 02:11:50 +01:00
|
|
|
return NULL;
|
|
|
|
}
|
2011-02-06 23:29:26 +01:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/*
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
* helper function for plperl_array_to_datum, recurses for multi-D arrays
|
2011-02-18 02:11:50 +01:00
|
|
|
*/
|
2014-11-25 18:21:22 +01:00
|
|
|
static void
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
array_to_datum_internal(AV *av, ArrayBuildState *astate,
|
|
|
|
int *ndims, int *dims, int cur_depth,
|
|
|
|
Oid arraytypid, Oid elemtypid, int32 typmod,
|
|
|
|
FmgrInfo *finfo, Oid typioparam)
|
2011-02-18 02:11:50 +01:00
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
int i;
|
2011-02-18 02:11:50 +01:00
|
|
|
int len = av_len(av) + 1;
|
|
|
|
|
|
|
|
for (i = 0; i < len; i++)
|
|
|
|
{
|
2011-08-17 17:59:18 +02:00
|
|
|
/* fetch the array element */
|
2011-02-18 02:11:50 +01:00
|
|
|
SV **svp = av_fetch(av, i, FALSE);
|
2011-08-17 17:59:18 +02:00
|
|
|
|
|
|
|
/* see if this element is an array, if so get that */
|
2011-02-18 02:11:50 +01:00
|
|
|
SV *sav = svp ? get_perl_array_ref(*svp) : NULL;
|
|
|
|
|
2011-08-17 17:59:18 +02:00
|
|
|
/* multi-dimensional array? */
|
2011-02-18 02:11:50 +01:00
|
|
|
if (sav)
|
|
|
|
{
|
|
|
|
AV *nav = (AV *) SvRV(sav);
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* dimensionality checks */
|
2011-02-18 02:11:50 +01:00
|
|
|
if (cur_depth + 1 > MAXDIM)
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
|
|
|
|
errmsg("number of array dimensions (%d) exceeds the maximum allowed (%d)",
|
|
|
|
cur_depth + 1, MAXDIM)));
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* set size when at first element in this level, else compare */
|
2011-02-18 02:11:50 +01:00
|
|
|
if (i == 0 && *ndims == cur_depth)
|
|
|
|
{
|
|
|
|
dims[*ndims] = av_len(nav) + 1;
|
|
|
|
(*ndims)++;
|
|
|
|
}
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
else if (av_len(nav) + 1 != dims[cur_depth])
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
|
|
|
|
errmsg("multidimensional arrays must have array expressions with matching dimensions")));
|
|
|
|
|
|
|
|
/* recurse to fetch elements of this sub-array */
|
2014-11-25 18:21:22 +01:00
|
|
|
array_to_datum_internal(nav, astate,
|
|
|
|
ndims, dims, cur_depth + 1,
|
|
|
|
arraytypid, elemtypid, typmod,
|
|
|
|
finfo, typioparam);
|
2011-02-18 02:11:50 +01:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
Datum dat;
|
2011-02-18 02:11:50 +01:00
|
|
|
bool isnull;
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* scalar after some sub-arrays at same level? */
|
|
|
|
if (*ndims != cur_depth)
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
|
|
|
|
errmsg("multidimensional arrays must have array expressions with matching dimensions")));
|
|
|
|
|
|
|
|
dat = plperl_sv_to_datum(svp ? *svp : NULL,
|
|
|
|
elemtypid,
|
|
|
|
typmod,
|
|
|
|
NULL,
|
|
|
|
finfo,
|
|
|
|
typioparam,
|
|
|
|
&isnull);
|
|
|
|
|
2014-11-25 18:21:22 +01:00
|
|
|
(void) accumArrayResult(astate, dat, isnull,
|
|
|
|
elemtypid, CurrentMemoryContext);
|
2011-02-18 02:11:50 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
/*
|
|
|
|
* convert perl array ref to a datum
|
|
|
|
*/
|
|
|
|
static Datum
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
plperl_array_to_datum(SV *src, Oid typid, int32 typmod)
|
2011-02-18 02:11:50 +01:00
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
ArrayBuildState *astate;
|
|
|
|
Oid elemtypid;
|
|
|
|
FmgrInfo finfo;
|
|
|
|
Oid typioparam;
|
2011-02-18 02:11:50 +01:00
|
|
|
int dims[MAXDIM];
|
|
|
|
int lbs[MAXDIM];
|
|
|
|
int ndims = 1;
|
|
|
|
int i;
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
elemtypid = get_element_type(typid);
|
|
|
|
if (!elemtypid)
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
|
|
|
errmsg("cannot convert Perl array to non-array type %s",
|
|
|
|
format_type_be(typid))));
|
|
|
|
|
2015-02-22 02:24:48 +01:00
|
|
|
astate = initArrayResult(elemtypid, CurrentMemoryContext, true);
|
2014-11-25 18:21:22 +01:00
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
_sv_to_datum_finfo(elemtypid, &finfo, &typioparam);
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
memset(dims, 0, sizeof(dims));
|
|
|
|
dims[0] = av_len((AV *) SvRV(src)) + 1;
|
|
|
|
|
2014-11-25 18:21:22 +01:00
|
|
|
array_to_datum_internal((AV *) SvRV(src), astate,
|
|
|
|
&ndims, dims, 1,
|
|
|
|
typid, elemtypid, typmod,
|
|
|
|
&finfo, typioparam);
|
2011-02-18 02:11:50 +01:00
|
|
|
|
2014-11-25 18:21:22 +01:00
|
|
|
/* ensure we get zero-D array for no inputs, as per PG convention */
|
|
|
|
if (dims[0] <= 0)
|
|
|
|
ndims = 0;
|
2011-08-17 17:59:18 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
for (i = 0; i < ndims; i++)
|
|
|
|
lbs[i] = 1;
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
return makeMdArrayResult(astate, ndims, dims, lbs,
|
|
|
|
CurrentMemoryContext, true);
|
2011-02-18 02:11:50 +01:00
|
|
|
}
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* Get the information needed to convert data to the specified PG type */
|
2011-02-18 02:11:50 +01:00
|
|
|
static void
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
_sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam)
|
2011-02-18 02:11:50 +01:00
|
|
|
{
|
|
|
|
Oid typinput;
|
|
|
|
|
|
|
|
/* XXX would be better to cache these lookups */
|
|
|
|
getTypeInputInfo(typid,
|
|
|
|
&typinput, typioparam);
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
fmgr_info(typinput, finfo);
|
2011-02-18 02:11:50 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
/*
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
* convert Perl SV to PG datum of type typid, typmod typmod
|
|
|
|
*
|
|
|
|
* Pass the PL/Perl function's fcinfo when attempting to convert to the
|
|
|
|
* function's result type; otherwise pass NULL. This is used when we need to
|
|
|
|
* resolve the actual result type of a function returning RECORD.
|
|
|
|
*
|
|
|
|
* finfo and typioparam should be the results of _sv_to_datum_finfo for the
|
|
|
|
* given typid, or NULL/InvalidOid to let this function do the lookups.
|
|
|
|
*
|
|
|
|
* *isnull is an output parameter.
|
2011-02-18 02:11:50 +01:00
|
|
|
*/
|
|
|
|
static Datum
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
|
|
|
|
FunctionCallInfo fcinfo,
|
|
|
|
FmgrInfo *finfo, Oid typioparam,
|
|
|
|
bool *isnull)
|
2011-02-18 02:11:50 +01:00
|
|
|
{
|
|
|
|
FmgrInfo tmp;
|
2015-04-26 16:33:14 +02:00
|
|
|
Oid funcid;
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
/* we might recurse */
|
|
|
|
check_stack_depth();
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
*isnull = false;
|
2011-02-18 02:11:50 +01:00
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/*
|
|
|
|
* Return NULL if result is undef, or if we're in a function returning
|
|
|
|
* VOID. In the latter case, we should pay no attention to the last Perl
|
|
|
|
* statement's result, and this is a convenient means to ensure that.
|
|
|
|
*/
|
|
|
|
if (!sv || !SvOK(sv) || typid == VOIDOID)
|
2011-02-18 02:11:50 +01:00
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* look up type info if they did not pass it */
|
2011-02-18 02:11:50 +01:00
|
|
|
if (!finfo)
|
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
_sv_to_datum_finfo(typid, &tmp, &typioparam);
|
2011-02-18 02:11:50 +01:00
|
|
|
finfo = &tmp;
|
|
|
|
}
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
*isnull = true;
|
|
|
|
/* must call typinput in case it wants to reject NULL */
|
2011-02-18 02:11:50 +01:00
|
|
|
return InputFunctionCall(finfo, NULL, typioparam, typmod);
|
|
|
|
}
|
2015-04-26 16:33:14 +02:00
|
|
|
else if ((funcid = get_transform_tosql(typid, current_call_data->prodesc->lang_oid, current_call_data->prodesc->trftypes)))
|
|
|
|
return OidFunctionCall1(funcid, PointerGetDatum(sv));
|
2011-02-18 02:11:50 +01:00
|
|
|
else if (SvROK(sv))
|
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* handle references */
|
2011-02-18 02:11:50 +01:00
|
|
|
SV *sav = get_perl_array_ref(sv);
|
|
|
|
|
|
|
|
if (sav)
|
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* handle an arrayref */
|
|
|
|
return plperl_array_to_datum(sav, typid, typmod);
|
2011-02-18 02:11:50 +01:00
|
|
|
}
|
|
|
|
else if (SvTYPE(SvRV(sv)) == SVt_PVHV)
|
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* handle a hashref */
|
|
|
|
Datum ret;
|
|
|
|
TupleDesc td;
|
2011-02-18 02:11:50 +01:00
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
if (!type_is_rowtype(typid))
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
2012-06-10 21:20:04 +02:00
|
|
|
errmsg("cannot convert Perl hash to non-composite type %s",
|
|
|
|
format_type_be(typid))));
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
|
|
|
|
td = lookup_rowtype_tupdesc_noerror(typid, typmod, true);
|
|
|
|
if (td == NULL)
|
|
|
|
{
|
|
|
|
/* Try to look it up based on our result type */
|
|
|
|
if (fcinfo == NULL ||
|
2012-06-10 21:20:04 +02:00
|
|
|
get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
2012-06-10 21:20:04 +02:00
|
|
|
errmsg("function returning record called in context "
|
|
|
|
"that cannot accept type record")));
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
ret = plperl_hash_to_datum(sv, td);
|
|
|
|
|
|
|
|
/* Release on the result of get_call_result_type is harmless */
|
2011-02-18 02:11:50 +01:00
|
|
|
ReleaseTupleDesc(td);
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
return ret;
|
|
|
|
}
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* Reference, but not reference to hash or array ... */
|
2011-02-18 02:11:50 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
2011-04-10 17:42:00 +02:00
|
|
|
errmsg("PL/Perl function must return reference to hash or array")));
|
2011-02-18 02:11:50 +01:00
|
|
|
return (Datum) 0; /* shut up compiler */
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* handle a string/number */
|
2011-02-18 02:11:50 +01:00
|
|
|
Datum ret;
|
|
|
|
char *str = sv2cstr(sv);
|
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
/* did not pass in any typeinfo? look it up */
|
2011-02-18 02:11:50 +01:00
|
|
|
if (!finfo)
|
|
|
|
{
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
_sv_to_datum_finfo(typid, &tmp, &typioparam);
|
2011-02-18 02:11:50 +01:00
|
|
|
finfo = &tmp;
|
|
|
|
}
|
|
|
|
|
|
|
|
ret = InputFunctionCall(finfo, str, typioparam, typmod);
|
|
|
|
pfree(str);
|
|
|
|
|
|
|
|
return ret;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Convert the perl SV to a string returned by the type output function */
|
|
|
|
char *
|
|
|
|
plperl_sv_to_literal(SV *sv, char *fqtypename)
|
|
|
|
{
|
|
|
|
Datum str = CStringGetDatum(fqtypename);
|
|
|
|
Oid typid = DirectFunctionCall1(regtypein, str);
|
|
|
|
Oid typoutput;
|
|
|
|
Datum datum;
|
|
|
|
bool typisvarlena,
|
|
|
|
isnull;
|
|
|
|
|
|
|
|
if (!OidIsValid(typid))
|
2015-08-03 05:49:19 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_UNDEFINED_OBJECT),
|
|
|
|
errmsg("lookup failed for type %s", fqtypename)));
|
2011-02-18 02:11:50 +01:00
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
datum = plperl_sv_to_datum(sv,
|
|
|
|
typid, -1,
|
|
|
|
NULL, NULL, InvalidOid,
|
|
|
|
&isnull);
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
if (isnull)
|
|
|
|
return NULL;
|
|
|
|
|
|
|
|
getTypeOutputInfo(typid,
|
|
|
|
&typoutput, &typisvarlena);
|
|
|
|
|
|
|
|
return OidOutputFunctionCall(typoutput, datum);
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
|
|
|
|
2005-07-10 17:32:47 +02:00
|
|
|
/*
|
2011-02-18 02:11:50 +01:00
|
|
|
* Convert PostgreSQL array datum to a perl array reference.
|
|
|
|
*
|
|
|
|
* typid is arg's OID, which must be an array type.
|
2005-07-10 17:32:47 +02:00
|
|
|
*/
|
2005-10-15 04:49:52 +02:00
|
|
|
static SV *
|
2011-02-18 02:11:50 +01:00
|
|
|
plperl_ref_from_pg_array(Datum arg, Oid typid)
|
2005-07-10 17:32:47 +02:00
|
|
|
{
|
2011-02-18 02:11:50 +01:00
|
|
|
ArrayType *ar = DatumGetArrayTypeP(arg);
|
|
|
|
Oid elementtype = ARR_ELEMTYPE(ar);
|
|
|
|
int16 typlen;
|
|
|
|
bool typbyval;
|
|
|
|
char typalign,
|
|
|
|
typdelim;
|
|
|
|
Oid typioparam;
|
|
|
|
Oid typoutputfunc;
|
2015-04-26 16:33:14 +02:00
|
|
|
Oid transform_funcid;
|
2011-02-18 02:11:50 +01:00
|
|
|
int i,
|
|
|
|
nitems,
|
|
|
|
*dims;
|
|
|
|
plperl_array_info *info;
|
|
|
|
SV *av;
|
|
|
|
HV *hv;
|
2010-02-26 03:01:40 +01:00
|
|
|
|
2016-09-01 01:54:58 +02:00
|
|
|
/*
|
|
|
|
* Currently we make no effort to cache any of the stuff we look up here,
|
|
|
|
* which is bad.
|
|
|
|
*/
|
2015-04-26 16:33:14 +02:00
|
|
|
info = palloc0(sizeof(plperl_array_info));
|
2005-07-10 17:32:47 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/* get element type information, including output conversion function */
|
|
|
|
get_type_io_data(elementtype, IOFunc_output,
|
|
|
|
&typlen, &typbyval, &typalign,
|
|
|
|
&typdelim, &typioparam, &typoutputfunc);
|
2005-07-10 17:32:47 +02:00
|
|
|
|
2016-09-01 01:54:58 +02:00
|
|
|
/* Check for a transform function */
|
|
|
|
transform_funcid = get_transform_fromsql(elementtype,
|
|
|
|
current_call_data->prodesc->lang_oid,
|
|
|
|
current_call_data->prodesc->trftypes);
|
|
|
|
|
|
|
|
/* Look up transform or output function as appropriate */
|
|
|
|
if (OidIsValid(transform_funcid))
|
|
|
|
fmgr_info(transform_funcid, &info->transform_proc);
|
2015-04-26 16:33:14 +02:00
|
|
|
else
|
2016-09-01 01:54:58 +02:00
|
|
|
fmgr_info(typoutputfunc, &info->proc);
|
2005-07-10 17:32:47 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
info->elem_is_rowtype = type_is_rowtype(elementtype);
|
2005-07-10 17:32:47 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/* Get the number and bounds of array dimensions */
|
|
|
|
info->ndims = ARR_NDIM(ar);
|
|
|
|
dims = ARR_DIMS(ar);
|
2005-07-10 17:32:47 +02:00
|
|
|
|
2016-03-08 22:33:24 +01:00
|
|
|
/* No dimensions? Return an empty array */
|
|
|
|
if (info->ndims == 0)
|
|
|
|
{
|
|
|
|
av = newRV_noinc((SV *) newAV());
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
deconstruct_array(ar, elementtype, typlen, typbyval,
|
|
|
|
typalign, &info->elements, &info->nulls,
|
|
|
|
&nitems);
|
2005-07-10 17:32:47 +02:00
|
|
|
|
2016-03-08 22:33:24 +01:00
|
|
|
/* Get total number of elements in each dimension */
|
|
|
|
info->nelems = palloc(sizeof(int) * info->ndims);
|
|
|
|
info->nelems[0] = nitems;
|
|
|
|
for (i = 1; i < info->ndims; i++)
|
|
|
|
info->nelems[i] = info->nelems[i - 1] / dims[i - 1];
|
2005-10-15 04:49:52 +02:00
|
|
|
|
2016-03-08 22:33:24 +01:00
|
|
|
av = split_array(info, 0, nitems, 0);
|
|
|
|
}
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
hv = newHV();
|
|
|
|
(void) hv_store(hv, "array", 5, av, 0);
|
Widen query numbers-of-tuples-processed counters to uint64.
This patch widens SPI_processed, EState's es_processed field, PortalData's
portalPos field, FuncCallContext's call_cntr and max_calls fields,
ExecutorRun's count argument, PortalRunFetch's result, and the max number
of rows in a SPITupleTable to uint64, and deals with (I hope) all the
ensuing fallout. Some of these values were declared uint32 before, and
others "long".
I also removed PortalData's posOverflow field, since that logic seems
pretty useless given that portalPos is now always 64 bits.
The user-visible results are that command tags for SELECT etc will
correctly report tuple counts larger than 4G, as will plpgsql's GET
GET DIAGNOSTICS ... ROW_COUNT command. Queries processing more tuples
than that are still not exactly the norm, but they're becoming more
common.
Most values associated with FETCH/MOVE distances, such as PortalRun's count
argument and the count argument of most SPI functions that have one, remain
declared as "long". It's not clear whether it would be worth promoting
those to int64; but it would definitely be a large dollop of additional
API churn on top of this, and it would only help 32-bit platforms which
seem relatively less likely to see any benefit.
Andreas Scherbaum, reviewed by Christian Ullrich, additional hacking by me
2016-03-12 22:05:10 +01:00
|
|
|
(void) hv_store(hv, "typeoid", 7, newSVuv(typid), 0);
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
return sv_bless(newRV_noinc((SV *) hv),
|
|
|
|
gv_stashpv("PostgreSQL::InServer::ARRAY", 0));
|
2005-07-10 17:32:47 +02:00
|
|
|
}
|
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/*
|
|
|
|
* Recursively form array references from splices of the initial array
|
|
|
|
*/
|
|
|
|
static SV *
|
|
|
|
split_array(plperl_array_info *info, int first, int last, int nest)
|
|
|
|
{
|
|
|
|
int i;
|
|
|
|
AV *result;
|
2004-10-15 19:08:26 +02:00
|
|
|
|
2016-03-08 22:33:24 +01:00
|
|
|
/* we should only be called when we have something to split */
|
|
|
|
Assert(info->ndims > 0);
|
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/* since this function recurses, it could be driven to stack overflow */
|
|
|
|
check_stack_depth();
|
|
|
|
|
|
|
|
/*
|
|
|
|
* Base case, return a reference to a single-dimensional array
|
|
|
|
*/
|
|
|
|
if (nest >= info->ndims - 1)
|
|
|
|
return make_array_ref(info, first, last);
|
|
|
|
|
|
|
|
result = newAV();
|
|
|
|
for (i = first; i < last; i += info->nelems[nest + 1])
|
|
|
|
{
|
|
|
|
/* Recursively form references to arrays of lower dimensions */
|
|
|
|
SV *ref = split_array(info, i, i + info->nelems[nest + 1], nest + 1);
|
|
|
|
|
|
|
|
av_push(result, ref);
|
|
|
|
}
|
|
|
|
return newRV_noinc((SV *) result);
|
|
|
|
}
|
|
|
|
|
|
|
|
/*
|
|
|
|
* Create a Perl reference from a one-dimensional C array, converting
|
|
|
|
* composite type elements to hash references.
|
|
|
|
*/
|
|
|
|
static SV *
|
|
|
|
make_array_ref(plperl_array_info *info, int first, int last)
|
|
|
|
{
|
|
|
|
int i;
|
|
|
|
AV *result = newAV();
|
|
|
|
|
|
|
|
for (i = first; i < last; i++)
|
|
|
|
{
|
|
|
|
if (info->nulls[i])
|
2011-05-30 18:15:13 +02:00
|
|
|
{
|
|
|
|
/*
|
|
|
|
* We can't use &PL_sv_undef here. See "AVs, HVs and undefined
|
|
|
|
* values" in perlguts.
|
|
|
|
*/
|
|
|
|
av_push(result, newSV(0));
|
|
|
|
}
|
2011-02-18 02:11:50 +01:00
|
|
|
else
|
|
|
|
{
|
|
|
|
Datum itemvalue = info->elements[i];
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2015-04-26 16:33:14 +02:00
|
|
|
if (info->transform_proc.fn_oid)
|
|
|
|
av_push(result, (SV *) DatumGetPointer(FunctionCall1(&info->transform_proc, itemvalue)));
|
|
|
|
else if (info->elem_is_rowtype)
|
|
|
|
/* Handle composite type elements */
|
2011-02-18 02:11:50 +01:00
|
|
|
av_push(result, plperl_hash_from_datum(itemvalue));
|
|
|
|
else
|
|
|
|
{
|
|
|
|
char *val = OutputFunctionCall(&info->proc, itemvalue);
|
|
|
|
|
|
|
|
av_push(result, cstr2sv(val));
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return newRV_noinc((SV *) result);
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Set up the arguments for a trigger call. */
|
2004-07-01 22:50:22 +02:00
|
|
|
static SV *
|
|
|
|
plperl_trigger_build_args(FunctionCallInfo fcinfo)
|
|
|
|
{
|
|
|
|
TriggerData *tdata;
|
|
|
|
TupleDesc tupdesc;
|
2004-11-23 01:21:24 +01:00
|
|
|
int i;
|
2004-10-15 19:08:26 +02:00
|
|
|
char *level;
|
|
|
|
char *event;
|
|
|
|
char *relid;
|
|
|
|
char *when;
|
|
|
|
HV *hv;
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2004-10-15 19:08:26 +02:00
|
|
|
hv = newHV();
|
2010-02-26 03:01:40 +01:00
|
|
|
hv_ksplit(hv, 12); /* pre-grow the hash */
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
tdata = (TriggerData *) fcinfo->context;
|
|
|
|
tupdesc = tdata->tg_relation->rd_att;
|
|
|
|
|
2004-10-15 19:08:26 +02:00
|
|
|
relid = DatumGetCString(
|
2005-10-15 04:49:52 +02:00
|
|
|
DirectFunctionCall1(oidout,
|
|
|
|
ObjectIdGetDatum(tdata->tg_relation->rd_id)
|
|
|
|
)
|
|
|
|
);
|
2004-10-15 19:08:26 +02:00
|
|
|
|
2011-02-06 23:29:26 +01:00
|
|
|
hv_store_string(hv, "name", cstr2sv(tdata->tg_trigger->tgname));
|
|
|
|
hv_store_string(hv, "relid", cstr2sv(relid));
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
if (TRIGGER_FIRED_BY_INSERT(tdata->tg_event))
|
|
|
|
{
|
2004-10-15 19:08:26 +02:00
|
|
|
event = "INSERT";
|
2005-01-14 17:25:42 +01:00
|
|
|
if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event))
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(hv, "new",
|
|
|
|
plperl_hash_from_tuple(tdata->tg_trigtuple,
|
|
|
|
tupdesc));
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
|
|
|
else if (TRIGGER_FIRED_BY_DELETE(tdata->tg_event))
|
|
|
|
{
|
2004-10-15 19:08:26 +02:00
|
|
|
event = "DELETE";
|
2005-01-14 17:25:42 +01:00
|
|
|
if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event))
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(hv, "old",
|
|
|
|
plperl_hash_from_tuple(tdata->tg_trigtuple,
|
|
|
|
tupdesc));
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
|
|
|
else if (TRIGGER_FIRED_BY_UPDATE(tdata->tg_event))
|
|
|
|
{
|
2004-10-15 19:08:26 +02:00
|
|
|
event = "UPDATE";
|
2005-01-14 17:25:42 +01:00
|
|
|
if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event))
|
|
|
|
{
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(hv, "old",
|
|
|
|
plperl_hash_from_tuple(tdata->tg_trigtuple,
|
|
|
|
tupdesc));
|
|
|
|
hv_store_string(hv, "new",
|
|
|
|
plperl_hash_from_tuple(tdata->tg_newtuple,
|
|
|
|
tupdesc));
|
2005-01-14 17:25:42 +01:00
|
|
|
}
|
2004-10-15 19:08:26 +02:00
|
|
|
}
|
2008-03-28 01:21:56 +01:00
|
|
|
else if (TRIGGER_FIRED_BY_TRUNCATE(tdata->tg_event))
|
|
|
|
event = "TRUNCATE";
|
2005-01-14 17:25:42 +01:00
|
|
|
else
|
2004-10-15 19:08:26 +02:00
|
|
|
event = "UNKNOWN";
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2011-02-06 23:29:26 +01:00
|
|
|
hv_store_string(hv, "event", cstr2sv(event));
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(hv, "argc", newSViv(tdata->tg_trigger->tgnargs));
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2005-01-14 17:25:42 +01:00
|
|
|
if (tdata->tg_trigger->tgnargs > 0)
|
2004-07-01 22:50:22 +02:00
|
|
|
{
|
2005-10-15 04:49:52 +02:00
|
|
|
AV *av = newAV();
|
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
av_extend(av, tdata->tg_trigger->tgnargs);
|
2005-10-15 04:49:52 +02:00
|
|
|
for (i = 0; i < tdata->tg_trigger->tgnargs; i++)
|
2011-02-06 23:29:26 +01:00
|
|
|
av_push(av, cstr2sv(tdata->tg_trigger->tgargs[i]));
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(hv, "args", newRV_noinc((SV *) av));
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
2004-10-15 19:08:26 +02:00
|
|
|
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(hv, "relname",
|
2011-02-06 23:29:26 +01:00
|
|
|
cstr2sv(SPI_getrelname(tdata->tg_relation)));
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(hv, "table_name",
|
2011-02-06 23:29:26 +01:00
|
|
|
cstr2sv(SPI_getrelname(tdata->tg_relation)));
|
2006-05-26 19:34:16 +02:00
|
|
|
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(hv, "table_schema",
|
2011-02-06 23:29:26 +01:00
|
|
|
cstr2sv(SPI_getnspname(tdata->tg_relation)));
|
2006-05-26 19:34:16 +02:00
|
|
|
|
2004-07-01 22:50:22 +02:00
|
|
|
if (TRIGGER_FIRED_BEFORE(tdata->tg_event))
|
2004-10-15 19:08:26 +02:00
|
|
|
when = "BEFORE";
|
2004-07-01 22:50:22 +02:00
|
|
|
else if (TRIGGER_FIRED_AFTER(tdata->tg_event))
|
2004-10-15 19:08:26 +02:00
|
|
|
when = "AFTER";
|
2010-10-10 19:43:33 +02:00
|
|
|
else if (TRIGGER_FIRED_INSTEAD(tdata->tg_event))
|
|
|
|
when = "INSTEAD OF";
|
2004-07-01 22:50:22 +02:00
|
|
|
else
|
2004-10-15 19:08:26 +02:00
|
|
|
when = "UNKNOWN";
|
2011-02-06 23:29:26 +01:00
|
|
|
hv_store_string(hv, "when", cstr2sv(when));
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event))
|
2004-10-15 19:08:26 +02:00
|
|
|
level = "ROW";
|
2004-07-01 22:50:22 +02:00
|
|
|
else if (TRIGGER_FIRED_FOR_STATEMENT(tdata->tg_event))
|
2004-10-15 19:08:26 +02:00
|
|
|
level = "STATEMENT";
|
2004-07-01 22:50:22 +02:00
|
|
|
else
|
2004-10-15 19:08:26 +02:00
|
|
|
level = "UNKNOWN";
|
2011-02-06 23:29:26 +01:00
|
|
|
hv_store_string(hv, "level", cstr2sv(level));
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2005-10-15 04:49:52 +02:00
|
|
|
return newRV_noinc((SV *) hv);
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2013-12-11 14:11:59 +01:00
|
|
|
/* Set up the arguments for an event trigger call. */
|
|
|
|
static SV *
|
|
|
|
plperl_event_trigger_build_args(FunctionCallInfo fcinfo)
|
|
|
|
{
|
|
|
|
EventTriggerData *tdata;
|
|
|
|
HV *hv;
|
|
|
|
|
|
|
|
hv = newHV();
|
|
|
|
|
|
|
|
tdata = (EventTriggerData *) fcinfo->context;
|
|
|
|
|
|
|
|
hv_store_string(hv, "event", cstr2sv(tdata->event));
|
|
|
|
hv_store_string(hv, "tag", cstr2sv(tdata->tag));
|
|
|
|
|
|
|
|
return newRV_noinc((SV *) hv);
|
|
|
|
}
|
|
|
|
|
2016-11-08 17:35:01 +01:00
|
|
|
/* Construct the modified new tuple to be returned from a trigger. */
|
2004-07-01 22:50:22 +02:00
|
|
|
static HeapTuple
|
2005-11-22 19:17:34 +01:00
|
|
|
plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
|
2004-07-01 22:50:22 +02:00
|
|
|
{
|
|
|
|
SV **svp;
|
|
|
|
HV *hvNew;
|
2011-02-06 23:29:26 +01:00
|
|
|
HE *he;
|
2004-07-01 22:50:22 +02:00
|
|
|
HeapTuple rtup;
|
|
|
|
TupleDesc tupdesc;
|
2016-11-08 17:35:01 +01:00
|
|
|
int natts;
|
|
|
|
Datum *modvalues;
|
|
|
|
bool *modnulls;
|
|
|
|
bool *modrepls;
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2006-10-15 20:56:39 +02:00
|
|
|
svp = hv_fetch_string(hvTD, "new");
|
2004-11-23 01:21:24 +01:00
|
|
|
if (!svp)
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_UNDEFINED_COLUMN),
|
|
|
|
errmsg("$_TD->{new} does not exist")));
|
2010-03-09 23:34:38 +01:00
|
|
|
if (!SvOK(*svp) || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV)
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
|
|
|
errmsg("$_TD->{new} is not a hash reference")));
|
2004-07-01 22:50:22 +02:00
|
|
|
hvNew = (HV *) SvRV(*svp);
|
|
|
|
|
2016-11-08 17:35:01 +01:00
|
|
|
tupdesc = tdata->tg_relation->rd_att;
|
|
|
|
natts = tupdesc->natts;
|
|
|
|
|
|
|
|
modvalues = (Datum *) palloc0(natts * sizeof(Datum));
|
|
|
|
modnulls = (bool *) palloc0(natts * sizeof(bool));
|
|
|
|
modrepls = (bool *) palloc0(natts * sizeof(bool));
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2004-11-23 01:21:24 +01:00
|
|
|
hv_iterinit(hvNew);
|
2011-02-06 23:29:26 +01:00
|
|
|
while ((he = hv_iternext(hvNew)))
|
2004-07-01 22:50:22 +02:00
|
|
|
{
|
2011-02-17 20:40:13 +01:00
|
|
|
char *key = hek2cstr(he);
|
2011-02-18 02:11:50 +01:00
|
|
|
SV *val = HeVAL(he);
|
2011-02-06 23:29:26 +01:00
|
|
|
int attn = SPI_fnumber(tupdesc, key);
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2016-11-08 17:35:01 +01:00
|
|
|
if (attn == SPI_ERROR_NOATTRIBUTE)
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_UNDEFINED_COLUMN),
|
|
|
|
errmsg("Perl hash contains nonexistent column \"%s\"",
|
|
|
|
key)));
|
2016-11-08 17:35:01 +01:00
|
|
|
if (attn <= 0)
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
|
|
|
errmsg("cannot set system attribute \"%s\"",
|
|
|
|
key)));
|
2011-02-18 02:11:50 +01:00
|
|
|
|
2016-11-08 17:35:01 +01:00
|
|
|
modvalues[attn - 1] = plperl_sv_to_datum(val,
|
2011-02-18 02:11:50 +01:00
|
|
|
tupdesc->attrs[attn - 1]->atttypid,
|
|
|
|
tupdesc->attrs[attn - 1]->atttypmod,
|
2016-11-08 17:35:01 +01:00
|
|
|
NULL,
|
|
|
|
NULL,
|
|
|
|
InvalidOid,
|
|
|
|
&modnulls[attn - 1]);
|
|
|
|
modrepls[attn - 1] = true;
|
2011-02-06 23:29:26 +01:00
|
|
|
|
|
|
|
pfree(key);
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
2004-11-23 01:21:24 +01:00
|
|
|
hv_iterinit(hvNew);
|
|
|
|
|
2016-11-08 17:35:01 +01:00
|
|
|
rtup = heap_modify_tuple(otup, tupdesc, modvalues, modnulls, modrepls);
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
pfree(modvalues);
|
|
|
|
pfree(modnulls);
|
2016-11-08 17:35:01 +01:00
|
|
|
pfree(modrepls);
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
return rtup;
|
|
|
|
}
|
2000-01-20 06:08:58 +01:00
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2005-06-22 18:45:51 +02:00
|
|
|
/*
|
2009-11-29 04:02:27 +01:00
|
|
|
* There are three externally visible pieces to plperl: plperl_call_handler,
|
|
|
|
* plperl_inline_handler, and plperl_validator.
|
|
|
|
*/
|
|
|
|
|
|
|
|
/*
|
|
|
|
* The call handler is called to run normal functions (including trigger
|
|
|
|
* functions) that are defined in pg_proc.
|
2005-06-22 18:45:51 +02:00
|
|
|
*/
|
2000-11-20 21:36:57 +01:00
|
|
|
PG_FUNCTION_INFO_V1(plperl_call_handler);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
Datum
|
2000-05-28 19:56:29 +02:00
|
|
|
plperl_call_handler(PG_FUNCTION_ARGS)
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
2005-10-15 04:49:52 +02:00
|
|
|
Datum retval;
|
2017-01-23 15:15:49 +01:00
|
|
|
plperl_call_data *volatile save_call_data = current_call_data;
|
|
|
|
plperl_interp_desc *volatile oldinterp = plperl_active_interp;
|
2012-09-13 19:44:20 +02:00
|
|
|
plperl_call_data this_call_data;
|
|
|
|
|
|
|
|
/* Initialize current-call status record */
|
|
|
|
MemSet(&this_call_data, 0, sizeof(this_call_data));
|
|
|
|
this_call_data.fcinfo = fcinfo;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2004-09-13 22:10:13 +02:00
|
|
|
PG_TRY();
|
|
|
|
{
|
2012-09-13 19:44:20 +02:00
|
|
|
current_call_data = &this_call_data;
|
2004-09-13 22:10:13 +02:00
|
|
|
if (CALLED_AS_TRIGGER(fcinfo))
|
|
|
|
retval = PointerGetDatum(plperl_trigger_handler(fcinfo));
|
2013-12-11 14:11:59 +01:00
|
|
|
else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
|
|
|
|
{
|
|
|
|
plperl_event_trigger_handler(fcinfo);
|
|
|
|
retval = (Datum) 0;
|
|
|
|
}
|
2004-09-13 22:10:13 +02:00
|
|
|
else
|
|
|
|
retval = plperl_func_handler(fcinfo);
|
|
|
|
}
|
|
|
|
PG_CATCH();
|
|
|
|
{
|
2006-01-28 04:28:15 +01:00
|
|
|
current_call_data = save_call_data;
|
2010-09-30 23:18:51 +02:00
|
|
|
activate_interpreter(oldinterp);
|
2016-09-01 01:54:58 +02:00
|
|
|
if (this_call_data.prodesc)
|
|
|
|
decrement_prodesc_refcount(this_call_data.prodesc);
|
2004-09-13 22:10:13 +02:00
|
|
|
PG_RE_THROW();
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
current_call_data = save_call_data;
|
2010-09-30 23:18:51 +02:00
|
|
|
activate_interpreter(oldinterp);
|
2016-09-01 01:54:58 +02:00
|
|
|
if (this_call_data.prodesc)
|
|
|
|
decrement_prodesc_refcount(this_call_data.prodesc);
|
2000-01-20 06:08:58 +01:00
|
|
|
return retval;
|
|
|
|
}
|
|
|
|
|
2005-06-22 18:45:51 +02:00
|
|
|
/*
|
2009-11-29 04:02:27 +01:00
|
|
|
* The inline handler runs anonymous code blocks (DO blocks).
|
|
|
|
*/
|
|
|
|
PG_FUNCTION_INFO_V1(plperl_inline_handler);
|
|
|
|
|
|
|
|
Datum
|
|
|
|
plperl_inline_handler(PG_FUNCTION_ARGS)
|
|
|
|
{
|
|
|
|
InlineCodeBlock *codeblock = (InlineCodeBlock *) PG_GETARG_POINTER(0);
|
|
|
|
FunctionCallInfoData fake_fcinfo;
|
2010-02-26 03:01:40 +01:00
|
|
|
FmgrInfo flinfo;
|
2009-11-29 04:02:27 +01:00
|
|
|
plperl_proc_desc desc;
|
2017-01-23 15:15:49 +01:00
|
|
|
plperl_call_data *volatile save_call_data = current_call_data;
|
|
|
|
plperl_interp_desc *volatile oldinterp = plperl_active_interp;
|
2012-09-13 19:44:20 +02:00
|
|
|
plperl_call_data this_call_data;
|
2009-11-29 04:02:27 +01:00
|
|
|
ErrorContextCallback pl_error_context;
|
|
|
|
|
2012-09-13 19:44:20 +02:00
|
|
|
/* Initialize current-call status record */
|
|
|
|
MemSet(&this_call_data, 0, sizeof(this_call_data));
|
|
|
|
|
2009-11-29 04:02:27 +01:00
|
|
|
/* Set up a callback for error reporting */
|
|
|
|
pl_error_context.callback = plperl_inline_callback;
|
|
|
|
pl_error_context.previous = error_context_stack;
|
2014-02-05 02:04:35 +01:00
|
|
|
pl_error_context.arg = NULL;
|
2009-11-29 04:02:27 +01:00
|
|
|
error_context_stack = &pl_error_context;
|
|
|
|
|
|
|
|
/*
|
|
|
|
* Set up a fake fcinfo and descriptor with just enough info to satisfy
|
|
|
|
* plperl_call_perl_func(). In particular note that this sets things up
|
|
|
|
* with no arguments passed, and a result type of VOID.
|
|
|
|
*/
|
|
|
|
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 = "inline_code_block";
|
|
|
|
desc.fn_readonly = false;
|
|
|
|
|
2015-04-26 16:33:14 +02:00
|
|
|
desc.lang_oid = codeblock->langOid;
|
|
|
|
desc.trftypes = NIL;
|
2009-11-29 04:02:27 +01:00
|
|
|
desc.lanpltrusted = codeblock->langIsTrusted;
|
|
|
|
|
|
|
|
desc.fn_retistuple = false;
|
|
|
|
desc.fn_retisset = false;
|
|
|
|
desc.fn_retisarray = false;
|
|
|
|
desc.result_oid = VOIDOID;
|
|
|
|
desc.nargs = 0;
|
|
|
|
desc.reference = NULL;
|
|
|
|
|
2012-09-13 19:44:20 +02:00
|
|
|
this_call_data.fcinfo = &fake_fcinfo;
|
|
|
|
this_call_data.prodesc = &desc;
|
|
|
|
/* we do not bother with refcounting the fake prodesc */
|
|
|
|
|
2009-11-29 04:02:27 +01:00
|
|
|
PG_TRY();
|
|
|
|
{
|
|
|
|
SV *perlret;
|
|
|
|
|
2012-09-13 19:44:20 +02:00
|
|
|
current_call_data = &this_call_data;
|
2012-09-10 02:32:54 +02:00
|
|
|
|
2009-11-29 04:02:27 +01:00
|
|
|
if (SPI_connect() != SPI_OK_CONNECT)
|
|
|
|
elog(ERROR, "could not connect to SPI manager");
|
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
select_perl_context(desc.lanpltrusted);
|
2009-11-29 04:02:27 +01:00
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
plperl_create_sub(&desc, codeblock->source_text, 0);
|
2009-11-29 04:02:27 +01:00
|
|
|
|
|
|
|
if (!desc.reference) /* can this happen? */
|
|
|
|
elog(ERROR, "could not create internal procedure for anonymous code block");
|
|
|
|
|
|
|
|
perlret = plperl_call_perl_func(&desc, &fake_fcinfo);
|
|
|
|
|
|
|
|
SvREFCNT_dec(perlret);
|
|
|
|
|
|
|
|
if (SPI_finish() != SPI_OK_FINISH)
|
|
|
|
elog(ERROR, "SPI_finish() failed");
|
|
|
|
}
|
|
|
|
PG_CATCH();
|
|
|
|
{
|
|
|
|
if (desc.reference)
|
|
|
|
SvREFCNT_dec(desc.reference);
|
2010-04-18 21:16:06 +02:00
|
|
|
current_call_data = save_call_data;
|
2010-09-30 23:18:51 +02:00
|
|
|
activate_interpreter(oldinterp);
|
2009-11-29 04:02:27 +01:00
|
|
|
PG_RE_THROW();
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
|
|
|
|
|
|
|
if (desc.reference)
|
|
|
|
SvREFCNT_dec(desc.reference);
|
|
|
|
|
2010-04-18 21:16:06 +02:00
|
|
|
current_call_data = save_call_data;
|
2010-09-30 23:18:51 +02:00
|
|
|
activate_interpreter(oldinterp);
|
2010-04-18 21:16:06 +02:00
|
|
|
|
2009-11-29 04:02:27 +01:00
|
|
|
error_context_stack = pl_error_context.previous;
|
|
|
|
|
|
|
|
PG_RETURN_VOID();
|
|
|
|
}
|
|
|
|
|
|
|
|
/*
|
|
|
|
* The validator is called during CREATE FUNCTION to validate the function
|
|
|
|
* being created/replaced. The precise behavior of the validator may be
|
|
|
|
* modified by the check_function_bodies GUC.
|
2005-06-22 18:45:51 +02:00
|
|
|
*/
|
|
|
|
PG_FUNCTION_INFO_V1(plperl_validator);
|
|
|
|
|
|
|
|
Datum
|
|
|
|
plperl_validator(PG_FUNCTION_ARGS)
|
|
|
|
{
|
|
|
|
Oid funcoid = PG_GETARG_OID(0);
|
|
|
|
HeapTuple tuple;
|
|
|
|
Form_pg_proc proc;
|
2005-12-28 19:34:16 +01:00
|
|
|
char functyptype;
|
2006-08-13 19:31:10 +02:00
|
|
|
int numargs;
|
|
|
|
Oid *argtypes;
|
|
|
|
char **argnames;
|
|
|
|
char *argmodes;
|
2013-12-11 14:11:59 +01:00
|
|
|
bool is_trigger = false;
|
|
|
|
bool is_event_trigger = false;
|
2006-08-13 19:31:10 +02:00
|
|
|
int i;
|
2005-06-22 18:45:51 +02:00
|
|
|
|
2014-02-17 15:33:31 +01:00
|
|
|
if (!CheckFunctionValidatorAccess(fcinfo->flinfo->fn_oid, funcoid))
|
|
|
|
PG_RETURN_VOID();
|
|
|
|
|
2005-06-22 18:45:51 +02:00
|
|
|
/* Get the new function's pg_proc entry */
|
2010-02-14 19:42:19 +01:00
|
|
|
tuple = SearchSysCache1(PROCOID, ObjectIdGetDatum(funcoid));
|
2005-06-22 18:45:51 +02:00
|
|
|
if (!HeapTupleIsValid(tuple))
|
|
|
|
elog(ERROR, "cache lookup failed for function %u", funcoid);
|
|
|
|
proc = (Form_pg_proc) GETSTRUCT(tuple);
|
|
|
|
|
2005-12-28 19:34:16 +01:00
|
|
|
functyptype = get_typtype(proc->prorettype);
|
|
|
|
|
|
|
|
/* Disallow pseudotype result */
|
2013-12-11 14:11:59 +01:00
|
|
|
/* except for TRIGGER, EVTTRIGGER, RECORD, or VOID */
|
2007-04-02 05:49:42 +02:00
|
|
|
if (functyptype == TYPTYPE_PSEUDO)
|
2005-12-28 19:34:16 +01:00
|
|
|
{
|
|
|
|
/* we assume OPAQUE with no arguments means a trigger */
|
|
|
|
if (proc->prorettype == TRIGGEROID ||
|
|
|
|
(proc->prorettype == OPAQUEOID && proc->pronargs == 0))
|
2013-12-11 14:11:59 +01:00
|
|
|
is_trigger = true;
|
|
|
|
else if (proc->prorettype == EVTTRIGGEROID)
|
|
|
|
is_event_trigger = true;
|
2005-12-28 19:34:16 +01:00
|
|
|
else if (proc->prorettype != RECORDOID &&
|
|
|
|
proc->prorettype != VOIDOID)
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
2009-02-19 11:33:17 +01:00
|
|
|
errmsg("PL/Perl functions cannot return type %s",
|
2005-12-28 19:34:16 +01:00
|
|
|
format_type_be(proc->prorettype))));
|
|
|
|
}
|
|
|
|
|
2006-08-13 19:31:10 +02:00
|
|
|
/* Disallow pseudotypes in arguments (either IN or OUT) */
|
|
|
|
numargs = get_func_arg_info(tuple,
|
|
|
|
&argtypes, &argnames, &argmodes);
|
|
|
|
for (i = 0; i < numargs; i++)
|
|
|
|
{
|
2010-11-23 21:27:50 +01:00
|
|
|
if (get_typtype(argtypes[i]) == TYPTYPE_PSEUDO &&
|
2010-10-29 02:48:12 +02:00
|
|
|
argtypes[i] != RECORDOID)
|
2006-08-13 19:31:10 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
2009-02-19 11:33:17 +01:00
|
|
|
errmsg("PL/Perl functions cannot accept type %s",
|
2006-08-13 19:31:10 +02:00
|
|
|
format_type_be(argtypes[i]))));
|
|
|
|
}
|
|
|
|
|
2005-06-22 18:45:51 +02:00
|
|
|
ReleaseSysCache(tuple);
|
|
|
|
|
2005-12-28 19:34:16 +01:00
|
|
|
/* Postpone body checks if !check_function_bodies */
|
|
|
|
if (check_function_bodies)
|
|
|
|
{
|
2013-12-11 14:11:59 +01:00
|
|
|
(void) compile_plperl_function(funcoid, is_trigger, is_event_trigger);
|
2005-12-28 19:34:16 +01:00
|
|
|
}
|
2005-06-22 18:45:51 +02:00
|
|
|
|
|
|
|
/* the result of a validator is ignored */
|
|
|
|
PG_RETURN_VOID();
|
|
|
|
}
|
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2011-03-05 03:51:14 +01:00
|
|
|
/*
|
|
|
|
* plperlu likewise requires three externally visible functions:
|
|
|
|
* plperlu_call_handler, plperlu_inline_handler, and plperlu_validator.
|
|
|
|
* These are currently just aliases that send control to the plperl
|
|
|
|
* handler functions, and we decide whether a particular function is
|
|
|
|
* trusted or not by inspecting the actual pg_language tuple.
|
|
|
|
*/
|
|
|
|
|
|
|
|
PG_FUNCTION_INFO_V1(plperlu_call_handler);
|
|
|
|
|
|
|
|
Datum
|
|
|
|
plperlu_call_handler(PG_FUNCTION_ARGS)
|
|
|
|
{
|
|
|
|
return plperl_call_handler(fcinfo);
|
|
|
|
}
|
|
|
|
|
|
|
|
PG_FUNCTION_INFO_V1(plperlu_inline_handler);
|
|
|
|
|
|
|
|
Datum
|
|
|
|
plperlu_inline_handler(PG_FUNCTION_ARGS)
|
|
|
|
{
|
|
|
|
return plperl_inline_handler(fcinfo);
|
|
|
|
}
|
|
|
|
|
|
|
|
PG_FUNCTION_INFO_V1(plperlu_validator);
|
|
|
|
|
|
|
|
Datum
|
|
|
|
plperlu_validator(PG_FUNCTION_ARGS)
|
|
|
|
{
|
2014-02-17 15:33:31 +01:00
|
|
|
/* call plperl validator with our fcinfo so it gets our oid */
|
2011-03-05 03:51:14 +01:00
|
|
|
return plperl_validator(fcinfo);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2006-10-15 20:56:39 +02:00
|
|
|
/*
|
2010-01-27 00:11:56 +01:00
|
|
|
* Uses mksafefunc/mkunsafefunc to create a subroutine whose text is
|
|
|
|
* supplied in s, and returns a reference to it
|
2006-10-15 20:56:39 +02:00
|
|
|
*/
|
2010-01-09 03:40:50 +01:00
|
|
|
static void
|
2010-01-27 00:11:56 +01:00
|
|
|
plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
|
2000-04-12 19:17:23 +02:00
|
|
|
{
|
2000-01-20 06:08:58 +01:00
|
|
|
dSP;
|
2010-02-26 03:01:40 +01:00
|
|
|
char subname[NAMEDATALEN + 40];
|
|
|
|
HV *pragma_hv = newHV();
|
|
|
|
SV *subref = NULL;
|
|
|
|
int count;
|
2010-01-27 00:11:56 +01:00
|
|
|
|
|
|
|
sprintf(subname, "%s__%u", prodesc->proname, fn_oid);
|
|
|
|
|
|
|
|
if (plperl_use_strict)
|
2010-02-26 03:01:40 +01:00
|
|
|
hv_store_string(pragma_hv, "strict", (SV *) newAV());
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
ENTER;
|
|
|
|
SAVETMPS;
|
|
|
|
PUSHMARK(SP);
|
2010-02-26 03:01:40 +01:00
|
|
|
EXTEND(SP, 4);
|
2011-02-06 23:29:26 +01:00
|
|
|
PUSHs(sv_2mortal(cstr2sv(subname)));
|
2010-02-26 03:01:40 +01:00
|
|
|
PUSHs(sv_2mortal(newRV_noinc((SV *) pragma_hv)));
|
2011-02-17 20:40:13 +01:00
|
|
|
|
|
|
|
/*
|
|
|
|
* Use 'false' for $prolog in mkfunc, which is kept for compatibility in
|
|
|
|
* case a module such as PostgreSQL::PLPerl::NYTprof replaces the function
|
|
|
|
* compiler.
|
2011-02-02 18:45:42 +01:00
|
|
|
*/
|
2011-02-17 20:40:13 +01:00
|
|
|
PUSHs(&PL_sv_no);
|
2011-02-06 23:29:26 +01:00
|
|
|
PUSHs(sv_2mortal(cstr2sv(s)));
|
2000-04-18 17:04:02 +02:00
|
|
|
PUTBACK;
|
2003-08-04 02:43:34 +02:00
|
|
|
|
2003-04-20 23:15:34 +02:00
|
|
|
/*
|
|
|
|
* G_KEEPERR seems to be needed here, else we don't recognize compile
|
2005-10-15 04:49:52 +02:00
|
|
|
* errors properly. Perhaps it's because there's another level of eval
|
|
|
|
* inside mksafefunc?
|
2003-04-20 23:15:34 +02:00
|
|
|
*/
|
2010-05-13 18:39:43 +02:00
|
|
|
count = perl_call_pv("PostgreSQL::InServer::mkfunc",
|
|
|
|
G_SCALAR | G_EVAL | G_KEEPERR);
|
2000-01-20 06:08:58 +01:00
|
|
|
SPAGAIN;
|
|
|
|
|
2010-02-26 03:01:40 +01:00
|
|
|
if (count == 1)
|
|
|
|
{
|
2010-05-13 18:39:43 +02:00
|
|
|
SV *sub_rv = (SV *) POPs;
|
2010-02-26 03:01:40 +01:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
if (sub_rv && SvROK(sub_rv) && SvTYPE(SvRV(sub_rv)) == SVt_PVCV)
|
2010-02-26 03:01:40 +01:00
|
|
|
{
|
2010-05-13 18:39:43 +02:00
|
|
|
subref = newRV_inc(SvRV(sub_rv));
|
2010-01-29 00:06:09 +01:00
|
|
|
}
|
2003-04-20 23:15:34 +02:00
|
|
|
}
|
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
2010-01-09 03:40:50 +01:00
|
|
|
|
2000-09-12 06:28:30 +02:00
|
|
|
if (SvTRUE(ERRSV))
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_SYNTAX_ERROR),
|
2011-02-06 23:29:26 +01:00
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV)))));
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
if (!subref)
|
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_SYNTAX_ERROR),
|
|
|
|
errmsg("didn't get a CODE reference from compiling function \"%s\"",
|
2010-07-06 21:19:02 +02:00
|
|
|
prodesc->proname)));
|
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
prodesc->reference = subref;
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-01-09 03:40:50 +01:00
|
|
|
return;
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
/**********************************************************************
|
2000-04-12 19:17:23 +02:00
|
|
|
* plperl_init_shared_libs() -
|
2000-01-20 06:08:58 +01:00
|
|
|
**********************************************************************/
|
|
|
|
|
2000-02-19 19:58:37 +01:00
|
|
|
static void
|
2002-01-24 22:40:44 +01:00
|
|
|
plperl_init_shared_libs(pTHX)
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
2000-04-12 19:17:23 +02:00
|
|
|
char *file = __FILE__;
|
|
|
|
|
2001-10-25 07:50:21 +02:00
|
|
|
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
|
2010-01-20 02:08:21 +01:00
|
|
|
newXS("PostgreSQL::InServer::Util::bootstrap",
|
2010-02-26 03:01:40 +01:00
|
|
|
boot_PostgreSQL__InServer__Util, file);
|
2010-02-12 20:35:25 +01:00
|
|
|
/* newXS for...::SPI::bootstrap is in select_perl_context() */
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2003-08-04 02:43:34 +02:00
|
|
|
static SV *
|
2005-11-22 19:17:34 +01:00
|
|
|
plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
|
|
|
dSP;
|
2000-04-12 19:17:23 +02:00
|
|
|
SV *retval;
|
|
|
|
int i;
|
|
|
|
int count;
|
2015-04-26 16:33:14 +02:00
|
|
|
Oid *argtypes = NULL;
|
|
|
|
int nargs = 0;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
ENTER;
|
|
|
|
SAVETMPS;
|
|
|
|
|
2003-04-20 23:15:34 +02:00
|
|
|
PUSHMARK(SP);
|
2011-02-01 15:43:25 +01:00
|
|
|
EXTEND(sp, desc->nargs);
|
2004-11-23 01:21:24 +01:00
|
|
|
|
2015-12-05 09:04:17 +01:00
|
|
|
/* Get signature for true functions; inline blocks have no args. */
|
2015-04-26 16:33:14 +02:00
|
|
|
if (fcinfo->flinfo->fn_oid)
|
|
|
|
get_func_signature(fcinfo->flinfo->fn_oid, &argtypes, &nargs);
|
2015-12-05 09:04:17 +01:00
|
|
|
Assert(nargs == desc->nargs);
|
2015-04-26 16:33:14 +02:00
|
|
|
|
2000-04-12 19:17:23 +02:00
|
|
|
for (i = 0; i < desc->nargs; i++)
|
|
|
|
{
|
2004-11-18 22:35:42 +01:00
|
|
|
if (fcinfo->argnull[i])
|
2010-01-27 00:11:56 +01:00
|
|
|
PUSHs(&PL_sv_undef);
|
2004-11-18 22:35:42 +01:00
|
|
|
else if (desc->arg_is_rowtype[i])
|
2000-04-12 19:17:23 +02:00
|
|
|
{
|
2011-02-18 02:11:50 +01:00
|
|
|
SV *sv = plperl_hash_from_datum(fcinfo->arg[i]);
|
|
|
|
|
|
|
|
PUSHs(sv_2mortal(sv));
|
2000-04-12 19:17:23 +02:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
2011-02-18 02:11:50 +01:00
|
|
|
SV *sv;
|
2015-04-26 16:33:14 +02:00
|
|
|
Oid funcid;
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
if (OidIsValid(desc->arg_arraytype[i]))
|
|
|
|
sv = plperl_ref_from_pg_array(fcinfo->arg[i], desc->arg_arraytype[i]);
|
2015-04-26 16:33:14 +02:00
|
|
|
else if ((funcid = get_transform_fromsql(argtypes[i], current_call_data->prodesc->lang_oid, current_call_data->prodesc->trftypes)))
|
|
|
|
sv = (SV *) DatumGetPointer(OidFunctionCall1(funcid, fcinfo->arg[i]));
|
2011-02-18 02:11:50 +01:00
|
|
|
else
|
|
|
|
{
|
|
|
|
char *tmp;
|
|
|
|
|
|
|
|
tmp = OutputFunctionCall(&(desc->arg_out_func[i]),
|
|
|
|
fcinfo->arg[i]);
|
|
|
|
sv = cstr2sv(tmp);
|
|
|
|
pfree(tmp);
|
|
|
|
}
|
2004-11-18 22:35:42 +01:00
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
PUSHs(sv_2mortal(sv));
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
PUTBACK;
|
2003-04-20 23:15:34 +02:00
|
|
|
|
|
|
|
/* Do NOT use G_KEEPERR here */
|
|
|
|
count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
SPAGAIN;
|
|
|
|
|
2000-04-12 19:17:23 +02:00
|
|
|
if (count != 1)
|
|
|
|
{
|
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
2000-01-20 06:08:58 +01:00
|
|
|
LEAVE;
|
2015-08-03 05:49:19 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("didn't get a return item from function")));
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
|
|
|
|
2000-09-12 06:28:30 +02:00
|
|
|
if (SvTRUE(ERRSV))
|
2000-04-12 19:17:23 +02:00
|
|
|
{
|
2004-11-17 22:23:36 +01:00
|
|
|
(void) POPs;
|
2000-04-12 19:17:23 +02:00
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
2000-01-20 06:08:58 +01:00
|
|
|
LEAVE;
|
2015-08-03 05:49:19 +02:00
|
|
|
/* XXX need to find a way to determine a better errcode here */
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV)))));
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
retval = newSVsv(POPs);
|
|
|
|
|
2000-04-12 19:17:23 +02:00
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
return retval;
|
|
|
|
}
|
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2004-07-01 22:50:22 +02:00
|
|
|
static SV *
|
2005-11-22 19:17:34 +01:00
|
|
|
plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
|
|
|
|
SV *td)
|
2004-07-01 22:50:22 +02:00
|
|
|
{
|
|
|
|
dSP;
|
2011-02-17 20:40:13 +01:00
|
|
|
SV *retval,
|
|
|
|
*TDsv;
|
|
|
|
int i,
|
|
|
|
count;
|
2011-02-01 15:43:25 +01:00
|
|
|
Trigger *tg_trigger = ((TriggerData *) fcinfo->context)->tg_trigger;
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
ENTER;
|
|
|
|
SAVETMPS;
|
|
|
|
|
2012-03-19 21:29:05 +01:00
|
|
|
TDsv = get_sv("main::_TD", 0);
|
2011-05-19 05:56:18 +02:00
|
|
|
if (!TDsv)
|
2015-08-03 05:49:19 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("couldn't fetch $_TD")));
|
2011-05-19 05:56:18 +02:00
|
|
|
|
2011-06-09 20:32:50 +02:00
|
|
|
save_item(TDsv); /* local $_TD */
|
2011-02-01 15:43:25 +01:00
|
|
|
sv_setsv(TDsv, td);
|
2004-11-23 01:21:24 +01:00
|
|
|
|
2011-02-01 15:43:25 +01:00
|
|
|
PUSHMARK(sp);
|
|
|
|
EXTEND(sp, tg_trigger->tgnargs);
|
2004-11-23 01:21:24 +01:00
|
|
|
|
2004-11-18 22:35:42 +01:00
|
|
|
for (i = 0; i < tg_trigger->tgnargs; i++)
|
2011-02-06 23:29:26 +01:00
|
|
|
PUSHs(sv_2mortal(cstr2sv(tg_trigger->tgargs[i])));
|
2004-07-01 22:50:22 +02:00
|
|
|
PUTBACK;
|
|
|
|
|
2004-11-23 01:21:24 +01:00
|
|
|
/* Do NOT use G_KEEPERR here */
|
|
|
|
count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
SPAGAIN;
|
|
|
|
|
|
|
|
if (count != 1)
|
|
|
|
{
|
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
2015-08-03 05:49:19 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("didn't get a return item from trigger function")));
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
if (SvTRUE(ERRSV))
|
|
|
|
{
|
2004-11-17 22:23:36 +01:00
|
|
|
(void) POPs;
|
2004-07-01 22:50:22 +02:00
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
2015-08-03 05:49:19 +02:00
|
|
|
/* XXX need to find a way to determine a better errcode here */
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV)))));
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
retval = newSVsv(POPs);
|
|
|
|
|
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
|
|
|
|
|
|
|
return retval;
|
|
|
|
}
|
2003-04-20 23:15:34 +02:00
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2013-12-11 14:11:59 +01:00
|
|
|
static void
|
|
|
|
plperl_call_perl_event_trigger_func(plperl_proc_desc *desc,
|
|
|
|
FunctionCallInfo fcinfo,
|
|
|
|
SV *td)
|
|
|
|
{
|
|
|
|
dSP;
|
|
|
|
SV *retval,
|
|
|
|
*TDsv;
|
|
|
|
int count;
|
|
|
|
|
|
|
|
ENTER;
|
|
|
|
SAVETMPS;
|
|
|
|
|
|
|
|
TDsv = get_sv("main::_TD", 0);
|
|
|
|
if (!TDsv)
|
2015-08-03 05:49:19 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("couldn't fetch $_TD")));
|
2013-12-11 14:11:59 +01:00
|
|
|
|
|
|
|
save_item(TDsv); /* local $_TD */
|
|
|
|
sv_setsv(TDsv, td);
|
|
|
|
|
|
|
|
PUSHMARK(sp);
|
|
|
|
PUTBACK;
|
|
|
|
|
|
|
|
/* Do NOT use G_KEEPERR here */
|
|
|
|
count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
|
|
|
|
|
|
|
|
SPAGAIN;
|
|
|
|
|
|
|
|
if (count != 1)
|
|
|
|
{
|
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
2015-08-03 05:49:19 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("didn't get a return item from trigger function")));
|
2013-12-11 14:11:59 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
if (SvTRUE(ERRSV))
|
|
|
|
{
|
|
|
|
(void) POPs;
|
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
2015-08-03 05:49:19 +02:00
|
|
|
/* XXX need to find a way to determine a better errcode here */
|
2013-12-11 14:11:59 +01:00
|
|
|
ereport(ERROR,
|
2015-08-03 05:49:19 +02:00
|
|
|
(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
|
|
|
|
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV)))));
|
2013-12-11 14:11:59 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
retval = newSVsv(POPs);
|
|
|
|
(void) retval; /* silence compiler warning */
|
|
|
|
|
|
|
|
PUTBACK;
|
|
|
|
FREETMPS;
|
|
|
|
LEAVE;
|
|
|
|
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
static Datum
|
2000-05-28 19:56:29 +02:00
|
|
|
plperl_func_handler(PG_FUNCTION_ARGS)
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
|
|
|
plperl_proc_desc *prodesc;
|
2000-04-12 19:17:23 +02:00
|
|
|
SV *perlret;
|
2011-02-19 14:14:32 +01:00
|
|
|
Datum retval = 0;
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
ReturnSetInfo *rsi;
|
2009-09-16 08:06:12 +02:00
|
|
|
ErrorContextCallback pl_error_context;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2004-11-22 21:31:53 +01:00
|
|
|
if (SPI_connect() != SPI_OK_CONNECT)
|
|
|
|
elog(ERROR, "could not connect to SPI manager");
|
|
|
|
|
2013-12-11 14:11:59 +01:00
|
|
|
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, false);
|
2006-01-28 04:28:15 +01:00
|
|
|
current_call_data->prodesc = prodesc;
|
2012-09-10 02:32:54 +02:00
|
|
|
increment_prodesc_refcount(prodesc);
|
2004-09-13 22:10:13 +02:00
|
|
|
|
2009-09-16 08:06:12 +02:00
|
|
|
/* Set a callback for error reporting */
|
|
|
|
pl_error_context.callback = plperl_exec_callback;
|
|
|
|
pl_error_context.previous = error_context_stack;
|
|
|
|
pl_error_context.arg = prodesc->proname;
|
|
|
|
error_context_stack = &pl_error_context;
|
|
|
|
|
2005-10-15 04:49:52 +02:00
|
|
|
rsi = (ReturnSetInfo *) fcinfo->resultinfo;
|
2005-08-12 23:09:34 +02:00
|
|
|
|
2005-08-12 23:26:32 +02:00
|
|
|
if (prodesc->fn_retisset)
|
2005-08-12 22:48:03 +02:00
|
|
|
{
|
2005-08-12 23:26:32 +02:00
|
|
|
/* Check context before allowing the call to go through */
|
|
|
|
if (!rsi || !IsA(rsi, ReturnSetInfo) ||
|
|
|
|
(rsi->allowedModes & SFRM_Materialize) == 0 ||
|
|
|
|
rsi->expectedDesc == NULL)
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
|
|
|
errmsg("set-valued function called in context that "
|
|
|
|
"cannot accept a set")));
|
2005-08-12 22:48:03 +02:00
|
|
|
}
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
activate_interpreter(prodesc->interp);
|
2006-11-13 18:13:57 +01:00
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
perlret = plperl_call_perl_func(prodesc, fcinfo);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* Disconnect from SPI manager and then create the return
|
|
|
|
* values datum (if the input function does a palloc for it
|
|
|
|
* this must not be allocated in the SPI memory context
|
|
|
|
* because SPI_finish would free it).
|
|
|
|
************************************************************/
|
|
|
|
if (SPI_finish() != SPI_OK_FINISH)
|
2003-07-26 01:37:31 +02:00
|
|
|
elog(ERROR, "SPI_finish() failed");
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2005-08-12 23:26:32 +02:00
|
|
|
if (prodesc->fn_retisset)
|
2005-07-10 17:32:47 +02:00
|
|
|
{
|
2011-02-18 02:11:50 +01:00
|
|
|
SV *sav;
|
|
|
|
|
2005-08-12 23:26:32 +02:00
|
|
|
/*
|
|
|
|
* If the Perl function returned an arrayref, we pretend that it
|
2005-10-15 04:49:52 +02:00
|
|
|
* called return_next() for each element of the array, to handle old
|
|
|
|
* SRFs that didn't know about return_next(). Any other sort of return
|
2007-06-28 19:49:59 +02:00
|
|
|
* value is an error, except undef which means return an empty set.
|
2005-08-12 23:26:32 +02:00
|
|
|
*/
|
2011-02-18 02:11:50 +01:00
|
|
|
sav = get_perl_array_ref(perlret);
|
|
|
|
if (sav)
|
2004-07-01 22:50:22 +02:00
|
|
|
{
|
2005-10-15 04:49:52 +02:00
|
|
|
int i = 0;
|
|
|
|
SV **svp = 0;
|
2011-02-18 02:11:50 +01:00
|
|
|
AV *rav = (AV *) SvRV(sav);
|
2005-10-15 04:49:52 +02:00
|
|
|
|
|
|
|
while ((svp = av_fetch(rav, i, FALSE)) != NULL)
|
2005-07-10 17:32:47 +02:00
|
|
|
{
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
plperl_return_next(*svp);
|
|
|
|
i++;
|
|
|
|
}
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
2007-06-28 19:49:59 +02:00
|
|
|
else if (SvOK(perlret))
|
2004-07-01 22:50:22 +02:00
|
|
|
{
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
2009-02-19 11:33:17 +01:00
|
|
|
errmsg("set-returning PL/Perl function must return "
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
"reference to array or use return_next")));
|
The attached patch, which incorporates the previous one sent and
currently unapplied regarding spi_internal.c, makes some additional
fixes relating to return types, and also contains the fix for
preventing the use of insecure versions of Safe.pm.
There is one remaing return case that does not appear to work, namely
return of a composite directly in a select, i.e. if foo returns some
composite type, 'select * from foo()' works but 'select foo()' doesn't.
We will either fix that or document it as a limitation.
The function plperl_func_handler is a mess - I will try to get it
cleaned up (and split up) in a subsequent patch, time permitting.
Also, reiterating previous advice - this changes slightly the API for
spi_exec_query - the returned object has either 2 or 3 members: 'status'
(string) and 'proceesed' (int,- number of rows) and, if rows are
returned, 'rows' (array of tuple hashes).
Andrew Dunstan
2004-07-12 16:31:04 +02:00
|
|
|
}
|
2004-08-29 07:07:03 +02:00
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
rsi->returnMode = SFRM_Materialize;
|
2006-01-28 04:28:15 +01:00
|
|
|
if (current_call_data->tuple_store)
|
2005-07-10 17:32:47 +02:00
|
|
|
{
|
2006-01-28 04:28:15 +01:00
|
|
|
rsi->setResult = current_call_data->tuple_store;
|
|
|
|
rsi->setDesc = current_call_data->ret_tdesc;
|
The attached patch, which incorporates the previous one sent and
currently unapplied regarding spi_internal.c, makes some additional
fixes relating to return types, and also contains the fix for
preventing the use of insecure versions of Safe.pm.
There is one remaing return case that does not appear to work, namely
return of a composite directly in a select, i.e. if foo returns some
composite type, 'select * from foo()' works but 'select foo()' doesn't.
We will either fix that or document it as a limitation.
The function plperl_func_handler is a mess - I will try to get it
cleaned up (and split up) in a subsequent patch, time permitting.
Also, reiterating previous advice - this changes slightly the API for
spi_exec_query - the returned object has either 2 or 3 members: 'status'
(string) and 'proceesed' (int,- number of rows) and, if rows are
returned, 'rows' (array of tuple hashes).
Andrew Dunstan
2004-07-12 16:31:04 +02:00
|
|
|
}
|
2005-10-15 04:49:52 +02:00
|
|
|
retval = (Datum) 0;
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
}
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
else
|
2011-02-18 02:11:50 +01:00
|
|
|
{
|
|
|
|
retval = plperl_sv_to_datum(perlret,
|
|
|
|
prodesc->result_oid,
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
-1,
|
|
|
|
fcinfo,
|
|
|
|
&prodesc->result_in_func,
|
|
|
|
prodesc->result_typioparam,
|
|
|
|
&fcinfo->isnull);
|
|
|
|
|
|
|
|
if (fcinfo->isnull && rsi && IsA(rsi, ReturnSetInfo))
|
|
|
|
rsi->isDone = ExprEndResult;
|
2000-05-28 19:56:29 +02:00
|
|
|
}
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2009-09-16 08:06:12 +02:00
|
|
|
/* Restore the previous error callback */
|
|
|
|
error_context_stack = pl_error_context.previous;
|
2009-11-29 04:02:27 +01:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
SvREFCNT_dec(perlret);
|
2005-07-12 03:16:22 +02:00
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
return retval;
|
|
|
|
}
|
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2004-07-01 22:50:22 +02:00
|
|
|
static Datum
|
|
|
|
plperl_trigger_handler(PG_FUNCTION_ARGS)
|
|
|
|
{
|
|
|
|
plperl_proc_desc *prodesc;
|
|
|
|
SV *perlret;
|
|
|
|
Datum retval;
|
|
|
|
SV *svTD;
|
|
|
|
HV *hvTD;
|
2009-09-16 08:06:12 +02:00
|
|
|
ErrorContextCallback pl_error_context;
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2004-11-22 21:31:53 +01:00
|
|
|
/* Connect to SPI manager */
|
|
|
|
if (SPI_connect() != SPI_OK_CONNECT)
|
|
|
|
elog(ERROR, "could not connect to SPI manager");
|
|
|
|
|
2004-07-01 22:50:22 +02:00
|
|
|
/* Find or compile the function */
|
2013-12-11 14:11:59 +01:00
|
|
|
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true, false);
|
2006-01-28 04:28:15 +01:00
|
|
|
current_call_data->prodesc = prodesc;
|
2012-09-10 02:32:54 +02:00
|
|
|
increment_prodesc_refcount(prodesc);
|
2004-09-13 22:10:13 +02:00
|
|
|
|
2009-09-16 08:06:12 +02:00
|
|
|
/* Set a callback for error reporting */
|
|
|
|
pl_error_context.callback = plperl_exec_callback;
|
|
|
|
pl_error_context.previous = error_context_stack;
|
|
|
|
pl_error_context.arg = prodesc->proname;
|
|
|
|
error_context_stack = &pl_error_context;
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
activate_interpreter(prodesc->interp);
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2004-07-01 22:50:22 +02:00
|
|
|
svTD = plperl_trigger_build_args(fcinfo);
|
|
|
|
perlret = plperl_call_perl_trigger_func(prodesc, fcinfo, svTD);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
hvTD = (HV *) SvRV(svTD);
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* Disconnect from SPI manager and then create the return
|
|
|
|
* values datum (if the input function does a palloc for it
|
|
|
|
* this must not be allocated in the SPI memory context
|
|
|
|
* because SPI_finish would free it).
|
|
|
|
************************************************************/
|
|
|
|
if (SPI_finish() != SPI_OK_FINISH)
|
2004-11-29 21:11:06 +01:00
|
|
|
elog(ERROR, "SPI_finish() failed");
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2007-06-28 19:49:59 +02:00
|
|
|
if (perlret == NULL || !SvOK(perlret))
|
2004-07-01 22:50:22 +02:00
|
|
|
{
|
2004-11-23 01:21:24 +01:00
|
|
|
/* undef result means go ahead with original tuple */
|
2004-07-01 22:50:22 +02:00
|
|
|
TriggerData *trigdata = ((TriggerData *) fcinfo->context);
|
|
|
|
|
|
|
|
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
|
|
|
|
retval = (Datum) trigdata->tg_trigtuple;
|
|
|
|
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
|
|
|
|
retval = (Datum) trigdata->tg_newtuple;
|
|
|
|
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
|
|
|
|
retval = (Datum) trigdata->tg_trigtuple;
|
2008-03-28 01:21:56 +01:00
|
|
|
else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event))
|
|
|
|
retval = (Datum) trigdata->tg_trigtuple;
|
2004-11-17 22:23:36 +01:00
|
|
|
else
|
2005-10-15 04:49:52 +02:00
|
|
|
retval = (Datum) 0; /* can this happen? */
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
2004-11-23 01:21:24 +01:00
|
|
|
HeapTuple trv;
|
|
|
|
char *tmp;
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2011-02-06 23:29:26 +01:00
|
|
|
tmp = sv2cstr(perlret);
|
2004-07-01 22:50:22 +02:00
|
|
|
|
2004-11-23 01:21:24 +01:00
|
|
|
if (pg_strcasecmp(tmp, "SKIP") == 0)
|
|
|
|
trv = NULL;
|
|
|
|
else if (pg_strcasecmp(tmp, "MODIFY") == 0)
|
|
|
|
{
|
|
|
|
TriggerData *trigdata = (TriggerData *) fcinfo->context;
|
|
|
|
|
|
|
|
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
|
|
|
|
trv = plperl_modify_tuple(hvTD, trigdata,
|
|
|
|
trigdata->tg_trigtuple);
|
|
|
|
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
|
|
|
|
trv = plperl_modify_tuple(hvTD, trigdata,
|
|
|
|
trigdata->tg_newtuple);
|
2004-07-01 22:50:22 +02:00
|
|
|
else
|
|
|
|
{
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(WARNING,
|
|
|
|
(errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
|
2009-06-11 16:49:15 +02:00
|
|
|
errmsg("ignoring modified row in DELETE trigger")));
|
2004-07-01 22:50:22 +02:00
|
|
|
trv = NULL;
|
|
|
|
}
|
|
|
|
}
|
2004-11-17 22:23:36 +01:00
|
|
|
else
|
2004-11-23 01:21:24 +01:00
|
|
|
{
|
2004-11-29 21:11:06 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
|
2009-06-11 16:49:15 +02:00
|
|
|
errmsg("result of PL/Perl trigger function must be undef, "
|
|
|
|
"\"SKIP\", or \"MODIFY\"")));
|
2004-11-23 01:21:24 +01:00
|
|
|
trv = NULL;
|
|
|
|
}
|
|
|
|
retval = PointerGetDatum(trv);
|
2011-02-06 23:29:26 +01:00
|
|
|
pfree(tmp);
|
2004-07-01 22:50:22 +02:00
|
|
|
}
|
|
|
|
|
2009-09-16 08:06:12 +02:00
|
|
|
/* Restore the previous error callback */
|
|
|
|
error_context_stack = pl_error_context.previous;
|
|
|
|
|
2004-11-23 01:21:24 +01:00
|
|
|
SvREFCNT_dec(svTD);
|
|
|
|
if (perlret)
|
|
|
|
SvREFCNT_dec(perlret);
|
2004-07-01 22:50:22 +02:00
|
|
|
|
|
|
|
return retval;
|
|
|
|
}
|
2000-01-20 06:08:58 +01:00
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2013-12-11 14:11:59 +01:00
|
|
|
static void
|
|
|
|
plperl_event_trigger_handler(PG_FUNCTION_ARGS)
|
|
|
|
{
|
|
|
|
plperl_proc_desc *prodesc;
|
|
|
|
SV *svTD;
|
|
|
|
ErrorContextCallback pl_error_context;
|
|
|
|
|
|
|
|
/* Connect to SPI manager */
|
|
|
|
if (SPI_connect() != SPI_OK_CONNECT)
|
|
|
|
elog(ERROR, "could not connect to SPI manager");
|
|
|
|
|
|
|
|
/* Find or compile the function */
|
|
|
|
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, true);
|
|
|
|
current_call_data->prodesc = prodesc;
|
|
|
|
increment_prodesc_refcount(prodesc);
|
|
|
|
|
|
|
|
/* Set a callback for error reporting */
|
|
|
|
pl_error_context.callback = plperl_exec_callback;
|
|
|
|
pl_error_context.previous = error_context_stack;
|
|
|
|
pl_error_context.arg = prodesc->proname;
|
|
|
|
error_context_stack = &pl_error_context;
|
|
|
|
|
|
|
|
activate_interpreter(prodesc->interp);
|
|
|
|
|
|
|
|
svTD = plperl_event_trigger_build_args(fcinfo);
|
|
|
|
plperl_call_perl_event_trigger_func(prodesc, fcinfo, svTD);
|
|
|
|
|
|
|
|
if (SPI_finish() != SPI_OK_FINISH)
|
|
|
|
elog(ERROR, "SPI_finish() failed");
|
|
|
|
|
|
|
|
/* Restore the previous error callback */
|
|
|
|
error_context_stack = pl_error_context.previous;
|
|
|
|
|
|
|
|
SvREFCNT_dec(svTD);
|
|
|
|
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
static bool
|
|
|
|
validate_plperl_function(plperl_proc_ptr *proc_ptr, HeapTuple procTup)
|
|
|
|
{
|
|
|
|
if (proc_ptr && proc_ptr->proc_ptr)
|
|
|
|
{
|
|
|
|
plperl_proc_desc *prodesc = proc_ptr->proc_ptr;
|
|
|
|
bool uptodate;
|
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* If it's present, must check whether it's still up to date.
|
|
|
|
* This is needed because CREATE OR REPLACE FUNCTION can modify the
|
|
|
|
* function's pg_proc entry without changing its OID.
|
|
|
|
************************************************************/
|
2013-12-22 21:49:09 +01:00
|
|
|
uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetRawXmin(procTup->t_data) &&
|
2010-09-30 23:18:51 +02:00
|
|
|
ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self));
|
|
|
|
|
|
|
|
if (uptodate)
|
|
|
|
return true;
|
|
|
|
|
|
|
|
/* Otherwise, unlink the obsoleted entry from the hashtable ... */
|
|
|
|
proc_ptr->proc_ptr = NULL;
|
2012-09-10 02:32:54 +02:00
|
|
|
/* ... and release the corresponding refcount, probably deleting it */
|
|
|
|
decrement_prodesc_refcount(prodesc);
|
2010-09-30 23:18:51 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2012-09-10 02:32:54 +02:00
|
|
|
static void
|
|
|
|
free_plperl_function(plperl_proc_desc *prodesc)
|
|
|
|
{
|
2016-09-01 01:54:58 +02:00
|
|
|
Assert(prodesc->fn_refcount == 0);
|
2012-09-10 02:32:54 +02:00
|
|
|
/* Release CODE reference, if we have one, from the appropriate interp */
|
|
|
|
if (prodesc->reference)
|
|
|
|
{
|
|
|
|
plperl_interp_desc *oldinterp = plperl_active_interp;
|
|
|
|
|
|
|
|
activate_interpreter(prodesc->interp);
|
|
|
|
SvREFCNT_dec(prodesc->reference);
|
|
|
|
activate_interpreter(oldinterp);
|
|
|
|
}
|
2016-09-01 01:54:58 +02:00
|
|
|
/* Release all PG-owned data for this proc */
|
|
|
|
MemoryContextDelete(prodesc->fn_cxt);
|
2012-09-10 02:32:54 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
static plperl_proc_desc *
|
2013-12-11 14:11:59 +01:00
|
|
|
compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
2001-10-20 00:43:49 +02:00
|
|
|
HeapTuple procTup;
|
|
|
|
Form_pg_proc procStruct;
|
2010-09-30 23:18:51 +02:00
|
|
|
plperl_proc_key proc_key;
|
|
|
|
plperl_proc_ptr *proc_ptr;
|
2016-09-01 01:54:58 +02:00
|
|
|
plperl_proc_desc *volatile prodesc = NULL;
|
|
|
|
volatile MemoryContext proc_cxt = NULL;
|
2010-09-30 23:18:51 +02:00
|
|
|
plperl_interp_desc *oldinterp = plperl_active_interp;
|
2009-09-16 08:06:12 +02:00
|
|
|
ErrorContextCallback plperl_error_context;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
/* We'll need the pg_proc tuple in any case... */
|
2010-02-14 19:42:19 +01:00
|
|
|
procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid));
|
2001-10-20 00:43:49 +02:00
|
|
|
if (!HeapTupleIsValid(procTup))
|
2003-07-26 01:37:31 +02:00
|
|
|
elog(ERROR, "cache lookup failed for function %u", fn_oid);
|
2001-10-20 00:43:49 +02:00
|
|
|
procStruct = (Form_pg_proc) GETSTRUCT(procTup);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2016-09-01 01:54:58 +02:00
|
|
|
/*
|
|
|
|
* Try to find function in plperl_proc_hash. The reason for this
|
|
|
|
* overcomplicated-seeming lookup procedure is that we don't know whether
|
|
|
|
* it's plperl or plperlu, and don't want to spend a lookup in pg_language
|
|
|
|
* to find out.
|
|
|
|
*/
|
2010-09-30 23:18:51 +02:00
|
|
|
proc_key.proc_id = fn_oid;
|
2010-10-31 16:42:51 +01:00
|
|
|
proc_key.is_trigger = is_trigger;
|
2010-09-30 23:18:51 +02:00
|
|
|
proc_key.user_id = GetUserId();
|
|
|
|
proc_ptr = hash_search(plperl_proc_hash, &proc_key,
|
|
|
|
HASH_FIND, NULL);
|
2016-09-01 01:54:58 +02:00
|
|
|
if (validate_plperl_function(proc_ptr, procTup))
|
|
|
|
{
|
|
|
|
/* Found valid plperl entry */
|
|
|
|
ReleaseSysCache(procTup);
|
|
|
|
return proc_ptr->proc_ptr;
|
|
|
|
}
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2016-09-01 01:54:58 +02:00
|
|
|
/* If not found or obsolete, maybe it's plperlu */
|
|
|
|
proc_key.user_id = InvalidOid;
|
|
|
|
proc_ptr = hash_search(plperl_proc_hash, &proc_key,
|
|
|
|
HASH_FIND, NULL);
|
2010-09-30 23:18:51 +02:00
|
|
|
if (validate_plperl_function(proc_ptr, procTup))
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
2016-09-01 01:54:58 +02:00
|
|
|
/* Found valid plperlu entry */
|
|
|
|
ReleaseSysCache(procTup);
|
|
|
|
return proc_ptr->proc_ptr;
|
2001-10-20 00:43:49 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* If we haven't found it in the hashtable, we analyze
|
2006-02-26 23:26:39 +01:00
|
|
|
* the function's arguments and return type and store
|
2016-09-01 01:54:58 +02:00
|
|
|
* the in-/out-functions in the prodesc block,
|
|
|
|
* then we load the procedure into the Perl interpreter,
|
|
|
|
* and last we create a new hashtable entry for it.
|
2001-10-20 00:43:49 +02:00
|
|
|
************************************************************/
|
2016-09-01 01:54:58 +02:00
|
|
|
|
|
|
|
/* Set a callback for reporting compilation errors */
|
|
|
|
plperl_error_context.callback = plperl_compile_callback;
|
|
|
|
plperl_error_context.previous = error_context_stack;
|
|
|
|
plperl_error_context.arg = NameStr(procStruct->proname);
|
|
|
|
error_context_stack = &plperl_error_context;
|
|
|
|
|
|
|
|
PG_TRY();
|
2001-10-20 00:43:49 +02:00
|
|
|
{
|
|
|
|
HeapTuple langTup;
|
|
|
|
HeapTuple typeTup;
|
|
|
|
Form_pg_language langStruct;
|
|
|
|
Form_pg_type typeStruct;
|
2015-04-26 16:33:14 +02:00
|
|
|
Datum protrftypes_datum;
|
2004-01-07 00:55:19 +01:00
|
|
|
Datum prosrcdatum;
|
|
|
|
bool isnull;
|
2000-01-20 06:08:58 +01:00
|
|
|
char *proc_source;
|
2016-09-01 01:54:58 +02:00
|
|
|
MemoryContext oldcontext;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
/************************************************************
|
2016-09-01 01:54:58 +02:00
|
|
|
* Allocate a context that will hold all PG data for the procedure.
|
2000-01-20 06:08:58 +01:00
|
|
|
************************************************************/
|
2016-09-01 01:54:58 +02:00
|
|
|
proc_cxt = AllocSetContextCreate(TopMemoryContext,
|
|
|
|
NameStr(procStruct->proname),
|
|
|
|
ALLOCSET_SMALL_SIZES);
|
2012-09-10 02:32:54 +02:00
|
|
|
|
2016-09-01 01:54:58 +02:00
|
|
|
/************************************************************
|
|
|
|
* Allocate and fill a new procedure description block.
|
|
|
|
* struct prodesc and subsidiary data must all live in proc_cxt.
|
|
|
|
************************************************************/
|
|
|
|
oldcontext = MemoryContextSwitchTo(proc_cxt);
|
|
|
|
prodesc = (plperl_proc_desc *) palloc0(sizeof(plperl_proc_desc));
|
|
|
|
prodesc->proname = pstrdup(NameStr(procStruct->proname));
|
|
|
|
prodesc->fn_cxt = proc_cxt;
|
|
|
|
prodesc->fn_refcount = 0;
|
2013-12-22 21:49:09 +01:00
|
|
|
prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data);
|
2007-02-09 04:35:35 +01:00
|
|
|
prodesc->fn_tid = procTup->t_self;
|
2016-09-01 01:54:58 +02:00
|
|
|
prodesc->nargs = procStruct->pronargs;
|
|
|
|
prodesc->arg_out_func = (FmgrInfo *) palloc0(prodesc->nargs * sizeof(FmgrInfo));
|
|
|
|
prodesc->arg_is_rowtype = (bool *) palloc0(prodesc->nargs * sizeof(bool));
|
|
|
|
prodesc->arg_arraytype = (Oid *) palloc0(prodesc->nargs * sizeof(Oid));
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2004-09-13 22:10:13 +02:00
|
|
|
/* Remember if function is STABLE/IMMUTABLE */
|
|
|
|
prodesc->fn_readonly =
|
|
|
|
(procStruct->provolatile != PROVOLATILE_VOLATILE);
|
|
|
|
|
2016-09-01 01:54:58 +02:00
|
|
|
/* Fetch protrftypes */
|
|
|
|
protrftypes_datum = SysCacheGetAttr(PROCOID, procTup,
|
2015-05-24 03:35:49 +02:00
|
|
|
Anum_pg_proc_protrftypes, &isnull);
|
2016-09-01 01:54:58 +02:00
|
|
|
MemoryContextSwitchTo(proc_cxt);
|
|
|
|
prodesc->trftypes = isnull ? NIL : oid_array_to_list(protrftypes_datum);
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
2015-04-26 16:33:14 +02:00
|
|
|
|
2000-01-20 06:08:58 +01:00
|
|
|
/************************************************************
|
2001-10-20 00:43:49 +02:00
|
|
|
* Lookup the pg_language tuple by Oid
|
2000-01-20 06:08:58 +01:00
|
|
|
************************************************************/
|
2010-02-14 19:42:19 +01:00
|
|
|
langTup = SearchSysCache1(LANGOID,
|
|
|
|
ObjectIdGetDatum(procStruct->prolang));
|
2001-10-20 00:43:49 +02:00
|
|
|
if (!HeapTupleIsValid(langTup))
|
2003-07-26 01:37:31 +02:00
|
|
|
elog(ERROR, "cache lookup failed for language %u",
|
2001-10-20 00:43:49 +02:00
|
|
|
procStruct->prolang);
|
|
|
|
langStruct = (Form_pg_language) GETSTRUCT(langTup);
|
2015-04-26 16:33:14 +02:00
|
|
|
prodesc->lang_oid = HeapTupleGetOid(langTup);
|
2001-10-20 00:43:49 +02:00
|
|
|
prodesc->lanpltrusted = langStruct->lanpltrusted;
|
|
|
|
ReleaseSysCache(langTup);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
/************************************************************
|
2001-10-20 00:43:49 +02:00
|
|
|
* Get the required information for input conversion of the
|
|
|
|
* return value.
|
2000-01-20 06:08:58 +01:00
|
|
|
************************************************************/
|
2013-12-11 14:11:59 +01:00
|
|
|
if (!is_trigger && !is_event_trigger)
|
2001-10-20 00:43:49 +02:00
|
|
|
{
|
2010-02-14 19:42:19 +01:00
|
|
|
typeTup =
|
|
|
|
SearchSysCache1(TYPEOID,
|
2010-02-26 03:01:40 +01:00
|
|
|
ObjectIdGetDatum(procStruct->prorettype));
|
2001-10-20 00:43:49 +02:00
|
|
|
if (!HeapTupleIsValid(typeTup))
|
2003-07-26 01:37:31 +02:00
|
|
|
elog(ERROR, "cache lookup failed for type %u",
|
2002-08-22 02:01:51 +02:00
|
|
|
procStruct->prorettype);
|
2001-10-20 00:43:49 +02:00
|
|
|
typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
|
|
|
|
|
2004-07-01 22:50:22 +02:00
|
|
|
/* Disallow pseudotype result, except VOID or RECORD */
|
2007-04-02 05:49:42 +02:00
|
|
|
if (typeStruct->typtype == TYPTYPE_PSEUDO)
|
2002-08-22 02:01:51 +02:00
|
|
|
{
|
2004-07-01 22:50:22 +02:00
|
|
|
if (procStruct->prorettype == VOIDOID ||
|
|
|
|
procStruct->prorettype == RECORDOID)
|
2002-09-04 22:31:48 +02:00
|
|
|
/* okay */ ;
|
2013-12-11 14:11:59 +01:00
|
|
|
else if (procStruct->prorettype == TRIGGEROID ||
|
|
|
|
procStruct->prorettype == EVTTRIGGEROID)
|
2003-07-26 01:37:31 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
Wording cleanup for error messages. Also change can't -> cannot.
Standard English uses "may", "can", and "might" in different ways:
may - permission, "You may borrow my rake."
can - ability, "I can lift that log."
might - possibility, "It might rain today."
Unfortunately, in conversational English, their use is often mixed, as
in, "You may use this variable to do X", when in fact, "can" is a better
choice. Similarly, "It may crash" is better stated, "It might crash".
2007-02-01 20:10:30 +01:00
|
|
|
errmsg("trigger functions can only be called "
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
"as triggers")));
|
2002-08-22 02:01:51 +02:00
|
|
|
else
|
2003-07-26 01:37:31 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
2009-02-19 11:33:17 +01:00
|
|
|
errmsg("PL/Perl functions cannot return type %s",
|
2005-10-15 04:49:52 +02:00
|
|
|
format_type_be(procStruct->prorettype))));
|
2002-08-22 02:01:51 +02:00
|
|
|
}
|
|
|
|
|
2004-11-22 21:31:53 +01:00
|
|
|
prodesc->result_oid = procStruct->prorettype;
|
|
|
|
prodesc->fn_retisset = procStruct->proretset;
|
2007-04-02 05:49:42 +02:00
|
|
|
prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID ||
|
2007-11-15 22:14:46 +01:00
|
|
|
typeStruct->typtype == TYPTYPE_COMPOSITE);
|
2001-10-20 00:43:49 +02:00
|
|
|
|
2005-10-15 04:49:52 +02:00
|
|
|
prodesc->fn_retisarray =
|
|
|
|
(typeStruct->typlen == -1 && typeStruct->typelem);
|
2005-07-10 17:32:47 +02:00
|
|
|
|
2016-09-01 01:54:58 +02:00
|
|
|
fmgr_info_cxt(typeStruct->typinput,
|
|
|
|
&(prodesc->result_in_func),
|
|
|
|
proc_cxt);
|
2004-06-06 02:41:28 +02:00
|
|
|
prodesc->result_typioparam = getTypeIOParam(typeTup);
|
2001-10-20 00:43:49 +02:00
|
|
|
|
|
|
|
ReleaseSysCache(typeTup);
|
|
|
|
}
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
/************************************************************
|
2001-10-20 00:43:49 +02:00
|
|
|
* Get the required information for output conversion
|
|
|
|
* of all procedure arguments
|
2000-01-20 06:08:58 +01:00
|
|
|
************************************************************/
|
2013-12-11 14:11:59 +01:00
|
|
|
if (!is_trigger && !is_event_trigger)
|
2001-10-20 00:43:49 +02:00
|
|
|
{
|
2016-09-01 01:54:58 +02:00
|
|
|
int i;
|
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
for (i = 0; i < prodesc->nargs; i++)
|
|
|
|
{
|
2010-02-14 19:42:19 +01:00
|
|
|
typeTup = SearchSysCache1(TYPEOID,
|
2010-02-26 03:01:40 +01:00
|
|
|
ObjectIdGetDatum(procStruct->proargtypes.values[i]));
|
2001-10-20 00:43:49 +02:00
|
|
|
if (!HeapTupleIsValid(typeTup))
|
2003-07-26 01:37:31 +02:00
|
|
|
elog(ERROR, "cache lookup failed for type %u",
|
2005-03-29 02:17:27 +02:00
|
|
|
procStruct->proargtypes.values[i]);
|
2001-10-20 00:43:49 +02:00
|
|
|
typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
|
|
|
|
|
2002-08-22 02:01:51 +02:00
|
|
|
/* Disallow pseudotype argument */
|
2010-11-23 21:27:50 +01:00
|
|
|
if (typeStruct->typtype == TYPTYPE_PSEUDO &&
|
2010-10-29 02:48:12 +02:00
|
|
|
procStruct->proargtypes.values[i] != RECORDOID)
|
2003-07-26 01:37:31 +02:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
2009-02-19 11:33:17 +01:00
|
|
|
errmsg("PL/Perl functions cannot accept type %s",
|
2005-10-15 04:49:52 +02:00
|
|
|
format_type_be(procStruct->proargtypes.values[i]))));
|
2002-08-22 02:01:51 +02:00
|
|
|
|
2010-11-23 21:27:50 +01:00
|
|
|
if (typeStruct->typtype == TYPTYPE_COMPOSITE ||
|
2010-10-29 02:48:12 +02:00
|
|
|
procStruct->proargtypes.values[i] == RECORDOID)
|
2004-04-01 23:28:47 +02:00
|
|
|
prodesc->arg_is_rowtype[i] = true;
|
2001-10-20 00:43:49 +02:00
|
|
|
else
|
2004-04-01 23:28:47 +02:00
|
|
|
{
|
|
|
|
prodesc->arg_is_rowtype[i] = false;
|
2016-09-01 01:54:58 +02:00
|
|
|
fmgr_info_cxt(typeStruct->typoutput,
|
|
|
|
&(prodesc->arg_out_func[i]),
|
|
|
|
proc_cxt);
|
2004-04-01 23:28:47 +02:00
|
|
|
}
|
2001-10-20 00:43:49 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/* Identify array attributes */
|
|
|
|
if (typeStruct->typelem != 0 && typeStruct->typlen == -1)
|
|
|
|
prodesc->arg_arraytype[i] = procStruct->proargtypes.values[i];
|
|
|
|
else
|
|
|
|
prodesc->arg_arraytype[i] = InvalidOid;
|
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
ReleaseSysCache(typeTup);
|
|
|
|
}
|
|
|
|
}
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
/************************************************************
|
|
|
|
* create the text of the anonymous subroutine.
|
|
|
|
* we do not use a named subroutine so that we can call directly
|
|
|
|
* through the reference.
|
|
|
|
************************************************************/
|
2004-01-07 00:55:19 +01:00
|
|
|
prosrcdatum = SysCacheGetAttr(PROCOID, procTup,
|
|
|
|
Anum_pg_proc_prosrc, &isnull);
|
|
|
|
if (isnull)
|
|
|
|
elog(ERROR, "null prosrc");
|
2008-03-25 23:42:46 +01:00
|
|
|
proc_source = TextDatumGetCString(prosrcdatum);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
/************************************************************
|
2010-09-30 23:18:51 +02:00
|
|
|
* Create the procedure in the appropriate interpreter
|
2000-01-20 06:08:58 +01:00
|
|
|
************************************************************/
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
select_perl_context(prodesc->lanpltrusted);
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
prodesc->interp = plperl_active_interp;
|
|
|
|
|
2010-01-27 00:11:56 +01:00
|
|
|
plperl_create_sub(prodesc, proc_source, fn_oid);
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
activate_interpreter(oldinterp);
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
pfree(proc_source);
|
2016-09-01 01:54:58 +02:00
|
|
|
|
2005-10-15 04:49:52 +02:00
|
|
|
if (!prodesc->reference) /* can this happen? */
|
2010-09-30 23:18:51 +02:00
|
|
|
elog(ERROR, "could not create PL/Perl internal procedure");
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
/************************************************************
|
2016-09-01 01:54:58 +02:00
|
|
|
* OK, link the procedure into the correct hashtable entry.
|
|
|
|
* Note we assume that the hashtable entry either doesn't exist yet,
|
|
|
|
* or we already cleared its proc_ptr during the validation attempts
|
|
|
|
* above. So no need to decrement an old refcount here.
|
2010-09-30 23:18:51 +02:00
|
|
|
************************************************************/
|
|
|
|
proc_key.user_id = prodesc->lanpltrusted ? GetUserId() : InvalidOid;
|
|
|
|
|
|
|
|
proc_ptr = hash_search(plperl_proc_hash, &proc_key,
|
|
|
|
HASH_ENTER, NULL);
|
2016-09-01 01:54:58 +02:00
|
|
|
/* We assume these two steps can't throw an error: */
|
2010-09-30 23:18:51 +02:00
|
|
|
proc_ptr->proc_ptr = prodesc;
|
2012-09-10 02:32:54 +02:00
|
|
|
increment_prodesc_refcount(prodesc);
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
2016-09-01 01:54:58 +02:00
|
|
|
PG_CATCH();
|
|
|
|
{
|
|
|
|
/*
|
|
|
|
* If we got as far as creating a reference, we should be able to use
|
|
|
|
* free_plperl_function() to clean up. If not, then at most we have
|
|
|
|
* some PG memory resources in proc_cxt, which we can just delete.
|
|
|
|
*/
|
|
|
|
if (prodesc && prodesc->reference)
|
|
|
|
free_plperl_function(prodesc);
|
|
|
|
else if (proc_cxt)
|
|
|
|
MemoryContextDelete(proc_cxt);
|
|
|
|
|
|
|
|
/* Be sure to restore the previous interpreter, too, for luck */
|
|
|
|
activate_interpreter(oldinterp);
|
|
|
|
|
|
|
|
PG_RE_THROW();
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2009-09-16 08:06:12 +02:00
|
|
|
/* restore previous error callback */
|
|
|
|
error_context_stack = plperl_error_context.previous;
|
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
ReleaseSysCache(procTup);
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2001-10-20 00:43:49 +02:00
|
|
|
return prodesc;
|
|
|
|
}
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/* Build a hash from a given composite/row datum */
|
|
|
|
static SV *
|
|
|
|
plperl_hash_from_datum(Datum attr)
|
|
|
|
{
|
|
|
|
HeapTupleHeader td;
|
|
|
|
Oid tupType;
|
|
|
|
int32 tupTypmod;
|
|
|
|
TupleDesc tupdesc;
|
|
|
|
HeapTupleData tmptup;
|
|
|
|
SV *sv;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
td = DatumGetHeapTupleHeader(attr);
|
|
|
|
|
|
|
|
/* Extract rowtype info and find a tupdesc */
|
|
|
|
tupType = HeapTupleHeaderGetTypeId(td);
|
|
|
|
tupTypmod = HeapTupleHeaderGetTypMod(td);
|
|
|
|
tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod);
|
|
|
|
|
|
|
|
/* Build a temporary HeapTuple control structure */
|
|
|
|
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
|
|
|
|
tmptup.t_data = td;
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
sv = plperl_hash_from_tuple(&tmptup, tupdesc);
|
|
|
|
ReleaseTupleDesc(tupdesc);
|
|
|
|
|
|
|
|
return sv;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Build a hash from all attributes of a given tuple. */
|
2003-08-04 02:43:34 +02:00
|
|
|
static SV *
|
2004-11-23 01:21:24 +01:00
|
|
|
plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
|
2000-01-20 06:08:58 +01:00
|
|
|
{
|
2004-10-15 19:08:26 +02:00
|
|
|
HV *hv;
|
2004-11-23 01:21:24 +01:00
|
|
|
int i;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/* since this function recurses, it could be driven to stack overflow */
|
|
|
|
check_stack_depth();
|
|
|
|
|
2004-10-15 19:08:26 +02:00
|
|
|
hv = newHV();
|
2010-02-26 03:01:40 +01:00
|
|
|
hv_ksplit(hv, tupdesc->natts); /* pre-grow the hash */
|
2000-01-20 06:08:58 +01:00
|
|
|
|
|
|
|
for (i = 0; i < tupdesc->natts; i++)
|
|
|
|
{
|
2004-11-23 01:21:24 +01:00
|
|
|
Datum attr;
|
2011-02-18 02:11:50 +01:00
|
|
|
bool isnull,
|
|
|
|
typisvarlena;
|
2004-11-23 01:21:24 +01:00
|
|
|
char *attname;
|
|
|
|
Oid typoutput;
|
|
|
|
|
2003-09-04 17:16:39 +02:00
|
|
|
if (tupdesc->attrs[i]->attisdropped)
|
|
|
|
continue;
|
|
|
|
|
2004-11-23 01:21:24 +01:00
|
|
|
attname = NameStr(tupdesc->attrs[i]->attname);
|
2000-01-20 06:08:58 +01:00
|
|
|
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
|
|
|
|
|
2005-10-15 04:49:52 +02:00
|
|
|
if (isnull)
|
|
|
|
{
|
2011-05-30 18:15:13 +02:00
|
|
|
/*
|
|
|
|
* Store (attname => undef) and move on. Note we can't use
|
|
|
|
* &PL_sv_undef here; see "AVs, HVs and undefined values" in
|
|
|
|
* perlguts for an explanation.
|
|
|
|
*/
|
|
|
|
hv_store_string(hv, attname, newSV(0));
|
2001-10-20 00:43:49 +02:00
|
|
|
continue;
|
|
|
|
}
|
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
if (type_is_rowtype(tupdesc->attrs[i]->atttypid))
|
|
|
|
{
|
|
|
|
SV *sv = plperl_hash_from_datum(attr);
|
|
|
|
|
|
|
|
hv_store_string(hv, attname, sv);
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
SV *sv;
|
2015-04-26 16:33:14 +02:00
|
|
|
Oid funcid;
|
2011-02-18 02:11:50 +01:00
|
|
|
|
|
|
|
if (OidIsValid(get_base_element_type(tupdesc->attrs[i]->atttypid)))
|
|
|
|
sv = plperl_ref_from_pg_array(attr, tupdesc->attrs[i]->atttypid);
|
2015-04-26 16:33:14 +02:00
|
|
|
else if ((funcid = get_transform_fromsql(tupdesc->attrs[i]->atttypid, current_call_data->prodesc->lang_oid, current_call_data->prodesc->trftypes)))
|
|
|
|
sv = (SV *) DatumGetPointer(OidFunctionCall1(funcid, attr));
|
2011-02-18 02:11:50 +01:00
|
|
|
else
|
|
|
|
{
|
|
|
|
char *outputstr;
|
2000-01-20 06:08:58 +01:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
/* XXX should have a way to cache these lookups */
|
|
|
|
getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
|
|
|
|
&typoutput, &typisvarlena);
|
2004-10-15 19:08:26 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
outputstr = OidOutputFunctionCall(typoutput, attr);
|
|
|
|
sv = cstr2sv(outputstr);
|
|
|
|
pfree(outputstr);
|
|
|
|
}
|
2005-07-03 23:56:16 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
hv_store_string(hv, attname, sv);
|
|
|
|
}
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
2004-11-23 01:21:24 +01:00
|
|
|
return newRV_noinc((SV *) hv);
|
2000-01-20 06:08:58 +01:00
|
|
|
}
|
2004-09-13 22:10:13 +02:00
|
|
|
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
static void
|
2015-08-15 17:25:00 +02:00
|
|
|
check_spi_usage_allowed(void)
|
2010-01-30 02:46:57 +01:00
|
|
|
{
|
2010-02-12 20:35:25 +01:00
|
|
|
/* see comment in plperl_fini() */
|
2010-02-26 03:01:40 +01:00
|
|
|
if (plperl_ending)
|
|
|
|
{
|
2010-01-30 02:46:57 +01:00
|
|
|
/* simple croak as we don't want to involve PostgreSQL code */
|
|
|
|
croak("SPI functions can not be used in END blocks");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-09-13 22:10:13 +02:00
|
|
|
HV *
|
|
|
|
plperl_spi_exec(char *query, int limit)
|
|
|
|
{
|
|
|
|
HV *ret_hv;
|
|
|
|
|
2004-11-21 22:17:07 +01:00
|
|
|
/*
|
2005-10-15 04:49:52 +02:00
|
|
|
* Execute the query inside a sub-transaction, so we can cope with errors
|
|
|
|
* sanely
|
2004-11-21 22:17:07 +01:00
|
|
|
*/
|
|
|
|
MemoryContext oldcontext = CurrentMemoryContext;
|
|
|
|
ResourceOwner oldowner = CurrentResourceOwner;
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
2004-11-21 22:17:07 +01:00
|
|
|
BeginInternalSubTransaction(NULL);
|
|
|
|
/* Want to run inside function's memory context */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
|
|
|
|
PG_TRY();
|
|
|
|
{
|
|
|
|
int spi_rv;
|
|
|
|
|
2010-03-09 03:48:33 +01:00
|
|
|
pg_verifymbstr(query, strlen(query), false);
|
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
spi_rv = SPI_execute(query, current_call_data->prodesc->fn_readonly,
|
2004-11-21 22:17:07 +01:00
|
|
|
limit);
|
|
|
|
ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
|
|
|
|
spi_rv);
|
|
|
|
|
|
|
|
/* Commit the inner transaction, return to outer xact context */
|
|
|
|
ReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
}
|
|
|
|
PG_CATCH();
|
|
|
|
{
|
|
|
|
ErrorData *edata;
|
|
|
|
|
|
|
|
/* Save error info */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
edata = CopyErrorData();
|
|
|
|
FlushErrorState();
|
|
|
|
|
|
|
|
/* Abort the inner transaction */
|
|
|
|
RollbackAndReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
|
|
|
|
/* Punt the error to Perl */
|
2015-09-29 16:52:22 +02:00
|
|
|
croak_cstr(edata->message);
|
2004-11-21 22:17:07 +01:00
|
|
|
|
|
|
|
/* Can't get here, but keep compiler quiet */
|
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
2004-09-13 22:10:13 +02:00
|
|
|
|
|
|
|
return ret_hv;
|
|
|
|
}
|
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2004-09-13 22:10:13 +02:00
|
|
|
static HV *
|
Widen query numbers-of-tuples-processed counters to uint64.
This patch widens SPI_processed, EState's es_processed field, PortalData's
portalPos field, FuncCallContext's call_cntr and max_calls fields,
ExecutorRun's count argument, PortalRunFetch's result, and the max number
of rows in a SPITupleTable to uint64, and deals with (I hope) all the
ensuing fallout. Some of these values were declared uint32 before, and
others "long".
I also removed PortalData's posOverflow field, since that logic seems
pretty useless given that portalPos is now always 64 bits.
The user-visible results are that command tags for SELECT etc will
correctly report tuple counts larger than 4G, as will plpgsql's GET
GET DIAGNOSTICS ... ROW_COUNT command. Queries processing more tuples
than that are still not exactly the norm, but they're becoming more
common.
Most values associated with FETCH/MOVE distances, such as PortalRun's count
argument and the count argument of most SPI functions that have one, remain
declared as "long". It's not clear whether it would be worth promoting
those to int64; but it would definitely be a large dollop of additional
API churn on top of this, and it would only help 32-bit platforms which
seem relatively less likely to see any benefit.
Andreas Scherbaum, reviewed by Christian Ullrich, additional hacking by me
2016-03-12 22:05:10 +01:00
|
|
|
plperl_spi_execute_fetch_result(SPITupleTable *tuptable, uint64 processed,
|
2004-11-21 22:17:07 +01:00
|
|
|
int status)
|
2004-09-13 22:10:13 +02:00
|
|
|
{
|
|
|
|
HV *result;
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
2004-09-13 22:10:13 +02:00
|
|
|
result = newHV();
|
|
|
|
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(result, "status",
|
2011-02-06 23:29:26 +01:00
|
|
|
cstr2sv(SPI_result_code_string(status)));
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(result, "processed",
|
2016-03-14 19:38:36 +01:00
|
|
|
(processed > (uint64) UV_MAX) ?
|
|
|
|
newSVnv((NV) processed) :
|
|
|
|
newSVuv((UV) processed));
|
2004-09-13 22:10:13 +02:00
|
|
|
|
2006-08-28 01:47:58 +02:00
|
|
|
if (status > 0 && tuptable)
|
2004-09-13 22:10:13 +02:00
|
|
|
{
|
2004-11-21 22:17:07 +01:00
|
|
|
AV *rows;
|
2004-11-23 01:21:24 +01:00
|
|
|
SV *row;
|
Widen query numbers-of-tuples-processed counters to uint64.
This patch widens SPI_processed, EState's es_processed field, PortalData's
portalPos field, FuncCallContext's call_cntr and max_calls fields,
ExecutorRun's count argument, PortalRunFetch's result, and the max number
of rows in a SPITupleTable to uint64, and deals with (I hope) all the
ensuing fallout. Some of these values were declared uint32 before, and
others "long".
I also removed PortalData's posOverflow field, since that logic seems
pretty useless given that portalPos is now always 64 bits.
The user-visible results are that command tags for SELECT etc will
correctly report tuple counts larger than 4G, as will plpgsql's GET
GET DIAGNOSTICS ... ROW_COUNT command. Queries processing more tuples
than that are still not exactly the norm, but they're becoming more
common.
Most values associated with FETCH/MOVE distances, such as PortalRun's count
argument and the count argument of most SPI functions that have one, remain
declared as "long". It's not clear whether it would be worth promoting
those to int64; but it would definitely be a large dollop of additional
API churn on top of this, and it would only help 32-bit platforms which
seem relatively less likely to see any benefit.
Andreas Scherbaum, reviewed by Christian Ullrich, additional hacking by me
2016-03-12 22:05:10 +01:00
|
|
|
uint64 i;
|
|
|
|
|
2016-03-14 19:38:36 +01:00
|
|
|
/* Prevent overflow in call to av_extend() */
|
|
|
|
if (processed > (uint64) AV_SIZE_MAX)
|
Widen query numbers-of-tuples-processed counters to uint64.
This patch widens SPI_processed, EState's es_processed field, PortalData's
portalPos field, FuncCallContext's call_cntr and max_calls fields,
ExecutorRun's count argument, PortalRunFetch's result, and the max number
of rows in a SPITupleTable to uint64, and deals with (I hope) all the
ensuing fallout. Some of these values were declared uint32 before, and
others "long".
I also removed PortalData's posOverflow field, since that logic seems
pretty useless given that portalPos is now always 64 bits.
The user-visible results are that command tags for SELECT etc will
correctly report tuple counts larger than 4G, as will plpgsql's GET
GET DIAGNOSTICS ... ROW_COUNT command. Queries processing more tuples
than that are still not exactly the norm, but they're becoming more
common.
Most values associated with FETCH/MOVE distances, such as PortalRun's count
argument and the count argument of most SPI functions that have one, remain
declared as "long". It's not clear whether it would be worth promoting
those to int64; but it would definitely be a large dollop of additional
API churn on top of this, and it would only help 32-bit platforms which
seem relatively less likely to see any benefit.
Andreas Scherbaum, reviewed by Christian Ullrich, additional hacking by me
2016-03-12 22:05:10 +01:00
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
|
|
|
|
errmsg("query result has too many rows to fit in a Perl array")));
|
2004-09-13 22:10:13 +02:00
|
|
|
|
2004-11-21 22:17:07 +01:00
|
|
|
rows = newAV();
|
2010-01-27 00:11:56 +01:00
|
|
|
av_extend(rows, processed);
|
2004-11-21 22:17:07 +01:00
|
|
|
for (i = 0; i < processed; i++)
|
|
|
|
{
|
|
|
|
row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
|
2004-11-23 01:21:24 +01:00
|
|
|
av_push(rows, row);
|
2004-09-13 22:10:13 +02:00
|
|
|
}
|
2006-10-15 20:56:39 +02:00
|
|
|
hv_store_string(result, "rows",
|
|
|
|
newRV_noinc((SV *) rows));
|
2004-09-13 22:10:13 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
SPI_freetuptable(tuptable);
|
|
|
|
|
|
|
|
return result;
|
|
|
|
}
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
/*
|
|
|
|
* Note: plperl_return_next is called both in Postgres and Perl contexts.
|
2014-05-06 18:12:18 +02:00
|
|
|
* We report any errors in Postgres fashion (via ereport). If called in
|
2005-10-18 19:13:14 +02:00
|
|
|
* Perl context, it is SPI.xs's responsibility to catch the error and
|
|
|
|
* convert to a Perl error. We assume (perhaps without adequate justification)
|
|
|
|
* that we need not abort the current transaction if the Perl code traps the
|
|
|
|
* error.
|
|
|
|
*/
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
void
|
2005-10-18 19:13:14 +02:00
|
|
|
plperl_return_next(SV *sv)
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
{
|
2006-01-28 04:28:15 +01:00
|
|
|
plperl_proc_desc *prodesc;
|
|
|
|
FunctionCallInfo fcinfo;
|
|
|
|
ReturnSetInfo *rsi;
|
|
|
|
MemoryContext old_cxt;
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
|
|
|
if (!sv)
|
|
|
|
return;
|
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
prodesc = current_call_data->prodesc;
|
|
|
|
fcinfo = current_call_data->fcinfo;
|
|
|
|
rsi = (ReturnSetInfo *) fcinfo->resultinfo;
|
|
|
|
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
if (!prodesc->fn_retisset)
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_SYNTAX_ERROR),
|
|
|
|
errmsg("cannot use return_next in a non-SETOF function")));
|
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
if (!current_call_data->ret_tdesc)
|
|
|
|
{
|
2006-10-04 02:30:14 +02:00
|
|
|
TupleDesc tupdesc;
|
2006-01-28 04:28:15 +01:00
|
|
|
|
|
|
|
Assert(!current_call_data->tuple_store);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
/*
|
2006-10-04 02:30:14 +02:00
|
|
|
* This is the first call to return_next in the current PL/Perl
|
|
|
|
* function call, so memoize some lookups
|
2006-01-28 04:28:15 +01:00
|
|
|
*/
|
|
|
|
if (prodesc->fn_retistuple)
|
|
|
|
(void) get_call_result_type(fcinfo, NULL, &tupdesc);
|
|
|
|
else
|
|
|
|
tupdesc = rsi->expectedDesc;
|
|
|
|
|
|
|
|
/*
|
|
|
|
* Make sure the tuple_store and ret_tdesc are sufficiently
|
|
|
|
* long-lived.
|
|
|
|
*/
|
|
|
|
old_cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
|
|
|
|
|
|
|
|
current_call_data->ret_tdesc = CreateTupleDescCopy(tupdesc);
|
|
|
|
current_call_data->tuple_store =
|
2008-10-29 01:00:39 +01:00
|
|
|
tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
|
|
|
|
false, work_mem);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
MemoryContextSwitchTo(old_cxt);
|
2006-10-04 02:30:14 +02:00
|
|
|
}
|
2006-01-28 04:28:15 +01:00
|
|
|
|
|
|
|
/*
|
|
|
|
* Producing the tuple we want to return requires making plenty of
|
2006-10-04 02:30:14 +02:00
|
|
|
* palloc() allocations that are not cleaned up. Since this function can
|
|
|
|
* be called many times before the current memory context is reset, we
|
|
|
|
* need to do those allocations in a temporary context.
|
2006-01-28 04:28:15 +01:00
|
|
|
*/
|
|
|
|
if (!current_call_data->tmp_cxt)
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
{
|
2006-01-28 04:28:15 +01:00
|
|
|
current_call_data->tmp_cxt =
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
AllocSetContextCreate(CurrentMemoryContext,
|
2006-01-28 04:28:15 +01:00
|
|
|
"PL/Perl return_next temporary cxt",
|
Add macros to make AllocSetContextCreate() calls simpler and safer.
I found that half a dozen (nearly 5%) of our AllocSetContextCreate calls
had typos in the context-sizing parameters. While none of these led to
especially significant problems, they did create minor inefficiencies,
and it's now clear that expecting people to copy-and-paste those calls
accurately is not a great idea. Let's reduce the risk of future errors
by introducing single macros that encapsulate the common use-cases.
Three such macros are enough to cover all but two special-purpose contexts;
those two calls can be left as-is, I think.
While this patch doesn't in itself improve matters for third-party
extensions, it doesn't break anything for them either, and they can
gradually adopt the simplified notation over time.
In passing, change TopMemoryContext to use the default allocation
parameters. Formerly it could only be extended 8K at a time. That was
probably reasonable when this code was written; but nowadays we create
many more contexts than we did then, so that it's not unusual to have a
couple hundred K in TopMemoryContext, even without considering various
dubious code that sticks other things there. There seems no good reason
not to let it use growing blocks like most other contexts.
Back-patch to 9.6, mostly because that's still close enough to HEAD that
it's easy to do so, and keeping the branches in sync can be expected to
avoid some future back-patching pain. The bugs fixed by these changes
don't seem to be significant enough to justify fixing them further back.
Discussion: <21072.1472321324@sss.pgh.pa.us>
2016-08-27 23:50:38 +02:00
|
|
|
ALLOCSET_DEFAULT_SIZES);
|
2006-01-28 04:28:15 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
old_cxt = MemoryContextSwitchTo(current_call_data->tmp_cxt);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
if (prodesc->fn_retistuple)
|
|
|
|
{
|
2009-06-11 16:49:15 +02:00
|
|
|
HeapTuple tuple;
|
2008-03-25 20:26:54 +01:00
|
|
|
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
if (!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
|
|
|
|
ereport(ERROR,
|
|
|
|
(errcode(ERRCODE_DATATYPE_MISMATCH),
|
|
|
|
errmsg("SETOF-composite-returning PL/Perl function "
|
|
|
|
"must call return_next with reference to hash")));
|
|
|
|
|
2006-01-28 04:28:15 +01:00
|
|
|
tuple = plperl_build_tuple_result((HV *) SvRV(sv),
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
current_call_data->ret_tdesc);
|
2008-03-25 20:26:54 +01:00
|
|
|
tuplestore_puttuple(current_call_data->tuple_store, tuple);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
2006-04-04 21:35:37 +02:00
|
|
|
Datum ret;
|
|
|
|
bool isNull;
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2011-02-18 02:11:50 +01:00
|
|
|
ret = plperl_sv_to_datum(sv,
|
|
|
|
prodesc->result_oid,
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
-1,
|
|
|
|
fcinfo,
|
|
|
|
&prodesc->result_in_func,
|
2011-02-18 02:11:50 +01:00
|
|
|
prodesc->result_typioparam,
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
&isNull);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
|
2008-03-25 20:26:54 +01:00
|
|
|
tuplestore_putvalues(current_call_data->tuple_store,
|
|
|
|
current_call_data->ret_tdesc,
|
|
|
|
&ret, &isNull);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
}
|
|
|
|
|
2009-12-29 18:40:59 +01:00
|
|
|
MemoryContextSwitchTo(old_cxt);
|
2006-01-28 04:28:15 +01:00
|
|
|
MemoryContextReset(current_call_data->tmp_cxt);
|
At 2005-05-21 20:18:50 +0530, ams@oryx.com wrote:
>
> > The second issue is where plperl returns a large result set.
I have attached the following seven patches to address this problem:
1. Trivial. Replaces some errant spaces with tabs.
2. Trivial. Fixes the spelling of Jan's name, and gets rid of many
inane, useless, annoying, and often misleading comments. Here's
a sample: "plperl_init_all() - Initialize all".
(I have tried to add some useful comments here and there, and will
continue to do so now and again.)
3. Trivial. Splits up some long lines.
4. Converts SRFs in PL/Perl to use a Tuplestore and SFRM_Materialize
to return the result set, based on the PL/PgSQL model.
There are two major consequences: result sets will spill to disk when
they can no longer fit in work_mem; and "select foo_srf()" no longer
works. (I didn't lose sleep over the latter, since that form is not
valid in PL/PgSQL, and it's not documented in PL/Perl.)
5. Trivial, but important. Fixes use of "undef" instead of undef. This
would cause empty functions to fail in bizarre ways. I suspect that
there's still another (old) bug here. I'll investigate further.
6. Moves the majority of (4) out into a new plperl_return_next()
function, to make it possible to expose the functionality to
Perl; cleans up some of the code besides.
7. Add an spi_return_next function for use in Perl code.
If you want to apply the patches and try them out, 8-composite.diff is
what you should use. (Note: my patches depend upon Andrew's use-strict
and %_SHARED patches being applied.)
Here's something to try:
create or replace function foo() returns setof record as $$
$i = 0;
for ("World", "PostgreSQL", "PL/Perl") {
spi_return_next({f1=>++$i, f2=>'Hello', f3=>$_});
}
return;
$$ language plperl;
select * from foo() as (f1 integer, f2 text, f3 text);
(Many thanks to Andrews Dunstan and Supernews for their help.)
Abhijit Menon-Sen
2005-06-04 22:33:06 +02:00
|
|
|
}
|
2005-07-10 17:19:43 +02:00
|
|
|
|
|
|
|
|
|
|
|
SV *
|
|
|
|
plperl_spi_query(char *query)
|
|
|
|
{
|
2005-10-15 04:49:52 +02:00
|
|
|
SV *cursor;
|
2005-07-10 17:19:43 +02:00
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
/*
|
|
|
|
* Execute the query inside a sub-transaction, so we can cope with errors
|
|
|
|
* sanely
|
|
|
|
*/
|
2005-07-10 17:19:43 +02:00
|
|
|
MemoryContext oldcontext = CurrentMemoryContext;
|
|
|
|
ResourceOwner oldowner = CurrentResourceOwner;
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
2005-07-10 17:19:43 +02:00
|
|
|
BeginInternalSubTransaction(NULL);
|
2005-10-18 19:13:14 +02:00
|
|
|
/* Want to run inside function's memory context */
|
2005-07-10 17:19:43 +02:00
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
|
|
|
|
PG_TRY();
|
|
|
|
{
|
2011-09-16 06:42:53 +02:00
|
|
|
SPIPlanPtr plan;
|
2006-03-05 17:40:51 +01:00
|
|
|
Portal portal;
|
2005-07-10 17:19:43 +02:00
|
|
|
|
2010-03-09 03:48:33 +01:00
|
|
|
/* Make sure the query is validly encoded */
|
|
|
|
pg_verifymbstr(query, strlen(query), false);
|
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
/* Create a cursor for the query */
|
2005-07-10 17:19:43 +02:00
|
|
|
plan = SPI_prepare(query, 0, NULL);
|
2006-10-04 02:30:14 +02:00
|
|
|
if (plan == NULL)
|
2006-03-05 17:40:51 +01:00
|
|
|
elog(ERROR, "SPI_prepare() failed:%s",
|
2006-10-04 02:30:14 +02:00
|
|
|
SPI_result_code_string(SPI_result));
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
|
2006-10-04 02:30:14 +02:00
|
|
|
SPI_freeplan(plan);
|
|
|
|
if (portal == NULL)
|
2006-03-05 17:40:51 +01:00
|
|
|
elog(ERROR, "SPI_cursor_open() failed:%s",
|
2006-10-04 02:30:14 +02:00
|
|
|
SPI_result_code_string(SPI_result));
|
2011-02-06 23:29:26 +01:00
|
|
|
cursor = cstr2sv(portal->name);
|
2005-07-10 17:19:43 +02:00
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
/* Commit the inner transaction, return to outer xact context */
|
2005-07-10 17:19:43 +02:00
|
|
|
ReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
}
|
|
|
|
PG_CATCH();
|
|
|
|
{
|
|
|
|
ErrorData *edata;
|
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
/* Save error info */
|
2005-07-10 17:19:43 +02:00
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
edata = CopyErrorData();
|
|
|
|
FlushErrorState();
|
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
/* Abort the inner transaction */
|
2005-07-10 17:19:43 +02:00
|
|
|
RollbackAndReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
/* Punt the error to Perl */
|
2015-09-29 16:52:22 +02:00
|
|
|
croak_cstr(edata->message);
|
2005-10-18 19:13:14 +02:00
|
|
|
|
|
|
|
/* Can't get here, but keep compiler quiet */
|
2005-07-10 17:19:43 +02:00
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
|
|
|
|
|
|
|
return cursor;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
SV *
|
|
|
|
plperl_spi_fetchrow(char *cursor)
|
|
|
|
{
|
2005-10-18 19:13:14 +02:00
|
|
|
SV *row;
|
|
|
|
|
|
|
|
/*
|
|
|
|
* Execute the FETCH inside a sub-transaction, so we can cope with errors
|
|
|
|
* sanely
|
|
|
|
*/
|
|
|
|
MemoryContext oldcontext = CurrentMemoryContext;
|
|
|
|
ResourceOwner oldowner = CurrentResourceOwner;
|
2005-07-10 17:19:43 +02:00
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
BeginInternalSubTransaction(NULL);
|
|
|
|
/* Want to run inside function's memory context */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
2005-07-10 17:19:43 +02:00
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
PG_TRY();
|
2005-10-15 04:49:52 +02:00
|
|
|
{
|
2005-10-18 19:13:14 +02:00
|
|
|
Portal p = SPI_cursor_find(cursor);
|
|
|
|
|
|
|
|
if (!p)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
|
|
|
row = &PL_sv_undef;
|
|
|
|
}
|
2005-10-18 19:13:14 +02:00
|
|
|
else
|
|
|
|
{
|
|
|
|
SPI_cursor_fetch(p, true, 1);
|
|
|
|
if (SPI_processed == 0)
|
|
|
|
{
|
|
|
|
SPI_cursor_close(p);
|
2006-03-05 17:40:51 +01:00
|
|
|
row = &PL_sv_undef;
|
2005-10-18 19:13:14 +02:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
row = plperl_hash_from_tuple(SPI_tuptable->vals[0],
|
|
|
|
SPI_tuptable->tupdesc);
|
|
|
|
}
|
|
|
|
SPI_freetuptable(SPI_tuptable);
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Commit the inner transaction, return to outer xact context */
|
|
|
|
ReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
2005-07-10 17:19:43 +02:00
|
|
|
}
|
2005-10-18 19:13:14 +02:00
|
|
|
PG_CATCH();
|
|
|
|
{
|
|
|
|
ErrorData *edata;
|
2005-07-10 17:19:43 +02:00
|
|
|
|
2005-10-18 19:13:14 +02:00
|
|
|
/* Save error info */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
edata = CopyErrorData();
|
|
|
|
FlushErrorState();
|
|
|
|
|
|
|
|
/* Abort the inner transaction */
|
|
|
|
RollbackAndReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
|
|
|
|
/* Punt the error to Perl */
|
2015-09-29 16:52:22 +02:00
|
|
|
croak_cstr(edata->message);
|
2005-10-18 19:13:14 +02:00
|
|
|
|
|
|
|
/* Can't get here, but keep compiler quiet */
|
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
2005-07-10 17:19:43 +02:00
|
|
|
|
|
|
|
return row;
|
|
|
|
}
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
void
|
|
|
|
plperl_spi_cursor_close(char *cursor)
|
|
|
|
{
|
2010-01-30 02:46:57 +01:00
|
|
|
Portal p;
|
|
|
|
|
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
|
|
|
p = SPI_cursor_find(cursor);
|
2006-10-04 02:30:14 +02:00
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
if (p)
|
|
|
|
SPI_cursor_close(p);
|
|
|
|
}
|
|
|
|
|
|
|
|
SV *
|
2006-10-04 02:30:14 +02:00
|
|
|
plperl_spi_prepare(char *query, int argc, SV **argv)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2013-03-02 03:33:34 +01:00
|
|
|
volatile SPIPlanPtr plan = NULL;
|
|
|
|
volatile MemoryContext plan_cxt = NULL;
|
|
|
|
plperl_query_desc *volatile qdesc = NULL;
|
|
|
|
plperl_query_entry *volatile hash_entry = NULL;
|
2006-03-05 17:40:51 +01:00
|
|
|
MemoryContext oldcontext = CurrentMemoryContext;
|
|
|
|
ResourceOwner oldowner = CurrentResourceOwner;
|
2013-03-02 03:33:34 +01:00
|
|
|
MemoryContext work_cxt;
|
|
|
|
bool found;
|
|
|
|
int i;
|
2006-03-05 17:40:51 +01:00
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
BeginInternalSubTransaction(NULL);
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
|
|
|
|
PG_TRY();
|
|
|
|
{
|
2013-03-02 03:33:34 +01:00
|
|
|
CHECK_FOR_INTERRUPTS();
|
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* Allocate the new querydesc structure
|
|
|
|
*
|
|
|
|
* The qdesc struct, as well as all its subsidiary data, lives in its
|
|
|
|
* plan_cxt. But note that the SPIPlan does not.
|
|
|
|
************************************************************/
|
|
|
|
plan_cxt = AllocSetContextCreate(TopMemoryContext,
|
|
|
|
"PL/Perl spi_prepare query",
|
Add macros to make AllocSetContextCreate() calls simpler and safer.
I found that half a dozen (nearly 5%) of our AllocSetContextCreate calls
had typos in the context-sizing parameters. While none of these led to
especially significant problems, they did create minor inefficiencies,
and it's now clear that expecting people to copy-and-paste those calls
accurately is not a great idea. Let's reduce the risk of future errors
by introducing single macros that encapsulate the common use-cases.
Three such macros are enough to cover all but two special-purpose contexts;
those two calls can be left as-is, I think.
While this patch doesn't in itself improve matters for third-party
extensions, it doesn't break anything for them either, and they can
gradually adopt the simplified notation over time.
In passing, change TopMemoryContext to use the default allocation
parameters. Formerly it could only be extended 8K at a time. That was
probably reasonable when this code was written; but nowadays we create
many more contexts than we did then, so that it's not unusual to have a
couple hundred K in TopMemoryContext, even without considering various
dubious code that sticks other things there. There seems no good reason
not to let it use growing blocks like most other contexts.
Back-patch to 9.6, mostly because that's still close enough to HEAD that
it's easy to do so, and keeping the branches in sync can be expected to
avoid some future back-patching pain. The bugs fixed by these changes
don't seem to be significant enough to justify fixing them further back.
Discussion: <21072.1472321324@sss.pgh.pa.us>
2016-08-27 23:50:38 +02:00
|
|
|
ALLOCSET_SMALL_SIZES);
|
2013-03-02 03:33:34 +01:00
|
|
|
MemoryContextSwitchTo(plan_cxt);
|
|
|
|
qdesc = (plperl_query_desc *) palloc0(sizeof(plperl_query_desc));
|
|
|
|
snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc);
|
|
|
|
qdesc->plan_cxt = plan_cxt;
|
|
|
|
qdesc->nargs = argc;
|
|
|
|
qdesc->argtypes = (Oid *) palloc(argc * sizeof(Oid));
|
|
|
|
qdesc->arginfuncs = (FmgrInfo *) palloc(argc * sizeof(FmgrInfo));
|
|
|
|
qdesc->argtypioparams = (Oid *) palloc(argc * sizeof(Oid));
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* Do the following work in a short-lived context so that we don't
|
|
|
|
* leak a lot of memory in the PL/Perl function's SPI Proc context.
|
|
|
|
************************************************************/
|
|
|
|
work_cxt = AllocSetContextCreate(CurrentMemoryContext,
|
|
|
|
"PL/Perl spi_prepare workspace",
|
Add macros to make AllocSetContextCreate() calls simpler and safer.
I found that half a dozen (nearly 5%) of our AllocSetContextCreate calls
had typos in the context-sizing parameters. While none of these led to
especially significant problems, they did create minor inefficiencies,
and it's now clear that expecting people to copy-and-paste those calls
accurately is not a great idea. Let's reduce the risk of future errors
by introducing single macros that encapsulate the common use-cases.
Three such macros are enough to cover all but two special-purpose contexts;
those two calls can be left as-is, I think.
While this patch doesn't in itself improve matters for third-party
extensions, it doesn't break anything for them either, and they can
gradually adopt the simplified notation over time.
In passing, change TopMemoryContext to use the default allocation
parameters. Formerly it could only be extended 8K at a time. That was
probably reasonable when this code was written; but nowadays we create
many more contexts than we did then, so that it's not unusual to have a
couple hundred K in TopMemoryContext, even without considering various
dubious code that sticks other things there. There seems no good reason
not to let it use growing blocks like most other contexts.
Back-patch to 9.6, mostly because that's still close enough to HEAD that
it's easy to do so, and keeping the branches in sync can be expected to
avoid some future back-patching pain. The bugs fixed by these changes
don't seem to be significant enough to justify fixing them further back.
Discussion: <21072.1472321324@sss.pgh.pa.us>
2016-08-27 23:50:38 +02:00
|
|
|
ALLOCSET_DEFAULT_SIZES);
|
2013-03-02 03:33:34 +01:00
|
|
|
MemoryContextSwitchTo(work_cxt);
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
/************************************************************
|
2007-02-09 04:35:35 +01:00
|
|
|
* Resolve argument type names and then look them up by oid
|
|
|
|
* in the system cache, and remember the required information
|
|
|
|
* for input conversion.
|
2006-03-05 17:40:51 +01:00
|
|
|
************************************************************/
|
|
|
|
for (i = 0; i < argc; i++)
|
|
|
|
{
|
2007-11-15 22:14:46 +01:00
|
|
|
Oid typId,
|
|
|
|
typInput,
|
|
|
|
typIOParam;
|
|
|
|
int32 typmod;
|
2011-02-17 20:40:13 +01:00
|
|
|
char *typstr;
|
2007-01-27 02:55:57 +01:00
|
|
|
|
2011-02-06 23:29:26 +01:00
|
|
|
typstr = sv2cstr(argv[i]);
|
2014-04-08 16:27:56 +02:00
|
|
|
parseTypeString(typstr, &typId, &typmod, false);
|
2011-02-06 23:29:26 +01:00
|
|
|
pfree(typstr);
|
2007-01-27 02:55:57 +01:00
|
|
|
|
|
|
|
getTypeInputInfo(typId, &typInput, &typIOParam);
|
|
|
|
|
|
|
|
qdesc->argtypes[i] = typId;
|
2013-03-02 03:33:34 +01:00
|
|
|
fmgr_info_cxt(typInput, &(qdesc->arginfuncs[i]), plan_cxt);
|
2007-01-27 02:55:57 +01:00
|
|
|
qdesc->argtypioparams[i] = typIOParam;
|
2006-03-05 17:40:51 +01:00
|
|
|
}
|
|
|
|
|
2010-03-09 03:48:33 +01:00
|
|
|
/* Make sure the query is validly encoded */
|
|
|
|
pg_verifymbstr(query, strlen(query), false);
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
/************************************************************
|
|
|
|
* Prepare the plan and check for errors
|
|
|
|
************************************************************/
|
|
|
|
plan = SPI_prepare(query, argc, qdesc->argtypes);
|
|
|
|
|
|
|
|
if (plan == NULL)
|
|
|
|
elog(ERROR, "SPI_prepare() failed:%s",
|
2006-10-04 02:30:14 +02:00
|
|
|
SPI_result_code_string(SPI_result));
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* Save the plan into permanent memory (right now it's in the
|
|
|
|
* SPI procCxt, which will go away at function end).
|
|
|
|
************************************************************/
|
2011-09-16 06:42:53 +02:00
|
|
|
if (SPI_keepplan(plan))
|
|
|
|
elog(ERROR, "SPI_keepplan() failed");
|
|
|
|
qdesc->plan = plan;
|
2006-03-05 17:40:51 +01:00
|
|
|
|
2013-03-02 03:33:34 +01:00
|
|
|
/************************************************************
|
|
|
|
* Insert a hashtable entry for the plan.
|
|
|
|
************************************************************/
|
|
|
|
hash_entry = hash_search(plperl_active_interp->query_hash,
|
|
|
|
qdesc->qname,
|
|
|
|
HASH_ENTER, &found);
|
|
|
|
hash_entry->query_data = qdesc;
|
|
|
|
|
|
|
|
/* Get rid of workspace */
|
|
|
|
MemoryContextDelete(work_cxt);
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
/* Commit the inner transaction, return to outer xact context */
|
|
|
|
ReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
}
|
|
|
|
PG_CATCH();
|
|
|
|
{
|
|
|
|
ErrorData *edata;
|
2006-10-04 02:30:14 +02:00
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
/* Save error info */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
edata = CopyErrorData();
|
|
|
|
FlushErrorState();
|
|
|
|
|
2013-03-02 03:33:34 +01:00
|
|
|
/* Drop anything we managed to allocate */
|
|
|
|
if (hash_entry)
|
|
|
|
hash_search(plperl_active_interp->query_hash,
|
|
|
|
qdesc->qname,
|
|
|
|
HASH_REMOVE, NULL);
|
|
|
|
if (plan_cxt)
|
|
|
|
MemoryContextDelete(plan_cxt);
|
|
|
|
if (plan)
|
|
|
|
SPI_freeplan(plan);
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
/* Abort the inner transaction */
|
|
|
|
RollbackAndReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
|
|
|
|
/* Punt the error to Perl */
|
2015-09-29 16:52:22 +02:00
|
|
|
croak_cstr(edata->message);
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
/* Can't get here, but keep compiler quiet */
|
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
|
|
|
|
|
|
|
/************************************************************
|
2013-03-02 03:33:34 +01:00
|
|
|
* Return the query's hash key to the caller.
|
2006-03-05 17:40:51 +01:00
|
|
|
************************************************************/
|
2011-02-06 23:29:26 +01:00
|
|
|
return cstr2sv(qdesc->qname);
|
2006-10-04 02:30:14 +02:00
|
|
|
}
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
HV *
|
2006-10-04 02:30:14 +02:00
|
|
|
plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
|
|
|
HV *ret_hv;
|
2006-10-04 02:30:14 +02:00
|
|
|
SV **sv;
|
|
|
|
int i,
|
|
|
|
limit,
|
|
|
|
spi_rv;
|
|
|
|
char *nulls;
|
2006-03-05 17:40:51 +01:00
|
|
|
Datum *argvalues;
|
|
|
|
plperl_query_desc *qdesc;
|
2006-11-13 18:13:57 +01:00
|
|
|
plperl_query_entry *hash_entry;
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
/*
|
2006-10-04 02:30:14 +02:00
|
|
|
* Execute the query inside a sub-transaction, so we can cope with errors
|
|
|
|
* sanely
|
2006-03-05 17:40:51 +01:00
|
|
|
*/
|
|
|
|
MemoryContext oldcontext = CurrentMemoryContext;
|
|
|
|
ResourceOwner oldowner = CurrentResourceOwner;
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
BeginInternalSubTransaction(NULL);
|
|
|
|
/* Want to run inside function's memory context */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
|
|
|
|
PG_TRY();
|
|
|
|
{
|
|
|
|
/************************************************************
|
|
|
|
* Fetch the saved plan descriptor, see if it's o.k.
|
|
|
|
************************************************************/
|
2010-09-30 23:18:51 +02:00
|
|
|
hash_entry = hash_search(plperl_active_interp->query_hash, query,
|
2007-11-15 22:14:46 +01:00
|
|
|
HASH_FIND, NULL);
|
2006-11-13 18:13:57 +01:00
|
|
|
if (hash_entry == NULL)
|
2006-03-05 17:40:51 +01:00
|
|
|
elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
|
|
|
|
|
2006-11-13 18:13:57 +01:00
|
|
|
qdesc = hash_entry->query_data;
|
2006-10-04 02:30:14 +02:00
|
|
|
if (qdesc == NULL)
|
2013-03-02 03:33:34 +01:00
|
|
|
elog(ERROR, "spi_exec_prepared: plperl query_hash value vanished");
|
2006-03-05 17:40:51 +01:00
|
|
|
|
2006-10-04 02:30:14 +02:00
|
|
|
if (qdesc->nargs != argc)
|
|
|
|
elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed",
|
|
|
|
qdesc->nargs, argc);
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
/************************************************************
|
|
|
|
* Parse eventual attributes
|
|
|
|
************************************************************/
|
|
|
|
limit = 0;
|
2006-10-04 02:30:14 +02:00
|
|
|
if (attr != NULL)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2006-10-15 20:56:39 +02:00
|
|
|
sv = hv_fetch_string(attr, "limit");
|
2011-02-18 02:11:50 +01:00
|
|
|
if (sv && *sv && SvIOK(*sv))
|
2006-10-04 02:30:14 +02:00
|
|
|
limit = SvIV(*sv);
|
2006-03-05 17:40:51 +01:00
|
|
|
}
|
|
|
|
/************************************************************
|
|
|
|
* Set up arguments
|
|
|
|
************************************************************/
|
2006-10-04 02:30:14 +02:00
|
|
|
if (argc > 0)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2006-04-04 21:35:37 +02:00
|
|
|
nulls = (char *) palloc(argc);
|
2006-03-05 17:40:51 +01:00
|
|
|
argvalues = (Datum *) palloc(argc * sizeof(Datum));
|
2006-10-04 02:30:14 +02:00
|
|
|
}
|
|
|
|
else
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
|
|
|
nulls = NULL;
|
|
|
|
argvalues = NULL;
|
|
|
|
}
|
|
|
|
|
2006-10-04 02:30:14 +02:00
|
|
|
for (i = 0; i < argc; i++)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2011-02-18 02:11:50 +01:00
|
|
|
bool isnull;
|
|
|
|
|
|
|
|
argvalues[i] = plperl_sv_to_datum(argv[i],
|
|
|
|
qdesc->argtypes[i],
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
-1,
|
|
|
|
NULL,
|
|
|
|
&qdesc->arginfuncs[i],
|
2011-02-18 02:11:50 +01:00
|
|
|
qdesc->argtypioparams[i],
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
&isnull);
|
2011-02-18 02:11:50 +01:00
|
|
|
nulls[i] = isnull ? 'n' : ' ';
|
2006-03-05 17:40:51 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* go
|
|
|
|
************************************************************/
|
2006-10-04 02:30:14 +02:00
|
|
|
spi_rv = SPI_execute_plan(qdesc->plan, argvalues, nulls,
|
2006-03-05 17:40:51 +01:00
|
|
|
current_call_data->prodesc->fn_readonly, limit);
|
|
|
|
ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
|
|
|
|
spi_rv);
|
2006-10-04 02:30:14 +02:00
|
|
|
if (argc > 0)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2006-10-04 02:30:14 +02:00
|
|
|
pfree(argvalues);
|
|
|
|
pfree(nulls);
|
2006-03-05 17:40:51 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
/* Commit the inner transaction, return to outer xact context */
|
|
|
|
ReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
}
|
|
|
|
PG_CATCH();
|
|
|
|
{
|
|
|
|
ErrorData *edata;
|
|
|
|
|
|
|
|
/* Save error info */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
edata = CopyErrorData();
|
|
|
|
FlushErrorState();
|
|
|
|
|
|
|
|
/* Abort the inner transaction */
|
|
|
|
RollbackAndReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
|
|
|
|
/* Punt the error to Perl */
|
2015-09-29 16:52:22 +02:00
|
|
|
croak_cstr(edata->message);
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
/* Can't get here, but keep compiler quiet */
|
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
|
|
|
|
|
|
|
return ret_hv;
|
|
|
|
}
|
|
|
|
|
|
|
|
SV *
|
2006-10-04 02:30:14 +02:00
|
|
|
plperl_spi_query_prepared(char *query, int argc, SV **argv)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2006-10-04 02:30:14 +02:00
|
|
|
int i;
|
|
|
|
char *nulls;
|
2006-03-05 17:40:51 +01:00
|
|
|
Datum *argvalues;
|
|
|
|
plperl_query_desc *qdesc;
|
2006-11-13 18:13:57 +01:00
|
|
|
plperl_query_entry *hash_entry;
|
2006-10-04 02:30:14 +02:00
|
|
|
SV *cursor;
|
|
|
|
Portal portal = NULL;
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
/*
|
2006-10-04 02:30:14 +02:00
|
|
|
* Execute the query inside a sub-transaction, so we can cope with errors
|
|
|
|
* sanely
|
2006-03-05 17:40:51 +01:00
|
|
|
*/
|
|
|
|
MemoryContext oldcontext = CurrentMemoryContext;
|
|
|
|
ResourceOwner oldowner = CurrentResourceOwner;
|
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
BeginInternalSubTransaction(NULL);
|
|
|
|
/* Want to run inside function's memory context */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
|
|
|
|
PG_TRY();
|
|
|
|
{
|
|
|
|
/************************************************************
|
|
|
|
* Fetch the saved plan descriptor, see if it's o.k.
|
|
|
|
************************************************************/
|
2010-09-30 23:18:51 +02:00
|
|
|
hash_entry = hash_search(plperl_active_interp->query_hash, query,
|
2007-11-15 22:14:46 +01:00
|
|
|
HASH_FIND, NULL);
|
2006-11-13 18:13:57 +01:00
|
|
|
if (hash_entry == NULL)
|
2013-03-02 03:33:34 +01:00
|
|
|
elog(ERROR, "spi_query_prepared: Invalid prepared query passed");
|
2006-11-13 18:13:57 +01:00
|
|
|
|
|
|
|
qdesc = hash_entry->query_data;
|
2006-10-04 02:30:14 +02:00
|
|
|
if (qdesc == NULL)
|
2013-03-02 03:33:34 +01:00
|
|
|
elog(ERROR, "spi_query_prepared: plperl query_hash value vanished");
|
2006-03-05 17:40:51 +01:00
|
|
|
|
2006-10-04 02:30:14 +02:00
|
|
|
if (qdesc->nargs != argc)
|
|
|
|
elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed",
|
|
|
|
qdesc->nargs, argc);
|
|
|
|
|
2006-03-05 17:40:51 +01:00
|
|
|
/************************************************************
|
|
|
|
* Set up arguments
|
|
|
|
************************************************************/
|
2006-10-04 02:30:14 +02:00
|
|
|
if (argc > 0)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2006-04-04 21:35:37 +02:00
|
|
|
nulls = (char *) palloc(argc);
|
2006-03-05 17:40:51 +01:00
|
|
|
argvalues = (Datum *) palloc(argc * sizeof(Datum));
|
2006-10-04 02:30:14 +02:00
|
|
|
}
|
|
|
|
else
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
|
|
|
nulls = NULL;
|
|
|
|
argvalues = NULL;
|
|
|
|
}
|
|
|
|
|
2006-10-04 02:30:14 +02:00
|
|
|
for (i = 0; i < argc; i++)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2011-02-18 02:11:50 +01:00
|
|
|
bool isnull;
|
|
|
|
|
|
|
|
argvalues[i] = plperl_sv_to_datum(argv[i],
|
|
|
|
qdesc->argtypes[i],
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
-1,
|
|
|
|
NULL,
|
|
|
|
&qdesc->arginfuncs[i],
|
2011-02-18 02:11:50 +01:00
|
|
|
qdesc->argtypioparams[i],
|
Fix up Perl-to-Postgres datatype conversions in pl/perl.
This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement. 9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.
Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format. We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.
In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively. Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.
Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.
Alex Hunsaker and Tom Lane
2011-10-14 00:02:43 +02:00
|
|
|
&isnull);
|
2011-02-18 02:11:50 +01:00
|
|
|
nulls[i] = isnull ? 'n' : ' ';
|
2006-03-05 17:40:51 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
/************************************************************
|
|
|
|
* go
|
|
|
|
************************************************************/
|
2006-10-04 02:30:14 +02:00
|
|
|
portal = SPI_cursor_open(NULL, qdesc->plan, argvalues, nulls,
|
|
|
|
current_call_data->prodesc->fn_readonly);
|
|
|
|
if (argc > 0)
|
2006-03-05 17:40:51 +01:00
|
|
|
{
|
2006-10-04 02:30:14 +02:00
|
|
|
pfree(argvalues);
|
|
|
|
pfree(nulls);
|
2006-03-05 17:40:51 +01:00
|
|
|
}
|
2006-10-04 02:30:14 +02:00
|
|
|
if (portal == NULL)
|
2006-03-05 17:40:51 +01:00
|
|
|
elog(ERROR, "SPI_cursor_open() failed:%s",
|
2006-10-04 02:30:14 +02:00
|
|
|
SPI_result_code_string(SPI_result));
|
2006-03-05 17:40:51 +01:00
|
|
|
|
2011-02-06 23:29:26 +01:00
|
|
|
cursor = cstr2sv(portal->name);
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
/* Commit the inner transaction, return to outer xact context */
|
|
|
|
ReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
}
|
|
|
|
PG_CATCH();
|
|
|
|
{
|
|
|
|
ErrorData *edata;
|
|
|
|
|
|
|
|
/* Save error info */
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
edata = CopyErrorData();
|
|
|
|
FlushErrorState();
|
|
|
|
|
|
|
|
/* Abort the inner transaction */
|
|
|
|
RollbackAndReleaseCurrentSubTransaction();
|
|
|
|
MemoryContextSwitchTo(oldcontext);
|
|
|
|
CurrentResourceOwner = oldowner;
|
|
|
|
|
|
|
|
/* Punt the error to Perl */
|
2015-09-29 16:52:22 +02:00
|
|
|
croak_cstr(edata->message);
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
/* Can't get here, but keep compiler quiet */
|
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
PG_END_TRY();
|
|
|
|
|
|
|
|
return cursor;
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
plperl_spi_freeplan(char *query)
|
|
|
|
{
|
2011-09-16 06:42:53 +02:00
|
|
|
SPIPlanPtr plan;
|
2006-03-05 17:40:51 +01:00
|
|
|
plperl_query_desc *qdesc;
|
2006-11-13 18:13:57 +01:00
|
|
|
plperl_query_entry *hash_entry;
|
2006-03-05 17:40:51 +01:00
|
|
|
|
2010-01-30 02:46:57 +01:00
|
|
|
check_spi_usage_allowed();
|
|
|
|
|
2010-09-30 23:18:51 +02:00
|
|
|
hash_entry = hash_search(plperl_active_interp->query_hash, query,
|
2007-11-15 22:14:46 +01:00
|
|
|
HASH_FIND, NULL);
|
2006-11-13 18:13:57 +01:00
|
|
|
if (hash_entry == NULL)
|
2013-03-02 03:33:34 +01:00
|
|
|
elog(ERROR, "spi_freeplan: Invalid prepared query passed");
|
2006-11-13 18:13:57 +01:00
|
|
|
|
|
|
|
qdesc = hash_entry->query_data;
|
2006-10-04 02:30:14 +02:00
|
|
|
if (qdesc == NULL)
|
2013-03-02 03:33:34 +01:00
|
|
|
elog(ERROR, "spi_freeplan: plperl query_hash value vanished");
|
|
|
|
plan = qdesc->plan;
|
2006-03-05 17:40:51 +01:00
|
|
|
|
|
|
|
/*
|
2006-10-04 02:30:14 +02:00
|
|
|
* free all memory before SPI_freeplan, so if it dies, nothing will be
|
|
|
|
* left over
|
|
|
|
*/
|
2010-09-30 23:18:51 +02:00
|
|
|
hash_search(plperl_active_interp->query_hash, query,
|
2007-02-09 04:35:35 +01:00
|
|
|
HASH_REMOVE, NULL);
|
2006-11-13 18:13:57 +01:00
|
|
|
|
2013-03-02 03:33:34 +01:00
|
|
|
MemoryContextDelete(qdesc->plan_cxt);
|
2006-03-05 17:40:51 +01:00
|
|
|
|
2006-10-04 02:30:14 +02:00
|
|
|
SPI_freeplan(plan);
|
2006-03-05 17:40:51 +01:00
|
|
|
}
|
2006-10-15 20:56:39 +02:00
|
|
|
|
|
|
|
/*
|
|
|
|
* Store an SV into a hash table under a key that is a string assumed to be
|
|
|
|
* in the current database's encoding.
|
|
|
|
*/
|
|
|
|
static SV **
|
|
|
|
hv_store_string(HV *hv, const char *key, SV *val)
|
|
|
|
{
|
2011-02-06 23:29:26 +01:00
|
|
|
int32 hlen;
|
2011-02-17 20:40:13 +01:00
|
|
|
char *hkey;
|
|
|
|
SV **ret;
|
2011-02-06 23:29:26 +01:00
|
|
|
|
2014-02-23 22:59:05 +01:00
|
|
|
hkey = pg_server_to_any(key, strlen(key), PG_UTF8);
|
2006-10-15 20:56:39 +02:00
|
|
|
|
|
|
|
/*
|
2016-03-14 19:45:45 +01:00
|
|
|
* hv_store() recognizes a negative klen parameter as meaning a UTF-8
|
|
|
|
* encoded key.
|
2006-10-15 20:56:39 +02:00
|
|
|
*/
|
2011-06-09 20:32:50 +02:00
|
|
|
hlen = -(int) strlen(hkey);
|
2011-02-06 23:29:26 +01:00
|
|
|
ret = hv_store(hv, hkey, hlen, val, 0);
|
|
|
|
|
|
|
|
if (hkey != key)
|
|
|
|
pfree(hkey);
|
|
|
|
|
|
|
|
return ret;
|
2006-10-15 20:56:39 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
/*
|
|
|
|
* Fetch an SV from a hash table under a key that is a string assumed to be
|
|
|
|
* in the current database's encoding.
|
|
|
|
*/
|
|
|
|
static SV **
|
|
|
|
hv_fetch_string(HV *hv, const char *key)
|
|
|
|
{
|
2011-02-06 23:29:26 +01:00
|
|
|
int32 hlen;
|
2011-02-17 20:40:13 +01:00
|
|
|
char *hkey;
|
|
|
|
SV **ret;
|
2011-02-06 23:29:26 +01:00
|
|
|
|
2014-02-23 22:59:05 +01:00
|
|
|
hkey = pg_server_to_any(key, strlen(key), PG_UTF8);
|
2006-10-15 20:56:39 +02:00
|
|
|
|
|
|
|
/* See notes in hv_store_string */
|
2011-06-09 20:32:50 +02:00
|
|
|
hlen = -(int) strlen(hkey);
|
2011-02-06 23:29:26 +01:00
|
|
|
ret = hv_fetch(hv, hkey, hlen, 0);
|
|
|
|
|
2011-02-17 20:40:13 +01:00
|
|
|
if (hkey != key)
|
2011-02-06 23:29:26 +01:00
|
|
|
pfree(hkey);
|
|
|
|
|
|
|
|
return ret;
|
2006-10-15 20:56:39 +02:00
|
|
|
}
|
2009-09-16 08:06:12 +02:00
|
|
|
|
|
|
|
/*
|
2009-11-29 04:02:27 +01:00
|
|
|
* Provide function name for PL/Perl execution errors
|
2009-09-16 08:06:12 +02:00
|
|
|
*/
|
2009-11-29 04:02:27 +01:00
|
|
|
static void
|
2009-09-16 08:06:12 +02:00
|
|
|
plperl_exec_callback(void *arg)
|
|
|
|
{
|
2010-02-26 03:01:40 +01:00
|
|
|
char *procname = (char *) arg;
|
|
|
|
|
2009-09-16 08:06:12 +02:00
|
|
|
if (procname)
|
|
|
|
errcontext("PL/Perl function \"%s\"", procname);
|
|
|
|
}
|
|
|
|
|
|
|
|
/*
|
2009-11-29 04:02:27 +01:00
|
|
|
* Provide function name for PL/Perl compilation errors
|
2009-09-16 08:06:12 +02:00
|
|
|
*/
|
|
|
|
static void
|
|
|
|
plperl_compile_callback(void *arg)
|
|
|
|
{
|
2010-02-26 03:01:40 +01:00
|
|
|
char *procname = (char *) arg;
|
|
|
|
|
2009-09-16 08:06:12 +02:00
|
|
|
if (procname)
|
|
|
|
errcontext("compilation of PL/Perl function \"%s\"", procname);
|
|
|
|
}
|
2009-11-29 04:02:27 +01:00
|
|
|
|
|
|
|
/*
|
|
|
|
* Provide error context for the inline handler
|
|
|
|
*/
|
|
|
|
static void
|
|
|
|
plperl_inline_callback(void *arg)
|
|
|
|
{
|
|
|
|
errcontext("PL/Perl anonymous code block");
|
|
|
|
}
|
2010-05-13 18:39:43 +02:00
|
|
|
|
|
|
|
|
|
|
|
/*
|
2016-04-02 03:53:10 +02:00
|
|
|
* Perl's own setlocale(), copied from POSIX.xs
|
2010-05-13 18:39:43 +02:00
|
|
|
* (needed because of the calls to new_*())
|
|
|
|
*/
|
|
|
|
#ifdef WIN32
|
|
|
|
static char *
|
|
|
|
setlocale_perl(int category, char *locale)
|
|
|
|
{
|
2010-07-06 21:19:02 +02:00
|
|
|
char *RETVAL = setlocale(category, locale);
|
|
|
|
|
|
|
|
if (RETVAL)
|
|
|
|
{
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef USE_LOCALE_CTYPE
|
2010-07-06 21:19:02 +02:00
|
|
|
if (category == LC_CTYPE
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef LC_ALL
|
2010-07-06 21:19:02 +02:00
|
|
|
|| category == LC_ALL
|
2010-05-13 18:39:43 +02:00
|
|
|
#endif
|
2010-07-06 21:19:02 +02:00
|
|
|
)
|
|
|
|
{
|
|
|
|
char *newctype;
|
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef LC_ALL
|
2010-07-06 21:19:02 +02:00
|
|
|
if (category == LC_ALL)
|
|
|
|
newctype = setlocale(LC_CTYPE, NULL);
|
|
|
|
else
|
2010-05-13 18:39:43 +02:00
|
|
|
#endif
|
2010-07-06 21:19:02 +02:00
|
|
|
newctype = RETVAL;
|
|
|
|
new_ctype(newctype);
|
|
|
|
}
|
|
|
|
#endif /* USE_LOCALE_CTYPE */
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef USE_LOCALE_COLLATE
|
2010-07-06 21:19:02 +02:00
|
|
|
if (category == LC_COLLATE
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef LC_ALL
|
2010-07-06 21:19:02 +02:00
|
|
|
|| category == LC_ALL
|
2010-05-13 18:39:43 +02:00
|
|
|
#endif
|
2010-07-06 21:19:02 +02:00
|
|
|
)
|
|
|
|
{
|
|
|
|
char *newcoll;
|
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef LC_ALL
|
2010-07-06 21:19:02 +02:00
|
|
|
if (category == LC_ALL)
|
|
|
|
newcoll = setlocale(LC_COLLATE, NULL);
|
|
|
|
else
|
2010-05-13 18:39:43 +02:00
|
|
|
#endif
|
2010-07-06 21:19:02 +02:00
|
|
|
newcoll = RETVAL;
|
|
|
|
new_collate(newcoll);
|
|
|
|
}
|
|
|
|
#endif /* USE_LOCALE_COLLATE */
|
2010-05-13 18:39:43 +02:00
|
|
|
|
|
|
|
#ifdef USE_LOCALE_NUMERIC
|
2010-07-06 21:19:02 +02:00
|
|
|
if (category == LC_NUMERIC
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef LC_ALL
|
2010-07-06 21:19:02 +02:00
|
|
|
|| category == LC_ALL
|
2010-05-13 18:39:43 +02:00
|
|
|
#endif
|
2010-07-06 21:19:02 +02:00
|
|
|
)
|
|
|
|
{
|
|
|
|
char *newnum;
|
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
#ifdef LC_ALL
|
2010-07-06 21:19:02 +02:00
|
|
|
if (category == LC_ALL)
|
|
|
|
newnum = setlocale(LC_NUMERIC, NULL);
|
|
|
|
else
|
2010-05-13 18:39:43 +02:00
|
|
|
#endif
|
2010-07-06 21:19:02 +02:00
|
|
|
newnum = RETVAL;
|
|
|
|
new_numeric(newnum);
|
|
|
|
}
|
|
|
|
#endif /* USE_LOCALE_NUMERIC */
|
|
|
|
}
|
2010-05-13 18:39:43 +02:00
|
|
|
|
2010-07-06 21:19:02 +02:00
|
|
|
return RETVAL;
|
2010-05-13 18:39:43 +02:00
|
|
|
}
|
2010-07-06 21:19:02 +02:00
|
|
|
|
2010-05-13 18:39:43 +02:00
|
|
|
#endif
|