1-- 2-- Test result value processing 3-- 4CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$ 5return undef; 6$$ LANGUAGE plperl; 7SELECT perl_int(11); 8 perl_int 9---------- 10 11(1 row) 12 13SELECT * FROM perl_int(42); 14 perl_int 15---------- 16 17(1 row) 18 19CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$ 20return $_[0] + 1; 21$$ LANGUAGE plperl; 22SELECT perl_int(11); 23 perl_int 24---------- 25 12 26(1 row) 27 28SELECT * FROM perl_int(42); 29 perl_int 30---------- 31 43 32(1 row) 33 34CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$ 35return undef; 36$$ LANGUAGE plperl; 37SELECT perl_set_int(5); 38 perl_set_int 39-------------- 40(0 rows) 41 42SELECT * FROM perl_set_int(5); 43 perl_set_int 44-------------- 45(0 rows) 46 47CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$ 48return [0..$_[0]]; 49$$ LANGUAGE plperl; 50SELECT perl_set_int(5); 51 perl_set_int 52-------------- 53 0 54 1 55 2 56 3 57 4 58 5 59(6 rows) 60 61SELECT * FROM perl_set_int(5); 62 perl_set_int 63-------------- 64 0 65 1 66 2 67 3 68 4 69 5 70(6 rows) 71 72CREATE TYPE testnestperl AS (f5 integer[]); 73CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text, f4 testnestperl); 74CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$ 75 return undef; 76$$ LANGUAGE plperl; 77SELECT perl_row(); 78 perl_row 79---------- 80 81(1 row) 82 83SELECT * FROM perl_row(); 84 f1 | f2 | f3 | f4 85----+----+----+---- 86 | | | 87(1 row) 88 89CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$ 90 return {f2 => 'hello', f1 => 1, f3 => 'world', 'f4' => { 'f5' => [[1]] } }; 91$$ LANGUAGE plperl; 92SELECT perl_row(); 93 perl_row 94--------------------------- 95 (1,hello,world,"({{1}})") 96(1 row) 97 98SELECT * FROM perl_row(); 99 f1 | f2 | f3 | f4 100----+-------+-------+--------- 101 1 | hello | world | ({{1}}) 102(1 row) 103 104-- test returning a composite literal 105CREATE OR REPLACE FUNCTION perl_row_lit() RETURNS testrowperl AS $$ 106 return '(1,hello,world,"({{1}})")'; 107$$ LANGUAGE plperl; 108SELECT perl_row_lit(); 109 perl_row_lit 110--------------------------- 111 (1,hello,world,"({{1}})") 112(1 row) 113 114CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ 115 return undef; 116$$ LANGUAGE plperl; 117SELECT perl_set(); 118 perl_set 119---------- 120(0 rows) 121 122SELECT * FROM perl_set(); 123 f1 | f2 | f3 | f4 124----+----+----+---- 125(0 rows) 126 127CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ 128 return [ 129 { f1 => 1, f2 => 'Hello', f3 => 'World' }, 130 undef, 131 { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => {} }, 132 { f1 => 4, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => undef }}, 133 { f1 => 5, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => '{1}' }}, 134 { f1 => 6, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => [1] }}, 135 ]; 136$$ LANGUAGE plperl; 137SELECT perl_set(); 138ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash 139CONTEXT: PL/Perl function "perl_set" 140SELECT * FROM perl_set(); 141ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash 142CONTEXT: PL/Perl function "perl_set" 143CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ 144 return [ 145 { f1 => 1, f2 => 'Hello', f3 => 'World' }, 146 { f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL', 'f4' => undef }, 147 { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => {} }, 148 { f1 => 4, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => undef }}, 149 { f1 => 5, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => '{1}' }}, 150 { f1 => 6, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => [1] }}, 151 { f1 => 7, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => '({1})' }, 152 ]; 153$$ LANGUAGE plperl; 154SELECT perl_set(); 155 perl_set 156--------------------------- 157 (1,Hello,World,) 158 (2,Hello,PostgreSQL,) 159 (3,Hello,PL/Perl,"()") 160 (4,Hello,PL/Perl,"()") 161 (5,Hello,PL/Perl,"({1})") 162 (6,Hello,PL/Perl,"({1})") 163 (7,Hello,PL/Perl,"({1})") 164(7 rows) 165 166SELECT * FROM perl_set(); 167 f1 | f2 | f3 | f4 168----+-------+------------+------- 169 1 | Hello | World | 170 2 | Hello | PostgreSQL | 171 3 | Hello | PL/Perl | () 172 4 | Hello | PL/Perl | () 173 5 | Hello | PL/Perl | ({1}) 174 6 | Hello | PL/Perl | ({1}) 175 7 | Hello | PL/Perl | ({1}) 176(7 rows) 177 178CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$ 179 return undef; 180$$ LANGUAGE plperl; 181SELECT perl_record(); 182 perl_record 183------------- 184 185(1 row) 186 187SELECT * FROM perl_record(); 188ERROR: a column definition list is required for functions returning "record" 189LINE 1: SELECT * FROM perl_record(); 190 ^ 191SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text, f4 testnestperl); 192 f1 | f2 | f3 | f4 193----+----+----+---- 194 | | | 195(1 row) 196 197CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$ 198 return {f2 => 'hello', f1 => 1, f3 => 'world', 'f4' => { 'f5' => [1] } }; 199$$ LANGUAGE plperl; 200SELECT perl_record(); 201ERROR: function returning record called in context that cannot accept type record 202CONTEXT: PL/Perl function "perl_record" 203SELECT * FROM perl_record(); 204ERROR: a column definition list is required for functions returning "record" 205LINE 1: SELECT * FROM perl_record(); 206 ^ 207SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text, f4 testnestperl); 208 f1 | f2 | f3 | f4 209----+-------+-------+------- 210 1 | hello | world | ({1}) 211(1 row) 212 213CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ 214 return undef; 215$$ LANGUAGE plperl; 216SELECT perl_record_set(); 217 perl_record_set 218----------------- 219(0 rows) 220 221SELECT * FROM perl_record_set(); 222ERROR: a column definition list is required for functions returning "record" 223LINE 1: SELECT * FROM perl_record_set(); 224 ^ 225SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); 226 f1 | f2 | f3 227----+----+---- 228(0 rows) 229 230CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ 231 return [ 232 { f1 => 1, f2 => 'Hello', f3 => 'World' }, 233 undef, 234 { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' } 235 ]; 236$$ LANGUAGE plperl; 237SELECT perl_record_set(); 238ERROR: function returning record called in context that cannot accept type record 239CONTEXT: PL/Perl function "perl_record_set" 240SELECT * FROM perl_record_set(); 241ERROR: a column definition list is required for functions returning "record" 242LINE 1: SELECT * FROM perl_record_set(); 243 ^ 244SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); 245ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash 246CONTEXT: PL/Perl function "perl_record_set" 247CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ 248 return [ 249 { f1 => 1, f2 => 'Hello', f3 => 'World' }, 250 { f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' }, 251 { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' } 252 ]; 253$$ LANGUAGE plperl; 254SELECT perl_record_set(); 255ERROR: function returning record called in context that cannot accept type record 256CONTEXT: PL/Perl function "perl_record_set" 257SELECT * FROM perl_record_set(); 258ERROR: a column definition list is required for functions returning "record" 259LINE 1: SELECT * FROM perl_record_set(); 260 ^ 261SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); 262 f1 | f2 | f3 263----+-------+------------ 264 1 | Hello | World 265 2 | Hello | PostgreSQL 266 3 | Hello | PL/Perl 267(3 rows) 268 269CREATE OR REPLACE FUNCTION 270perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$ 271 return {f2 => 'hello', f1 => 1, f3 => 'world'}; 272$$ LANGUAGE plperl; 273SELECT perl_out_params(); 274 perl_out_params 275----------------- 276 (1,hello,world) 277(1 row) 278 279SELECT * FROM perl_out_params(); 280 f1 | f2 | f3 281----+-------+------- 282 1 | hello | world 283(1 row) 284 285SELECT (perl_out_params()).f2; 286 f2 287------- 288 hello 289(1 row) 290 291CREATE OR REPLACE FUNCTION 292perl_out_params_set(out f1 integer, out f2 text, out f3 text) 293RETURNS SETOF record AS $$ 294 return [ 295 { f1 => 1, f2 => 'Hello', f3 => 'World' }, 296 { f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' }, 297 { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' } 298 ]; 299$$ LANGUAGE plperl; 300SELECT perl_out_params_set(); 301 perl_out_params_set 302---------------------- 303 (1,Hello,World) 304 (2,Hello,PostgreSQL) 305 (3,Hello,PL/Perl) 306(3 rows) 307 308SELECT * FROM perl_out_params_set(); 309 f1 | f2 | f3 310----+-------+------------ 311 1 | Hello | World 312 2 | Hello | PostgreSQL 313 3 | Hello | PL/Perl 314(3 rows) 315 316SELECT (perl_out_params_set()).f3; 317 f3 318------------ 319 World 320 PostgreSQL 321 PL/Perl 322(3 rows) 323 324-- 325-- Check behavior with erroneous return values 326-- 327CREATE TYPE footype AS (x INTEGER, y INTEGER); 328CREATE OR REPLACE FUNCTION foo_good() RETURNS SETOF footype AS $$ 329return [ 330 {x => 1, y => 2}, 331 {x => 3, y => 4} 332]; 333$$ LANGUAGE plperl; 334SELECT * FROM foo_good(); 335 x | y 336---+--- 337 1 | 2 338 3 | 4 339(2 rows) 340 341CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ 342 return {y => 3, z => 4}; 343$$ LANGUAGE plperl; 344SELECT * FROM foo_bad(); 345ERROR: Perl hash contains nonexistent column "z" 346CONTEXT: PL/Perl function "foo_bad" 347CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ 348return 42; 349$$ LANGUAGE plperl; 350SELECT * FROM foo_bad(); 351ERROR: malformed record literal: "42" 352DETAIL: Missing left parenthesis. 353CONTEXT: PL/Perl function "foo_bad" 354CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ 355return [ 356 [1, 2], 357 [3, 4] 358]; 359$$ LANGUAGE plperl; 360SELECT * FROM foo_bad(); 361ERROR: cannot convert Perl array to non-array type footype 362CONTEXT: PL/Perl function "foo_bad" 363CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ 364 return 42; 365$$ LANGUAGE plperl; 366SELECT * FROM foo_set_bad(); 367ERROR: set-returning PL/Perl function must return reference to array or use return_next 368CONTEXT: PL/Perl function "foo_set_bad" 369CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ 370 return {y => 3, z => 4}; 371$$ LANGUAGE plperl; 372SELECT * FROM foo_set_bad(); 373ERROR: set-returning PL/Perl function must return reference to array or use return_next 374CONTEXT: PL/Perl function "foo_set_bad" 375CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ 376return [ 377 [1, 2], 378 [3, 4] 379]; 380$$ LANGUAGE plperl; 381SELECT * FROM foo_set_bad(); 382ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash 383CONTEXT: PL/Perl function "foo_set_bad" 384CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ 385return [ 386 {y => 3, z => 4} 387]; 388$$ LANGUAGE plperl; 389SELECT * FROM foo_set_bad(); 390ERROR: Perl hash contains nonexistent column "z" 391CONTEXT: PL/Perl function "foo_set_bad" 392CREATE DOMAIN orderedfootype AS footype CHECK ((VALUE).x <= (VALUE).y); 393CREATE OR REPLACE FUNCTION foo_ordered() RETURNS orderedfootype AS $$ 394 return {x => 3, y => 4}; 395$$ LANGUAGE plperl; 396SELECT * FROM foo_ordered(); 397 x | y 398---+--- 399 3 | 4 400(1 row) 401 402CREATE OR REPLACE FUNCTION foo_ordered() RETURNS orderedfootype AS $$ 403 return {x => 5, y => 4}; 404$$ LANGUAGE plperl; 405SELECT * FROM foo_ordered(); -- fail 406ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" 407CONTEXT: PL/Perl function "foo_ordered" 408CREATE OR REPLACE FUNCTION foo_ordered_set() RETURNS SETOF orderedfootype AS $$ 409return [ 410 {x => 3, y => 4}, 411 {x => 4, y => 7} 412]; 413$$ LANGUAGE plperl; 414SELECT * FROM foo_ordered_set(); 415 x | y 416---+--- 417 3 | 4 418 4 | 7 419(2 rows) 420 421CREATE OR REPLACE FUNCTION foo_ordered_set() RETURNS SETOF orderedfootype AS $$ 422return [ 423 {x => 3, y => 4}, 424 {x => 9, y => 7} 425]; 426$$ LANGUAGE plperl; 427SELECT * FROM foo_ordered_set(); -- fail 428ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" 429CONTEXT: PL/Perl function "foo_ordered_set" 430-- 431-- Check passing a tuple argument 432-- 433CREATE OR REPLACE FUNCTION perl_get_field(footype, text) RETURNS integer AS $$ 434 return $_[0]->{$_[1]}; 435$$ LANGUAGE plperl; 436SELECT perl_get_field((11,12), 'x'); 437 perl_get_field 438---------------- 439 11 440(1 row) 441 442SELECT perl_get_field((11,12), 'y'); 443 perl_get_field 444---------------- 445 12 446(1 row) 447 448SELECT perl_get_field((11,12), 'z'); 449 perl_get_field 450---------------- 451 452(1 row) 453 454CREATE OR REPLACE FUNCTION perl_get_cfield(orderedfootype, text) RETURNS integer AS $$ 455 return $_[0]->{$_[1]}; 456$$ LANGUAGE plperl; 457SELECT perl_get_cfield((11,12), 'x'); 458 perl_get_cfield 459----------------- 460 11 461(1 row) 462 463SELECT perl_get_cfield((11,12), 'y'); 464 perl_get_cfield 465----------------- 466 12 467(1 row) 468 469SELECT perl_get_cfield((12,11), 'x'); -- fail 470ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" 471CREATE OR REPLACE FUNCTION perl_get_rfield(record, text) RETURNS integer AS $$ 472 return $_[0]->{$_[1]}; 473$$ LANGUAGE plperl; 474SELECT perl_get_rfield((11,12), 'f1'); 475 perl_get_rfield 476----------------- 477 11 478(1 row) 479 480SELECT perl_get_rfield((11,12)::footype, 'y'); 481 perl_get_rfield 482----------------- 483 12 484(1 row) 485 486SELECT perl_get_rfield((11,12)::orderedfootype, 'x'); 487 perl_get_rfield 488----------------- 489 11 490(1 row) 491 492SELECT perl_get_rfield((12,11)::orderedfootype, 'x'); -- fail 493ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" 494-- 495-- Test return_next 496-- 497CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$ 498my $i = 0; 499for ("World", "PostgreSQL", "PL/Perl") { 500 return_next({f1=>++$i, f2=>'Hello', f3=>$_}); 501} 502return; 503$$ language plperl; 504SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT); 505 f1 | f2 | f3 506----+-------+------------ 507 1 | Hello | World 508 2 | Hello | PostgreSQL 509 3 | Hello | PL/Perl 510(3 rows) 511 512-- 513-- Test spi_query/spi_fetchrow 514-- 515CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$ 516my $x = spi_query("select 1 as a union select 2 as a"); 517while (defined (my $y = spi_fetchrow($x))) { 518 return_next($y->{a}); 519} 520return; 521$$ LANGUAGE plperl; 522SELECT * from perl_spi_func(); 523 perl_spi_func 524--------------- 525 1 526 2 527(2 rows) 528 529-- 530-- Test spi_fetchrow abort 531-- 532CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$ 533my $x = spi_query("select 1 as a union select 2 as a"); 534spi_cursor_close( $x); 535return 0; 536$$ LANGUAGE plperl; 537SELECT * from perl_spi_func2(); 538 perl_spi_func2 539---------------- 540 0 541(1 row) 542 543--- 544--- Test recursion via SPI 545--- 546CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl 547AS $$ 548 549 my $i = shift; 550 foreach my $x (1..$i) 551 { 552 return_next "hello $x"; 553 } 554 if ($i > 2) 555 { 556 my $z = $i-1; 557 my $cursor = spi_query("select * from recurse($z)"); 558 while (defined(my $row = spi_fetchrow($cursor))) 559 { 560 return_next "recurse $i: $row->{recurse}"; 561 } 562 } 563 return undef; 564 565$$; 566SELECT * FROM recurse(2); 567 recurse 568--------- 569 hello 1 570 hello 2 571(2 rows) 572 573SELECT * FROM recurse(3); 574 recurse 575-------------------- 576 hello 1 577 hello 2 578 hello 3 579 recurse 3: hello 1 580 recurse 3: hello 2 581(5 rows) 582 583--- 584--- Test array return 585--- 586CREATE OR REPLACE FUNCTION array_of_text() RETURNS TEXT[][] 587LANGUAGE plperl as $$ 588 return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; 589$$; 590SELECT array_of_text(); 591 array_of_text 592--------------------------------------- 593 {{"a\"b",NULL,"c,d"},{"e\\f",NULL,g}} 594(1 row) 595 596-- 597-- Test spi_prepare/spi_exec_prepared/spi_freeplan 598-- 599CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$ 600 my $x = spi_prepare('select $1 AS a', 'INTEGER'); 601 my $q = spi_exec_prepared( $x, $_[0] + 1); 602 spi_freeplan($x); 603return $q->{rows}->[0]->{a}; 604$$ LANGUAGE plperl; 605SELECT * from perl_spi_prepared(42); 606 perl_spi_prepared 607------------------- 608 43 609(1 row) 610 611-- 612-- Test spi_prepare/spi_query_prepared/spi_freeplan 613-- 614CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$ 615 my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4'); 616 my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]); 617 while (defined (my $y = spi_fetchrow($q))) { 618 return_next $y->{a}; 619 } 620 spi_freeplan($x); 621 return; 622$$ LANGUAGE plperl; 623SELECT * from perl_spi_prepared_set(1,2); 624 perl_spi_prepared_set 625----------------------- 626 2 627 4 628(2 rows) 629 630-- 631-- Test prepare with a type with spaces 632-- 633CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$ 634 my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION'); 635 my $q = spi_query_prepared($x,$_[0]); 636 my $result; 637 while (defined (my $y = spi_fetchrow($q))) { 638 $result = $y->{a}; 639 } 640 spi_freeplan($x); 641 return $result; 642$$ LANGUAGE plperl; 643SELECT perl_spi_prepared_double(4.35) as "double precision"; 644 double precision 645------------------ 646 43.5 647(1 row) 648 649-- 650-- Test with a bad type 651-- 652CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$ 653 my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist'); 654 my $q = spi_query_prepared($x,$_[0]); 655 my $result; 656 while (defined (my $y = spi_fetchrow($q))) { 657 $result = $y->{a}; 658 } 659 spi_freeplan($x); 660 return $result; 661$$ LANGUAGE plperl; 662SELECT perl_spi_prepared_bad(4.35) as "double precision"; 663ERROR: type "does_not_exist" does not exist at line 2. 664CONTEXT: PL/Perl function "perl_spi_prepared_bad" 665-- Test with a row type 666CREATE OR REPLACE FUNCTION perl_spi_prepared() RETURNS INTEGER AS $$ 667 my $x = spi_prepare('select $1::footype AS a', 'footype'); 668 my $q = spi_exec_prepared( $x, '(1, 2)'); 669 spi_freeplan($x); 670return $q->{rows}->[0]->{a}->{x}; 671$$ LANGUAGE plperl; 672SELECT * from perl_spi_prepared(); 673 perl_spi_prepared 674------------------- 675 1 676(1 row) 677 678CREATE OR REPLACE FUNCTION perl_spi_prepared_row(footype) RETURNS footype AS $$ 679 my $footype = shift; 680 my $x = spi_prepare('select $1 AS a', 'footype'); 681 my $q = spi_exec_prepared( $x, {}, $footype ); 682 spi_freeplan($x); 683return $q->{rows}->[0]->{a}; 684$$ LANGUAGE plperl; 685SELECT * from perl_spi_prepared_row('(1, 2)'); 686 x | y 687---+--- 688 1 | 2 689(1 row) 690 691-- simple test of a DO block 692DO $$ 693 $a = 'This is a test'; 694 elog(NOTICE, $a); 695$$ LANGUAGE plperl; 696NOTICE: This is a test 697-- check that restricted operations are rejected in a plperl DO block 698DO $$ system("/nonesuch"); $$ LANGUAGE plperl; 699ERROR: 'system' trapped by operation mask at line 1. 700CONTEXT: PL/Perl anonymous code block 701DO $$ qx("/nonesuch"); $$ LANGUAGE plperl; 702ERROR: 'quoted execution (``, qx)' trapped by operation mask at line 1. 703CONTEXT: PL/Perl anonymous code block 704DO $$ open my $fh, "</nonesuch"; $$ LANGUAGE plperl; 705ERROR: 'open' trapped by operation mask at line 1. 706CONTEXT: PL/Perl anonymous code block 707-- check that eval is allowed and eval'd restricted ops are caught 708DO $$ eval q{chdir '.';}; warn "Caught: $@"; $$ LANGUAGE plperl; 709WARNING: Caught: 'chdir' trapped by operation mask at line 1. 710-- check that compiling do (dofile opcode) is allowed 711-- but that executing it for a file not already loaded (via require) dies 712DO $$ warn do "/dev/null"; $$ LANGUAGE plperl; 713ERROR: Unable to load /dev/null into plperl at line 1. 714CONTEXT: PL/Perl anonymous code block 715-- check that we can't "use" a module that's not been loaded already 716-- compile-time error: "Unable to load blib.pm into plperl" 717DO $$ use blib; $$ LANGUAGE plperl; 718ERROR: Unable to load blib.pm into plperl at line 1. 719BEGIN failed--compilation aborted at line 1. 720CONTEXT: PL/Perl anonymous code block 721-- check that we can "use" a module that has already been loaded 722-- runtime error: "Can't use string ("foo") as a SCALAR ref while "strict refs" in use 723DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl; 724ERROR: Can't use string ("foo") as a SCALAR ref while "strict refs" in use at line 1. 725CONTEXT: PL/Perl anonymous code block 726-- check that we can "use warnings" (in this case to turn a warn into an error) 727-- yields "ERROR: Useless use of sort in scalar context." 728DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl; 729ERROR: Useless use of sort in scalar context at line 1. 730CONTEXT: PL/Perl anonymous code block 731-- make sure functions marked as VOID without an explicit return work 732CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$ 733 $_SHARED{myquote} = sub { 734 my $arg = shift; 735 $arg =~ s/(['\\])/\\$1/g; 736 return "'$arg'"; 737 }; 738$$ LANGUAGE plperl; 739SELECT myfuncs(); 740 myfuncs 741--------- 742 743(1 row) 744 745-- make sure we can't return an array as a scalar 746CREATE OR REPLACE FUNCTION text_arrayref() RETURNS text AS $$ 747 return ['array']; 748$$ LANGUAGE plperl; 749SELECT text_arrayref(); 750ERROR: cannot convert Perl array to non-array type text 751CONTEXT: PL/Perl function "text_arrayref" 752--- make sure we can't return a hash as a scalar 753CREATE OR REPLACE FUNCTION text_hashref() RETURNS text AS $$ 754 return {'hash'=>1}; 755$$ LANGUAGE plperl; 756SELECT text_hashref(); 757ERROR: cannot convert Perl hash to non-composite type text 758CONTEXT: PL/Perl function "text_hashref" 759---- make sure we can't return a blessed object as a scalar 760CREATE OR REPLACE FUNCTION text_obj() RETURNS text AS $$ 761 return bless({}, 'Fake::Object'); 762$$ LANGUAGE plperl; 763SELECT text_obj(); 764ERROR: cannot convert Perl hash to non-composite type text 765CONTEXT: PL/Perl function "text_obj" 766-- test looking through a scalar ref 767CREATE OR REPLACE FUNCTION text_scalarref() RETURNS text AS $$ 768 my $str = 'str'; 769 return \$str; 770$$ LANGUAGE plperl; 771SELECT text_scalarref(); 772 text_scalarref 773---------------- 774 str 775(1 row) 776 777-- check safe behavior when a function body is replaced during execution 778CREATE OR REPLACE FUNCTION self_modify(INTEGER) RETURNS INTEGER AS $$ 779 spi_exec_query('CREATE OR REPLACE FUNCTION self_modify(INTEGER) RETURNS INTEGER AS \'return $_[0] * 3;\' LANGUAGE plperl;'); 780 spi_exec_query('select self_modify(42) AS a'); 781 return $_[0] * 2; 782$$ LANGUAGE plperl; 783SELECT self_modify(42); 784 self_modify 785------------- 786 84 787(1 row) 788 789SELECT self_modify(42); 790 self_modify 791------------- 792 126 793(1 row) 794 795