mirror of
https://git.postgresql.org/git/postgresql.git
synced 2024-12-21 08:29:39 +08:00
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.) Abhijit Menon-Sen
This commit is contained in:
parent
bdb8b394c4
commit
ce1c20248d
@ -33,7 +33,7 @@
|
|||||||
* ENHANCEMENTS, OR MODIFICATIONS.
|
* ENHANCEMENTS, OR MODIFICATIONS.
|
||||||
*
|
*
|
||||||
* IDENTIFICATION
|
* 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;
|
plperl_safe_init_done = true;
|
||||||
}
|
}
|
||||||
|
|
||||||
/**********************************************************************
|
|
||||||
* turn a tuple into a hash expression and add it to a list
|
static HV *
|
||||||
**********************************************************************/
|
plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
|
||||||
static void
|
|
||||||
plperl_sv_add_tuple_value(SV *rv, HeapTuple tuple, TupleDesc tupdesc)
|
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
char *value;
|
HV *hv = newHV();
|
||||||
char *key;
|
|
||||||
|
|
||||||
sv_catpvf(rv, "{ ");
|
|
||||||
|
|
||||||
for (i = 0; i < tupdesc->natts; i++)
|
for (i = 0; i < tupdesc->natts; i++)
|
||||||
{
|
{
|
||||||
key = SPI_fname(tupdesc, i + 1);
|
SV *value;
|
||||||
value = SPI_getvalue(tuple, tupdesc, i + 1);
|
|
||||||
if (value)
|
|
||||||
sv_catpvf(rv, "%s => '%s'", key, value);
|
|
||||||
else
|
|
||||||
sv_catpvf(rv, "%s => undef", key);
|
|
||||||
if (i != tupdesc->natts - 1)
|
|
||||||
sv_catpvf(rv, ", ");
|
|
||||||
}
|
|
||||||
|
|
||||||
sv_catpvf(rv, " }");
|
char *key = SPI_fname(tupdesc, i+1);
|
||||||
|
char *val = SPI_getvalue(tuple, tupdesc, i + 1);
|
||||||
|
|
||||||
|
if (val)
|
||||||
|
value = newSVpv(val, 0);
|
||||||
|
else
|
||||||
|
value = newSV(0);
|
||||||
|
|
||||||
|
hv_store(hv, key, strlen(key), value, 0);
|
||||||
|
}
|
||||||
|
return hv;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/**********************************************************************
|
/**********************************************************************
|
||||||
* set up arguments for a trigger call
|
* set up arguments for a trigger call
|
||||||
**********************************************************************/
|
**********************************************************************/
|
||||||
@ -312,76 +309,89 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
|
|||||||
TriggerData *tdata;
|
TriggerData *tdata;
|
||||||
TupleDesc tupdesc;
|
TupleDesc tupdesc;
|
||||||
int i = 0;
|
int i = 0;
|
||||||
SV *rv;
|
char *level;
|
||||||
|
char *event;
|
||||||
|
char *relid;
|
||||||
|
char *when;
|
||||||
|
HV *hv;
|
||||||
|
|
||||||
rv = newSVpv("{ ", 0);
|
hv = newHV();
|
||||||
|
|
||||||
tdata = (TriggerData *) fcinfo->context;
|
tdata = (TriggerData *) fcinfo->context;
|
||||||
|
|
||||||
tupdesc = tdata->tg_relation->rd_att;
|
tupdesc = tdata->tg_relation->rd_att;
|
||||||
|
|
||||||
sv_catpvf(rv, "name => '%s'", tdata->tg_trigger->tgname);
|
relid = DatumGetCString(
|
||||||
sv_catpvf(rv, ", relid => '%s'", DatumGetCString(DirectFunctionCall1(oidout, ObjectIdGetDatum(tdata->tg_relation->rd_id))));
|
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))
|
if (TRIGGER_FIRED_BY_INSERT(tdata->tg_event))
|
||||||
{
|
{
|
||||||
sv_catpvf(rv, ", event => 'INSERT'");
|
event = "INSERT";
|
||||||
sv_catpvf(rv, ", new =>");
|
hv_store(hv, "new", 3,
|
||||||
plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc);
|
newRV((SV *)plperl_hash_from_tuple(tdata->tg_trigtuple,
|
||||||
|
tupdesc)),
|
||||||
|
0);
|
||||||
}
|
}
|
||||||
else if (TRIGGER_FIRED_BY_DELETE(tdata->tg_event))
|
else if (TRIGGER_FIRED_BY_DELETE(tdata->tg_event))
|
||||||
{
|
{
|
||||||
sv_catpvf(rv, ", event => 'DELETE'");
|
event = "DELETE";
|
||||||
sv_catpvf(rv, ", old => ");
|
hv_store(hv, "old", 3,
|
||||||
plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc);
|
newRV((SV *)plperl_hash_from_tuple(tdata->tg_trigtuple,
|
||||||
|
tupdesc)),
|
||||||
|
0);
|
||||||
}
|
}
|
||||||
else if (TRIGGER_FIRED_BY_UPDATE(tdata->tg_event))
|
else if (TRIGGER_FIRED_BY_UPDATE(tdata->tg_event))
|
||||||
{
|
{
|
||||||
sv_catpvf(rv, ", event => 'UPDATE'");
|
event = "UPDATE";
|
||||||
|
hv_store(hv, "old", 3,
|
||||||
sv_catpvf(rv, ", new =>");
|
newRV((SV *)plperl_hash_from_tuple(tdata->tg_trigtuple,
|
||||||
plperl_sv_add_tuple_value(rv, tdata->tg_newtuple, tupdesc);
|
tupdesc)),
|
||||||
|
0);
|
||||||
sv_catpvf(rv, ", old => ");
|
hv_store(hv, "new", 3,
|
||||||
plperl_sv_add_tuple_value(rv, tdata->tg_trigtuple, tupdesc);
|
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)
|
if (tdata->tg_trigger->tgnargs != 0)
|
||||||
{
|
{
|
||||||
sv_catpvf(rv, ", args => [ ");
|
AV *av = newAV();
|
||||||
for (i = 0; i < tdata->tg_trigger->tgnargs; i++)
|
for (i=0; i < tdata->tg_trigger->tgnargs; i++)
|
||||||
{
|
av_push(av, newSVpv(tdata->tg_trigger->tgargs[i], 0));
|
||||||
sv_catpvf(rv, "%s", tdata->tg_trigger->tgargs[i]);
|
hv_store(hv, "args", 4, newRV((SV *)av), 0);
|
||||||
if (i != tdata->tg_trigger->tgnargs - 1)
|
|
||||||
sv_catpvf(rv, ", ");
|
|
||||||
}
|
}
|
||||||
sv_catpvf(rv, " ]");
|
|
||||||
}
|
hv_store(hv, "relname", 7,
|
||||||
sv_catpvf(rv, ", relname => '%s'", SPI_getrelname(tdata->tg_relation));
|
newSVpv(SPI_getrelname(tdata->tg_relation), 0), 0);
|
||||||
|
|
||||||
if (TRIGGER_FIRED_BEFORE(tdata->tg_event))
|
if (TRIGGER_FIRED_BEFORE(tdata->tg_event))
|
||||||
sv_catpvf(rv, ", when => 'BEFORE'");
|
when = "BEFORE";
|
||||||
else if (TRIGGER_FIRED_AFTER(tdata->tg_event))
|
else if (TRIGGER_FIRED_AFTER(tdata->tg_event))
|
||||||
sv_catpvf(rv, ", when => 'AFTER'");
|
when = "AFTER";
|
||||||
else
|
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))
|
if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event))
|
||||||
sv_catpvf(rv, ", level => 'ROW'");
|
level = "ROW";
|
||||||
else if (TRIGGER_FIRED_FOR_STATEMENT(tdata->tg_event))
|
else if (TRIGGER_FIRED_FOR_STATEMENT(tdata->tg_event))
|
||||||
sv_catpvf(rv, ", level => 'STATEMENT'");
|
level = "STATEMENT";
|
||||||
else
|
else
|
||||||
sv_catpvf(rv, ", level => 'UNKNOWN'");
|
level = "UNKNOWN";
|
||||||
|
hv_store(hv, "level", 5, newSVpv(level, 0), 0);
|
||||||
|
|
||||||
sv_catpvf(rv, " }");
|
return newRV((SV*)hv);
|
||||||
|
|
||||||
rv = perl_eval_pv(SvPV(rv, PL_na), TRUE);
|
|
||||||
|
|
||||||
return rv;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -440,21 +450,17 @@ static AV *
|
|||||||
plperl_get_keys(HV *hv)
|
plperl_get_keys(HV *hv)
|
||||||
{
|
{
|
||||||
AV *ret;
|
AV *ret;
|
||||||
int key_count;
|
|
||||||
SV *val;
|
SV *val;
|
||||||
char *key;
|
char *key;
|
||||||
I32 klen;
|
I32 klen;
|
||||||
|
|
||||||
key_count = 0;
|
|
||||||
ret = newAV();
|
ret = newAV();
|
||||||
|
|
||||||
hv_iterinit(hv);
|
hv_iterinit(hv);
|
||||||
while ((val = hv_iternextsv(hv, (char **) &key, &klen)))
|
while ((val = hv_iternextsv(hv, (char **) &key, &klen)))
|
||||||
{
|
av_push(ret, newSVpv(key, 0));
|
||||||
av_store(ret, key_count, eval_pv(key, TRUE));
|
|
||||||
key_count++;
|
|
||||||
}
|
|
||||||
hv_iterinit(hv);
|
hv_iterinit(hv);
|
||||||
|
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -484,11 +490,8 @@ plperl_get_key(AV *keys, int index)
|
|||||||
static char *
|
static char *
|
||||||
plperl_get_elem(HV *hash, char *key)
|
plperl_get_elem(HV *hash, char *key)
|
||||||
{
|
{
|
||||||
SV **svp;
|
SV **svp = hv_fetch(hash, key, strlen(key), FALSE);
|
||||||
|
if (!svp)
|
||||||
if (hv_exists_ent(hash, eval_pv(key, TRUE), FALSE))
|
|
||||||
svp = hv_fetch(hash, key, strlen(key), FALSE);
|
|
||||||
else
|
|
||||||
{
|
{
|
||||||
elog(ERROR, "plperl: key '%s' not found", key);
|
elog(ERROR, "plperl: key '%s' not found", key);
|
||||||
return NULL;
|
return NULL;
|
||||||
@ -998,7 +1001,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
|
|||||||
g_attr_num = tupdesc->natts;
|
g_attr_num = tupdesc->natts;
|
||||||
|
|
||||||
for (i = 0; i < tupdesc->natts; i++)
|
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);
|
slot = TupleDescGetSlot(tupdesc);
|
||||||
funcctx->slot = slot;
|
funcctx->slot = slot;
|
||||||
@ -1269,6 +1273,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
|
|||||||
int proname_len;
|
int proname_len;
|
||||||
plperl_proc_desc *prodesc = NULL;
|
plperl_proc_desc *prodesc = NULL;
|
||||||
int i;
|
int i;
|
||||||
|
SV **svp;
|
||||||
|
|
||||||
/* We'll need the pg_proc tuple in any case... */
|
/* We'll need the pg_proc tuple in any case... */
|
||||||
procTup = SearchSysCache(PROCOID,
|
procTup = SearchSysCache(PROCOID,
|
||||||
@ -1291,12 +1296,12 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
|
|||||||
/************************************************************
|
/************************************************************
|
||||||
* Lookup the internal proc name in the hashtable
|
* 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;
|
bool uptodate;
|
||||||
|
|
||||||
prodesc = (plperl_proc_desc *) SvIV(*hv_fetch(plperl_proc_hash,
|
prodesc = (plperl_proc_desc *) SvIV(*svp);
|
||||||
internal_proname, proname_len, 0));
|
|
||||||
|
|
||||||
/************************************************************
|
/************************************************************
|
||||||
* If it's present, must check whether it's still up to date.
|
* 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)
|
plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
SV *output;
|
HV *hv;
|
||||||
Datum attr;
|
Datum attr;
|
||||||
bool isnull;
|
bool isnull;
|
||||||
char *attname;
|
char *attname;
|
||||||
@ -1527,31 +1532,22 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
|
|||||||
HeapTuple typeTup;
|
HeapTuple typeTup;
|
||||||
Oid typoutput;
|
Oid typoutput;
|
||||||
Oid typioparam;
|
Oid typioparam;
|
||||||
|
int namelen;
|
||||||
|
|
||||||
output = sv_2mortal(newSVpv("{", 0));
|
hv = newHV();
|
||||||
|
|
||||||
for (i = 0; i < tupdesc->natts; i++)
|
for (i = 0; i < tupdesc->natts; i++)
|
||||||
{
|
{
|
||||||
/* ignore dropped attributes */
|
|
||||||
if (tupdesc->attrs[i]->attisdropped)
|
if (tupdesc->attrs[i]->attisdropped)
|
||||||
continue;
|
continue;
|
||||||
|
|
||||||
/************************************************************
|
|
||||||
* Get the attribute name
|
|
||||||
************************************************************/
|
|
||||||
attname = tupdesc->attrs[i]->attname.data;
|
attname = tupdesc->attrs[i]->attname.data;
|
||||||
|
namelen = strlen(attname);
|
||||||
/************************************************************
|
|
||||||
* Get the attributes value
|
|
||||||
************************************************************/
|
|
||||||
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
|
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
|
||||||
|
|
||||||
/************************************************************
|
if (isnull) {
|
||||||
* If it is null it will be set to undef in the hash.
|
/* Store (attname => undef) and move on. */
|
||||||
************************************************************/
|
hv_store(hv, attname, namelen, newSV(0), 0);
|
||||||
if (isnull)
|
|
||||||
{
|
|
||||||
sv_catpvf(output, "'%s' => undef,", attname);
|
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1577,13 +1573,11 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
|
|||||||
attr,
|
attr,
|
||||||
ObjectIdGetDatum(typioparam),
|
ObjectIdGetDatum(typioparam),
|
||||||
Int32GetDatum(tupdesc->attrs[i]->atttypmod)));
|
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, "}");
|
return sv_2mortal(newRV((SV *)hv));
|
||||||
output = perl_eval_pv(SvPV(output, PL_na), TRUE);
|
|
||||||
return output;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -1599,36 +1593,6 @@ plperl_spi_exec(char *query, int limit)
|
|||||||
return ret_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 *
|
static HV *
|
||||||
plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status)
|
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++)
|
for (i = 0; i < processed; i++)
|
||||||
{
|
{
|
||||||
row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
|
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"),
|
hv_store(result, "rows", strlen("rows"),
|
||||||
newRV_noinc((SV *) rows), 0);
|
newRV_noinc((SV *) rows), 0);
|
||||||
|
Loading…
Reference in New Issue
Block a user