Commit e2480165 authored by Tom Lane's avatar Tom Lane

plperl was not being quite paranoid enough about detecting 'undef' values

returned by Perl.  Per report from Nicolas Addington.
parent 6ff40870
...@@ -33,7 +33,7 @@ ...@@ -33,7 +33,7 @@
* ENHANCEMENTS, OR MODIFICATIONS. * ENHANCEMENTS, OR MODIFICATIONS.
* *
* IDENTIFICATION * IDENTIFICATION
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.65 2004/11/29 20:11:05 tgl Exp $ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.66 2005/01/11 06:08:45 tgl Exp $
* *
**********************************************************************/ **********************************************************************/
...@@ -295,7 +295,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta) ...@@ -295,7 +295,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
(errcode(ERRCODE_UNDEFINED_COLUMN), (errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("Perl hash contains nonexistent column \"%s\"", errmsg("Perl hash contains nonexistent column \"%s\"",
key))); key)));
if (SvTYPE(val) != SVt_NULL) if (SvOK(val) && SvTYPE(val) != SVt_NULL)
values[attn - 1] = SvPV(val, PL_na); values[attn - 1] = SvPV(val, PL_na);
} }
hv_iterinit(perlhash); hv_iterinit(perlhash);
...@@ -446,7 +446,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ...@@ -446,7 +446,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN), (errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("$_TD->{new} does not exist"))); errmsg("$_TD->{new} does not exist")));
if (SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV) if (!SvOK(*svp) || SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("$_TD->{new} is not a hash reference"))); errmsg("$_TD->{new} is not a hash reference")));
...@@ -467,7 +467,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ...@@ -467,7 +467,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
(errcode(ERRCODE_UNDEFINED_COLUMN), (errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("Perl hash contains nonexistent column \"%s\"", errmsg("Perl hash contains nonexistent column \"%s\"",
key))); key)));
if (SvTYPE(val) != SVt_NULL) if (SvOK(val) && SvTYPE(val) != SVt_NULL)
{ {
Oid typinput; Oid typinput;
Oid typioparam; Oid typioparam;
...@@ -873,7 +873,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -873,7 +873,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
TupleDesc tupdesc; TupleDesc tupdesc;
AttInMetadata *attinmeta; AttInMetadata *attinmeta;
if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV) if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("set-returning Perl function must return reference to array"))); errmsg("set-returning Perl function must return reference to array")));
...@@ -911,7 +911,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -911,7 +911,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
svp = av_fetch(ret_av, funcctx->call_cntr, FALSE); svp = av_fetch(ret_av, funcctx->call_cntr, FALSE);
Assert(svp != NULL); Assert(svp != NULL);
if (SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV) if (!SvOK(*svp) || SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("elements of Perl result array must be reference to hash"))); errmsg("elements of Perl result array must be reference to hash")));
...@@ -933,7 +933,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -933,7 +933,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
AV *ret_av; AV *ret_av;
FuncCallContext *funcctx; FuncCallContext *funcctx;
if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV) if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("set-returning Perl function must return reference to array"))); errmsg("set-returning Perl function must return reference to array")));
...@@ -957,7 +957,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -957,7 +957,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
svp = av_fetch(ret_av, funcctx->call_cntr, FALSE); svp = av_fetch(ret_av, funcctx->call_cntr, FALSE);
Assert(svp != NULL); Assert(svp != NULL);
if (SvTYPE(*svp) != SVt_NULL) if (SvOK(*svp) && SvTYPE(*svp) != SVt_NULL)
{ {
char *val = SvPV(*svp, PL_na); char *val = SvPV(*svp, PL_na);
...@@ -988,7 +988,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -988,7 +988,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
AttInMetadata *attinmeta; AttInMetadata *attinmeta;
HeapTuple tup; HeapTuple tup;
if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVHV) if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVHV)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("composite-returning Perl function must return reference to hash"))); errmsg("composite-returning Perl function must return reference to hash")));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment