1CREATE OR REPLACE FUNCTION plperl_sum_array(INTEGER[]) RETURNS text AS $$
2	my $array_arg = shift;
3	my $result = 0;
4	my @arrays;
5
6	push @arrays, @$array_arg;
7
8	while (@arrays > 0) {
9		my $el = shift @arrays;
10		if (is_array_ref($el)) {
11			push @arrays, @$el;
12		} else {
13			$result += $el;
14		}
15	}
16	return $result.' '.$array_arg;
17$$ LANGUAGE plperl;
18
19select plperl_sum_array('{1,2,NULL}');
20select plperl_sum_array('{}');
21select plperl_sum_array('{{1,2,3}, {4,5,6}}');
22select plperl_sum_array('{{{1,2,3}, {4,5,6}}, {{7,8,9}, {10,11,12}}}');
23
24-- check whether we can handle arrays of maximum dimension (6)
25select plperl_sum_array(ARRAY[[[[[[1,2],[3,4]],[[5,6],[7,8]]],[[[9,10],[11,12]],
26[[13,14],[15,16]]]],
27[[[[17,18],[19,20]],[[21,22],[23,24]]],[[[25,26],[27,28]],[[29,30],[31,32]]]]],
28[[[[[1,2],[3,4]],[[5,6],[7,8]]],[[[9,10],[11,12]],[[13,14],[15,16]]]],
29[[[[17,18],[19,20]],[[21,22],[23,24]]],[[[25,26],[27,28]],[[29,30],[31,32]]]]]]);
30
31-- what would we do with the arrays exceeding maximum dimension (7)
32select plperl_sum_array('{{{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},
33{{13,14},{15,16}}}},
34{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}},
35{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
36{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}}},
37{{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
38{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}},
39{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
40{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}}}}'
41);
42
43select plperl_sum_array('{{{1,2,3}, {4,5,6,7}}, {{7,8,9}, {10, 11, 12}}}');
44
45CREATE OR REPLACE FUNCTION plperl_concat(TEXT[]) RETURNS TEXT AS $$
46	my $array_arg = shift;
47	my $result = "";
48	my @arrays;
49
50	push @arrays, @$array_arg;
51	while (@arrays > 0) {
52		my $el = shift @arrays;
53		if (is_array_ref($el)) {
54			push @arrays, @$el;
55		} else {
56			$result .= $el;
57		}
58	}
59	return $result.' '.$array_arg;
60$$ LANGUAGE plperl;
61
62select plperl_concat('{"NULL","NULL","NULL''"}');
63select plperl_concat('{{NULL,NULL,NULL}}');
64select plperl_concat('{"hello"," ","world!"}');
65
66-- array of rows --
67CREATE TYPE foo AS (bar INTEGER, baz TEXT);
68CREATE OR REPLACE FUNCTION plperl_array_of_rows(foo[]) RETURNS TEXT AS $$
69	my $array_arg = shift;
70	my $result = "";
71
72	for my $row_ref (@$array_arg) {
73		die "not a hash reference" unless (ref $row_ref eq "HASH");
74			$result .= $row_ref->{bar}." items of ".$row_ref->{baz}.";";
75	}
76	return $result .' '. $array_arg;
77$$ LANGUAGE plperl;
78
79select plperl_array_of_rows(ARRAY[ ROW(2, 'coffee'), ROW(0, 'sugar')]::foo[]);
80
81-- composite type containing arrays
82CREATE TYPE rowfoo AS (bar INTEGER, baz INTEGER[]);
83
84CREATE OR REPLACE FUNCTION plperl_sum_row_elements(rowfoo) RETURNS TEXT AS $$
85	my $row_ref = shift;
86	my $result;
87
88	if (ref $row_ref ne 'HASH') {
89		$result = 0;
90	}
91	else {
92		$result = $row_ref->{bar};
93		die "not an array reference".ref ($row_ref->{baz})
94		unless (is_array_ref($row_ref->{baz}));
95		# process a single-dimensional array
96		foreach my $elem (@{$row_ref->{baz}}) {
97			$result += $elem unless ref $elem;
98		}
99	}
100	return $result;
101$$ LANGUAGE plperl;
102
103select plperl_sum_row_elements(ROW(1, ARRAY[2,3,4,5,6,7,8,9,10])::rowfoo);
104
105-- composite type containing array of another composite type, which, in order,
106-- contains an array of integers.
107CREATE TYPE rowbar AS (foo rowfoo[]);
108
109CREATE OR REPLACE FUNCTION plperl_sum_array_of_rows(rowbar) RETURNS TEXT AS $$
110	my $rowfoo_ref = shift;
111	my $result = 0;
112
113	if (ref $rowfoo_ref eq 'HASH') {
114		my $row_array_ref = $rowfoo_ref->{foo};
115		if (is_array_ref($row_array_ref)) {
116			foreach my $row_ref (@{$row_array_ref}) {
117				if (ref $row_ref eq 'HASH') {
118					$result += $row_ref->{bar};
119					die "not an array reference".ref ($row_ref->{baz})
120					unless (is_array_ref($row_ref->{baz}));
121					foreach my $elem (@{$row_ref->{baz}}) {
122						$result += $elem unless ref $elem;
123					}
124				}
125				else {
126					die "element baz is not a reference to a rowfoo";
127				}
128			}
129		} else {
130			die "not a reference to an array of rowfoo elements"
131		}
132	} else {
133		die "not a reference to type rowbar";
134	}
135	return $result;
136$$ LANGUAGE plperl;
137
138select plperl_sum_array_of_rows(ROW(ARRAY[ROW(1, ARRAY[2,3,4,5,6,7,8,9,10])::rowfoo,
139ROW(11, ARRAY[12,13,14,15,16,17,18,19,20])::rowfoo])::rowbar);
140
141-- check arrays as out parameters
142CREATE OR REPLACE FUNCTION plperl_arrays_out(OUT INTEGER[]) AS $$
143	return [[1,2,3],[4,5,6]];
144$$ LANGUAGE plperl;
145
146select plperl_arrays_out();
147
148-- check that we can return the array we passed in
149CREATE OR REPLACE FUNCTION plperl_arrays_inout(INTEGER[]) returns INTEGER[] AS $$
150	return shift;
151$$ LANGUAGE plperl;
152
153select plperl_arrays_inout('{{1}, {2}, {3}}');
154
155-- check that we can return an array literal
156CREATE OR REPLACE FUNCTION plperl_arrays_inout_l(INTEGER[]) returns INTEGER[] AS $$
157	return shift.''; # stringify it
158$$ LANGUAGE plperl;
159
160select plperl_arrays_inout_l('{{1}, {2}, {3}}');
161
162-- make sure setof works
163create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
164	my $arr = shift;
165	for my $r (@$arr) {
166		return_next $r;
167	}
168	return undef;
169$$;
170
171select perl_setof_array('{{1}, {2}, {3}}');
172