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

so that they will be translatable.  Give messages some semblance of
conformance to the style guide.

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 20364d27da6e953d080e1d9e97070cc977f1b923..db12a92864272c2fea7c1e94a8f2fab076e2931f 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *       ENHANCEMENTS, OR MODIFICATIONS.
  *
  * 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();
        if (!plperl_interp)
-               elog(ERROR, "could not allocate perl interpreter");
+               elog(ERROR, "could not allocate Perl interpreter");
 
        perl_construct(plperl_interp);
        perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL);
@@ -233,8 +233,8 @@ plperl_safe_init(void)
        "$PLContainer->permit_only(':default');"
        "$PLContainer->share(qw[&elog &ERROR ]);"
        "sub ::mksafefunc { return $PLContainer->reval(qq[sub { "
-       "elog(ERROR,'trusted perl functions disabled - "
-    "please upgrade perl Safe module to at least 2.09');}]); }"
+       "elog(ERROR,'trusted Perl functions disabled - "
+    "please upgrade Perl Safe module to version 2.09 or later');}]); }"
                           ;
 
        SV                 *res;
@@ -291,7 +291,10 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
                int                     attn = SPI_fnumber(td, key);
 
                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)
                        values[attn - 1] = SvPV(val, PL_na);
        }
@@ -408,8 +411,9 @@ get_function_tupdesc(Oid result_type, ReturnSetInfo *rsinfo)
                if (!rsinfo || !IsA(rsinfo, ReturnSetInfo) ||
                        rsinfo->expectedDesc == NULL)
                        ereport(ERROR,
-                                       (errcode(ERRCODE_DATATYPE_MISMATCH),
-                                        errmsg("could not determine row description for function returning record")));
+                                       (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+                                        errmsg("function returning record called in context "
+                                                       "that cannot accept type record")));
                return rsinfo->expectedDesc;
        }
        else                            /* ordinary composite type */
@@ -439,9 +443,13 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
 
        svp = hv_fetch(hvTD, "new", 3, FALSE);
        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)
-               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);
 
        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);
 
                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)
                {
                        Oid                     typinput;
@@ -490,7 +501,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
        pfree(modnulls);
 
        if (rtup == NULL)
-               elog(ERROR, "plperl: SPI_modifytuple failed: %s",
+               elog(ERROR, "SPI_modifytuple failed: %s",
                         SPI_result_code_string(SPI_result));
 
        return rtup;
@@ -594,8 +605,10 @@ plperl_create_sub(char *s, bool trusted)
                PUTBACK;
                FREETMPS;
                LEAVE;
-               elog(ERROR, "creation of function failed: %s",
-                        strip_trailing_ws(SvPV(ERRSV, PL_na)));
+               ereport(ERROR,
+                               (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;
                FREETMPS;
                LEAVE;
-               elog(ERROR, "error from function: %s",
-                        strip_trailing_ws(SvPV(ERRSV, PL_na)));
+               /* XXX need to find a way to assign an errcode here */
+               ereport(ERROR,
+                               (errmsg("error from Perl function: %s",
+                                               strip_trailing_ws(SvPV(ERRSV, PL_na)))));
        }
 
        retval = newSVsv(POPs);
@@ -780,8 +795,10 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
                PUTBACK;
                FREETMPS;
                LEAVE;
-               elog(ERROR, "error from trigger function: %s",
-                        strip_trailing_ws(SvPV(ERRSV, PL_na)));
+               /* XXX need to find a way to assign an errcode here */
+               ereport(ERROR,
+                               (errmsg("error from Perl trigger function: %s",
+                                               strip_trailing_ws(SvPV(ERRSV, PL_na)))));
        }
 
        retval = newSVsv(POPs);
@@ -857,7 +874,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
                AttInMetadata *attinmeta;
 
                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);
 
                if (SRF_IS_FIRSTCALL())
@@ -893,7 +912,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
                        Assert(svp != NULL);
 
                        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);
 
                        tuple = plperl_build_tuple_result(row_hv, attinmeta);
@@ -913,7 +934,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
                FuncCallContext *funcctx;
 
                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);
 
                if (SRF_IS_FIRSTCALL())
@@ -966,7 +989,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
                HeapTuple       tup;
 
                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);
 
                /*
@@ -1036,7 +1061,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
        * because SPI_finish would free it).
        ************************************************************/
        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))
        {
@@ -1073,13 +1098,17 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
                                                                                  trigdata->tg_newtuple);
                        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;
                        }
                }
                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;
                }
                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);
                pfree(proc_source);
-               if (!prodesc->reference)
+               if (!prodesc->reference) /* can this happen? */
                {
                        free(prodesc->proname);
                        free(prodesc);

diff --git a/src/pl/plperl/test/test.expected b/src/pl/plperl/test/test.expected
index c5b928f82092a01ce426575a58e9eaccb6d3b210..38782e8958c92f1f1154ba6c601642655d140bfb 100644 (file)
--- a/src/pl/plperl/test/test.expected
+++ b/src/pl/plperl/test/test.expected
@@ -119,9 +119,9 @@ CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
     ];
 $$  LANGUAGE plperl;
 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();
-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 $$
     return [
         { 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'};
 $$ LANGUAGE plperl;
 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();
 ERROR:  a column definition list is required for functions returning "record"
 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;
 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();
 ERROR:  a column definition list is required for functions returning "record"
 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 $$
     return [
         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
@@ -211,7 +211,7 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
     ];
 $$  LANGUAGE plperl;
 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();
 ERROR:  a column definition list is required for functions returning "record"
 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};
 $$ LANGUAGE plperl;
 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 $$
 return 42;
 $$ LANGUAGE plperl;
 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 $$
 return [
     [1, 2],
@@ -253,17 +253,17 @@ return [
 ];
 $$ LANGUAGE plperl;
 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 $$
     return 42;
 $$ LANGUAGE plperl;
 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 $$
     return {y => 3, z => 4};
 $$ LANGUAGE plperl;
 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 $$
 return [
     [1, 2],
@@ -271,14 +271,14 @@ return [
 ];
 $$ LANGUAGE plperl;
 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 $$
 return [
     {y => 3, z => 4}
 ];
 $$ LANGUAGE plperl;
 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 $$
     return $_[0]->{$_[1]};
 $$ LANGUAGE plperl;