src/pl/plperl/sql/plperl.sql

   1 --
   2 -- Test result value processing
   3 --
   4
   5 CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$
   6 return undef;
   7 $$ LANGUAGE plperl;
   8
   9 SELECT perl_int(11);
  10 SELECT * FROM perl_int(42);
  11
  12 CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$
  13 return $_[0] + 1;
  14 $$ LANGUAGE plperl;
  15
  16 SELECT perl_int(11);
  17 SELECT * FROM perl_int(42);
  18
  19
  20 CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$
  21 return undef;
  22 $$ LANGUAGE plperl;
  23
  24 SELECT perl_set_int(5);
  25 SELECT * FROM perl_set_int(5);
  26
  27 CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$
  28 return [0..$_[0]];
  29 $$ LANGUAGE plperl;
  30
  31 SELECT perl_set_int(5);
  32 SELECT * FROM perl_set_int(5);
  33
  34
  35 CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text);
  36
  37 CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
  38     return undef;
  39 $$ LANGUAGE plperl;
  40
  41 SELECT perl_row();
  42 SELECT * FROM perl_row();
  43
  44 CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
  45     return {f2 => 'hello', f1 => 1, f3 => 'world'};
  46 $$ LANGUAGE plperl;
  47
  48 SELECT perl_row();
  49 SELECT * FROM perl_row();
  50
  51
  52 CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
  53     return undef;
  54 $$  LANGUAGE plperl;
  55
  56 SELECT perl_set();
  57 SELECT * FROM perl_set();
  58
  59 CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
  60     return [
  61         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
  62         undef,
  63         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
  64     ];
  65 $$  LANGUAGE plperl;
  66
  67 SELECT perl_set();
  68 SELECT * FROM perl_set();
  69
  70 CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
  71     return [
  72         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
  73         { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
  74         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
  75     ];
  76 $$  LANGUAGE plperl;
  77
  78 SELECT perl_set();
  79 SELECT * FROM perl_set();
  80
  81
  82
  83 CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
  84     return undef;
  85 $$ LANGUAGE plperl;
  86
  87 SELECT perl_record();
  88 SELECT * FROM perl_record();
  89 SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
  90
  91 CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
  92     return {f2 => 'hello', f1 => 1, f3 => 'world'};
  93 $$ LANGUAGE plperl;
  94
  95 SELECT perl_record();
  96 SELECT * FROM perl_record();
  97 SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
  98
  99
 100 CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
 101     return undef;
 102 $$  LANGUAGE plperl;
 103
 104 SELECT perl_record_set();
 105 SELECT * FROM perl_record_set();
 106 SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
 107
 108 CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
 109     return [
 110         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
 111         undef,
 112         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
 113     ];
 114 $$  LANGUAGE plperl;
 115
 116 SELECT perl_record_set();
 117 SELECT * FROM perl_record_set();
 118 SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
 119
 120 CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
 121     return [
 122         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
 123         { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
 124         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
 125     ];
 126 $$  LANGUAGE plperl;
 127
 128 SELECT perl_record_set();
 129 SELECT * FROM perl_record_set();
 130 SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
 131
 132 CREATE OR REPLACE FUNCTION
 133 perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$
 134     return {f2 => 'hello', f1 => 1, f3 => 'world'};
 135 $$ LANGUAGE plperl;
 136
 137 SELECT perl_out_params();
 138 SELECT * FROM perl_out_params();
 139 SELECT (perl_out_params()).f2;
 140
 141 CREATE OR REPLACE FUNCTION
 142 perl_out_params_set(out f1 integer, out f2 text, out f3 text)
 143 RETURNS SETOF record AS $$
 144     return [
 145         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
 146         { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
 147         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
 148     ];
 149 $$  LANGUAGE plperl;
 150
 151 SELECT perl_out_params_set();
 152 SELECT * FROM perl_out_params_set();
 153 SELECT (perl_out_params_set()).f3;
 154
 155 --
 156 -- Check behavior with erroneous return values
 157 --
 158
 159 CREATE TYPE footype AS (x INTEGER, y INTEGER);
 160
 161 CREATE OR REPLACE FUNCTION foo_good() RETURNS SETOF footype AS $$
 162 return [
 163     {x => 1, y => 2},
 164     {x => 3, y => 4}
 165 ];
 166 $$ LANGUAGE plperl;
 167
 168 SELECT * FROM foo_good();
 169
 170 CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
 171     return {y => 3, z => 4};
 172 $$ LANGUAGE plperl;
 173
 174 SELECT * FROM foo_bad();
 175
 176 CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
 177 return 42;
 178 $$ LANGUAGE plperl;
 179
 180 SELECT * FROM foo_bad();
 181
 182 CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
 183 return [
 184     [1, 2],
 185     [3, 4]
 186 ];
 187 $$ LANGUAGE plperl;
 188
 189 SELECT * FROM foo_bad();
 190
 191 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
 192     return 42;
 193 $$ LANGUAGE plperl;
 194
 195 SELECT * FROM foo_set_bad();
 196
 197 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
 198     return {y => 3, z => 4};
 199 $$ LANGUAGE plperl;
 200
 201 SELECT * FROM foo_set_bad();
 202
 203 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
 204 return [
 205     [1, 2],
 206     [3, 4]
 207 ];
 208 $$ LANGUAGE plperl;
 209
 210 SELECT * FROM foo_set_bad();
 211
 212 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
 213 return [
 214     {y => 3, z => 4}
 215 ];
 216 $$ LANGUAGE plperl;
 217
 218 SELECT * FROM foo_set_bad();
 219
 220 --
 221 -- Check passing a tuple argument
 222 --
 223
 224 CREATE OR REPLACE FUNCTION perl_get_field(footype, text) RETURNS integer AS $$
 225     return $_[0]->{$_[1]};
 226 $$ LANGUAGE plperl;
 227
 228 SELECT perl_get_field((11,12), 'x');
 229 SELECT perl_get_field((11,12), 'y');
 230 SELECT perl_get_field((11,12), 'z');
 231
 232 --
 233 -- Test return_next
 234 --
 235
 236 CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$
 237 my $i = 0;
 238 for ("World", "PostgreSQL", "PL/Perl") {
 239     return_next({f1=>++$i, f2=>'Hello', f3=>$_});
 240 }
 241 return;
 242 $$ language plperl;
 243 SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT);
 244
 245 --
 246 -- Test spi_query/spi_fetchrow
 247 --
 248
 249 CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
 250 my $x = spi_query("select 1 as a union select 2 as a");
 251 while (defined (my $y = spi_fetchrow($x))) {
 252     return_next($y->{a});
 253 }
 254 return;
 255 $$ LANGUAGE plperl;
 256 SELECT * from perl_spi_func();
 257
 258 --
 259 -- Test spi_fetchrow abort
 260 --
 261 CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$
 262 my $x = spi_query("select 1 as a union select 2 as a");
 263 spi_cursor_close( $x);
 264 return 0;
 265 $$ LANGUAGE plperl;
 266 SELECT * from perl_spi_func2();
 267
 268
 269 ---
 270 --- Test recursion via SPI
 271 ---
 272
 273
 274 CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl
 275 AS $$
 276
 277   my $i = shift;
 278   foreach my $x (1..$i)
 279   {
 280     return_next "hello $x";
 281   }
 282   if ($i > 2)
 283   {
 284     my $z = $i-1;
 285     my $cursor = spi_query("select * from recurse($z)");
 286     while (defined(my $row = spi_fetchrow($cursor)))
 287     {
 288       return_next "recurse $i: $row->{recurse}";
 289     }
 290   }
 291   return undef;
 292
 293 $$;
 294
 295 SELECT * FROM recurse(2);
 296 SELECT * FROM recurse(3);
 297
 298
 299 ---
 300 --- Test arrary return
 301 ---
 302 CREATE OR REPLACE FUNCTION  array_of_text() RETURNS TEXT[][]
 303 LANGUAGE plperl as $$
 304     return [['a"b',undef,'c,d'],['e\\f',undef,'g']];
 305 $$;
 306
 307 SELECT array_of_text();
 308
 309 --
 310 -- Test spi_prepare/spi_exec_prepared/spi_freeplan
 311 --
 312 CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
 313    my $x = spi_prepare('select $1 AS a', 'INTEGER');
 314    my $q = spi_exec_prepared( $x, $_[0] + 1);
 315    spi_freeplan($x);
 316 return $q->{rows}->[0]->{a};
 317 $$ LANGUAGE plperl;
 318 SELECT * from perl_spi_prepared(42);
 319
 320 --
 321 -- Test spi_prepare/spi_query_prepared/spi_freeplan
 322 --
 323 CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$
 324   my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4');
 325   my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]);
 326   while (defined (my $y = spi_fetchrow($q))) {
 327       return_next $y->{a};
 328   }
 329   spi_freeplan($x);
 330   return;
 331 $$ LANGUAGE plperl;
 332 SELECT * from perl_spi_prepared_set(1,2);
 333
 334 --
 335 -- Test prepare with a type with spaces
 336 --
 337 CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$
 338   my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION');
 339   my $q = spi_query_prepared($x,$_[0]);
 340   my $result;
 341   while (defined (my $y = spi_fetchrow($q))) {
 342       $result = $y->{a};
 343   }
 344   spi_freeplan($x);
 345   return $result;
 346 $$ LANGUAGE plperl;
 347 SELECT perl_spi_prepared_double(4.35) as "double precision";
 348
 349 --
 350 -- Test with a bad type
 351 --
 352 CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$
 353   my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist');
 354   my $q = spi_query_prepared($x,$_[0]);
 355   my $result;
 356   while (defined (my $y = spi_fetchrow($q))) {
 357       $result = $y->{a};
 358   }
 359   spi_freeplan($x);
 360   return $result;
 361 $$ LANGUAGE plperl;
 362 SELECT perl_spi_prepared_bad(4.35) as "double precision";
 363