| -- |
| -- 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, "</nonesuch"; $$ LANGUAGE plperl; |
| ERROR: 'open' trapped by operation mask at line 1. |
| CONTEXT: PL/Perl anonymous code block |
| -- check that eval is allowed and eval'd restricted ops are caught |
| DO $$ eval q{chdir '.';}; warn "Caught: $@"; $$ LANGUAGE plperl; |
| WARNING: Caught: 'chdir' trapped by operation mask at line 1. |
| -- check that compiling do (dofile opcode) is allowed |
| -- but that executing it for a file not already loaded (via require) dies |
| DO $$ warn do "/dev/null"; $$ LANGUAGE plperl; |
| ERROR: Unable to load /dev/null into plperl at line 1. |
| CONTEXT: PL/Perl anonymous code block |
| -- check that we can't "use" a module that's not been loaded already |
| -- compile-time error: "Unable to load blib.pm into plperl" |
| DO $$ use blib; $$ LANGUAGE plperl; |
| ERROR: Unable to load blib.pm into plperl at line 1. |
| BEGIN failed--compilation aborted at line 1. |
| CONTEXT: PL/Perl anonymous code block |
| -- check that we can "use" a module that has already been loaded |
| -- runtime error: "Can't use string ("foo") as a SCALAR ref while "strict refs" in use |
| DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl; |
| ERROR: Can't use string ("foo") as a SCALAR ref while "strict refs" in use at line 1. |
| CONTEXT: PL/Perl anonymous code block |
| -- check that we can "use warnings" (in this case to turn a warn into an error) |
| -- yields "ERROR: Useless use of sort in void context." |
| DO $do$ use warnings FATAL => 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) |
| |
