sharpetronics/PostgreSQL
1
0
Fork 0
mirror of https://github.com/postgres/postgres.git synced 2025-10-30 00:04:49 -04:00
Code Issues Projects Releases Wiki Activity

Update plperl to use ereport() not elog() for user-facing messages,

Browse Source 
so that they will be translatable.  Give messages some semblance of
conformance to the style guide.
This commit is contained in:
Tom Lane 2004-11-29 20:11:06 +00:00
parent 71929165e8
commit af434fcdf4
2 changed files with 67 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
src/pl/plperl/plperl.c
View File

@ -33,7 +33,7 @@
* ENHANCEMENTS, OR MODIFICATIONS. * ENHANCEMENTS, OR MODIFICATIONS.
* *
* IDENTIFICATION * IDENTIFICATION
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.64 2004/11/24 18:47:38 tgl Exp $ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.65 2004/11/29 20:11:05 tgl Exp $
* *
**********************************************************************/ **********************************************************************/
@ -200,7 +200,7 @@ plperl_init_interp(void)
plperl_interp = perl_alloc(); plperl_interp = perl_alloc();
if (!plperl_interp) if (!plperl_interp)
elog(ERROR, "could not allocate perl interpreter"); elog(ERROR, "could not allocate Perl interpreter");
perl_construct(plperl_interp); perl_construct(plperl_interp);
perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL); perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL);
@ -233,8 +233,8 @@ plperl_safe_init(void)
"$PLContainer->permit_only(':default');" "$PLContainer->permit_only(':default');"
"$PLContainer->share(qw[&elog &ERROR ]);" "$PLContainer->share(qw[&elog &ERROR ]);"
"sub ::mksafefunc { return $PLContainer->reval(qq[sub { " "sub ::mksafefunc { return $PLContainer->reval(qq[sub { "
"elog(ERROR,'trusted perl functions disabled - " "elog(ERROR,'trusted Perl functions disabled - "
"please upgrade perl Safe module to at least 2.09');}]); }" "please upgrade Perl Safe module to version 2.09 or later');}]); }"
; ;
SV *res; SV *res;
@ -291,7 +291,10 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
int attn = SPI_fnumber(td, key); int attn = SPI_fnumber(td, key);
if (attn <= 0 || td->attrs[attn - 1]->attisdropped) if (attn <= 0 || td->attrs[attn - 1]->attisdropped)
elog(ERROR, "plperl: invalid attribute \"%s\" in hash", key); ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("Perl hash contains nonexistent column \"%s\"",
key)));
if (SvTYPE(val) != SVt_NULL) if (SvTYPE(val) != SVt_NULL)
values[attn - 1] = SvPV(val, PL_na); values[attn - 1] = SvPV(val, PL_na);
} }
@ -408,8 +411,9 @@ get_function_tupdesc(Oid result_type, ReturnSetInfo *rsinfo)
if (!rsinfo || !IsA(rsinfo, ReturnSetInfo) || if (!rsinfo || !IsA(rsinfo, ReturnSetInfo) ||
rsinfo->expectedDesc == NULL) rsinfo->expectedDesc == NULL)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("could not determine row description for function returning record"))); errmsg("function returning record called in context "
"that cannot accept type record")));
return rsinfo->expectedDesc; return rsinfo->expectedDesc;
} }
else /* ordinary composite type */ else /* ordinary composite type */
@ -439,9 +443,13 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
svp = hv_fetch(hvTD, "new", 3, FALSE); svp = hv_fetch(hvTD, "new", 3, FALSE);
if (!svp) if (!svp)
elog(ERROR, "plperl: key \"new\" not found"); ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("$_TD->{new} does not exist")));
if (SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV) if (SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV)
elog(ERROR, "plperl: $_TD->{new} is not a hash reference"); ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("$_TD->{new} is not a hash reference")));
hvNew = (HV *) SvRV(*svp); hvNew = (HV *) SvRV(*svp);
modattrs = palloc(tupdesc->natts * sizeof(int)); modattrs = palloc(tupdesc->natts * sizeof(int));
@ -455,7 +463,10 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
int attn = SPI_fnumber(tupdesc, key); int attn = SPI_fnumber(tupdesc, key);
if (attn <= 0 || tupdesc->attrs[attn - 1]->attisdropped) if (attn <= 0 || tupdesc->attrs[attn - 1]->attisdropped)
elog(ERROR, "plperl: invalid attribute \"%s\" in hash", key); ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("Perl hash contains nonexistent column \"%s\"",
key)));
if (SvTYPE(val) != SVt_NULL) if (SvTYPE(val) != SVt_NULL)
{ {
Oid typinput; Oid typinput;
@ -490,7 +501,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
pfree(modnulls); pfree(modnulls);
if (rtup == NULL) if (rtup == NULL)
elog(ERROR, "plperl: SPI_modifytuple failed: %s", elog(ERROR, "SPI_modifytuple failed: %s",
SPI_result_code_string(SPI_result)); SPI_result_code_string(SPI_result));
return rtup; return rtup;
@ -594,8 +605,10 @@ plperl_create_sub(char *s, bool trusted)
PUTBACK; PUTBACK;
FREETMPS; FREETMPS;
LEAVE; LEAVE;
elog(ERROR, "creation of function failed: %s", ereport(ERROR,
strip_trailing_ws(SvPV(ERRSV, PL_na))); (errcode(ERRCODE_SYNTAX_ERROR),
errmsg("creation of Perl function failed: %s",
strip_trailing_ws(SvPV(ERRSV, PL_na)))));
} }
/* /*
@ -722,8 +735,10 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
PUTBACK; PUTBACK;
FREETMPS; FREETMPS;
LEAVE; LEAVE;
elog(ERROR, "error from function: %s", /* XXX need to find a way to assign an errcode here */
strip_trailing_ws(SvPV(ERRSV, PL_na))); ereport(ERROR,
(errmsg("error from Perl function: %s",
strip_trailing_ws(SvPV(ERRSV, PL_na)))));
} }
retval = newSVsv(POPs); retval = newSVsv(POPs);
@ -780,8 +795,10 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
PUTBACK; PUTBACK;
FREETMPS; FREETMPS;
LEAVE; LEAVE;
elog(ERROR, "error from trigger function: %s", /* XXX need to find a way to assign an errcode here */
strip_trailing_ws(SvPV(ERRSV, PL_na))); ereport(ERROR,
(errmsg("error from Perl trigger function: %s",
strip_trailing_ws(SvPV(ERRSV, PL_na)))));
} }
retval = newSVsv(POPs); retval = newSVsv(POPs);
@ -857,7 +874,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
AttInMetadata *attinmeta; AttInMetadata *attinmeta;
if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV) if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV)
elog(ERROR, "plperl: set-returning function must return reference to array"); ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("set-returning Perl function must return reference to array")));
ret_av = (AV *) SvRV(perlret); ret_av = (AV *) SvRV(perlret);
if (SRF_IS_FIRSTCALL()) if (SRF_IS_FIRSTCALL())
@ -893,7 +912,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
Assert(svp != NULL); Assert(svp != NULL);
if (SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV) if (SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV)
elog(ERROR, "plperl: element of result array is not a reference to hash"); ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("elements of Perl result array must be reference to hash")));
row_hv = (HV *) SvRV(*svp); row_hv = (HV *) SvRV(*svp);
tuple = plperl_build_tuple_result(row_hv, attinmeta); tuple = plperl_build_tuple_result(row_hv, attinmeta);
@ -913,7 +934,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
FuncCallContext *funcctx; FuncCallContext *funcctx;
if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV) if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVAV)
elog(ERROR, "plperl: set-returning function must return reference to array"); ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("set-returning Perl function must return reference to array")));
ret_av = (AV *) SvRV(perlret); ret_av = (AV *) SvRV(perlret);
if (SRF_IS_FIRSTCALL()) if (SRF_IS_FIRSTCALL())
@ -966,7 +989,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
HeapTuple tup; HeapTuple tup;
if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVHV) if (SvTYPE(perlret) != SVt_RV || SvTYPE(SvRV(perlret)) != SVt_PVHV)
elog(ERROR, "plperl: composite-returning function must return a reference to hash"); ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("composite-returning Perl function must return reference to hash")));
perlhash = (HV *) SvRV(perlret); perlhash = (HV *) SvRV(perlret);
/* /*
@ -1036,7 +1061,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
* because SPI_finish would free it). * because SPI_finish would free it).
************************************************************/ ************************************************************/
if (SPI_finish() != SPI_OK_FINISH) if (SPI_finish() != SPI_OK_FINISH)
elog(ERROR, "plperl: SPI_finish() failed"); elog(ERROR, "SPI_finish() failed");
if (!(perlret && SvOK(perlret) && SvTYPE(perlret) != SVt_NULL)) if (!(perlret && SvOK(perlret) && SvTYPE(perlret) != SVt_NULL))
{ {
@ -1073,13 +1098,17 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
trigdata->tg_newtuple); trigdata->tg_newtuple);
else else
{ {
elog(WARNING, "plperl: ignoring modified tuple in DELETE trigger"); ereport(WARNING,
(errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
errmsg("ignoring modified tuple in DELETE trigger")));
trv = NULL; trv = NULL;
} }
} }
else else
{ {
elog(ERROR, "plperl: expected trigger result to be undef, \"SKIP\" or \"MODIFY\""); ereport(ERROR,
(errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
errmsg("result of Perl trigger function must be undef, \"SKIP\" or \"MODIFY\"")));
trv = NULL; trv = NULL;
} }
retval = PointerGetDatum(trv); retval = PointerGetDatum(trv);
@ -1318,7 +1347,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
************************************************************/ ************************************************************/
prodesc->reference = plperl_create_sub(proc_source, prodesc->lanpltrusted); prodesc->reference = plperl_create_sub(proc_source, prodesc->lanpltrusted);
pfree(proc_source); pfree(proc_source);
if (!prodesc->reference) if (!prodesc->reference) /* can this happen? */
{ {
free(prodesc->proname); free(prodesc->proname);
free(prodesc); free(prodesc);

26
src/pl/plperl/test/test.expected
View File

@ -119,9 +119,9 @@ CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
]; ];
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT perl_set(); SELECT perl_set();
ERROR: plperl: element of result array is not a reference to hash ERROR: elements of Perl result array must be reference to hash
SELECT * FROM perl_set(); SELECT * FROM perl_set();
ERROR: plperl: element of result array is not a reference to hash ERROR: elements of Perl result array must be reference to hash
CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
return [ return [
{ f1 => 1, f2 => 'Hello', f3 => 'World' }, { f1 => 1, f2 => 'Hello', f3 => 'World' },
@ -166,7 +166,7 @@ CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
return {f2 => 'hello', f1 => 1, f3 => 'world'}; return {f2 => 'hello', f1 => 1, f3 => 'world'};
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT perl_record(); SELECT perl_record();
ERROR: could not determine row description for function returning record ERROR: function returning record called in context that cannot accept type record
SELECT * FROM perl_record(); SELECT * FROM perl_record();
ERROR: a column definition list is required for functions returning "record" ERROR: a column definition list is required for functions returning "record"
SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text); SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
@ -198,11 +198,11 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
]; ];
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT perl_record_set(); SELECT perl_record_set();
ERROR: could not determine row description for function returning record ERROR: function returning record called in context that cannot accept type record
SELECT * FROM perl_record_set(); SELECT * FROM perl_record_set();
ERROR: a column definition list is required for functions returning "record" ERROR: a column definition list is required for functions returning "record"
SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
ERROR: plperl: element of result array is not a reference to hash ERROR: elements of Perl result array must be reference to hash
CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
return [ return [
{ f1 => 1, f2 => 'Hello', f3 => 'World' }, { f1 => 1, f2 => 'Hello', f3 => 'World' },
@ -211,7 +211,7 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
]; ];
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT perl_record_set(); SELECT perl_record_set();
ERROR: could not determine row description for function returning record ERROR: function returning record called in context that cannot accept type record
SELECT * FROM perl_record_set(); SELECT * FROM perl_record_set();
ERROR: a column definition list is required for functions returning "record" ERROR: a column definition list is required for functions returning "record"
SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
@ -240,12 +240,12 @@ CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
return {y => 3, z => 4}; return {y => 3, z => 4};
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT * FROM foo_bad(); SELECT * FROM foo_bad();
ERROR: plperl: invalid attribute "z" in hash ERROR: Perl hash contains nonexistent column "z"
CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
return 42; return 42;
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT * FROM foo_bad(); SELECT * FROM foo_bad();
ERROR: plperl: composite-returning function must return a reference to hash ERROR: composite-returning Perl function must return reference to hash
CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
return [ return [
[1, 2], [1, 2],
@ -253,17 +253,17 @@ return [
]; ];
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT * FROM foo_bad(); SELECT * FROM foo_bad();
ERROR: plperl: composite-returning function must return a reference to hash ERROR: composite-returning Perl function must return reference to hash
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
return 42; return 42;
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT * FROM foo_set_bad(); SELECT * FROM foo_set_bad();
ERROR: plperl: set-returning function must return reference to array ERROR: set-returning Perl function must return reference to array
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
return {y => 3, z => 4}; return {y => 3, z => 4};
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT * FROM foo_set_bad(); SELECT * FROM foo_set_bad();
ERROR: plperl: set-returning function must return reference to array ERROR: set-returning Perl function must return reference to array
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
return [ return [
[1, 2], [1, 2],
@ -271,14 +271,14 @@ return [
]; ];
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT * FROM foo_set_bad(); SELECT * FROM foo_set_bad();
ERROR: plperl: element of result array is not a reference to hash ERROR: elements of Perl result array must be reference to hash
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
return [ return [
{y => 3, z => 4} {y => 3, z => 4}
]; ];
$$ LANGUAGE plperl; $$ LANGUAGE plperl;
SELECT * FROM foo_set_bad(); SELECT * FROM foo_set_bad();
ERROR: plperl: invalid attribute "z" in hash ERROR: Perl hash contains nonexistent column "z"
CREATE OR REPLACE FUNCTION perl_get_field(footype, text) RETURNS integer AS $$ CREATE OR REPLACE FUNCTION perl_get_field(footype, text) RETURNS integer AS $$
return $_[0]->{$_[1]}; return $_[0]->{$_[1]};
$$ LANGUAGE plperl; $$ LANGUAGE plperl;