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
|
-- test plperl utility functions (defined in Util.xs)
-- test quote_literal
create or replace function perl_quote_literal() returns setof text language plperl as $$
return_next "undef: ".quote_literal(undef);
return_next sprintf"$_: ".quote_literal($_)
for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
return undef;
$$;
select perl_quote_literal();
-- test quote_nullable
create or replace function perl_quote_nullable() returns setof text language plperl as $$
return_next "undef: ".quote_nullable(undef);
return_next sprintf"$_: ".quote_nullable($_)
for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
return undef;
$$;
select perl_quote_nullable();
-- test quote_ident
create or replace function perl_quote_ident() returns setof text language plperl as $$
return_next "undef: ".quote_ident(undef); # generates undef warning if warnings enabled
return_next "$_: ".quote_ident($_)
for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{g.h}, q{};
return undef;
$$;
select perl_quote_ident();
-- test decode_bytea
create or replace function perl_decode_bytea() returns setof text language plperl as $$
return_next "undef: ".decode_bytea(undef); # generates undef warning if warnings enabled
return_next "$_: ".decode_bytea($_)
for q{foo}, q{a\047b}, q{};
return undef;
$$;
select perl_decode_bytea();
-- test encode_bytea
create or replace function perl_encode_bytea() returns setof text language plperl as $$
return_next encode_bytea(undef); # generates undef warning if warnings enabled
return_next encode_bytea($_)
for q{@}, qq{@\x01@}, qq{@\x00@}, q{};
return undef;
$$;
select perl_encode_bytea();
-- test encode_array_literal
create or replace function perl_encode_array_literal() returns setof text language plperl as $$
return_next encode_array_literal(undef);
return_next encode_array_literal(0);
return_next encode_array_literal(42);
return_next encode_array_literal($_)
for [], [0], [1..5], [[]], [[1,2,[3]],4];
return_next encode_array_literal($_,'|')
for [], [0], [1..5], [[]], [[1,2,[3]],4];
return undef;
$$;
select perl_encode_array_literal();
-- test encode_array_constructor
create or replace function perl_encode_array_constructor() returns setof text language plperl as $$
return_next encode_array_constructor(undef);
return_next encode_array_constructor(0);
return_next encode_array_constructor(42);
return_next encode_array_constructor($_)
for [], [0], [1..5], [[]], [[1,2,[3]],4];
return undef;
$$;
select perl_encode_array_constructor();
-- test looks_like_number
create or replace function perl_looks_like_number() returns setof text language plperl as $$
return_next "undef is undef" if not defined looks_like_number(undef);
return_next quote_nullable($_).": ". (looks_like_number($_) ? "number" : "not number")
for 'foo', 0, 1, 1.3, '+3.e-4',
'42 x', # trailing garbage
'99 ', # trailing space
' 99', # leading space
' ', # only space
''; # empty string
return undef;
$$;
select perl_looks_like_number();
-- test encode_typed_literal
create type perl_foo as (a integer, b text[]);
create type perl_bar as (c perl_foo[]);
create domain perl_foo_pos as perl_foo check((value).a > 0);
create or replace function perl_encode_typed_literal() returns setof text language plperl as $$
return_next encode_typed_literal(undef, 'text');
return_next encode_typed_literal([[1,2,3],[3,2,1],[1,3,2]], 'integer[]');
return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo');
return_next encode_typed_literal({c => [{a => 9, b => ['PostgreSQL']}, {b => ['Postgres'], a => 1}]}, 'perl_bar');
return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo_pos');
$$;
select perl_encode_typed_literal();
create or replace function perl_encode_typed_literal() returns setof text language plperl as $$
return_next encode_typed_literal({a => 0, b => ['PL','/','Perl']}, 'perl_foo_pos');
$$;
select perl_encode_typed_literal(); -- fail
|
