open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fix up Perl-to-Postgres datatype conversions in pl/perl.

Browse Source 
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
pull/1/head
Tom Lane 14 years ago
parent fb4340c5ea
commit 23610daf8a
5 changed files with 289 additions and 130 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 58
      src/pl/plperl/expected/plperl.out
  2. 10
      src/pl/plperl/expected/plperl_array.out
  3. 285
      src/pl/plperl/plperl.c
  4. 47
      src/pl/plperl/sql/plperl.sql
  5. 7
      src/pl/plperl/sql/plperl_array.sql

58
src/pl/plperl/expected/plperl.out
Unescape View File

@ -101,6 +101,16 @@ SELECT * FROM perl_row();
1 | hello | world | ({{1}})
(1 row)
-- test returning a composite literal
CREATE OR REPLACE FUNCTION perl_row_lit() RETURNS testrowperl AS $$
return '(1,hello,world,"({{1}})")';
$$ LANGUAGE plperl;
SELECT perl_row_lit();
perl_row_lit
---------------------------
(1,hello,world,"({{1}})")
(1 row)
CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
return undef;
$$ LANGUAGE plperl;
@ -336,7 +346,8 @@ CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
return 42;
$$ LANGUAGE plperl;
SELECT * FROM foo_bad();
ERROR: composite-returning PL/Perl function must return reference to hash
ERROR: malformed record literal: "42"
DETAIL: Missing left parenthesis.
CONTEXT: PL/Perl function "foo_bad"
CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
return [
@ -345,7 +356,7 @@ return [
];
$$ LANGUAGE plperl;
SELECT * FROM foo_bad();
ERROR: composite-returning PL/Perl function must return reference to hash
ERROR: cannot convert Perl array to non-array type footype
CONTEXT: PL/Perl function "foo_bad"
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
return 42;
@ -639,3 +650,46 @@ CONTEXT: PL/Perl anonymous code block
DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
ERROR: Useless use of sort in scalar context at line 1.
CONTEXT: PL/Perl anonymous code block
-- make sure functions marked as VOID without an explicit return work
CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$
$_SHARED{myquote} = sub {
my $arg = shift;
$arg =~ s/(['\\])/\\$1/g;
return "'$arg'";
};
$$ LANGUAGE plperl;
SELECT myfuncs();
myfuncs
---------
(1 row)
-- make sure we can't return an array as a scalar
CREATE OR REPLACE FUNCTION text_arrayref() RETURNS text AS $$
return ['array'];
$$ LANGUAGE plperl;
SELECT text_arrayref();
ERROR: cannot convert Perl array to non-array type text
CONTEXT: PL/Perl function "text_arrayref"
--- make sure we can't return a hash as a scalar
CREATE OR REPLACE FUNCTION text_hashref() RETURNS text AS $$
return {'hash'=>1};
$$ LANGUAGE plperl;
SELECT text_hashref();
ERROR: cannot convert Perl hash to non-composite type text
CONTEXT: PL/Perl function "text_hashref"
---- make sure we can't return a blessed object as a scalar
CREATE OR REPLACE FUNCTION text_obj() RETURNS text AS $$
return bless({}, 'Fake::Object');
$$ LANGUAGE plperl;
SELECT text_obj();
ERROR: cannot convert Perl hash to non-composite type text
CONTEXT: PL/Perl function "text_obj"
----- make sure we can't return a scalar ref
CREATE OR REPLACE FUNCTION text_scalarref() RETURNS text AS $$
my $str = 'str';
return \$str;
$$ LANGUAGE plperl;
SELECT text_scalarref();
ERROR: PL/Perl function must return reference to hash or array
CONTEXT: PL/Perl function "text_scalarref"

10
src/pl/plperl/expected/plperl_array.out
Unescape View File

@ -204,6 +204,16 @@ select plperl_arrays_inout('{{1}, {2}, {3}}');
{{1},{2},{3}}
(1 row)
-- check that we can return an array literal
CREATE OR REPLACE FUNCTION plperl_arrays_inout_l(INTEGER[]) returns INTEGER[] AS $$
return shift.''; # stringify it
$$ LANGUAGE plperl;
select plperl_arrays_inout_l('{{1}, {2}, {3}}');
plperl_arrays_inout_l
-----------------------
{{1},{2},{3}}
(1 row)
-- make sure setof works
create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
my $arr = shift;

285
src/pl/plperl/plperl.c
Unescape View File

@ -155,7 +155,6 @@ typedef struct plperl_call_data
FunctionCallInfo fcinfo;
Tuplestorestate *tuple_store;
TupleDesc ret_tdesc;
AttInMetadata *attinmeta;
MemoryContext tmp_cxt;
} plperl_call_data;
@ -244,12 +243,16 @@ 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);
static Datum plperl_sv_to_datum(SV *sv, FmgrInfo *func, Oid typid,
Oid typioparam, int32 typmod, bool *isnull);
static void _sv_to_datum_finfo(FmgrInfo *fcinfo, Oid typid, Oid *typioparam);
static Datum plperl_array_to_datum(SV *src, Oid typid);
static ArrayBuildState *_array_to_datum(AV *av, int *ndims, int *dims,
int cur_depth, ArrayBuildState *astate, Oid typid, Oid atypid);
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);
static ArrayBuildState *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);
static Datum plperl_hash_to_datum(SV *src, TupleDesc td);
static void plperl_init_shared_libs(pTHX);
@ -988,9 +991,8 @@ strip_trailing_ws(const char *msg)
/* Build a tuple from a hash. */
static HeapTuple
plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
plperl_build_tuple_result(HV *perlhash, TupleDesc td)
{
TupleDesc td = attinmeta->tupdesc;
Datum *values;
bool *nulls;
HE *he;
@ -1006,7 +1008,6 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
SV *val = HeVAL(he);
char *key = hek2cstr(he);
int attn = SPI_fnumber(td, key);
bool isnull;
if (attn <= 0 || td->attrs[attn - 1]->attisdropped)
ereport(ERROR,
@ -1015,12 +1016,12 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
key)));
values[attn - 1] = plperl_sv_to_datum(val,
NULL,
td->attrs[attn - 1]->atttypid,
InvalidOid,
td->attrs[attn - 1]->atttypmod,
&isnull);
nulls[attn - 1] = isnull;
NULL,
NULL,
InvalidOid,
&nulls[attn - 1]);
pfree(key);
}
@ -1036,8 +1037,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
static Datum
plperl_hash_to_datum(SV *src, TupleDesc td)
{
AttInMetadata *attinmeta = TupleDescGetAttInMetadata(td);
HeapTuple tup = plperl_build_tuple_result((HV *) SvRV(src), attinmeta);
HeapTuple tup = plperl_build_tuple_result((HV *) SvRV(src), td);
return HeapTupleGetDatum(tup);
}
@ -1069,13 +1069,15 @@ get_perl_array_ref(SV *sv)
}
/*
* helper function for plperl_array_to_datum, does the main recursing
* helper function for plperl_array_to_datum, recurses for multi-D arrays
*/
static ArrayBuildState *
_array_to_datum(AV *av, int *ndims, int *dims, int cur_depth,
ArrayBuildState *astate, Oid typid, Oid atypid)
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)
{
int i = 0;
int i;
int len = av_len(av) + 1;
for (i = 0; i < len; i++)
@ -1091,36 +1093,51 @@ _array_to_datum(AV *av, int *ndims, int *dims, int cur_depth,
{
AV *nav = (AV *) SvRV(sav);
/* dimensionality checks */
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)));
/* size based off the first element */
/* set size when at first element in this level, else compare */
if (i == 0 && *ndims == cur_depth)
{
dims[*ndims] = av_len(nav) + 1;
(*ndims)++;
}
else
{
if (av_len(nav) + 1 != dims[cur_depth])
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")));
}
astate = _array_to_datum(nav, ndims, dims, cur_depth + 1, astate,
typid, atypid);
/* recurse to fetch elements of this sub-array */
astate = array_to_datum_internal(nav, astate,
ndims, dims, cur_depth + 1,
arraytypid, elemtypid, typmod,
finfo, typioparam);
}
else
{
Datum dat;
bool isnull;
Datum dat = plperl_sv_to_datum(svp ? *svp : NULL, NULL,
atypid, 0, -1, &isnull);
astate = accumArrayResult(astate, dat, isnull, atypid, NULL);
/* 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);
astate = accumArrayResult(astate, dat, isnull,
elemtypid, CurrentMemoryContext);
}
}
@ -1131,89 +1148,141 @@ _array_to_datum(AV *av, int *ndims, int *dims, int cur_depth,
* convert perl array ref to a datum
*/
static Datum
plperl_array_to_datum(SV *src, Oid typid)
plperl_array_to_datum(SV *src, Oid typid, int32 typmod)
{
ArrayBuildState *astate = NULL;
Oid atypid;
ArrayBuildState *astate;
Oid elemtypid;
FmgrInfo finfo;
Oid typioparam;
int dims[MAXDIM];
int lbs[MAXDIM];
int ndims = 1;
int i;
atypid = get_element_type(typid);
if (!atypid)
atypid = typid;
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))));
_sv_to_datum_finfo(elemtypid, &finfo, &typioparam);
memset(dims, 0, sizeof(dims));
dims[0] = av_len((AV *) SvRV(src)) + 1;
astate = _array_to_datum((AV *) SvRV(src), &ndims, dims, 1, astate, typid,
atypid);
astate = array_to_datum_internal((AV *) SvRV(src), NULL,
&ndims, dims, 1,
typid, elemtypid, typmod,
&finfo, typioparam);
if (!astate)
return PointerGetDatum(construct_empty_array(atypid));
return PointerGetDatum(construct_empty_array(elemtypid));
for (i = 0; i < ndims; i++)
lbs[i] = 1;
return makeMdArrayResult(astate, ndims, dims, lbs, CurrentMemoryContext, true);
return makeMdArrayResult(astate, ndims, dims, lbs,
CurrentMemoryContext, true);
}
/* Get the information needed to convert data to the specified PG type */
static void
_sv_to_datum_finfo(FmgrInfo *fcinfo, Oid typid, Oid *typioparam)
_sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam)
{
Oid typinput;
/* XXX would be better to cache these lookups */
getTypeInputInfo(typid,
&typinput, typioparam);
fmgr_info(typinput, fcinfo);
fmgr_info(typinput, finfo);
}
/*
* convert a sv to datum
* fcinfo and typioparam are optional and will be looked-up if needed
* 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.
*/
static Datum
plperl_sv_to_datum(SV *sv, FmgrInfo *finfo, Oid typid, Oid typioparam,
int32 typmod, bool *isnull)
plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
FunctionCallInfo fcinfo,
FmgrInfo *finfo, Oid typioparam,
bool *isnull)
{
FmgrInfo tmp;
/* we might recurse */
check_stack_depth();
if (isnull)
*isnull = false;
if (!sv || !SvOK(sv))
/*
* 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)
{
/* look up type info if they did not pass it */
if (!finfo)
{
_sv_to_datum_finfo(&tmp, typid, &typioparam);
_sv_to_datum_finfo(typid, &tmp, &typioparam);
finfo = &tmp;
}
if (isnull)
*isnull = true;
/* must call typinput in case it wants to reject NULL */
return InputFunctionCall(finfo, NULL, typioparam, typmod);
}
else if (SvROK(sv))
{
/* handle references */
SV *sav = get_perl_array_ref(sv);
if (sav)
{
return plperl_array_to_datum(sav, typid);
/* handle an arrayref */
return plperl_array_to_datum(sav, typid, typmod);
}
else if (SvTYPE(SvRV(sv)) == SVt_PVHV)
{
TupleDesc td = lookup_rowtype_tupdesc(typid, typmod);
Datum ret = plperl_hash_to_datum(sv, td);
/* handle a hashref */
Datum ret;
TupleDesc td;
if (!type_is_rowtype(typid))
ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("cannot convert Perl hash to non-composite type %s",
format_type_be(typid))));
td = lookup_rowtype_tupdesc_noerror(typid, typmod, true);
if (td == NULL)
{
/* Try to look it up based on our result type */
if (fcinfo == NULL ||
get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
ereport(ERROR,
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("function returning record called in context "
"that cannot accept type record")));
}
ret = plperl_hash_to_datum(sv, td);
/* Release on the result of get_call_result_type is harmless */
ReleaseTupleDesc(td);
return ret;
}
/* Reference, but not reference to hash or array ... */
ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("PL/Perl function must return reference to hash or array")));
@ -1221,12 +1290,14 @@ plperl_sv_to_datum(SV *sv, FmgrInfo *finfo, Oid typid, Oid typioparam,
}
else
{
/* handle a string/number */
Datum ret;
char *str = sv2cstr(sv);
/* did not pass in any typeinfo? look it up */
if (!finfo)
{
_sv_to_datum_finfo(&tmp, typid, &typioparam);
_sv_to_datum_finfo(typid, &tmp, &typioparam);
finfo = &tmp;
}
@ -1251,7 +1322,10 @@ plperl_sv_to_literal(SV *sv, char *fqtypename)
if (!OidIsValid(typid))
elog(ERROR, "lookup failed for type %s", fqtypename);
datum = plperl_sv_to_datum(sv, NULL, typid, 0, -1, &isnull);
datum = plperl_sv_to_datum(sv,
typid, -1,
NULL, NULL, InvalidOid,
&isnull);
if (isnull)
return NULL;
@ -1542,10 +1616,11 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
key)));
modvalues[slotsused] = plperl_sv_to_datum(val,
NULL,
tupdesc->attrs[attn - 1]->atttypid,
InvalidOid,
tupdesc->attrs[attn - 1]->atttypmod,
NULL,
NULL,
InvalidOid,
&isnull);
modnulls[slotsused] = isnull ? 'n' : ' ';
@ -2043,10 +2118,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
Datum retval = 0;
ReturnSetInfo *rsi;
ErrorContextCallback pl_error_context;
bool has_retval = false;
/*
* Create the call_data beforing connecting to SPI, so that it is not
* Create the call_data before connecting to SPI, so that it is not
* allocated in the SPI memory context
*/
current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
@ -2129,51 +2203,19 @@ plperl_func_handler(PG_FUNCTION_ARGS)
rsi->setDesc = current_call_data->ret_tdesc;
}
retval = (Datum) 0;
has_retval = true;
}
else if (!SvOK(perlret))
{
/* Return NULL if Perl code returned undef */
if (rsi && IsA(rsi, ReturnSetInfo))
rsi->isDone = ExprEndResult;
}
else if (prodesc->fn_retistuple)
{
/* Return a perl hash converted to a Datum */
TupleDesc td;
if (!SvOK(perlret) || !SvROK(perlret) ||
SvTYPE(SvRV(perlret)) != SVt_PVHV)
{
ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("composite-returning PL/Perl function "
"must return reference to hash")));
}
/* XXX should cache the attinmeta data instead of recomputing */
if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
{
ereport(ERROR,
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("function returning record called in context "
"that cannot accept type record")));
}
retval = plperl_hash_to_datum(perlret, td);
has_retval = true;
}
if (!has_retval)
else
{
bool isnull;
retval = plperl_sv_to_datum(perlret,
&prodesc->result_in_func,
prodesc->result_oid,
prodesc->result_typioparam, -1, &isnull);
fcinfo->isnull = isnull;
has_retval = true;
-1,
fcinfo,
&prodesc->result_in_func,
prodesc->result_typioparam,
&fcinfo->isnull);
if (fcinfo->isnull && rsi && IsA(rsi, ReturnSetInfo))
rsi->isDone = ExprEndResult;
}
/* Restore the previous error callback */
@ -2196,7 +2238,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
ErrorContextCallback pl_error_context;
/*
* Create the call_data beforing connecting to SPI, so that it is not
* Create the call_data before connecting to SPI, so that it is not
* allocated in the SPI memory context
*/
current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
@ -2842,19 +2884,11 @@ plperl_return_next(SV *sv)
(errcode(ERRCODE_SYNTAX_ERROR),
errmsg("cannot use return_next in a non-SETOF function")));
if (prodesc->fn_retistuple &&
!(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")));
if (!current_call_data->ret_tdesc)
{
TupleDesc tupdesc;
Assert(!current_call_data->tuple_store);
Assert(!current_call_data->attinmeta);
/*
* This is the first call to return_next in the current PL/Perl
@ -2875,11 +2909,6 @@ plperl_return_next(SV *sv)
current_call_data->tuple_store =
tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
false, work_mem);
if (prodesc->fn_retistuple)
{
current_call_data->attinmeta =
TupleDescGetAttInMetadata(current_call_data->ret_tdesc);
}
MemoryContextSwitchTo(old_cxt);
}
@ -2893,7 +2922,7 @@ plperl_return_next(SV *sv)
if (!current_call_data->tmp_cxt)
{
current_call_data->tmp_cxt =
AllocSetContextCreate(rsi->econtext->ecxt_per_tuple_memory,
AllocSetContextCreate(CurrentMemoryContext,
"PL/Perl return_next temporary cxt",
ALLOCSET_DEFAULT_MINSIZE,
ALLOCSET_DEFAULT_INITSIZE,
@ -2906,8 +2935,14 @@ plperl_return_next(SV *sv)
{
HeapTuple tuple;
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")));
tuple = plperl_build_tuple_result((HV *) SvRV(sv),
current_call_data->attinmeta);
current_call_data->ret_tdesc);
tuplestore_puttuple(current_call_data->tuple_store, tuple);
}
else
@ -2916,10 +2951,12 @@ plperl_return_next(SV *sv)
bool isNull;
ret = plperl_sv_to_datum(sv,
&prodesc->result_in_func,
prodesc->result_oid,
-1,
fcinfo,
&prodesc->result_in_func,
prodesc->result_typioparam,
-1, &isNull);
&isNull);
tuplestore_putvalues(current_call_data->tuple_store,
current_call_data->ret_tdesc,
@ -3318,10 +3355,12 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
bool isnull;
argvalues[i] = plperl_sv_to_datum(argv[i],
&qdesc->arginfuncs[i],
qdesc->argtypes[i],
-1,
NULL,
&qdesc->arginfuncs[i],
qdesc->argtypioparams[i],
-1, &isnull);
&isnull);
nulls[i] = isnull ? 'n' : ' ';
}
@ -3443,10 +3482,12 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
bool isnull;
argvalues[i] = plperl_sv_to_datum(argv[i],
&qdesc->arginfuncs[i],
qdesc->argtypes[i],
-1,
NULL,
&qdesc->arginfuncs[i],
qdesc->argtypioparams[i],
-1, &isnull);
&isnull);
nulls[i] = isnull ? 'n' : ' ';
}

47
src/pl/plperl/sql/plperl.sql
Unescape View File

@ -50,6 +50,13 @@ $$ LANGUAGE plperl;
SELECT perl_row();
SELECT * FROM perl_row();
-- test returning a composite literal
CREATE OR REPLACE FUNCTION perl_row_lit() RETURNS testrowperl AS $$
return '(1,hello,world,"({{1}})")';
$$ LANGUAGE plperl;
SELECT perl_row_lit();
CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
return undef;
@ -415,3 +422,43 @@ DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
-- check that we can "use warnings" (in this case to turn a warn into an error)
-- yields "ERROR: Useless use of sort in scalar context."
DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
-- make sure functions marked as VOID without an explicit return work
CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$
$_SHARED{myquote} = sub {
my $arg = shift;
$arg =~ s/(['\\])/\\$1/g;
return "'$arg'";
};
$$ LANGUAGE plperl;
SELECT myfuncs();
-- make sure we can't return an array as a scalar
CREATE OR REPLACE FUNCTION text_arrayref() RETURNS text AS $$
return ['array'];
$$ LANGUAGE plperl;
SELECT text_arrayref();
--- make sure we can't return a hash as a scalar
CREATE OR REPLACE FUNCTION text_hashref() RETURNS text AS $$
return {'hash'=>1};
$$ LANGUAGE plperl;
SELECT text_hashref();
---- make sure we can't return a blessed object as a scalar
CREATE OR REPLACE FUNCTION text_obj() RETURNS text AS $$
return bless({}, 'Fake::Object');
$$ LANGUAGE plperl;
SELECT text_obj();
----- make sure we can't return a scalar ref
CREATE OR REPLACE FUNCTION text_scalarref() RETURNS text AS $$
my $str = 'str';
return \$str;
$$ LANGUAGE plperl;
SELECT text_scalarref();

7
src/pl/plperl/sql/plperl_array.sql
Unescape View File

@ -152,6 +152,13 @@ $$ LANGUAGE plperl;
select plperl_arrays_inout('{{1}, {2}, {3}}');
-- check that we can return an array literal
CREATE OR REPLACE FUNCTION plperl_arrays_inout_l(INTEGER[]) returns INTEGER[] AS $$
return shift.''; # stringify it
$$ LANGUAGE plperl;
select plperl_arrays_inout_l('{{1}, {2}, {3}}');
-- make sure setof works
create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
my $arr = shift;

Write Preview
Loading…
Cancel
Save