Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commitce1c202

Browse files
committed
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 wouldappreciate 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
1 parentbdb8b39 commitce1c202

File tree

1 file changed

+93
-129
lines changed

1 file changed

+93
-129
lines changed

‎src/pl/plperl/plperl.c

Lines changed: 93 additions & 129 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
* ENHANCEMENTS, OR MODIFICATIONS.
3434
*
3535
* IDENTIFICATION
36-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.54 2004/10/07 19:01:09 momjian Exp $
36+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.55 2004/10/15 17:08:26 momjian Exp $
3737
*
3838
**********************************************************************/
3939

@@ -276,33 +276,30 @@ plperl_safe_init(void)
276276
plperl_safe_init_done= true;
277277
}
278278

279-
/**********************************************************************
280-
* turn a tuple into a hash expression and add it to a list
281-
**********************************************************************/
282-
staticvoid
283-
plperl_sv_add_tuple_value(SV*rv,HeapTupletuple,TupleDesctupdesc)
284-
{
285-
inti;
286-
char*value;
287-
char*key;
288-
289-
sv_catpvf(rv,"{ ");
290279

280+
staticHV*
281+
plperl_hash_from_tuple(HeapTupletuple,TupleDesctupdesc)
282+
{
283+
inti;
284+
HV*hv=newHV();
291285
for (i=0;i<tupdesc->natts;i++)
292286
{
293-
key=SPI_fname(tupdesc,i+1);
294-
value=SPI_getvalue(tuple,tupdesc,i+1);
295-
if (value)
296-
sv_catpvf(rv,"%s => '%s'",key,value);
287+
SV*value;
288+
289+
char*key=SPI_fname(tupdesc,i+1);
290+
char*val=SPI_getvalue(tuple,tupdesc,i+1);
291+
292+
if (val)
293+
value=newSVpv(val,0);
297294
else
298-
sv_catpvf(rv,"%s => undef",key);
299-
if (i!=tupdesc->natts-1)
300-
sv_catpvf(rv,", ");
301-
}
295+
value=newSV(0);
302296

303-
sv_catpvf(rv," }");
297+
hv_store(hv,key,strlen(key),value,0);
298+
}
299+
returnhv;
304300
}
305301

302+
306303
/**********************************************************************
307304
* set up arguments for a trigger call
308305
**********************************************************************/
@@ -312,76 +309,89 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
312309
TriggerData*tdata;
313310
TupleDesctupdesc;
314311
inti=0;
315-
SV*rv;
312+
char*level;
313+
char*event;
314+
char*relid;
315+
char*when;
316+
HV*hv;
316317

317-
rv=newSVpv("{ ",0);
318+
hv=newHV();
318319

319320
tdata= (TriggerData*)fcinfo->context;
320-
321321
tupdesc=tdata->tg_relation->rd_att;
322322

323-
sv_catpvf(rv,"name => '%s'",tdata->tg_trigger->tgname);
324-
sv_catpvf(rv,", relid => '%s'",DatumGetCString(DirectFunctionCall1(oidout,ObjectIdGetDatum(tdata->tg_relation->rd_id))));
323+
relid=DatumGetCString(
324+
DirectFunctionCall1(
325+
oidout,ObjectIdGetDatum(tdata->tg_relation->rd_id)
326+
)
327+
);
328+
329+
hv_store(hv,"name",4,newSVpv(tdata->tg_trigger->tgname,0),0);
330+
hv_store(hv,"relid",5,newSVpv(relid,0),0);
325331

326332
if (TRIGGER_FIRED_BY_INSERT(tdata->tg_event))
327333
{
328-
sv_catpvf(rv,", event => 'INSERT'");
329-
sv_catpvf(rv,", new =>");
330-
plperl_sv_add_tuple_value(rv,tdata->tg_trigtuple,tupdesc);
334+
event="INSERT";
335+
hv_store(hv,"new",3,
336+
newRV((SV*)plperl_hash_from_tuple(tdata->tg_trigtuple,
337+
tupdesc)),
338+
0);
331339
}
332340
elseif (TRIGGER_FIRED_BY_DELETE(tdata->tg_event))
333341
{
334-
sv_catpvf(rv,", event => 'DELETE'");
335-
sv_catpvf(rv,", old => ");
336-
plperl_sv_add_tuple_value(rv,tdata->tg_trigtuple,tupdesc);
342+
event="DELETE";
343+
hv_store(hv,"old",3,
344+
newRV((SV*)plperl_hash_from_tuple(tdata->tg_trigtuple,
345+
tupdesc)),
346+
0);
337347
}
338348
elseif (TRIGGER_FIRED_BY_UPDATE(tdata->tg_event))
339349
{
340-
sv_catpvf(rv,", event => 'UPDATE'");
341-
342-
sv_catpvf(rv,", new =>");
343-
plperl_sv_add_tuple_value(rv,tdata->tg_newtuple,tupdesc);
344-
345-
sv_catpvf(rv,", old => ");
346-
plperl_sv_add_tuple_value(rv,tdata->tg_trigtuple,tupdesc);
350+
event="UPDATE";
351+
hv_store(hv,"old",3,
352+
newRV((SV*)plperl_hash_from_tuple(tdata->tg_trigtuple,
353+
tupdesc)),
354+
0);
355+
hv_store(hv,"new",3,
356+
newRV((SV*)plperl_hash_from_tuple(tdata->tg_newtuple,
357+
tupdesc)),
358+
0);
359+
}
360+
else {
361+
event="UNKNOWN";
347362
}
348-
else
349-
sv_catpvf(rv,", event => 'UNKNOWN'");
350363

351-
sv_catpvf(rv,", argc => %d",tdata->tg_trigger->tgnargs);
364+
hv_store(hv,"event",5,newSVpv(event,0),0);
365+
hv_store(hv,"argc",4,newSViv(tdata->tg_trigger->tgnargs),0);
352366

353367
if (tdata->tg_trigger->tgnargs!=0)
354368
{
355-
sv_catpvf(rv,", args => [ ");
356-
for (i=0;i<tdata->tg_trigger->tgnargs;i++)
357-
{
358-
sv_catpvf(rv,"%s",tdata->tg_trigger->tgargs[i]);
359-
if (i!=tdata->tg_trigger->tgnargs-1)
360-
sv_catpvf(rv,", ");
361-
}
362-
sv_catpvf(rv," ]");
369+
AV*av=newAV();
370+
for (i=0;i<tdata->tg_trigger->tgnargs;i++)
371+
av_push(av,newSVpv(tdata->tg_trigger->tgargs[i],0));
372+
hv_store(hv,"args",4,newRV((SV*)av),0);
363373
}
364-
sv_catpvf(rv,", relname => '%s'",SPI_getrelname(tdata->tg_relation));
374+
375+
hv_store(hv,"relname",7,
376+
newSVpv(SPI_getrelname(tdata->tg_relation),0),0);
365377

366378
if (TRIGGER_FIRED_BEFORE(tdata->tg_event))
367-
sv_catpvf(rv,",when => 'BEFORE'");
379+
when="BEFORE";
368380
elseif (TRIGGER_FIRED_AFTER(tdata->tg_event))
369-
sv_catpvf(rv,",when => 'AFTER'");
381+
when="AFTER";
370382
else
371-
sv_catpvf(rv,", when => 'UNKNOWN'");
383+
when="UNKNOWN";
384+
hv_store(hv,"when",4,newSVpv(when,0),0);
372385

373386
if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event))
374-
sv_catpvf(rv,",level => 'ROW'");
387+
level="ROW";
375388
elseif (TRIGGER_FIRED_FOR_STATEMENT(tdata->tg_event))
376-
sv_catpvf(rv,",level => 'STATEMENT'");
389+
level="STATEMENT";
377390
else
378-
sv_catpvf(rv,", level => 'UNKNOWN'");
391+
level="UNKNOWN";
392+
hv_store(hv,"level",5,newSVpv(level,0),0);
379393

380-
sv_catpvf(rv," }");
381-
382-
rv=perl_eval_pv(SvPV(rv,PL_na), TRUE);
383-
384-
returnrv;
394+
returnnewRV((SV*)hv);
385395
}
386396

387397

@@ -440,21 +450,17 @@ static AV *
440450
plperl_get_keys(HV*hv)
441451
{
442452
AV*ret;
443-
intkey_count;
444453
SV*val;
445454
char*key;
446455
I32klen;
447456

448-
key_count=0;
449457
ret=newAV();
450458

451459
hv_iterinit(hv);
452460
while ((val=hv_iternextsv(hv, (char**)&key,&klen)))
453-
{
454-
av_store(ret,key_count,eval_pv(key, TRUE));
455-
key_count++;
456-
}
461+
av_push(ret,newSVpv(key,0));
457462
hv_iterinit(hv);
463+
458464
returnret;
459465
}
460466

@@ -484,11 +490,8 @@ plperl_get_key(AV *keys, int index)
484490
staticchar*
485491
plperl_get_elem(HV*hash,char*key)
486492
{
487-
SV**svp;
488-
489-
if (hv_exists_ent(hash,eval_pv(key, TRUE), FALSE))
490-
svp=hv_fetch(hash,key,strlen(key), FALSE);
491-
else
493+
SV**svp=hv_fetch(hash,key,strlen(key), FALSE);
494+
if (!svp)
492495
{
493496
elog(ERROR,"plperl: key '%s' not found",key);
494497
returnNULL;
@@ -998,7 +1001,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
9981001
g_attr_num=tupdesc->natts;
9991002

10001003
for (i=0;i<tupdesc->natts;i++)
1001-
av_store(g_column_keys,i+1,eval_pv(SPI_fname(tupdesc,i+1), TRUE));
1004+
av_store(g_column_keys,i+1,
1005+
newSVpv(SPI_fname(tupdesc,i+1),0));
10021006

10031007
slot=TupleDescGetSlot(tupdesc);
10041008
funcctx->slot=slot;
@@ -1269,6 +1273,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
12691273
intproname_len;
12701274
plperl_proc_desc*prodesc=NULL;
12711275
inti;
1276+
SV**svp;
12721277

12731278
/* We'll need the pg_proc tuple in any case... */
12741279
procTup=SearchSysCache(PROCOID,
@@ -1291,12 +1296,12 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
12911296
/************************************************************
12921297
* Lookup the internal proc name in the hashtable
12931298
************************************************************/
1294-
if (hv_exists(plperl_proc_hash,internal_proname,proname_len))
1299+
svp=hv_fetch(plperl_proc_hash,internal_proname,proname_len, FALSE);
1300+
if (svp)
12951301
{
12961302
booluptodate;
12971303

1298-
prodesc= (plperl_proc_desc*)SvIV(*hv_fetch(plperl_proc_hash,
1299-
internal_proname,proname_len,0));
1304+
prodesc= (plperl_proc_desc*)SvIV(*svp);
13001305

13011306
/************************************************************
13021307
* If it's present, must check whether it's still up to date.
@@ -1519,39 +1524,30 @@ static SV *
15191524
plperl_build_tuple_argument(HeapTupletuple,TupleDesctupdesc)
15201525
{
15211526
inti;
1522-
SV*output;
1527+
HV*hv;
15231528
Datumattr;
15241529
boolisnull;
15251530
char*attname;
15261531
char*outputstr;
15271532
HeapTupletypeTup;
15281533
Oidtypoutput;
15291534
Oidtypioparam;
1535+
intnamelen;
15301536

1531-
output=sv_2mortal(newSVpv("{",0));
1537+
hv=newHV();
15321538

15331539
for (i=0;i<tupdesc->natts;i++)
15341540
{
1535-
/* ignore dropped attributes */
15361541
if (tupdesc->attrs[i]->attisdropped)
15371542
continue;
15381543

1539-
/************************************************************
1540-
* Get the attribute name
1541-
************************************************************/
15421544
attname=tupdesc->attrs[i]->attname.data;
1543-
1544-
/************************************************************
1545-
* Get the attributes value
1546-
************************************************************/
1545+
namelen=strlen(attname);
15471546
attr=heap_getattr(tuple,i+1,tupdesc,&isnull);
15481547

1549-
/************************************************************
1550-
*If it is null it will be set to undef in the hash.
1551-
************************************************************/
1552-
if (isnull)
1553-
{
1554-
sv_catpvf(output,"'%s' => undef,",attname);
1548+
if (isnull) {
1549+
/* Store (attname => undef) and move on. */
1550+
hv_store(hv,attname,namelen,newSV(0),0);
15551551
continue;
15561552
}
15571553

@@ -1577,13 +1573,11 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
15771573
attr,
15781574
ObjectIdGetDatum(typioparam),
15791575
Int32GetDatum(tupdesc->attrs[i]->atttypmod)));
1580-
sv_catpvf(output,"'%s' => '%s',",attname,outputstr);
1581-
pfree(outputstr);
1576+
1577+
hv_store(hv,attname,namelen,newSVpv(outputstr,0),0);
15821578
}
15831579

1584-
sv_catpv(output,"}");
1585-
output=perl_eval_pv(SvPV(output,PL_na), TRUE);
1586-
returnoutput;
1580+
returnsv_2mortal(newRV((SV*)hv));
15871581
}
15881582

15891583

@@ -1599,36 +1593,6 @@ plperl_spi_exec(char *query, int limit)
15991593
returnret_hv;
16001594
}
16011595

1602-
staticHV*
1603-
plperl_hash_from_tuple(HeapTupletuple,TupleDesctupdesc)
1604-
{
1605-
inti;
1606-
char*attname;
1607-
char*attdata;
1608-
1609-
HV*array;
1610-
1611-
array=newHV();
1612-
1613-
for (i=0;i<tupdesc->natts;i++)
1614-
{
1615-
/************************************************************
1616-
* Get the attribute name
1617-
************************************************************/
1618-
attname=tupdesc->attrs[i]->attname.data;
1619-
1620-
/************************************************************
1621-
* Get the attributes value
1622-
************************************************************/
1623-
attdata=SPI_getvalue(tuple,tupdesc,i+1);
1624-
if (attdata)
1625-
hv_store(array,attname,strlen(attname),newSVpv(attdata,0),0);
1626-
else
1627-
hv_store(array,attname,strlen(attname),newSVpv("undef",0),0);
1628-
}
1629-
returnarray;
1630-
}
1631-
16321596
staticHV*
16331597
plperl_spi_execute_fetch_result(SPITupleTable*tuptable,intprocessed,intstatus)
16341598
{
@@ -1653,7 +1617,7 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int stat
16531617
for (i=0;i<processed;i++)
16541618
{
16551619
row=plperl_hash_from_tuple(tuptable->vals[i],tuptable->tupdesc);
1656-
av_store(rows,i,newRV_noinc((SV*)row));
1620+
av_push(rows,newRV_noinc((SV*)row));
16571621
}
16581622
hv_store(result,"rows",strlen("rows"),
16591623
newRV_noinc((SV*)rows),0);

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp