* ENHANCEMENTS, OR MODIFICATIONS.
*
* IDENTIFICATION
- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.54 2004/10/07 19:01:09 momjian Exp $
+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.55 2004/10/15 17:08:26 momjian Exp $
*
**********************************************************************/
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
**********************************************************************/
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'");
+ level = "UNKNOWN";
+ hv_store(hv, "level", 5, newSVpv(level, 0), 0);
- sv_catpvf(rv, " }");
-
- rv = perl_eval_pv(SvPV(rv, PL_na), TRUE);
-
- return rv;
+ return newRV((SV*)hv);
}
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, eval_pv(key, TRUE));
- key_count++;
- }
+ av_push(ret, newSVpv(key, 0));
hv_iterinit(hv);
+
return ret;
}
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;
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;
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,
/************************************************************
* 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.
plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
{
int i;
- SV *output;
+ HV *hv;
Datum attr;
bool isnull;
char *attname;
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;
}
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));
}
return ret_hv;
}
-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), newSVpv("undef", 0), 0);
- }
- return array;
-}
-
static HV *
plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status)
{
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);
projects / postgresql.git / commitdiff