-- test warnings and errors from plperl

create or replace function perl_elog(text) returns void language plperl as $$

my $msg = shift;

elog(NOTICE,$msg);

$$;

select perl_elog('explicit elog');

NOTICE: explicit elog

CONTEXT: PL/Perl function "perl_elog"

perl_elog

-----------

(1 row)

create or replace function perl_warn(text) returns void language plperl as $$

my $msg = shift;

warn($msg);

$$;

select perl_warn('implicit elog via warn');

WARNING: implicit elog via warn at line 4.

CONTEXT: PL/Perl function "perl_warn"

perl_warn

-----------

(1 row)

-- test strict mode on/off

SET plperl.use_strict = true;

create or replace function uses_global() returns text language plperl as $$

$global = 1;

$other_global = 2;

return 'uses_global worked';

$$;

ERROR: Global symbol "$global" requires explicit package name (did you forget to declare "my $global"?) at line 3.

Global symbol "$other_global" requires explicit package name (did you forget to declare "my $other_global"?) at line 4.

CONTEXT: compilation of PL/Perl function "uses_global"

select uses_global();

ERROR: function uses_global() does not exist

LINE 1: select uses_global();

^

HINT: No function matches the given name and argument types. You might need to add explicit type casts.

SET plperl.use_strict = false;

create or replace function uses_global() returns text language plperl as $$

$global = 1;

$other_global=2;

return 'uses_global worked';

$$;

select uses_global();

uses_global

--------------------

uses_global worked

(1 row)

-- make sure we don't choke on readonly values

do language plperl $$ elog(NOTICE, ${^TAINT}); $$;

NOTICE: 0

CONTEXT: PL/Perl anonymous code block

-- test recovery after "die"

create or replace function just_die() returns void language plperl AS $$

die "just die";

$$;

select just_die();

ERROR: just die at line 2.

CONTEXT: PL/Perl function "just_die"

create or replace function die_caller() returns int language plpgsql as $$

BEGIN

BEGIN

PERFORM just_die();

EXCEPTION WHEN OTHERS THEN

RAISE NOTICE 'caught die';

END;

RETURN 1;

END;

$$;

select die_caller();

NOTICE: caught die

die_caller

------------

1

(1 row)

create or replace function indirect_die_caller() returns int language plperl as $$

my $prepared = spi_prepare('SELECT die_caller() AS fx');

my $a = spi_exec_prepared($prepared)->{rows}->[0]->{fx};

my $b = spi_exec_prepared($prepared)->{rows}->[0]->{fx};

return $a + $b;

$$;

select indirect_die_caller();

NOTICE: caught die

CONTEXT: SQL statement "SELECT die_caller() AS fx"

PL/Perl function "indirect_die_caller"

NOTICE: caught die

CONTEXT: SQL statement "SELECT die_caller() AS fx"

PL/Perl function "indirect_die_caller"

indirect_die_caller

---------------------

2

(1 row)