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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
# Copyright (c) 2021-2022, PostgreSQL Global Development Group
# src/pl/plperl/plc_perlboot.pl
use strict;
use warnings;
use 5.008001;
use vars qw(%_SHARED $_TD);
PostgreSQL::InServer::Util::bootstrap();
# globals
sub ::is_array_ref
{
return ref($_[0]) =~ m/^(?:PostgreSQL::InServer::)?ARRAY$/;
}
sub ::encode_array_literal
{
my ($arg, $delim) = @_;
return $arg unless (::is_array_ref($arg));
$delim = ', ' unless defined $delim;
my $res = '';
foreach my $elem (@$arg)
{
$res .= $delim if length $res;
if (ref $elem)
{
$res .= ::encode_array_literal($elem, $delim);
}
elsif (defined $elem)
{
(my $str = $elem) =~ s/(["\\])/\\$1/g;
$res .= qq("$str");
}
else
{
$res .= 'NULL';
}
}
return qq({$res});
}
sub ::encode_array_constructor
{
my $arg = shift;
return ::quote_nullable($arg) unless ::is_array_ref($arg);
my $res = join ", ",
map { (ref $_) ? ::encode_array_constructor($_) : ::quote_nullable($_) }
@$arg;
return "ARRAY[$res]";
}
{
#<<< protect next line from perltidy so perlcritic annotation works
package PostgreSQL::InServer; ## no critic (RequireFilenameMatchesPackage)
#>>>
use strict;
use warnings;
sub plperl_warn
{
(my $msg = shift) =~ s/\(eval \d+\) //g;
chomp $msg;
&::elog(&::WARNING, $msg);
return;
}
$SIG{__WARN__} = \&plperl_warn;
sub plperl_die
{
(my $msg = shift) =~ s/\(eval \d+\) //g;
die $msg;
}
$SIG{__DIE__} = \&plperl_die;
sub mkfuncsrc
{
my ($name, $imports, $prolog, $src) = @_;
my $BEGIN = join "\n", map {
my $names = $imports->{$_} || [];
"$_->import(qw(@$names));"
} sort keys %$imports;
$BEGIN &&= "BEGIN { $BEGIN }";
return qq[ package main; sub { $BEGIN $prolog $src } ];
}
sub mkfunc
{
## no critic (ProhibitNoStrict, ProhibitStringyEval);
no strict; # default to no strict for the eval
no warnings; # default to no warnings for the eval
my $ret = eval(mkfuncsrc(@_));
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
## use critic
}
1;
}
{
package PostgreSQL::InServer::ARRAY;
use strict;
use warnings;
use overload
'""' => \&to_str,
'@{}' => \&to_arr;
sub to_str
{
my $self = shift;
return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'});
}
sub to_arr
{
return shift->{'array'};
}
1;
}
|
