-- -- Test result value processing -- CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$ return undef; $$ LANGUAGE plperl; SELECT perl_int(11); perl_int ---------- (1 row) SELECT * FROM perl_int(42); perl_int ---------- (1 row) CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$ return $_[0] + 1; $$ LANGUAGE plperl; SELECT perl_int(11); perl_int ---------- 12 (1 row) SELECT * FROM perl_int(42); perl_int ---------- 43 (1 row) CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$ return undef; $$ LANGUAGE plperl; SELECT perl_set_int(5); perl_set_int -------------- (0 rows) SELECT * FROM perl_set_int(5); perl_set_int -------------- (0 rows) CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$ return [0..$_[0]]; $$ LANGUAGE plperl; SELECT perl_set_int(5); perl_set_int -------------- 0 1 2 3 4 5 (6 rows) SELECT * FROM perl_set_int(5); perl_set_int -------------- 0 1 2 3 4 5 (6 rows) CREATE TYPE testnestperl AS (f5 integer[]); CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text, f4 testnestperl); CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$ return undef; $$ LANGUAGE plperl; SELECT perl_row(); perl_row ---------- (1 row) SELECT * FROM perl_row(); f1 | f2 | f3 | f4 ----+----+----+---- | | | (1 row) CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$ return {f2 => 'hello', f1 => 1, f3 => 'world', 'f4' => { 'f5' => [[1]] } }; $$ LANGUAGE plperl; SELECT perl_row(); perl_row --------------------------- (1,hello,world,"({{1}})") (1 row) SELECT * FROM perl_row(); f1 | f2 | f3 | f4 ----+-------+-------+--------- 1 | hello | world | ({{1}}) (1 row) -- test returning a composite literal CREATE OR REPLACE FUNCTION perl_row_lit() RETURNS testrowperl AS $$ return '(1,hello,world,"({{1}})")'; $$ LANGUAGE plperl; SELECT perl_row_lit(); perl_row_lit --------------------------- (1,hello,world,"({{1}})") (1 row) CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ return undef; $$ LANGUAGE plperl; SELECT perl_set(); perl_set ---------- (0 rows) SELECT * FROM perl_set(); f1 | f2 | f3 | f4 ----+----+----+---- (0 rows) CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ return [ { f1 => 1, f2 => 'Hello', f3 => 'World' }, undef, { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => {} }, { f1 => 4, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => undef }}, { f1 => 5, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => '{1}' }}, { f1 => 6, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => [1] }}, ]; $$ LANGUAGE plperl; SELECT perl_set(); ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash CONTEXT: PL/Perl function "perl_set" SELECT * FROM perl_set(); ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash CONTEXT: PL/Perl function "perl_set" CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ return [ { f1 => 1, f2 => 'Hello', f3 => 'World' }, { f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL', 'f4' => undef }, { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => {} }, { f1 => 4, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => undef }}, { f1 => 5, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => '{1}' }}, { f1 => 6, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => [1] }}, { f1 => 7, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => '({1})' }, ]; $$ LANGUAGE plperl; SELECT perl_set(); perl_set --------------------------- (1,Hello,World,) (2,Hello,PostgreSQL,) (3,Hello,PL/Perl,"()") (4,Hello,PL/Perl,"()") (5,Hello,PL/Perl,"({1})") (6,Hello,PL/Perl,"({1})") (7,Hello,PL/Perl,"({1})") (7 rows) SELECT * FROM perl_set(); f1 | f2 | f3 | f4 ----+-------+------------+------- 1 | Hello | World | 2 | Hello | PostgreSQL | 3 | Hello | PL/Perl | () 4 | Hello | PL/Perl | () 5 | Hello | PL/Perl | ({1}) 6 | Hello | PL/Perl | ({1}) 7 | Hello | PL/Perl | ({1}) (7 rows) CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$ return undef; $$ LANGUAGE plperl; SELECT perl_record(); perl_record ------------- (1 row) SELECT * FROM perl_record(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record(); ^ SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text, f4 testnestperl); f1 | f2 | f3 | f4 ----+----+----+---- | | | (1 row) CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$ return {f2 => 'hello', f1 => 1, f3 => 'world', 'f4' => { 'f5' => [1] } }; $$ LANGUAGE plperl; SELECT perl_record(); ERROR: function returning record called in context that cannot accept type record CONTEXT: PL/Perl function "perl_record" SELECT * FROM perl_record(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record(); ^ SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text, f4 testnestperl); f1 | f2 | f3 | f4 ----+-------+-------+------- 1 | hello | world | ({1}) (1 row) CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ return undef; $$ LANGUAGE plperl; SELECT perl_record_set(); perl_record_set ----------------- (0 rows) SELECT * FROM perl_record_set(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record_set(); ^ SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); f1 | f2 | f3 ----+----+---- (0 rows) CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ return [ { f1 => 1, f2 => 'Hello', f3 => 'World' }, undef, { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' } ]; $$ LANGUAGE plperl; SELECT perl_record_set(); ERROR: function returning record called in context that cannot accept type record CONTEXT: PL/Perl function "perl_record_set" SELECT * FROM perl_record_set(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record_set(); ^ SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash CONTEXT: PL/Perl function "perl_record_set" CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ return [ { f1 => 1, f2 => 'Hello', f3 => 'World' }, { f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' }, { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' } ]; $$ LANGUAGE plperl; SELECT perl_record_set(); ERROR: function returning record called in context that cannot accept type record CONTEXT: PL/Perl function "perl_record_set" SELECT * FROM perl_record_set(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record_set(); ^ SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); f1 | f2 | f3 ----+-------+------------ 1 | Hello | World 2 | Hello | PostgreSQL 3 | Hello | PL/Perl (3 rows) CREATE OR REPLACE FUNCTION perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$ return {f2 => 'hello', f1 => 1, f3 => 'world'}; $$ LANGUAGE plperl; SELECT perl_out_params(); perl_out_params ----------------- (1,hello,world) (1 row) SELECT * FROM perl_out_params(); f1 | f2 | f3 ----+-------+------- 1 | hello | world (1 row) SELECT (perl_out_params()).f2; f2 ------- hello (1 row) CREATE OR REPLACE FUNCTION perl_out_params_set(out f1 integer, out f2 text, out f3 text) RETURNS SETOF record AS $$ return [ { f1 => 1, f2 => 'Hello', f3 => 'World' }, { f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' }, { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' } ]; $$ LANGUAGE plperl; SELECT perl_out_params_set(); perl_out_params_set ---------------------- (1,Hello,World) (2,Hello,PostgreSQL) (3,Hello,PL/Perl) (3 rows) SELECT * FROM perl_out_params_set(); f1 | f2 | f3 ----+-------+------------ 1 | Hello | World 2 | Hello | PostgreSQL 3 | Hello | PL/Perl (3 rows) SELECT (perl_out_params_set()).f3; f3 ------------ World PostgreSQL PL/Perl (3 rows) -- -- Check behavior with erroneous return values -- CREATE TYPE footype AS (x INTEGER, y INTEGER); CREATE OR REPLACE FUNCTION foo_good() RETURNS SETOF footype AS $$ return [ {x => 1, y => 2}, {x => 3, y => 4} ]; $$ LANGUAGE plperl; SELECT * FROM foo_good(); x | y ---+--- 1 | 2 3 | 4 (2 rows) CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ return {y => 3, z => 4}; $$ LANGUAGE plperl; SELECT * FROM foo_bad(); ERROR: Perl hash contains nonexistent column "z" CONTEXT: PL/Perl function "foo_bad" CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ return 42; $$ LANGUAGE plperl; SELECT * FROM foo_bad(); ERROR: malformed record literal: "42" DETAIL: Missing left parenthesis. CONTEXT: PL/Perl function "foo_bad" CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ return [ [1, 2], [3, 4] ]; $$ LANGUAGE plperl; SELECT * FROM foo_bad(); ERROR: cannot convert Perl array to non-array type footype CONTEXT: PL/Perl function "foo_bad" CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ return 42; $$ LANGUAGE plperl; SELECT * FROM foo_set_bad(); ERROR: set-returning PL/Perl function must return reference to array or use return_next CONTEXT: PL/Perl function "foo_set_bad" CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ return {y => 3, z => 4}; $$ LANGUAGE plperl; SELECT * FROM foo_set_bad(); ERROR: set-returning PL/Perl function must return reference to array or use return_next CONTEXT: PL/Perl function "foo_set_bad" CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ return [ [1, 2], [3, 4] ]; $$ LANGUAGE plperl; SELECT * FROM foo_set_bad(); ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash CONTEXT: PL/Perl function "foo_set_bad" CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ return [ {y => 3, z => 4} ]; $$ LANGUAGE plperl; SELECT * FROM foo_set_bad(); ERROR: Perl hash contains nonexistent column "z" CONTEXT: PL/Perl function "foo_set_bad" CREATE DOMAIN orderedfootype AS footype CHECK ((VALUE).x <= (VALUE).y); CREATE OR REPLACE FUNCTION foo_ordered() RETURNS orderedfootype AS $$ return {x => 3, y => 4}; $$ LANGUAGE plperl; SELECT * FROM foo_ordered(); x | y ---+--- 3 | 4 (1 row) CREATE OR REPLACE FUNCTION foo_ordered() RETURNS orderedfootype AS $$ return {x => 5, y => 4}; $$ LANGUAGE plperl; SELECT * FROM foo_ordered(); -- fail ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" CONTEXT: PL/Perl function "foo_ordered" CREATE OR REPLACE FUNCTION foo_ordered_set() RETURNS SETOF orderedfootype AS $$ return [ {x => 3, y => 4}, {x => 4, y => 7} ]; $$ LANGUAGE plperl; SELECT * FROM foo_ordered_set(); x | y ---+--- 3 | 4 4 | 7 (2 rows) CREATE OR REPLACE FUNCTION foo_ordered_set() RETURNS SETOF orderedfootype AS $$ return [ {x => 3, y => 4}, {x => 9, y => 7} ]; $$ LANGUAGE plperl; SELECT * FROM foo_ordered_set(); -- fail ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" CONTEXT: PL/Perl function "foo_ordered_set" -- -- Check passing a tuple argument -- CREATE OR REPLACE FUNCTION perl_get_field(footype, text) RETURNS integer AS $$ return $_[0]->{$_[1]}; $$ LANGUAGE plperl; SELECT perl_get_field((11,12), 'x'); perl_get_field ---------------- 11 (1 row) SELECT perl_get_field((11,12), 'y'); perl_get_field ---------------- 12 (1 row) SELECT perl_get_field((11,12), 'z'); perl_get_field ---------------- (1 row) CREATE OR REPLACE FUNCTION perl_get_cfield(orderedfootype, text) RETURNS integer AS $$ return $_[0]->{$_[1]}; $$ LANGUAGE plperl; SELECT perl_get_cfield((11,12), 'x'); perl_get_cfield ----------------- 11 (1 row) SELECT perl_get_cfield((11,12), 'y'); perl_get_cfield ----------------- 12 (1 row) SELECT perl_get_cfield((12,11), 'x'); -- fail ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" CREATE OR REPLACE FUNCTION perl_get_rfield(record, text) RETURNS integer AS $$ return $_[0]->{$_[1]}; $$ LANGUAGE plperl; SELECT perl_get_rfield((11,12), 'f1'); perl_get_rfield ----------------- 11 (1 row) SELECT perl_get_rfield((11,12)::footype, 'y'); perl_get_rfield ----------------- 12 (1 row) SELECT perl_get_rfield((11,12)::orderedfootype, 'x'); perl_get_rfield ----------------- 11 (1 row) SELECT perl_get_rfield((12,11)::orderedfootype, 'x'); -- fail ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" -- -- Test return_next -- CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$ my $i = 0; for ("World", "PostgreSQL", "PL/Perl") { return_next({f1=>++$i, f2=>'Hello', f3=>$_}); } return; $$ language plperl; SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT); f1 | f2 | f3 ----+-------+------------ 1 | Hello | World 2 | Hello | PostgreSQL 3 | Hello | PL/Perl (3 rows) -- -- Test spi_query/spi_fetchrow -- CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$ my $x = spi_query("select 1 as a union select 2 as a"); while (defined (my $y = spi_fetchrow($x))) { return_next($y->{a}); } return; $$ LANGUAGE plperl; SELECT * from perl_spi_func(); perl_spi_func --------------- 1 2 (2 rows) -- -- Test spi_fetchrow abort -- CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$ my $x = spi_query("select 1 as a union select 2 as a"); spi_cursor_close( $x); return 0; $$ LANGUAGE plperl; SELECT * from perl_spi_func2(); perl_spi_func2 ---------------- 0 (1 row) --- --- Test recursion via SPI --- CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl AS $$ my $i = shift; foreach my $x (1..$i) { return_next "hello $x"; } if ($i > 2) { my $z = $i-1; my $cursor = spi_query("select * from recurse($z)"); while (defined(my $row = spi_fetchrow($cursor))) { return_next "recurse $i: $row->{recurse}"; } } return undef; $$; SELECT * FROM recurse(2); recurse --------- hello 1 hello 2 (2 rows) SELECT * FROM recurse(3); recurse -------------------- hello 1 hello 2 hello 3 recurse 3: hello 1 recurse 3: hello 2 (5 rows) --- --- Test array return --- CREATE OR REPLACE FUNCTION array_of_text() RETURNS TEXT[][] LANGUAGE plperl as $$ return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; $$; SELECT array_of_text(); array_of_text --------------------------------------- {{"a\"b",NULL,"c,d"},{"e\\f",NULL,g}} (1 row) -- -- Test spi_prepare/spi_exec_prepared/spi_freeplan -- CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$ my $x = spi_prepare('select $1 AS a', 'INTEGER'); my $q = spi_exec_prepared( $x, $_[0] + 1); spi_freeplan($x); return $q->{rows}->[0]->{a}; $$ LANGUAGE plperl; SELECT * from perl_spi_prepared(42); perl_spi_prepared ------------------- 43 (1 row) -- -- Test spi_prepare/spi_query_prepared/spi_freeplan -- CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$ my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4'); my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]); while (defined (my $y = spi_fetchrow($q))) { return_next $y->{a}; } spi_freeplan($x); return; $$ LANGUAGE plperl; SELECT * from perl_spi_prepared_set(1,2); perl_spi_prepared_set ----------------------- 2 4 (2 rows) -- -- Test prepare with a type with spaces -- CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$ my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION'); my $q = spi_query_prepared($x,$_[0]); my $result; while (defined (my $y = spi_fetchrow($q))) { $result = $y->{a}; } spi_freeplan($x); return $result; $$ LANGUAGE plperl; SELECT perl_spi_prepared_double(4.35) as "double precision"; double precision ------------------ 43.5 (1 row) -- -- Test with a bad type -- CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$ my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist'); my $q = spi_query_prepared($x,$_[0]); my $result; while (defined (my $y = spi_fetchrow($q))) { $result = $y->{a}; } spi_freeplan($x); return $result; $$ LANGUAGE plperl; SELECT perl_spi_prepared_bad(4.35) as "double precision"; ERROR: type "does_not_exist" does not exist at line 2. CONTEXT: PL/Perl function "perl_spi_prepared_bad" -- Test with a row type CREATE OR REPLACE FUNCTION perl_spi_prepared() RETURNS INTEGER AS $$ my $x = spi_prepare('select $1::footype AS a', 'footype'); my $q = spi_exec_prepared( $x, '(1, 2)'); spi_freeplan($x); return $q->{rows}->[0]->{a}->{x}; $$ LANGUAGE plperl; SELECT * from perl_spi_prepared(); perl_spi_prepared ------------------- 1 (1 row) CREATE OR REPLACE FUNCTION perl_spi_prepared_row(footype) RETURNS footype AS $$ my $footype = shift; my $x = spi_prepare('select $1 AS a', 'footype'); my $q = spi_exec_prepared( $x, {}, $footype ); spi_freeplan($x); return $q->{rows}->[0]->{a}; $$ LANGUAGE plperl; SELECT * from perl_spi_prepared_row('(1, 2)'); x | y ---+--- 1 | 2 (1 row) -- simple test of a DO block DO $$ $a = 'This is a test'; elog(NOTICE, $a); $$ LANGUAGE plperl; NOTICE: This is a test -- check that restricted operations are rejected in a plperl DO block DO $$ system("/nonesuch"); $$ LANGUAGE plperl; ERROR: 'system' trapped by operation mask at line 1. CONTEXT: PL/Perl anonymous code block DO $$ qx("/nonesuch"); $$ LANGUAGE plperl; ERROR: 'quoted execution (``, qx)' trapped by operation mask at line 1. CONTEXT: PL/Perl anonymous code block DO $$ open my $fh, " qw(void) ; my @y; sort @y; 1; $do$ LANGUAGE plperl; ERROR: Useless use of sort in void context at line 1. CONTEXT: PL/Perl anonymous code block -- make sure functions marked as VOID without an explicit return work CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$ $_SHARED{myquote} = sub { my $arg = shift; $arg =~ s/(['\\])/\\$1/g; return "'$arg'"; }; $$ LANGUAGE plperl; SELECT myfuncs(); myfuncs --------- (1 row) -- make sure we can't return an array as a scalar CREATE OR REPLACE FUNCTION text_arrayref() RETURNS text AS $$ return ['array']; $$ LANGUAGE plperl; SELECT text_arrayref(); ERROR: cannot convert Perl array to non-array type text CONTEXT: PL/Perl function "text_arrayref" --- make sure we can't return a hash as a scalar CREATE OR REPLACE FUNCTION text_hashref() RETURNS text AS $$ return {'hash'=>1}; $$ LANGUAGE plperl; SELECT text_hashref(); ERROR: cannot convert Perl hash to non-composite type text CONTEXT: PL/Perl function "text_hashref" ---- make sure we can't return a blessed object as a scalar CREATE OR REPLACE FUNCTION text_obj() RETURNS text AS $$ return bless({}, 'Fake::Object'); $$ LANGUAGE plperl; SELECT text_obj(); ERROR: cannot convert Perl hash to non-composite type text CONTEXT: PL/Perl function "text_obj" -- test looking through a scalar ref CREATE OR REPLACE FUNCTION text_scalarref() RETURNS text AS $$ my $str = 'str'; return \$str; $$ LANGUAGE plperl; SELECT text_scalarref(); text_scalarref ---------------- str (1 row) -- check safe behavior when a function body is replaced during execution CREATE OR REPLACE FUNCTION self_modify(INTEGER) RETURNS INTEGER AS $$ spi_exec_query('CREATE OR REPLACE FUNCTION self_modify(INTEGER) RETURNS INTEGER AS \'return $_[0] * 3;\' LANGUAGE plperl;'); spi_exec_query('select self_modify(42) AS a'); return $_[0] * 2; $$ LANGUAGE plperl; SELECT self_modify(42); self_modify ------------- 84 (1 row) SELECT self_modify(42); self_modify ------------- 126 (1 row)