src/pl/plperl/sql/plperl_array.sql

   1 CREATE 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
  19 select plperl_sum_array('{1,2,NULL}');
  20 select plperl_sum_array('{}');
  21 select plperl_sum_array('{{1,2,3}, {4,5,6}}');
  22 select 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)
  25 select 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)
  32 select 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
  43 select plperl_sum_array('{{{1,2,3}, {4,5,6,7}}, {{7,8,9}, {10, 11, 12}}}');
  44
  45 CREATE 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
  62 select plperl_concat('{"NULL","NULL","NULL''"}');
  63 select plperl_concat('{{NULL,NULL,NULL}}');
  64 select plperl_concat('{"hello"," ","world!"}');
  65
  66 -- array of rows --
  67 CREATE TYPE foo AS (bar INTEGER, baz TEXT);
  68 CREATE 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
  79 select plperl_array_of_rows(ARRAY[ ROW(2, 'coffee'), ROW(0, 'sugar')]::foo[]);
  80
  81 -- composite type containing arrays
  82 CREATE TYPE rowfoo AS (bar INTEGER, baz INTEGER[]);
  83
  84 CREATE 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
 103 select 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.
 107 CREATE TYPE rowbar AS (foo rowfoo[]);
 108
 109 CREATE 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
 138 select plperl_sum_array_of_rows(ROW(ARRAY[ROW(1, ARRAY[2,3,4,5,6,7,8,9,10])::rowfoo,
 139 ROW(11, ARRAY[12,13,14,15,16,17,18,19,20])::rowfoo])::rowbar);
 140
 141 -- check arrays as out parameters
 142 CREATE OR REPLACE FUNCTION plperl_arrays_out(OUT INTEGER[]) AS $$
 143         return [[1,2,3],[4,5,6]];
 144 $$ LANGUAGE plperl;
 145
 146 select plperl_arrays_out();
 147
 148 -- check that we can return the array we passed in
 149 CREATE OR REPLACE FUNCTION plperl_arrays_inout(INTEGER[]) returns INTEGER[] AS $$
 150         return shift;
 151 $$ LANGUAGE plperl;
 152
 153 select plperl_arrays_inout('{{1}, {2}, {3}}');
 154
 155 -- check that we can return an array literal
 156 CREATE OR REPLACE FUNCTION plperl_arrays_inout_l(INTEGER[]) returns INTEGER[] AS $$
 157         return shift.''; # stringify it
 158 $$ LANGUAGE plperl;
 159
 160 select plperl_arrays_inout_l('{{1}, {2}, {3}}');
 161
 162 -- check output of multi-dimensional arrays
 163 CREATE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
 164         return [['a'], ['b'], ['c']];
 165 $$ LANGUAGE plperl;
 166
 167 select plperl_md_array_out();
 168
 169 CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
 170         return [[], []];
 171 $$ LANGUAGE plperl;
 172
 173 select plperl_md_array_out();
 174
 175 CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
 176         return [[], [1]];
 177 $$ LANGUAGE plperl;
 178
 179 select plperl_md_array_out();  -- fail
 180
 181 CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
 182         return [[], 1];
 183 $$ LANGUAGE plperl;
 184
 185 select plperl_md_array_out();  -- fail
 186
 187 CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
 188         return [1, []];
 189 $$ LANGUAGE plperl;
 190
 191 select plperl_md_array_out();  -- fail
 192
 193 CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
 194         return [[1], [[]]];
 195 $$ LANGUAGE plperl;
 196
 197 select plperl_md_array_out();  -- fail
 198
 199 -- make sure setof works
 200 create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
 201         my $arr = shift;
 202         for my $r (@$arr) {
 203                 return_next $r;
 204         }
 205         return undef;
 206 $$;
 207
 208 select perl_setof_array('{{1}, {2}, {3}}');