I have attached 5 patches (split up for ease of review) to plperl.c.

1. Two minor cleanups:

    - We don't need to call hv_exists+hv_fetch; we should just check the
      return value of hv_fetch.
    - newSVpv("undef",0) is the string "undef", not a real undef.

2. This should fix the bug Andrew Dunstan described in a recent -hackers
   post. It replaces three bogus "eval_pv(key, 0)" calls with newSVpv,
   and eliminates another redundant hv_exists+hv_fetch pair.

3. plperl_build_tuple_argument builds up a string of Perl code to create
   a hash representing the tuple. This patch creates the hash directly.

4. Another minor cleanup: replace a couple of av_store()s with av_push.

5. Analogous to #3 for plperl_trigger_build_args. This patch removes the
   static sv_add_tuple_value function, which does much the same as two
   other utility functions defined later, and merges the functionality
   into plperl_hash_from_tuple.

I have tested the patches to the best of my limited ability, but I would
appreciate it very much if someone else could review and test them too.

(Thanks to Andrew and David Fetter for their help with some testing.)

-- ams
--- plperl.c~   2004-10-02 04:12:05.189765562 +0530
+++ plperl.c    2004-10-02 04:12:28.017002164 +0530
@@ -1270,6 +1270,7 @@ compile_plperl_function(Oid fn_oid, bool
        int                     proname_len;
        plperl_proc_desc *prodesc = NULL;
        int                     i;
+       SV                      **svp;
 
        /* We'll need the pg_proc tuple in any case... */
        procTup = SearchSysCache(PROCOID,
@@ -1292,12 +1293,12 @@ compile_plperl_function(Oid fn_oid, bool
        /************************************************************
         * Lookup the internal proc name in the hashtable
         ************************************************************/
-       if (hv_exists(plperl_proc_hash, internal_proname, proname_len))
+       svp = hv_fetch(plperl_proc_hash, internal_proname, proname_len, FALSE);
+       if (svp)
        {
                bool            uptodate;
 
-               prodesc = (plperl_proc_desc *) SvIV(*hv_fetch(plperl_proc_hash,
-                                                                         
internal_proname, proname_len, 0));
+               prodesc = (plperl_proc_desc *) SvIV(*svp);
 
                /************************************************************
                 * If it's present, must check whether it's still up to date.
@@ -1625,7 +1626,7 @@ plperl_hash_from_tuple(HeapTuple tuple, 
                if (attdata)
                        hv_store(array, attname, strlen(attname), newSVpv(attdata, 0), 
0);
                else
-                       hv_store(array, attname, strlen(attname), newSVpv("undef", 0), 
0);
+                       hv_store(array, attname, strlen(attname), newSV(0), 0);
        }
        return array;
 }
--- plperl.c~   2004-10-02 04:14:43.768721344 +0530
+++ plperl.c    2004-10-02 04:14:53.325733327 +0530
@@ -451,7 +451,7 @@ plperl_get_keys(HV *hv)
        hv_iterinit(hv);
        while ((val = hv_iternextsv(hv, (char **) &key, &klen)))
        {
-               av_store(ret, key_count, eval_pv(key, TRUE));
+               av_store(ret, key_count, newSVpv(key, 0));
                key_count++;
        }
        hv_iterinit(hv);
@@ -484,11 +484,8 @@ plperl_get_key(AV *keys, int index)
 static char *
 plperl_get_elem(HV *hash, char *key)
 {
-       SV                **svp;
-
-       if (hv_exists_ent(hash, eval_pv(key, TRUE), FALSE))
-               svp = hv_fetch(hash, key, strlen(key), FALSE);
-       else
+       SV **svp = hv_fetch(hash, key, strlen(key), FALSE);
+       if (!svp)
        {
                elog(ERROR, "plperl: key '%s' not found", key);
                return NULL;
@@ -998,7 +995,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
                        g_attr_num = tupdesc->natts;
 
                        for (i = 0; i < tupdesc->natts; i++)
-                               av_store(g_column_keys, i + 1, 
eval_pv(SPI_fname(tupdesc, i + 1), TRUE));
+                               av_store(g_column_keys, i + 1,
+                                                newSVpv(SPI_fname(tupdesc, i+1), 0));
 
                        slot = TupleDescGetSlot(tupdesc);
                        funcctx->slot = slot;
--- plperl.c~   2004-10-02 04:15:16.737864847 +0530
+++ plperl.c    2004-10-02 04:16:36.108850361 +0530
@@ -1519,7 +1519,7 @@ static SV  *
 plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 {
        int                     i;
-       SV                 *output;
+       HV                 *hv;
        Datum           attr;
        bool            isnull;
        char       *attname;
@@ -1527,31 +1527,22 @@ plperl_build_tuple_argument(HeapTuple tu
        HeapTuple       typeTup;
        Oid                     typoutput;
        Oid                     typioparam;
+       int                     namelen;
 
-       output = sv_2mortal(newSVpv("{", 0));
+       hv = newHV();
 
        for (i = 0; i < tupdesc->natts; i++)
        {
-               /* ignore dropped attributes */
                if (tupdesc->attrs[i]->attisdropped)
                        continue;
 
-               /************************************************************
-                * Get the attribute name
-                ************************************************************/
                attname = tupdesc->attrs[i]->attname.data;
-
-               /************************************************************
-                * Get the attributes value
-                ************************************************************/
+               namelen = strlen(attname);
                attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
 
-               /************************************************************
-                *      If it is null it will be set to undef in the hash.
-                ************************************************************/
-               if (isnull)
-               {
-                       sv_catpvf(output, "'%s' => undef,", attname);
+               if (isnull) {
+                       /* Store (attname => undef) and move on. */
+                       hv_store(hv, attname, namelen, newSV(0), 0);
                        continue;
                }
 
@@ -1577,13 +1568,11 @@ plperl_build_tuple_argument(HeapTuple tu
                                                                                       
                  attr,
                                                                                       
 ObjectIdGetDatum(typioparam),
                                                   
Int32GetDatum(tupdesc->attrs[i]->atttypmod)));
-               sv_catpvf(output, "'%s' => '%s',", attname, outputstr);
-               pfree(outputstr);
+
+               hv_store(hv, attname, namelen, newSVpv(outputstr, 0), 0);
        }
 
-       sv_catpv(output, "}");
-       output = perl_eval_pv(SvPV(output, PL_na), TRUE);
-       return output;
+       return sv_2mortal(newRV((SV *)hv));
 }
 
 
--- plperl.c~   2004-10-02 04:16:58.886277828 +0530
+++ plperl.c    2004-10-02 04:17:05.604929308 +0530
@@ -440,21 +440,17 @@ static AV  *
 plperl_get_keys(HV *hv)
 {
        AV                 *ret;
-       int                     key_count;
        SV                 *val;
        char       *key;
        I32                     klen;
 
-       key_count = 0;
        ret = newAV();
 
        hv_iterinit(hv);
        while ((val = hv_iternextsv(hv, (char **) &key, &klen)))
-       {
-               av_store(ret, key_count, newSVpv(key, 0));
-               key_count++;
-       }
+               av_push(ret, newSVpv(key, 0));
        hv_iterinit(hv);
+
        return ret;
 }
 
@@ -1642,7 +1638,7 @@ plperl_spi_execute_fetch_result(SPITuple
                        for (i = 0; i < processed; i++)
                        {
                                row = plperl_hash_from_tuple(tuptable->vals[i], 
tuptable->tupdesc);
-                               av_store(rows, i, newRV_noinc((SV *) row));
+                               av_push(rows, newRV_noinc((SV *)row));
                        }
                        hv_store(result, "rows", strlen("rows"),
                                         newRV_noinc((SV *) rows), 0);
--- plperl.c~   2004-10-02 04:17:24.939049308 +0530
+++ plperl.c    2004-10-02 04:17:31.452742332 +0530
@@ -276,33 +276,30 @@ plperl_safe_init(void)
        plperl_safe_init_done = true;
 }
 
-/**********************************************************************
- * turn a tuple into a hash expression and add it to a list
- **********************************************************************/
-static void
-plperl_sv_add_tuple_value(SV *rv, HeapTuple tuple, TupleDesc tupdesc)
-{
-       int                     i;
-       char       *value;
-       char       *key;
-
-       sv_catpvf(rv, "{ ");
 
+static HV *
+plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
+{
+       int     i;
+       HV *hv = newHV();
        for (i = 0; i < tupdesc->natts; i++)
        {
-               key = SPI_fname(tupdesc, i + 1);
-               value = SPI_getvalue(tuple, tupdesc, i + 1);
-               if (value)
-                       sv_catpvf(rv, "%s => '%s'", key, value);
+               SV *value;
+
+               char *key = SPI_fname(tupdesc, i+1);
+               char *val = SPI_getvalue(tuple, tupdesc, i + 1);
+
+               if (val)
+                       value = newSVpv(val, 0);
                else
-                       sv_catpvf(rv, "%s => undef", key);
-               if (i != tupdesc->natts - 1)
-                       sv_catpvf(rv, ", ");
-       }
+                       value = newSV(0);
 
-       sv_catpvf(rv, " }");
+               hv_store(hv, key, strlen(key), value, 0);
+       }
+       return hv;
 }
 
+
 /**********************************************************************
  * set up arguments for a trigger call
  **********************************************************************/
@@ -312,76 +309,89 @@ plperl_trigger_build_args(FunctionCallIn
        TriggerData *tdata;
        TupleDesc       tupdesc;
        int                     i = 0;
-       SV                 *rv;
+       char       *level;
+       char       *event;
+       char       *relid;
+       char       *when;
+       HV                 *hv;
 
-       rv = newSVpv("{ ", 0);
+       hv = newHV();
 
        tdata = (TriggerData *) fcinfo->context;
-
        tupdesc = tdata->tg_relation->rd_att;
 
-       sv_catpvf(rv, "name => '%s'", tdata->tg_trigger->tgname);
-       sv_catpvf(rv, ", relid => '%s'", DatumGetCString(DirectFunctionCall1(oidout, 
ObjectIdGetDatum(tdata->tg_relation->rd_id))));
+       relid = DatumGetCString(
+                               DirectFunctionCall1(
+                                       oidout, 
ObjectIdGetDatum(tdata->tg_relation->rd_id)
+                               )
+                       );
+
+       hv_store(hv, "name", 4, newSVpv(tdata->tg_trigger->tgname, 0), 0);
+       hv_store(hv, "relid", 5, newSVpv(relid, 0), 0);
 
        if (TRIGGER_FIRED_BY_INSERT(tdata->tg_event))
        {
-               sv_catpvf(rv, ", event => 'INSERT'");
-               sv_catpvf(rv, ", new =>");
-               plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc);
+               event = "INSERT";
+               hv_store(hv, "new", 3,
+                                newRV((SV 
*)plperl_hash_from_tuple(tdata->tg_trigtuple,
+                                                                                      
                 tupdesc)),
+                                0);
        }
        else if (TRIGGER_FIRED_BY_DELETE(tdata->tg_event))
        {
-               sv_catpvf(rv, ", event => 'DELETE'");
-               sv_catpvf(rv, ", old => ");
-               plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc);
+               event = "DELETE";
+               hv_store(hv, "old", 3,
+                                newRV((SV 
*)plperl_hash_from_tuple(tdata->tg_trigtuple,
+                                                                                      
                 tupdesc)),
+                                0);
        }
        else if (TRIGGER_FIRED_BY_UPDATE(tdata->tg_event))
        {
-               sv_catpvf(rv, ", event => 'UPDATE'");
-
-               sv_catpvf(rv, ", new =>");
-               plperl_sv_add_tuple_value(rv, tdata->tg_newtuple, tupdesc);
-
-               sv_catpvf(rv, ", old => ");
-               plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc);
+               event = "UPDATE";
+               hv_store(hv, "old", 3,
+                                newRV((SV 
*)plperl_hash_from_tuple(tdata->tg_trigtuple,
+                                                                                      
                 tupdesc)),
+                                0);
+               hv_store(hv, "new", 3,
+                                newRV((SV *)plperl_hash_from_tuple(tdata->tg_newtuple,
+                                                                                      
                 tupdesc)),
+                                0);
+       }
+       else {
+               event = "UNKNOWN";
        }
-       else
-               sv_catpvf(rv, ", event => 'UNKNOWN'");
 
-       sv_catpvf(rv, ", argc => %d", tdata->tg_trigger->tgnargs);
+       hv_store(hv, "event", 5, newSVpv(event, 0), 0);
+       hv_store(hv, "argc", 4, newSViv(tdata->tg_trigger->tgnargs), 0);
 
        if (tdata->tg_trigger->tgnargs != 0)
        {
-               sv_catpvf(rv, ", args => [ ");
-               for (i = 0; i < tdata->tg_trigger->tgnargs; i++)
-               {
-                       sv_catpvf(rv, "%s", tdata->tg_trigger->tgargs[i]);
-                       if (i != tdata->tg_trigger->tgnargs - 1)
-                               sv_catpvf(rv, ", ");
-               }
-               sv_catpvf(rv, " ]");
+               AV *av = newAV();
+               for (i=0; i < tdata->tg_trigger->tgnargs; i++)
+                       av_push(av, newSVpv(tdata->tg_trigger->tgargs[i], 0));
+               hv_store(hv, "args", 4, newRV((SV *)av), 0);
        }
-       sv_catpvf(rv, ", relname => '%s'", SPI_getrelname(tdata->tg_relation));
+
+       hv_store(hv, "relname", 7,
+                        newSVpv(SPI_getrelname(tdata->tg_relation), 0), 0);
 
        if (TRIGGER_FIRED_BEFORE(tdata->tg_event))
-               sv_catpvf(rv, ", when => 'BEFORE'");
+               when = "BEFORE";
        else if (TRIGGER_FIRED_AFTER(tdata->tg_event))
-               sv_catpvf(rv, ", when => 'AFTER'");
+               when = "AFTER";
        else
-               sv_catpvf(rv, ", when => 'UNKNOWN'");
+               when = "UNKNOWN";
+       hv_store(hv, "when", 4, newSVpv(when, 0), 0);
 
        if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event))
-               sv_catpvf(rv, ", level => 'ROW'");
+               level = "ROW";
        else if (TRIGGER_FIRED_FOR_STATEMENT(tdata->tg_event))
-               sv_catpvf(rv, ", level => 'STATEMENT'");
+               level = "STATEMENT";
        else
-               sv_catpvf(rv, ", level => 'UNKNOWN'");
-
-       sv_catpvf(rv, " }");
+               level = "UNKNOWN";
+       hv_store(hv, "level", 5, newSVpv(level, 0), 0);
 
-       rv = perl_eval_pv(SvPV(rv, PL_na), TRUE);
-
-       return rv;
+       return newRV((SV*)hv);
 }
 
 
@@ -1585,36 +1595,6 @@ plperl_spi_exec(char *query, int limit)
 }
 
 static HV  *
-plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
-{
-       int                     i;
-       char       *attname;
-       char       *attdata;
-
-       HV                 *array;
-
-       array = newHV();
-
-       for (i = 0; i < tupdesc->natts; i++)
-       {
-               /************************************************************
-               * Get the attribute name
-               ************************************************************/
-               attname = tupdesc->attrs[i]->attname.data;
-
-               /************************************************************
-               * Get the attributes value
-               ************************************************************/
-               attdata = SPI_getvalue(tuple, tupdesc, i + 1);
-               if (attdata)
-                       hv_store(array, attname, strlen(attname), newSVpv(attdata, 0), 
0);
-               else
-                       hv_store(array, attname, strlen(attname), newSV(0), 0);
-       }
-       return array;
-}
-
-static HV  *
 plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status)
 {
        HV                 *result;
---------------------------(end of broadcast)---------------------------
TIP 5: Have you checked our extensive FAQ?

               http://www.postgresql.org/docs/faqs/FAQ.html

Reply via email to