aboutsummaryrefslogtreecommitdiff
path: root/src/pl/plperl/sql/plperl_env.sql
blob: 4108f392d1dcb7c1c7a7275e44ce797842f079a9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
--
-- Test the environment setting
--

-- directory path and dlsuffix are passed to us in environment variables
\getenv libdir PG_LIBDIR
\getenv dlsuffix PG_DLSUFFIX

\set regresslib :libdir '/regress' :dlsuffix

CREATE FUNCTION get_environ()
   RETURNS text[]
   AS :'regresslib', 'get_environ'
   LANGUAGE C STRICT;

-- fetch the process environment

CREATE FUNCTION process_env () RETURNS text[]
LANGUAGE plpgsql AS
$$

declare
   res text[];
   tmp text[];
   f record;
begin
    for f in select unnest(get_environ()) as t loop
         tmp := regexp_split_to_array(f.t, '=');
         if array_length(tmp, 1) = 2 then
            res := res || tmp;
         end if;
    end loop;
    return res;
end

$$;

-- plperl should not be able to affect the process environment

DO
$$
   $ENV{TEST_PLPERL_ENV_FOO} = "shouldfail";
   untie %ENV;
   $ENV{TEST_PLPERL_ENV_FOO} = "testval";
   my $penv = spi_exec_query("select unnest(process_env()) as pe");
   my %received;
   for (my $f = 0; $f < $penv->{processed}; $f += 2)
   {
      my $k = $penv->{rows}[$f]->{pe};
      my $v = $penv->{rows}[$f+1]->{pe};
      $received{$k} = $v;
   }
   unless (exists $received{TEST_PLPERL_ENV_FOO})
   {
      elog(NOTICE, "environ unaffected")
   }

$$ LANGUAGE plperl;