src/pl/plperl/sql/plperl_elog.sql

   1 -- test warnings and errors from plperl
   2
   3 create or replace function perl_elog(text) returns void language plperl as $$
   4
   5   my $msg = shift;
   6   elog(NOTICE,$msg);
   7
   8 $$;
   9
  10 select perl_elog('explicit elog');
  11
  12 create or replace function perl_warn(text) returns void language plperl as $$
  13
  14   my $msg = shift;
  15   warn($msg);
  16
  17 $$;
  18
  19 select perl_warn('implicit elog via warn');
  20
  21 -- test strict mode on/off
  22
  23 SET plperl.use_strict = true;
  24
  25 create or replace function uses_global() returns text language plperl as $$
  26
  27   $global = 1;
  28   $other_global = 2;
  29   return 'uses_global worked';
  30
  31 $$;
  32
  33 select uses_global();
  34
  35 SET plperl.use_strict = false;
  36
  37 create or replace function uses_global() returns text language plperl as $$
  38
  39   $global = 1;
  40   $other_global=2;
  41   return 'uses_global worked';
  42
  43 $$;
  44
  45 select uses_global();
  46
  47 -- make sure we don't choke on readonly values
  48 do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
  49
  50 -- test recovery after "die"
  51
  52 create or replace function just_die() returns void language plperl AS $$
  53 die "just die";
  54 $$;
  55
  56 select just_die();
  57
  58 create or replace function die_caller() returns int language plpgsql as $$
  59 BEGIN
  60   BEGIN
  61     PERFORM just_die();
  62   EXCEPTION WHEN OTHERS THEN
  63     RAISE NOTICE 'caught die';
  64   END;
  65   RETURN 1;
  66 END;
  67 $$;
  68
  69 select die_caller();
  70
  71 create or replace function indirect_die_caller() returns int language plperl as $$
  72 my $prepared = spi_prepare('SELECT die_caller() AS fx');
  73 my $a = spi_exec_prepared($prepared)->{rows}->[0]->{fx};
  74 my $b = spi_exec_prepared($prepared)->{rows}->[0]->{fx};
  75 return $a + $b;
  76 $$;
  77
  78 select indirect_die_caller();
  79
  80 -- Test non-ASCII error messages
  81 --
  82 -- Note: this test case is known to fail if the database encoding is
  83 -- EUC_CN, EUC_JP, EUC_KR, or EUC_TW, for lack of any equivalent to
  84 -- U+00A0 (no-break space) in those encodings.  However, testing with
  85 -- plain ASCII data would be rather useless, so we must live with that.
  86
  87 SET client_encoding TO UTF8;
  88
  89 create or replace function error_with_nbsp() returns void language plperl as $$
  90   elog(ERROR, "this message contains a no-break space");
  91 $$;
  92
  93 select error_with_nbsp();