open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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.)

Abhijit Menon-Sen
REL8_0_STABLE
Bruce Momjian 21 years ago
parent bdb8b394c4
commit ce1c20248d
1 changed files with 93 additions and 129 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 222
      src/pl/plperl/plperl.c

222
src/pl/plperl/plperl.c
Unescape View File

@ -33,7 +33,7 @@
* 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 $
*
**********************************************************************/
@ -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(FunctionCallInfo fcinfo)
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);
}
@ -440,21 +450,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, eval_pv(key, TRUE));
key_count++;
}
av_push(ret, newSVpv(key, 0));
hv_iterinit(hv);
return ret;
}
@ -484,11 +490,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 +1001,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;
@ -1269,6 +1273,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
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,
@ -1291,12 +1296,12 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
/************************************************************
* 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.
@ -1519,7 +1524,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 +1532,22 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
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 +1573,11 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
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));
}
@ -1599,36 +1593,6 @@ plperl_spi_exec(char *query, int limit)
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)
{
@ -1653,7 +1617,7 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int stat
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);

Write Preview
Loading…
Cancel
Save