src/pl/plperl/expected/plperl.out

   1 --
   2 -- Test result value processing
   3 --
   4 CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$
   5 return undef;
   6 $$ LANGUAGE plperl;
   7 SELECT perl_int(11);
   8  perl_int
   9 ----------
  10
  11 (1 row)
  12
  13 SELECT * FROM perl_int(42);
  14  perl_int
  15 ----------
  16
  17 (1 row)
  18
  19 CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$
  20 return $_[0] + 1;
  21 $$ LANGUAGE plperl;
  22 SELECT perl_int(11);
  23  perl_int
  24 ----------
  25        12
  26 (1 row)
  27
  28 SELECT * FROM perl_int(42);
  29  perl_int
  30 ----------
  31        43
  32 (1 row)
  33
  34 CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$
  35 return undef;
  36 $$ LANGUAGE plperl;
  37 SELECT perl_set_int(5);
  38  perl_set_int
  39 --------------
  40 (0 rows)
  41
  42 SELECT * FROM perl_set_int(5);
  43  perl_set_int
  44 --------------
  45 (0 rows)
  46
  47 CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$
  48 return [0..$_[0]];
  49 $$ LANGUAGE plperl;
  50 SELECT perl_set_int(5);
  51  perl_set_int
  52 --------------
  53             0
  54             1
  55             2
  56             3
  57             4
  58             5
  59 (6 rows)
  60
  61 SELECT * FROM perl_set_int(5);
  62  perl_set_int
  63 --------------
  64             0
  65             1
  66             2
  67             3
  68             4
  69             5
  70 (6 rows)
  71
  72 CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text);
  73 CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
  74     return undef;
  75 $$ LANGUAGE plperl;
  76 SELECT perl_row();
  77  perl_row
  78 ----------
  79
  80 (1 row)
  81
  82 SELECT * FROM perl_row();
  83  f1 | f2 | f3
  84 ----+----+----
  85     |    |
  86 (1 row)
  87
  88 CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
  89     return {f2 => 'hello', f1 => 1, f3 => 'world'};
  90 $$ LANGUAGE plperl;
  91 SELECT perl_row();
  92     perl_row
  93 -----------------
  94  (1,hello,world)
  95 (1 row)
  96
  97 SELECT * FROM perl_row();
  98  f1 |  f2   |  f3
  99 ----+-------+-------
 100   1 | hello | world
 101 (1 row)
 102
 103 CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
 104     return undef;
 105 $$  LANGUAGE plperl;
 106 SELECT perl_set();
 107  perl_set
 108 ----------
 109 (0 rows)
 110
 111 SELECT * FROM perl_set();
 112  f1 | f2 | f3
 113 ----+----+----
 114 (0 rows)
 115
 116 CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
 117     return [
 118         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
 119         undef,
 120         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
 121     ];
 122 $$  LANGUAGE plperl;
 123 SELECT perl_set();
 124 ERROR:  SETOF-composite-returning PL/Perl function must call return_next with reference to hash
 125 CONTEXT:  PL/Perl function "perl_set"
 126 SELECT * FROM perl_set();
 127 ERROR:  SETOF-composite-returning PL/Perl function must call return_next with reference to hash
 128 CONTEXT:  PL/Perl function "perl_set"
 129 CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
 130     return [
 131         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
 132         { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
 133         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
 134     ];
 135 $$  LANGUAGE plperl;
 136 SELECT perl_set();
 137        perl_set
 138 ----------------------
 139  (1,Hello,World)
 140  (2,Hello,PostgreSQL)
 141  (3,Hello,PL/Perl)
 142 (3 rows)
 143
 144 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)
 151
 152 CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
 153     return undef;
 154 $$ LANGUAGE plperl;
 155 SELECT perl_record();
 156  perl_record
 157 -------------
 158
 159 (1 row)
 160
 161 SELECT * FROM perl_record();
 162 ERROR:  a column definition list is required for functions returning "record"
 163 LINE 1: SELECT * FROM perl_record();
 164                       ^
 165 SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
 166  f1 | f2 | f3
 167 ----+----+----
 168     |    |
 169 (1 row)
 170
 171 CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
 172     return {f2 => 'hello', f1 => 1, f3 => 'world'};
 173 $$ LANGUAGE plperl;
 174 SELECT perl_record();
 175 ERROR:  function returning record called in context that cannot accept type record
 176 CONTEXT:  PL/Perl function "perl_record"
 177 SELECT * FROM perl_record();
 178 ERROR:  a column definition list is required for functions returning "record"
 179 LINE 1: SELECT * FROM perl_record();
 180                       ^
 181 SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
 182  f1 |  f2   |  f3
 183 ----+-------+-------
 184   1 | hello | world
 185 (1 row)
 186
 187 CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
 188     return undef;
 189 $$  LANGUAGE plperl;
 190 SELECT perl_record_set();
 191 ERROR:  set-valued function called in context that cannot accept a set
 192 CONTEXT:  PL/Perl function "perl_record_set"
 193 SELECT * FROM perl_record_set();
 194 ERROR:  a column definition list is required for functions returning "record"
 195 LINE 1: SELECT * FROM perl_record_set();
 196                       ^
 197 SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
 198  f1 | f2 | f3
 199 ----+----+----
 200 (0 rows)
 201
 202 CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
 203     return [
 204         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
 205         undef,
 206         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
 207     ];
 208 $$  LANGUAGE plperl;
 209 SELECT perl_record_set();
 210 ERROR:  set-valued function called in context that cannot accept a set
 211 CONTEXT:  PL/Perl function "perl_record_set"
 212 SELECT * FROM perl_record_set();
 213 ERROR:  a column definition list is required for functions returning "record"
 214 LINE 1: SELECT * FROM perl_record_set();
 215                       ^
 216 SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
 217 ERROR:  SETOF-composite-returning PL/Perl function must call return_next with reference to hash
 218 CONTEXT:  PL/Perl function "perl_record_set"
 219 CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
 220     return [
 221         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
 222         { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
 223         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
 224     ];
 225 $$  LANGUAGE plperl;
 226 SELECT perl_record_set();
 227 ERROR:  set-valued function called in context that cannot accept a set
 228 CONTEXT:  PL/Perl function "perl_record_set"
 229 SELECT * FROM perl_record_set();
 230 ERROR:  a column definition list is required for functions returning "record"
 231 LINE 1: SELECT * FROM perl_record_set();
 232                       ^
 233 SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
 234  f1 |  f2   |     f3
 235 ----+-------+------------
 236   1 | Hello | World
 237   2 | Hello | PostgreSQL
 238   3 | Hello | PL/Perl
 239 (3 rows)
 240
 241 CREATE OR REPLACE FUNCTION
 242 perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$
 243     return {f2 => 'hello', f1 => 1, f3 => 'world'};
 244 $$ LANGUAGE plperl;
 245 SELECT perl_out_params();
 246  perl_out_params
 247 -----------------
 248  (1,hello,world)
 249 (1 row)
 250
 251 SELECT * FROM perl_out_params();
 252  f1 |  f2   |  f3
 253 ----+-------+-------
 254   1 | hello | world
 255 (1 row)
 256
 257 SELECT (perl_out_params()).f2;
 258   f2
 259 -------
 260  hello
 261 (1 row)
 262
 263 CREATE OR REPLACE FUNCTION
 264 perl_out_params_set(out f1 integer, out f2 text, out f3 text)
 265 RETURNS SETOF record AS $$
 266     return [
 267         { f1 => 1, f2 => 'Hello', f3 =>  'World' },
 268         { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
 269         { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
 270     ];
 271 $$  LANGUAGE plperl;
 272 SELECT perl_out_params_set();
 273  perl_out_params_set
 274 ----------------------
 275  (1,Hello,World)
 276  (2,Hello,PostgreSQL)
 277  (3,Hello,PL/Perl)
 278 (3 rows)
 279
 280 SELECT * FROM perl_out_params_set();
 281  f1 |  f2   |     f3
 282 ----+-------+------------
 283   1 | Hello | World
 284   2 | Hello | PostgreSQL
 285   3 | Hello | PL/Perl
 286 (3 rows)
 287
 288 SELECT (perl_out_params_set()).f3;
 289      f3
 290 ------------
 291  World
 292  PostgreSQL
 293  PL/Perl
 294 (3 rows)
 295
 296 --
 297 -- Check behavior with erroneous return values
 298 --
 299 CREATE TYPE footype AS (x INTEGER, y INTEGER);
 300 CREATE OR REPLACE FUNCTION foo_good() RETURNS SETOF footype AS $$
 301 return [
 302     {x => 1, y => 2},
 303     {x => 3, y => 4}
 304 ];
 305 $$ LANGUAGE plperl;
 306 SELECT * FROM foo_good();
 307  x | y
 308 ---+---
 309  1 | 2
 310  3 | 4
 311 (2 rows)
 312
 313 CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
 314     return {y => 3, z => 4};
 315 $$ LANGUAGE plperl;
 316 SELECT * FROM foo_bad();
 317 ERROR:  Perl hash contains nonexistent column "z"
 318 CONTEXT:  PL/Perl function "foo_bad"
 319 CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
 320 return 42;
 321 $$ LANGUAGE plperl;
 322 SELECT * FROM foo_bad();
 323 ERROR:  composite-returning PL/Perl function must return reference to hash
 324 CONTEXT:  PL/Perl function "foo_bad"
 325 CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
 326 return [
 327     [1, 2],
 328     [3, 4]
 329 ];
 330 $$ LANGUAGE plperl;
 331 SELECT * FROM foo_bad();
 332 ERROR:  composite-returning PL/Perl function must return reference to hash
 333 CONTEXT:  PL/Perl function "foo_bad"
 334 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
 335     return 42;
 336 $$ LANGUAGE plperl;
 337 SELECT * FROM foo_set_bad();
 338 ERROR:  set-returning PL/Perl function must return reference to array or use return_next
 339 CONTEXT:  PL/Perl function "foo_set_bad"
 340 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
 341     return {y => 3, z => 4};
 342 $$ LANGUAGE plperl;
 343 SELECT * FROM foo_set_bad();
 344 ERROR:  set-returning PL/Perl function must return reference to array or use return_next
 345 CONTEXT:  PL/Perl function "foo_set_bad"
 346 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
 347 return [
 348     [1, 2],
 349     [3, 4]
 350 ];
 351 $$ LANGUAGE plperl;
 352 SELECT * FROM foo_set_bad();
 353 ERROR:  SETOF-composite-returning PL/Perl function must call return_next with reference to hash
 354 CONTEXT:  PL/Perl function "foo_set_bad"
 355 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
 356 return [
 357     {y => 3, z => 4}
 358 ];
 359 $$ LANGUAGE plperl;
 360 SELECT * FROM foo_set_bad();
 361 ERROR:  Perl hash contains nonexistent column "z"
 362 CONTEXT:  PL/Perl function "foo_set_bad"
 363 --
 364 -- Check passing a tuple argument
 365 --
 366 CREATE OR REPLACE FUNCTION perl_get_field(footype, text) RETURNS integer AS $$
 367     return $_[0]->{$_[1]};
 368 $$ LANGUAGE plperl;
 369 SELECT perl_get_field((11,12), 'x');
 370  perl_get_field
 371 ----------------
 372              11
 373 (1 row)
 374
 375 SELECT perl_get_field((11,12), 'y');
 376  perl_get_field
 377 ----------------
 378              12
 379 (1 row)
 380
 381 SELECT perl_get_field((11,12), 'z');
 382  perl_get_field
 383 ----------------
 384
 385 (1 row)
 386
 387 --
 388 -- Test return_next
 389 --
 390 CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$
 391 my $i = 0;
 392 for ("World", "PostgreSQL", "PL/Perl") {
 393     return_next({f1=>++$i, f2=>'Hello', f3=>$_});
 394 }
 395 return;
 396 $$ language plperl;
 397 SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT);
 398  f1 |  f2   |     f3
 399 ----+-------+------------
 400   1 | Hello | World
 401   2 | Hello | PostgreSQL
 402   3 | Hello | PL/Perl
 403 (3 rows)
 404
 405 --
 406 -- Test spi_query/spi_fetchrow
 407 --
 408 CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
 409 my $x = spi_query("select 1 as a union select 2 as a");
 410 while (defined (my $y = spi_fetchrow($x))) {
 411     return_next($y->{a});
 412 }
 413 return;
 414 $$ LANGUAGE plperl;
 415 SELECT * from perl_spi_func();
 416  perl_spi_func
 417 ---------------
 418              1
 419              2
 420 (2 rows)
 421
 422 --
 423 -- Test spi_fetchrow abort
 424 --
 425 CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$
 426 my $x = spi_query("select 1 as a union select 2 as a");
 427 spi_cursor_close( $x);
 428 return 0;
 429 $$ LANGUAGE plperl;
 430 SELECT * from perl_spi_func2();
 431  perl_spi_func2
 432 ----------------
 433               0
 434 (1 row)
 435
 436 ---
 437 --- Test recursion via SPI
 438 ---
 439 CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl
 440 AS $$
 441
 442   my $i = shift;
 443   foreach my $x (1..$i)
 444   {
 445     return_next "hello $x";
 446   }
 447   if ($i > 2)
 448   {
 449     my $z = $i-1;
 450     my $cursor = spi_query("select * from recurse($z)");
 451     while (defined(my $row = spi_fetchrow($cursor)))
 452     {
 453       return_next "recurse $i: $row->{recurse}";
 454     }
 455   }
 456   return undef;
 457
 458 $$;
 459 SELECT * FROM recurse(2);
 460  recurse
 461 ---------
 462  hello 1
 463  hello 2
 464 (2 rows)
 465
 466 SELECT * FROM recurse(3);
 467       recurse
 468 --------------------
 469  hello 1
 470  hello 2
 471  hello 3
 472  recurse 3: hello 1
 473  recurse 3: hello 2
 474 (5 rows)
 475
 476 ---
 477 --- Test arrary return
 478 ---
 479 CREATE OR REPLACE FUNCTION  array_of_text() RETURNS TEXT[][]
 480 LANGUAGE plperl as $$
 481     return [['a"b',undef,'c,d'],['e\\f',undef,'g']];
 482 $$;
 483 SELECT array_of_text();
 484              array_of_text
 485 ---------------------------------------
 486  {{"a\"b",NULL,"c,d"},{"e\\f",NULL,g}}
 487 (1 row)
 488
 489 --
 490 -- Test spi_prepare/spi_exec_prepared/spi_freeplan
 491 --
 492 CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$
 493    my $x = spi_prepare('select $1 AS a', 'INTEGER');
 494    my $q = spi_exec_prepared( $x, $_[0] + 1);
 495    spi_freeplan($x);
 496 return $q->{rows}->[0]->{a};
 497 $$ LANGUAGE plperl;
 498 SELECT * from perl_spi_prepared(42);
 499  perl_spi_prepared
 500 -------------------
 501                 43
 502 (1 row)
 503
 504 --
 505 -- Test spi_prepare/spi_query_prepared/spi_freeplan
 506 --
 507 CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$
 508   my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4');
 509   my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]);
 510   while (defined (my $y = spi_fetchrow($q))) {
 511       return_next $y->{a};
 512   }
 513   spi_freeplan($x);
 514   return;
 515 $$ LANGUAGE plperl;
 516 SELECT * from perl_spi_prepared_set(1,2);
 517  perl_spi_prepared_set
 518 -----------------------
 519                      2
 520                      4
 521 (2 rows)
 522
 523 --
 524 -- Test prepare with a type with spaces
 525 --
 526 CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$
 527   my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION');
 528   my $q = spi_query_prepared($x,$_[0]);
 529   my $result;
 530   while (defined (my $y = spi_fetchrow($q))) {
 531       $result = $y->{a};
 532   }
 533   spi_freeplan($x);
 534   return $result;
 535 $$ LANGUAGE plperl;
 536 SELECT perl_spi_prepared_double(4.35) as "double precision";
 537  double precision
 538 ------------------
 539              43.5
 540 (1 row)
 541
 542 --
 543 -- Test with a bad type
 544 --
 545 CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$
 546   my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist');
 547   my $q = spi_query_prepared($x,$_[0]);
 548   my $result;
 549   while (defined (my $y = spi_fetchrow($q))) {
 550       $result = $y->{a};
 551   }
 552   spi_freeplan($x);
 553   return $result;
 554 $$ LANGUAGE plperl;
 555 SELECT perl_spi_prepared_bad(4.35) as "double precision";
 556 ERROR:  type "does_not_exist" does not exist at line 2.
 557 CONTEXT:  PL/Perl function "perl_spi_prepared_bad"
 558 -- simple test of a DO block
 559 DO $$
 560   $a = 'This is a test';
 561   elog(NOTICE, $a);
 562 $$ LANGUAGE plperl;
 563 NOTICE:  This is a test
 564 CONTEXT:  PL/Perl anonymous code block
 565 -- check that restricted operations are rejected in a plperl DO block
 566 DO $$ eval "1+1"; $$ LANGUAGE plperl;
 567 ERROR:  'eval "string"' trapped by operation mask at line 1.
 568 CONTEXT:  PL/Perl anonymous code block
 569 -- check that we can't "use" a module that's not been loaded already
 570 -- compile-time error: "Unable to load blib.pm into plperl"
 571 DO $$ use blib; $$ LANGUAGE plperl;
 572 ERROR:  Unable to load blib.pm into plperl at line 1.
 573 BEGIN failed--compilation aborted at line 1.
 574 CONTEXT:  PL/Perl anonymous code block
 575 -- check that we can "use" a module that has already been loaded
 576 -- runtime error: "Can't use string ("foo") as a SCALAR ref while "strict refs" in use
 577 DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
 578 ERROR:  Can't use string ("foo") as a SCALAR ref while "strict refs" in use at line 1.
 579 CONTEXT:  PL/Perl anonymous code block
 580 -- check that we can "use warnings" (in this case to turn a warn into an error)
 581 -- yields "ERROR:  Useless use of length in void context"
 582 DO $do$ use warnings FATAL => qw(void) ; length "abc" ; 1; $do$ LANGUAGE plperl;
 583 ERROR:  Useless use of length in void context at line 1.
 584 CONTEXT:  PL/Perl anonymous code block