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

Commit87bb2ad

Browse files
committed
Convert Postgres arrays to Perl arrays on PL/perl input arguments
More generally, arrays are turned in Perl array references, and row andcomposite types are turned into Perl hash references. This is donerecursively, in a way that's natural to every Perl programmer.To avoid a backwards compatibility hit, the string representation ofeach structure is also available if the function requests it.Authors: Alexey Klyukin and Alex Hunsaker.Some code cleanups by me.
1 parentf7b51d1 commit87bb2ad

File tree

14 files changed

+1296
-368
lines changed

14 files changed

+1296
-368
lines changed

‎doc/src/sgml/plperl.sgml

Lines changed: 69 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -198,6 +198,42 @@ select returns_array();
198198
</programlisting>
199199
</para>
200200

201+
<para>
202+
Perl passes <productname>PostgreSQL</productname> arrays as a blessed
203+
PostgreSQL::InServer::ARRAY object. This object may be treated as an array
204+
reference or a string, allowing for backwards compatibility with Perl
205+
code written for <productname>PostgreSQL</productname> versions below 9.1 to
206+
run. For example:
207+
208+
<programlisting>
209+
CREATE OR REPLACE FUNCTION concat_array_elements(text[]) RETURNS TEXT AS $$
210+
my $arg = shift;
211+
my $result = "";
212+
return undef if (!defined $arg);
213+
214+
# as an array reference
215+
for (@$arg) {
216+
$result .= $_;
217+
}
218+
219+
# also works as a string
220+
$result .= $arg;
221+
222+
return $result;
223+
$$ LANGUAGE plperl;
224+
225+
SELECT concat_array_elements(ARRAY['PL','/','Perl']);
226+
</programlisting>
227+
228+
<note>
229+
<para>
230+
Multi-dimensional arrays are represented as references to
231+
lower-dimensional arrays of references in a way common to every Perl
232+
programmer.
233+
</para>
234+
</note>
235+
</para>
236+
201237
<para>
202238
Composite-type arguments are passed to the function as references
203239
to hashes. The keys of the hash are the attribute names of the
@@ -740,6 +776,22 @@ SELECT release_hosts_query();
740776
</listitem>
741777
</varlistentry>
742778

779+
<varlistentry>
780+
<indexterm>
781+
<primary>encode_typed_literal</primary>
782+
<secondary>in PL/Perl</secondary>
783+
</indexterm>
784+
785+
<term><literal><function>encode_typed_literal(<replaceable>value</replaceable>, <replaceable>typename</replaceable>)</function></literal></term>
786+
<listitem>
787+
<para>
788+
Converts a Perl variable to the value of the datatype passed as a
789+
second argument and returns a string representation of this value.
790+
Correctly handles nested arrays and values of composite types.
791+
</para>
792+
</listitem>
793+
</varlistentry>
794+
743795
<varlistentry>
744796
<indexterm>
745797
<primary>encode_array_constructor</primary>
@@ -775,8 +827,24 @@ SELECT release_hosts_query();
775827
</listitem>
776828
</varlistentry>
777829

830+
<varlistentry>
831+
<indexterm>
832+
<primary>is_array_ref</primary>
833+
<secondary>in PL/Perl</secondary>
834+
</indexterm>
835+
836+
<term><literal><function>is_array_ref(<replaceable>argument</replaceable>)</function></literal></term>
837+
<listitem>
838+
<para>
839+
Returns a true value if the given argument may be treated as an
840+
array reference, that is, if ref of the argument is <literal>ARRAY</> or
841+
<literal>PostgreSQL::InServer::ARRAY</>. Returns false otherwise.
842+
</para>
843+
</listitem>
844+
</varlistentry>
845+
778846
</variablelist>
779-
</sect2>
847+
</sect2>
780848
</sect1>
781849

782850
<sect1 id="plperl-global">

‎src/pl/plperl/GNUmakefile

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ PERLCHUNKS = plc_perlboot.pl plc_trusted.pl
4141
SHLIB_LINK =$(perl_embed_ldflags)
4242

4343
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
44-
REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu
44+
REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array
4545
# if Perl can support two interpreters in one backend,
4646
# test plperl-and-plperlu cases
4747
ifneq ($(PERL),)

‎src/pl/plperl/Util.xs

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -198,6 +198,20 @@ looks_like_number(sv)
198198
OUTPUT:
199199
RETVAL
200200

201+
SV*
202+
encode_typed_literal(sv,typname)
203+
SV*sv
204+
char*typname;
205+
PREINIT:
206+
char*outstr;
207+
CODE:
208+
outstr=plperl_sv_to_literal(sv,typname);
209+
if (outstr==NULL)
210+
RETVAL=&PL_sv_undef;
211+
else
212+
RETVAL=cstr2sv(outstr);
213+
OUTPUT:
214+
RETVAL
201215

202216
BOOT:
203217
items=0;/* avoid 'unused variable' warning */

‎src/pl/plperl/expected/plperl.out

Lines changed: 80 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,8 @@ SELECT * FROM perl_set_int(5);
6969
5
7070
(6 rows)
7171

72-
CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text);
72+
CREATE TYPE testnestperl AS (f5 integer[]);
73+
CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text, f4 testnestperl);
7374
CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
7475
return undef;
7576
$$ LANGUAGE plperl;
@@ -80,24 +81,24 @@ SELECT perl_row();
8081
(1 row)
8182

8283
SELECT * FROM perl_row();
83-
f1 | f2 | f3
84-
----+----+----
85-
| |
84+
f1 | f2 | f3| f4
85+
----+----+----+----
86+
| | |
8687
(1 row)
8788

8889
CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
89-
return {f2 => 'hello', f1 => 1, f3 => 'world'};
90+
return {f2 => 'hello', f1 => 1, f3 => 'world', 'f4' => { 'f5' => [[1]] }};
9091
$$ LANGUAGE plperl;
9192
SELECT perl_row();
92-
perl_row
93-
-----------------
94-
(1,hello,world)
93+
perl_row
94+
---------------------------
95+
(1,hello,world,"({{1}})")
9596
(1 row)
9697

9798
SELECT * FROM perl_row();
98-
f1 | f2 | f3
99-
----+-------+-------
100-
1 | hello | world
99+
f1 | f2 | f3| f4
100+
----+-------+-------+---------
101+
1 | hello | world | ({{1}})
101102
(1 row)
102103

103104
CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
@@ -109,15 +110,18 @@ SELECT perl_set();
109110
(0 rows)
110111

111112
SELECT * FROM perl_set();
112-
f1 | f2 | f3
113-
----+----+----
113+
f1 | f2 | f3| f4
114+
----+----+----+----
114115
(0 rows)
115116

116117
CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
117118
return [
118119
{ f1 => 1, f2 => 'Hello', f3 => 'World' },
119120
undef,
120-
{ f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' }
121+
{ f1 => 3, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => {} },
122+
{ f1 => 4, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => undef }},
123+
{ f1 => 5, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => '{1}' }},
124+
{ f1 => 6, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => [1] }},
121125
];
122126
$$ LANGUAGE plperl;
123127
SELECT perl_set();
@@ -129,25 +133,37 @@ CONTEXT: PL/Perl function "perl_set"
129133
CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
130134
return [
131135
{ f1 => 1, f2 => 'Hello', f3 => 'World' },
132-
{ f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' },
133-
{ f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' }
136+
{ f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL', 'f4' => undef },
137+
{ f1 => 3, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => {} },
138+
{ f1 => 4, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => undef }},
139+
{ f1 => 5, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => '{1}' }},
140+
{ f1 => 6, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => [1] }},
141+
{ f1 => 7, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => '({1})' },
134142
];
135143
$$ LANGUAGE plperl;
136144
SELECT perl_set();
137-
perl_set
138-
----------------------
139-
(1,Hello,World)
140-
(2,Hello,PostgreSQL)
141-
(3,Hello,PL/Perl)
142-
(3 rows)
145+
perl_set
146+
---------------------------
147+
(1,Hello,World,)
148+
(2,Hello,PostgreSQL,)
149+
(3,Hello,PL/Perl,"()")
150+
(4,Hello,PL/Perl,"()")
151+
(5,Hello,PL/Perl,"({1})")
152+
(6,Hello,PL/Perl,"({1})")
153+
(7,Hello,PL/Perl,"({1})")
154+
(7 rows)
143155

144156
SELECT * FROM perl_set();
145-
f1 | f2 | f3
146-
----+-------+------------
147-
1 | Hello | World
148-
2 | Hello | PostgreSQL
149-
3 | Hello | PL/Perl
150-
(3 rows)
157+
f1 | f2 | f3 | f4
158+
----+-------+------------+-------
159+
1 | Hello | World |
160+
2 | Hello | PostgreSQL |
161+
3 | Hello | PL/Perl | ()
162+
4 | Hello | PL/Perl | ()
163+
5 | Hello | PL/Perl | ({1})
164+
6 | Hello | PL/Perl | ({1})
165+
7 | Hello | PL/Perl | ({1})
166+
(7 rows)
151167

152168
CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
153169
return undef;
@@ -162,14 +178,14 @@ SELECT * FROM perl_record();
162178
ERROR: a column definition list is required for functions returning "record"
163179
LINE 1: SELECT * FROM perl_record();
164180
^
165-
SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
166-
f1 | f2 | f3
167-
----+----+----
168-
| |
181+
SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text, f4 testnestperl);
182+
f1 | f2 | f3| f4
183+
----+----+----+----
184+
| | |
169185
(1 row)
170186

171187
CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
172-
return {f2 => 'hello', f1 => 1, f3 => 'world'};
188+
return {f2 => 'hello', f1 => 1, f3 => 'world', 'f4' => { 'f5' => [1] }};
173189
$$ LANGUAGE plperl;
174190
SELECT perl_record();
175191
ERROR: function returning record called in context that cannot accept type record
@@ -178,10 +194,10 @@ SELECT * FROM perl_record();
178194
ERROR: a column definition list is required for functions returning "record"
179195
LINE 1: SELECT * FROM perl_record();
180196
^
181-
SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
182-
f1 | f2 | f3
183-
----+-------+-------
184-
1 | hello | world
197+
SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text, f4 testnestperl);
198+
f1 | f2 | f3| f4
199+
----+-------+-------+-------
200+
1 | hello | world | ({1})
185201
(1 row)
186202

187203
CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
@@ -474,7 +490,7 @@ SELECT * FROM recurse(3);
474490
(5 rows)
475491

476492
---
477-
--- Testarrary return
493+
--- Testarray return
478494
---
479495
CREATE OR REPLACE FUNCTION array_of_text() RETURNS TEXT[][]
480496
LANGUAGE plperl as $$
@@ -555,6 +571,32 @@ $$ LANGUAGE plperl;
555571
SELECT perl_spi_prepared_bad(4.35) as "double precision";
556572
ERROR: type "does_not_exist" does not exist at line 2.
557573
CONTEXT: PL/Perl function "perl_spi_prepared_bad"
574+
-- Test with a row type
575+
CREATE OR REPLACE FUNCTION perl_spi_prepared() RETURNS INTEGER AS $$
576+
my $x = spi_prepare('select $1::footype AS a', 'footype');
577+
my $q = spi_exec_prepared( $x, '(1, 2)');
578+
spi_freeplan($x);
579+
return $q->{rows}->[0]->{a}->{x};
580+
$$ LANGUAGE plperl;
581+
SELECT * from perl_spi_prepared();
582+
perl_spi_prepared
583+
-------------------
584+
1
585+
(1 row)
586+
587+
CREATE OR REPLACE FUNCTION perl_spi_prepared_row(footype) RETURNS footype AS $$
588+
my $footype = shift;
589+
my $x = spi_prepare('select $1 AS a', 'footype');
590+
my $q = spi_exec_prepared( $x, {}, $footype );
591+
spi_freeplan($x);
592+
return $q->{rows}->[0]->{a};
593+
$$ LANGUAGE plperl;
594+
SELECT * from perl_spi_prepared_row('(1, 2)');
595+
x | y
596+
---+---
597+
1 | 2
598+
(1 row)
599+
558600
-- simple test of a DO block
559601
DO $$
560602
$a = 'This is a test';

0 commit comments

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