mirror of
https://github.com/postgres/postgres.git
synced 2025-06-01 00:01:20 -04:00
60651e4cdd
In passing, don't insist on rsi->expectedDesc being set unless we actually need it; this allows succeeding in a couple of cases where PL/Perl functions returning setof composite would have failed before, and makes the error message more apropos in other cases. Discussion: https://postgr.es/m/4206.1499798337@sss.pgh.pa.us
792 lines
22 KiB
Plaintext
792 lines
22 KiB
Plaintext
--
|
|
-- 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 scalar context."
|
|
DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
|
|
ERROR: Useless use of sort in scalar 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"
|
|
----- make sure we can't return a scalar ref
|
|
CREATE OR REPLACE FUNCTION text_scalarref() RETURNS text AS $$
|
|
my $str = 'str';
|
|
return \$str;
|
|
$$ LANGUAGE plperl;
|
|
SELECT text_scalarref();
|
|
ERROR: PL/Perl function must return reference to hash or array
|
|
CONTEXT: PL/Perl function "text_scalarref"
|
|
-- 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)
|
|
|