Back-patch 8.0 version of plperl_hash_from_tuple() into prior releases

to fix failure to cope with quote marks in field values; not to mention
that it is shorter and faster.  Per report from Charles Haron.

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 5916977a3f90407e85b764e3c16c1f7671f6aa19..3aa551cdbe02153f758581035e8053a5218233bf 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *       ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *       $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.40 2003/09/04 15:16:39 tgl Exp $
+ *       $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.40.2.1 2005/01/26 17:09:21 tgl Exp $
  *
  **********************************************************************/
 
@@ -737,76 +737,53 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
 
 
 /**********************************************************************
- * plperl_build_tuple_argument() - Build a string for a ref to a hash
+ * plperl_build_tuple_argument() - Build a ref to a hash
  *                               from all attributes of a given tuple
  **********************************************************************/
 static SV  *
 plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 {
+       HV                 *hv;
        int                     i;
-       SV                 *output;
-       Datum           attr;
-       bool            isnull;
-       char       *attname;
-       char       *outputstr;
-       HeapTuple       typeTup;
-       Oid                     typoutput;
-       Oid                     typelem;
 
-       output = sv_2mortal(newSVpv("{", 0));
+       hv = newHV();
 
        for (i = 0; i < tupdesc->natts; i++)
        {
-               /* ignore dropped attributes */
+               Datum           attr;
+               bool            isnull;
+               char       *attname;
+               char       *outputstr;
+               Oid                     typoutput;
+               Oid                     typioparam;
+               bool            typisvarlena;
+               int                     namelen;
+
                if (tupdesc->attrs[i]->attisdropped)
                        continue;
 
-               /************************************************************
-                * Get the attribute name
-                ************************************************************/
-               attname = tupdesc->attrs[i]->attname.data;
-
-               /************************************************************
-                * Get the attributes value
-                ************************************************************/
+               attname = NameStr(tupdesc->attrs[i]->attname);
+               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;
                }
 
-               /************************************************************
-                * Lookup the attribute type in the syscache
-                * for the output function
-                ************************************************************/
-               typeTup = SearchSysCache(TYPEOID,
-                                                  ObjectIdGetDatum(tupdesc->attrs[i]->atttypid),
-                                                                0, 0, 0);
-               if (!HeapTupleIsValid(typeTup))
-                       elog(ERROR, "cache lookup failed for type %u",
-                                tupdesc->attrs[i]->atttypid);
+               /* XXX should have a way to cache these lookups */
 
-               typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
-               typelem = ((Form_pg_type) GETSTRUCT(typeTup))->typelem;
-               ReleaseSysCache(typeTup);
+               getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
+                                                 &typoutput, &typioparam, &typisvarlena);
 
-               /************************************************************
-                * Append the attribute name and the value to the list.
-                ************************************************************/
                outputstr = DatumGetCString(OidFunctionCall3(typoutput,
                                                                                                         attr,
-                                                                                          ObjectIdGetDatum(typelem),
+                                                                                       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 newRV_noinc((SV *) hv);
 }