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