vndb/fu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

base: vndb:1.3
Branches Tags
vndb:master
vndb:1.4
vndb:1.3
vndb:1.2
vndb:1.1
vndb:1.0
vndb:0.5
vndb:0.4
vndb:0.3
vndb:0.2
vndb:0.1
...
compare: vndb:master
Branches Tags
vndb:master
vndb:1.4
vndb:1.3
vndb:1.2
vndb:1.1
vndb:1.0
vndb:0.5
vndb:0.4
vndb:0.3
vndb:0.2
vndb:0.1

8 commits
1.3 ... master

Author SHA1 Message Date
Yorhel
7980af731e Version 1.4 2026-01-10 17:30:41 +01:00
Yorhel
f50da04ba5 Benchmarks: Improve accuracy + re-run with latest versions 2026-01-10 16:42:06 +01:00
Yorhel
a7e9fa1866 FU: Less verbose and cryptic error message on write error 2026-01-05 13:20:59 +01:00
Yorhel
48fe393d5f FastCGI: Improve handling of EPIPE while writing response 
That would previously result in the worker getting killed with SIGPIPE.
Which works, but we can also recover from that error without restarting
the process.
 2026-01-05 08:57:50 +01:00
Yorhel
d300f4d791 FU: Log unclean worker shutdowns in supervisor 
This is mainly to monitor kills from OOM or other situations that the
worker process itself is unable to log properly.
 2026-01-04 10:46:50 +01:00
Yorhel
8140fefbca FU::Pg: Rename q() and Q() to sql() and SQL() 
Because this easily confuses syntax highlighters and some humans with
the q// string syntax. Also for consistency with the 'fu->sql()'
aliases.

The old names are still available as alias.
 2025-12-04 14:16:37 +01:00
Yorhel
876613d03f FU: Fix useless warning on empty cookie sections 2025-12-04 11:22:21 +01:00
Yorhel
144d88fc8b Misc doc fixes 2025-12-04 11:19:40 +01:00
21 changed files with 590 additions and 515 deletions
Download patch file Download diff file Expand all files Collapse all files

7
ChangeLog
View file

@ -1,3 +1,10 @@
1.4 - 2026-01-10
- FU::Pg: rename q() and Q() to sql() and SQL() (old names still work)
- FU: Improve handling of EPIPE when writing FastCGI response
- FU: Log unclean worker process shutdown
- FU: Fix warning when parsing empty cookie values
- Misc doc fixes
1.3 - 2025-09-04 1.3 - 2025-09-04
- FU::Validate: Scalar validations now reject control characters by default - FU::Validate: Scalar validations now reject control characters by default
- FU::Validate: Add `allow_control` option to override above behavior - FU::Validate: Add `allow_control` option to override above behavior

24
FU.pm
View file

@ -1,4 +1,4 @@
package FU 1.3; package FU 1.4;
use v5.36; use v5.36;
use Carp 'confess', 'croak'; use Carp 'confess', 'croak';
use IO::Socket; use IO::Socket;
@ -292,7 +292,8 @@ sub _read_req($c) {
: $r == -2 ? "I/O error while reading from FastCGI socket\n" : $r == -2 ? "I/O error while reading from FastCGI socket\n"
: $r == -3 ? "FastCGI protocol error\n" : $r == -3 ? "FastCGI protocol error\n"
: $r == -4 ? "Too long FastCGI parameter\n" : $r == -4 ? "Too long FastCGI parameter\n"
: $r == -5 ? "Too long request body\n" : undef if $r != -7; : $r == -5 ? "Too long request body\n"
: $r == -8 ? "I/O error while writing to FastCGI socket\n" : undef if $r != -7;
delete $c->{fcgi_obj}; delete $c->{fcgi_obj};
fu->error(-1); fu->error(-1);
} }
@ -400,7 +401,13 @@ sub _do_req($c) {
} }
$REQ->{trace_end} = clock_gettime(CLOCK_MONOTONIC); $REQ->{trace_end} = clock_gettime(CLOCK_MONOTONIC);
eval {
fu->_flush($c->{fcgi_obj} || $c->{client_sock}); fu->_flush($c->{fcgi_obj} || $c->{client_sock});
1;
} || do {
log_write "Error writing response: $@\n";
$c->{client_sock} = $c->{fcgi_obj} = undef;
};
if (debug && $REQ->{trace_id} && $debug_info->{history} && $debug_info->{storage}) { if (debug && $REQ->{trace_id} && $debug_info->{history} && $debug_info->{storage}) {
require FU::DebugImpl; require FU::DebugImpl;
@ -491,6 +498,8 @@ sub _supervisor($c) {
if (!$err && (!$childs{$pid} || $childs{$pid} != 2)) { if (!$err && (!$childs{$pid} || $childs{$pid} != 2)) {
$err = 1; $err = 1;
log_write "Script exited before calling FU::run()\n"; log_write "Script exited before calling FU::run()\n";
} elsif ($?) {
log_write "Unclean shutdown of worker PID $pid status $?\n";
} }
delete $childs{$pid}; delete $childs{$pid};
} }
@ -646,8 +655,8 @@ sub db {
}; };
} }
sub sql { shift->db->q(@_) } sub sql { shift->db->sql(@_) }
sub SQL { shift->db->Q(@_) } sub SQL { shift->db->SQL(@_) }
sub _fmt_section($s) { $s =~ s/^\s*/ /r =~ s/\s+$//r =~ s/\n/\n /rg } sub _fmt_section($s) { $s =~ s/^\s*/ /r =~ s/\s+$//r =~ s/\n/\n /rg }
@ -705,7 +714,8 @@ sub cookie {
my %c; my %c;
for my $c (split /; /, fu->header('cookie')||'') { for my $c (split /; /, fu->header('cookie')||'') {
my($n, $v) = split /=/, $c, 2; my($n, $v) = split /=/, $c, 2;
if (!exists $c{$n}) { $c{$n} = $v } if (!defined $v) {}
elsif (!exists $c{$n}) { $c{$n} = $v }
elsif (ref $c{$n}) { push $c{$n}->@*, $v } elsif (ref $c{$n}) { push $c{$n}->@*, $v }
else { $c{$n} = [ $c{$n}, $v ] } else { $c{$n} = [ $c{$n}, $v ] }
} }
@ -1305,11 +1315,11 @@ has successfully been processed, or rolled back if there was an error.
=item fu->sql($query, @params) =item fu->sql($query, @params)
Convenient short-hand for C<< fu->db->q($query, @params) >>. Convenient short-hand for C<< fu->db->sql($query, @params) >>.
=item fu->SQL(@args) =item fu->SQL(@args)
Convenient short-hand for C<< fu->db->Q(@args) >>. Convenient short-hand for C<< fu->db->SQL(@args) >>.
=item fu->log_verbose($message) =item fu->log_verbose($message)

14
FU.xs
View file

@ -3,7 +3,7 @@
#include <time.h> /* struct timespec & clock_gettime() */ #include <time.h> /* struct timespec & clock_gettime() */
#include <string.h> /* strerror() */ #include <string.h> /* strerror() */
#include <arpa/inet.h> /* inet_ntop(), inet_ntoa() */ #include <arpa/inet.h> /* inet_ntop(), inet_ntoa() */
#include <sys/socket.h> /* fd passing */ #include <sys/socket.h> /* send(), fd passing */
#include <sys/un.h> /* fd passing */ #include <sys/un.h> /* fd passing */
#include <dlfcn.h> /* dlopen() etc */ #include <dlfcn.h> /* dlopen() etc */
@ -170,11 +170,11 @@ void print(fufcgi *ctx, SV *sv)
CODE: CODE:
STRLEN len; STRLEN len;
const char *buf = SvPVbyte(sv, len); const char *buf = SvPVbyte(sv, len);
fufcgi_print(ctx, buf, len); fufcgi_print(aTHX_ ctx, buf, len);
void flush(fufcgi *ctx) void flush(fufcgi *ctx)
CODE: CODE:
fufcgi_done(ctx); fufcgi_done(aTHX_ ctx);
void DESTROY(fufcgi *ctx) void DESTROY(fufcgi *ctx)
CODE: CODE:
@ -277,10 +277,10 @@ void exec(fupg_conn *c, SV *sv)
FUPG_CONN_COOKIE; FUPG_CONN_COOKIE;
ST(0) = fupg_exec(aTHX_ c, SvPVutf8_nolen(sv)); ST(0) = fupg_exec(aTHX_ c, SvPVutf8_nolen(sv));
void q(fupg_conn *c, SV *sv, ...) void sql(fupg_conn *c, SV *sv, ...)
CODE: CODE:
FUPG_CONN_COOKIE; FUPG_CONN_COOKIE;
ST(0) = fupg_q(aTHX_ c, c->stflags, SvPVutf8_nolen(sv), ax, items); ST(0) = fupg_sql(aTHX_ c, c->stflags, SvPVutf8_nolen(sv), ax, items);
void copy(fupg_conn *c, SV *sv) void copy(fupg_conn *c, SV *sv)
CODE: CODE:
@ -353,10 +353,10 @@ void exec(fupg_txn *t, SV *sv)
FUPG_TXN_COOKIE; FUPG_TXN_COOKIE;
ST(0) = fupg_exec(aTHX_ t->conn, SvPVutf8_nolen(sv)); ST(0) = fupg_exec(aTHX_ t->conn, SvPVutf8_nolen(sv));
void q(fupg_txn *t, SV *sv, ...) void sql(fupg_txn *t, SV *sv, ...)
CODE: CODE:
FUPG_TXN_COOKIE; FUPG_TXN_COOKIE;
ST(0) = fupg_q(aTHX_ t->conn, t->stflags, SvPVutf8_nolen(sv), ax, items); ST(0) = fupg_sql(aTHX_ t->conn, t->stflags, SvPVutf8_nolen(sv), ax, items);
# XXX: The copy object should probably keep a ref on the transaction # XXX: The copy object should probably keep a ref on the transaction
void copy(fupg_txn *t, SV *sv) void copy(fupg_txn *t, SV *sv)

448
FU/Benchmarks.pod
View file

@ -26,25 +26,25 @@ The following module versions were used:
=over =over
=item L<Cpanel::JSON::XS> 4.39 =item L<Cpanel::JSON::XS> 4.40
=item L<DBD::Pg> 3.18.0 =item L<DBD::Pg> 3.18.0
=item L<FU> 1.2 =item L<FU> 1.4
=item L<HTML::Tiny> 1.08 =item L<HTML::Tiny> 1.08
=item L<JSON::PP> 4.16 =item L<JSON::PP> 4.16
=item L<JSON::SIMD> 1.06 =item L<JSON::SIMD> 1.07
=item L<JSON::Tiny> 0.58 =item L<JSON::Tiny> 0.58
=item L<JSON::XS> 4.03 =item L<JSON::XS> 4.04
=item L<Pg::PQ> 0.15 =item L<Pg::PQ> 0.15
=item L<TUWF::XML> 1.5 =item L<TUWF::XML> 1.6
=item L<XML::Writer> 0.900 =item L<XML::Writer> 0.900
@ -66,102 +66,102 @@ L<JSON::XS>, the SIMD parts are only used for parsing.
API object from L<JSON::XS> documentation. API object from L<JSON::XS> documentation.
Encode Canonical Decode Encode Canonical Decode
JSON::PP 5312/s 5119/s 1290/s JSON::PP 5136/s 4943/s 1240/s
JSON::Tiny 7757/s - 3426/s JSON::Tiny 7617/s - 3474/s
Cpanel::JSON::XS 114802/s 104141/s 107274/s Cpanel::JSON::XS 108128/s 98734/s 105811/s
JSON::SIMD 130137/s 118948/s 115123/s JSON::SIMD 125105/s 114822/s 118410/s
JSON::XS 128421/s 120243/s 117940/s JSON::XS 128749/s 117518/s 120190/s
FU::Util 132067/s 111328/s 117781/s FU::Util 126909/s 109166/s 113983/s
Object (small) Object (small)
Encode Canonical Decode Encode Canonical Decode
JSON::PP 907/s 829/s 202/s JSON::PP 896/s 826/s 194/s
JSON::Tiny 1224/s - 499/s JSON::Tiny 1216/s - 519/s
Cpanel::JSON::XS 45732/s 30862/s 20102/s Cpanel::JSON::XS 44184/s 28190/s 19449/s
JSON::SIMD 49019/s 30699/s 23267/s JSON::SIMD 52633/s 31157/s 23587/s
JSON::XS 49814/s 31326/s 25336/s JSON::XS 50314/s 34276/s 25294/s
FU::Util 39684/s 24971/s 17998/s FU::Util 42121/s 25618/s 19203/s
Object (large) Object (large)
Encode Canonical Decode Encode Canonical Decode
JSON::PP 927/s 747/s 104/s JSON::PP 910/s 734/s 98/s
JSON::Tiny 1108/s - 392/s JSON::Tiny 1068/s - 404/s
Cpanel::JSON::XS 30587/s 11875/s 15515/s Cpanel::JSON::XS 27626/s 12484/s 15333/s
JSON::SIMD 24418/s 12388/s 22895/s JSON::SIMD 34106/s 12808/s 23674/s
JSON::XS 23192/s 13174/s 23553/s JSON::XS 35738/s 13099/s 22637/s
FU::Util 35489/s 13247/s 16571/s FU::Util 37663/s 13366/s 16292/s
Object (large, mixed unicode) Object (large, mixed unicode)
Encode Canonical Decode Encode Canonical Decode
JSON::PP 817/s 679/s 86/s JSON::PP 835/s 664/s 82/s
JSON::Tiny 1036/s - 402/s JSON::Tiny 1028/s - 427/s
Cpanel::JSON::XS 25333/s 1459/s 7480/s Cpanel::JSON::XS 24123/s 1352/s 8694/s
JSON::SIMD 25031/s 1331/s 15997/s JSON::SIMD 26008/s 1413/s 19707/s
JSON::XS 23580/s 1375/s 8526/s JSON::XS 25444/s 1391/s 10442/s
FU::Util 32519/s 12488/s 9290/s FU::Util 33132/s 12006/s 11861/s
Small integers Small integers
Encode Decode Encode Decode
JSON::PP 113/s 29/s JSON::PP 116/s 30/s
JSON::Tiny 160/s 86/s JSON::Tiny 158/s 86/s
Cpanel::JSON::XS 7345/s 6151/s Cpanel::JSON::XS 7426/s 5774/s
JSON::SIMD 7963/s 4361/s JSON::SIMD 8294/s 4375/s
JSON::XS 7915/s 6058/s JSON::XS 8526/s 6179/s
FU::Util 7851/s 5828/s FU::Util 7996/s 5962/s
Large integers Large integers
Encode Decode Encode Decode
JSON::PP 2176/s 329/s JSON::PP 2213/s 341/s
JSON::Tiny 2999/s 1638/s JSON::Tiny 2910/s 1661/s
Cpanel::JSON::XS 32545/s 50162/s Cpanel::JSON::XS 32616/s 53053/s
JSON::SIMD 37201/s 51719/s JSON::SIMD 37749/s 53032/s
JSON::XS 36722/s 50110/s JSON::XS 38644/s 55004/s
FU::Util 109163/s 63176/s FU::Util 109930/s 63358/s
ASCII strings ASCII strings
Encode Decode Encode Decode
JSON::PP 2934/s 336/s JSON::PP 2811/s 312/s
JSON::Tiny 4126/s 1439/s JSON::Tiny 3924/s 1506/s
Cpanel::JSON::XS 116721/s 44560/s Cpanel::JSON::XS 129468/s 51536/s
JSON::SIMD 134711/s 50429/s JSON::SIMD 140393/s 64499/s
JSON::XS 135419/s 43976/s JSON::XS 141149/s 56913/s
FU::Util 162246/s 44216/s FU::Util 165938/s 55034/s
Unicode strings Unicode strings
Encode Decode Encode Decode
JSON::PP 5113/s 253/s JSON::PP 5138/s 248/s
JSON::Tiny 6603/s 2585/s JSON::Tiny 6501/s 2677/s
Cpanel::JSON::XS 97039/s 67669/s Cpanel::JSON::XS 91004/s 64101/s
JSON::SIMD 106928/s 102440/s JSON::SIMD 101185/s 80941/s
JSON::XS 105473/s 60558/s JSON::XS 106312/s 61104/s
FU::Util 201648/s 57397/s FU::Util 205716/s 52041/s
String escaping (few) String escaping (few)
Encode Decode Encode Decode
JSON::PP 4251/s 352/s JSON::PP 4269/s 329/s
JSON::Tiny 4704/s 1869/s JSON::Tiny 4878/s 2101/s
Cpanel::JSON::XS 136755/s 118059/s Cpanel::JSON::XS 152958/s 105597/s
JSON::SIMD 158171/s 153692/s JSON::SIMD 165340/s 130074/s
JSON::XS 157261/s 97676/s JSON::XS 165863/s 87872/s
FU::Util 225259/s 92515/s FU::Util 228511/s 81599/s
String escaping (many) String escaping (many)
Encode Decode Encode Decode
JSON::PP 3963/s 561/s JSON::PP 4052/s 573/s
JSON::Tiny 4463/s 2175/s JSON::Tiny 4575/s 2274/s
Cpanel::JSON::XS 197154/s 133102/s Cpanel::JSON::XS 201958/s 102800/s
JSON::SIMD 199955/s 152557/s JSON::SIMD 242806/s 146341/s
JSON::XS 231905/s 125191/s JSON::XS 209689/s 98420/s
FU::Util 215367/s 118073/s FU::Util 210713/s 100255/s
@ -173,10 +173,10 @@ templating modules will perform better, though.
HTML fragment HTML fragment
TUWF::XML 795/s TUWF::XML 787/s
XML::Writer 833/s XML::Writer 832/s
HTML::Tiny 423/s HTML::Tiny 403/s
FU::XMLWriter 5327/s FU::XMLWriter 5192/s
@ -189,165 +189,165 @@ bottleneck where there shouldn't be one.
Fetch and bitwise-or 20k integers Fetch and bitwise-or 20k integers
Smallint Bigint Smallint Bigint
DBD::Pg 194/s 22/s DBD::Pg 346/s 33/s
Pg::PQ 226/s 19/s Pg::PQ 270/s 24/s
FU::Pg (bin) 245/s 22/s FU::Pg (bin) 476/s 46/s
FU::Pg (text) 217/s 20/s FU::Pg (text) 273/s 23/s
=cut =cut
# Cached data used by bench.PL. Same as the formatted tables above but easier to parse. # Cached data used by bench.PL. Same as the formatted tables above but easier to parse.
json/api Canonical Cpanel::JSON::XS 104141 json/api Canonical Cpanel::JSON::XS 98734
json/api Canonical FU::Util 111328 json/api Canonical FU::Util 109166
json/api Canonical JSON::PP 5119 json/api Canonical JSON::PP 4943
json/api Canonical JSON::SIMD 118948 json/api Canonical JSON::SIMD 114822
json/api Canonical JSON::XS 120243 json/api Canonical JSON::XS 117518
json/api Decode Cpanel::JSON::XS 107274 json/api Decode Cpanel::JSON::XS 105811
json/api Decode FU::Util 117781 json/api Decode FU::Util 113983
json/api Decode JSON::PP 1290 json/api Decode JSON::PP 1240
json/api Decode JSON::SIMD 115123 json/api Decode JSON::SIMD 118410
json/api Decode JSON::Tiny 3426 json/api Decode JSON::Tiny 3474
json/api Decode JSON::XS 117940 json/api Decode JSON::XS 120190
json/api Encode Cpanel::JSON::XS 114802 json/api Encode Cpanel::JSON::XS 108128
json/api Encode FU::Util 132067 json/api Encode FU::Util 126909
json/api Encode JSON::PP 5312 json/api Encode JSON::PP 5136
json/api Encode JSON::SIMD 130137 json/api Encode JSON::SIMD 125105
json/api Encode JSON::Tiny 7757 json/api Encode JSON::Tiny 7617
json/api Encode JSON::XS 128421 json/api Encode JSON::XS 128749
json/intl Decode Cpanel::JSON::XS 50162 json/intl Decode Cpanel::JSON::XS 53053
json/intl Decode FU::Util 63176 json/intl Decode FU::Util 63358
json/intl Decode JSON::PP 329 json/intl Decode JSON::PP 341
json/intl Decode JSON::SIMD 51719 json/intl Decode JSON::SIMD 53032
json/intl Decode JSON::Tiny 1638 json/intl Decode JSON::Tiny 1661
json/intl Decode JSON::XS 50110 json/intl Decode JSON::XS 55004
json/intl Encode Cpanel::JSON::XS 32545 json/intl Encode Cpanel::JSON::XS 32616
json/intl Encode FU::Util 109163 json/intl Encode FU::Util 109930
json/intl Encode JSON::PP 2176 json/intl Encode JSON::PP 2213
json/intl Encode JSON::SIMD 37201 json/intl Encode JSON::SIMD 37749
json/intl Encode JSON::Tiny 2999 json/intl Encode JSON::Tiny 2910
json/intl Encode JSON::XS 36722 json/intl Encode JSON::XS 38644
json/ints Decode Cpanel::JSON::XS 6151 json/ints Decode Cpanel::JSON::XS 5774
json/ints Decode FU::Util 5828 json/ints Decode FU::Util 5962
json/ints Decode JSON::PP 29 json/ints Decode JSON::PP 30
json/ints Decode JSON::SIMD 4361 json/ints Decode JSON::SIMD 4375
json/ints Decode JSON::Tiny 86 json/ints Decode JSON::Tiny 86
json/ints Decode JSON::XS 6058 json/ints Decode JSON::XS 6179
json/ints Encode Cpanel::JSON::XS 7345 json/ints Encode Cpanel::JSON::XS 7426
json/ints Encode FU::Util 7851 json/ints Encode FU::Util 7996
json/ints Encode JSON::PP 113 json/ints Encode JSON::PP 116
json/ints Encode JSON::SIMD 7963 json/ints Encode JSON::SIMD 8294
json/ints Encode JSON::Tiny 160 json/ints Encode JSON::Tiny 158
json/ints Encode JSON::XS 7915 json/ints Encode JSON::XS 8526
json/objl Canonical Cpanel::JSON::XS 11875 json/objl Canonical Cpanel::JSON::XS 12484
json/objl Canonical FU::Util 13247 json/objl Canonical FU::Util 13366
json/objl Canonical JSON::PP 747 json/objl Canonical JSON::PP 734
json/objl Canonical JSON::SIMD 12388 json/objl Canonical JSON::SIMD 12808
json/objl Canonical JSON::XS 13174 json/objl Canonical JSON::XS 13099
json/objl Decode Cpanel::JSON::XS 15515 json/objl Decode Cpanel::JSON::XS 15333
json/objl Decode FU::Util 16571 json/objl Decode FU::Util 16292
json/objl Decode JSON::PP 104 json/objl Decode JSON::PP 98
json/objl Decode JSON::SIMD 22895 json/objl Decode JSON::SIMD 23674
json/objl Decode JSON::Tiny 392 json/objl Decode JSON::Tiny 404
json/objl Decode JSON::XS 23553 json/objl Decode JSON::XS 22637
json/objl Encode Cpanel::JSON::XS 30587 json/objl Encode Cpanel::JSON::XS 27626
json/objl Encode FU::Util 35489 json/objl Encode FU::Util 37663
json/objl Encode JSON::PP 927 json/objl Encode JSON::PP 910
json/objl Encode JSON::SIMD 24418 json/objl Encode JSON::SIMD 34106
json/objl Encode JSON::Tiny 1108 json/objl Encode JSON::Tiny 1068
json/objl Encode JSON::XS 23192 json/objl Encode JSON::XS 35738
json/objs Canonical Cpanel::JSON::XS 30862 json/objs Canonical Cpanel::JSON::XS 28190
json/objs Canonical FU::Util 24971 json/objs Canonical FU::Util 25618
json/objs Canonical JSON::PP 829 json/objs Canonical JSON::PP 826
json/objs Canonical JSON::SIMD 30699 json/objs Canonical JSON::SIMD 31157
json/objs Canonical JSON::XS 31326 json/objs Canonical JSON::XS 34276
json/objs Decode Cpanel::JSON::XS 20102 json/objs Decode Cpanel::JSON::XS 19449
json/objs Decode FU::Util 17998 json/objs Decode FU::Util 19203
json/objs Decode JSON::PP 202 json/objs Decode JSON::PP 194
json/objs Decode JSON::SIMD 23267 json/objs Decode JSON::SIMD 23587
json/objs Decode JSON::Tiny 499 json/objs Decode JSON::Tiny 519
json/objs Decode JSON::XS 25336 json/objs Decode JSON::XS 25294
json/objs Encode Cpanel::JSON::XS 45732 json/objs Encode Cpanel::JSON::XS 44184
json/objs Encode FU::Util 39684 json/objs Encode FU::Util 42121
json/objs Encode JSON::PP 907 json/objs Encode JSON::PP 896
json/objs Encode JSON::SIMD 49019 json/objs Encode JSON::SIMD 52633
json/objs Encode JSON::Tiny 1224 json/objs Encode JSON::Tiny 1216
json/objs Encode JSON::XS 49814 json/objs Encode JSON::XS 50314
json/obju Canonical Cpanel::JSON::XS 1459 json/obju Canonical Cpanel::JSON::XS 1352
json/obju Canonical FU::Util 12488 json/obju Canonical FU::Util 12006
json/obju Canonical JSON::PP 679 json/obju Canonical JSON::PP 664
json/obju Canonical JSON::SIMD 1331 json/obju Canonical JSON::SIMD 1413
json/obju Canonical JSON::XS 1375 json/obju Canonical JSON::XS 1391
json/obju Decode Cpanel::JSON::XS 7480 json/obju Decode Cpanel::JSON::XS 8694
json/obju Decode FU::Util 9290 json/obju Decode FU::Util 11861
json/obju Decode JSON::PP 86 json/obju Decode JSON::PP 82
json/obju Decode JSON::SIMD 15997 json/obju Decode JSON::SIMD 19707
json/obju Decode JSON::Tiny 402 json/obju Decode JSON::Tiny 427
json/obju Decode JSON::XS 8526 json/obju Decode JSON::XS 10442
json/obju Encode Cpanel::JSON::XS 25333 json/obju Encode Cpanel::JSON::XS 24123
json/obju Encode FU::Util 32519 json/obju Encode FU::Util 33132
json/obju Encode JSON::PP 817 json/obju Encode JSON::PP 835
json/obju Encode JSON::SIMD 25031 json/obju Encode JSON::SIMD 26008
json/obju Encode JSON::Tiny 1036 json/obju Encode JSON::Tiny 1028
json/obju Encode JSON::XS 23580 json/obju Encode JSON::XS 25444
json/strel Decode Cpanel::JSON::XS 133102 json/strel Decode Cpanel::JSON::XS 102800
json/strel Decode FU::Util 118073 json/strel Decode FU::Util 100255
json/strel Decode JSON::PP 561 json/strel Decode JSON::PP 573
json/strel Decode JSON::SIMD 152557 json/strel Decode JSON::SIMD 146341
json/strel Decode JSON::Tiny 2175 json/strel Decode JSON::Tiny 2274
json/strel Decode JSON::XS 125191 json/strel Decode JSON::XS 98420
json/strel Encode Cpanel::JSON::XS 197154 json/strel Encode Cpanel::JSON::XS 201958
json/strel Encode FU::Util 215367 json/strel Encode FU::Util 210713
json/strel Encode JSON::PP 3963 json/strel Encode JSON::PP 4052
json/strel Encode JSON::SIMD 199955 json/strel Encode JSON::SIMD 242806
json/strel Encode JSON::Tiny 4463 json/strel Encode JSON::Tiny 4575
json/strel Encode JSON::XS 231905 json/strel Encode JSON::XS 209689
json/stres Decode Cpanel::JSON::XS 118059 json/stres Decode Cpanel::JSON::XS 105597
json/stres Decode FU::Util 92515 json/stres Decode FU::Util 81599
json/stres Decode JSON::PP 352 json/stres Decode JSON::PP 329
json/stres Decode JSON::SIMD 153692 json/stres Decode JSON::SIMD 130074
json/stres Decode JSON::Tiny 1869 json/stres Decode JSON::Tiny 2101
json/stres Decode JSON::XS 97676 json/stres Decode JSON::XS 87872
json/stres Encode Cpanel::JSON::XS 136755 json/stres Encode Cpanel::JSON::XS 152958
json/stres Encode FU::Util 225259 json/stres Encode FU::Util 228511
json/stres Encode JSON::PP 4251 json/stres Encode JSON::PP 4269
json/stres Encode JSON::SIMD 158171 json/stres Encode JSON::SIMD 165340
json/stres Encode JSON::Tiny 4704 json/stres Encode JSON::Tiny 4878
json/stres Encode JSON::XS 157261 json/stres Encode JSON::XS 165863
json/strs Decode Cpanel::JSON::XS 44560 json/strs Decode Cpanel::JSON::XS 51536
json/strs Decode FU::Util 44216 json/strs Decode FU::Util 55034
json/strs Decode JSON::PP 336 json/strs Decode JSON::PP 312
json/strs Decode JSON::SIMD 50429 json/strs Decode JSON::SIMD 64499
json/strs Decode JSON::Tiny 1439 json/strs Decode JSON::Tiny 1506
json/strs Decode JSON::XS 43976 json/strs Decode JSON::XS 56913
json/strs Encode Cpanel::JSON::XS 116721 json/strs Encode Cpanel::JSON::XS 129468
json/strs Encode FU::Util 162246 json/strs Encode FU::Util 165938
json/strs Encode JSON::PP 2934 json/strs Encode JSON::PP 2811
json/strs Encode JSON::SIMD 134711 json/strs Encode JSON::SIMD 140393
json/strs Encode JSON::Tiny 4126 json/strs Encode JSON::Tiny 3924
json/strs Encode JSON::XS 135419 json/strs Encode JSON::XS 141149
json/stru Decode Cpanel::JSON::XS 67669 json/stru Decode Cpanel::JSON::XS 64101
json/stru Decode FU::Util 57397 json/stru Decode FU::Util 52041
json/stru Decode JSON::PP 253 json/stru Decode JSON::PP 248
json/stru Decode JSON::SIMD 102440 json/stru Decode JSON::SIMD 80941
json/stru Decode JSON::Tiny 2585 json/stru Decode JSON::Tiny 2677
json/stru Decode JSON::XS 60558 json/stru Decode JSON::XS 61104
json/stru Encode Cpanel::JSON::XS 97039 json/stru Encode Cpanel::JSON::XS 91004
json/stru Encode FU::Util 201648 json/stru Encode FU::Util 205716
json/stru Encode JSON::PP 5113 json/stru Encode JSON::PP 5138
json/stru Encode JSON::SIMD 106928 json/stru Encode JSON::SIMD 101185
json/stru Encode JSON::Tiny 6603 json/stru Encode JSON::Tiny 6501
json/stru Encode JSON::XS 105473 json/stru Encode JSON::XS 106312
pg/ints Bigint DBD::Pg 22 pg/ints Bigint DBD::Pg 33
pg/ints Bigint FU::Pg (bin) 22 pg/ints Bigint FU::Pg (bin) 46
pg/ints Bigint FU::Pg (text) 20 pg/ints Bigint FU::Pg (text) 23
pg/ints Bigint Pg::PQ 19 pg/ints Bigint Pg::PQ 24
pg/ints Smallint DBD::Pg 194 pg/ints Smallint DBD::Pg 346
pg/ints Smallint FU::Pg (bin) 245 pg/ints Smallint FU::Pg (bin) 476
pg/ints Smallint FU::Pg (text) 217 pg/ints Smallint FU::Pg (text) 273
pg/ints Smallint Pg::PQ 226 pg/ints Smallint Pg::PQ 270
xml/a Rate FU::XMLWriter 5327 xml/a Rate FU::XMLWriter 5192
xml/a Rate HTML::Tiny 423 xml/a Rate HTML::Tiny 403
xml/a Rate TUWF::XML 795 xml/a Rate TUWF::XML 787
xml/a Rate XML::Writer 833 xml/a Rate XML::Writer 832

4
FU/DebugImpl.pm
View file

@ -1,5 +1,5 @@
# Internal module used by FU.pm # Internal module used by FU.pm
package FU::DebugImpl 1.3; package FU::DebugImpl 1.4;
use v5.36; use v5.36;
use utf8; use utf8;
use experimental 'for_list'; use experimental 'for_list';
@ -283,7 +283,7 @@ my @sections = (
pgst => sub { pgst => sub {
return () if !$FU::DB; return () if !$FU::DB;
my $lst = eval { $FU::DB->q( my $lst = eval { $FU::DB->sql(
'SELECT generic_plans + custom_plans, statement FROM pg_prepared_statements ORDER BY generic_plans + custom_plans DESC, statement' 'SELECT generic_plans + custom_plans, statement FROM pg_prepared_statements ORDER BY generic_plans + custom_plans DESC, statement'
)->cache(0)->alla } || do { warn "Unable to collect prepared statement list: $@"; return () }; )->cache(0)->alla } || do { warn "Unable to collect prepared statement list: $@"; return () };
return () if !@$lst; return () if !@$lst;

2
FU/Log.pm
View file

@ -1,4 +1,4 @@
package FU::Log 1.3; package FU::Log 1.4;
use v5.36; use v5.36;
use Exporter 'import'; use Exporter 'import';
use POSIX 'strftime'; use POSIX 'strftime';

2
FU/MultipartFormData.pm
View file

@ -1,4 +1,4 @@
package FU::MultipartFormData 1.3; package FU::MultipartFormData 1.4;
use v5.36; use v5.36;
use Carp 'confess'; use Carp 'confess';
use FU::Util 'utf8_decode'; use FU::Util 'utf8_decode';

74
FU/Pg.pm
View file

@ -1,4 +1,4 @@
package FU::Pg 1.3; package FU::Pg 1.4;
use v5.36; use v5.36;
use FU::XS; use FU::XS;
@ -7,7 +7,7 @@ _load_libpq();
package FU::Pg::conn { package FU::Pg::conn {
sub lib_version { FU::Pg::lib_version() } sub lib_version { FU::Pg::lib_version() }
sub Q { sub SQL {
require FU::SQL; require FU::SQL;
my $s = shift; my $s = shift;
my($sql, $params) = FU::SQL::SQL(@_)->compile( my($sql, $params) = FU::SQL::SQL(@_)->compile(
@ -15,7 +15,7 @@ package FU::Pg::conn {
in_style => 'pg', in_style => 'pg',
quote_identifier => sub { $s->conn->escape_identifier(@_) }, quote_identifier => sub { $s->conn->escape_identifier(@_) },
); );
$s->q($sql, @$params); $s->sql($sql, @$params);
} }
sub set_type($s, $n, @arg) { sub set_type($s, $n, @arg) {
@ -26,7 +26,13 @@ package FU::Pg::conn {
} }
}; };
*FU::Pg::txn::Q = \*FU::Pg::conn::Q; *FU::Pg::txn::SQL = \*FU::Pg::conn::SQL;
# Compat
*FU::Pg::conn::q = \*FU::Pg::conn::sql;
*FU::Pg::txn::q = \*FU::Pg::txn::sql;
*FU::Pg::conn::Q = \*FU::Pg::conn::SQL;
*FU::Pg::txn::Q = \*FU::Pg::txn::SQL;
package FU::Pg::error { package FU::Pg::error {
use overload '""' => sub($e, @) { $e->{full_message} }; use overload '""' => sub($e, @) { $e->{full_message} };
@ -47,10 +53,10 @@ FU::Pg - The Ultimate (synchronous) Interface to PostgreSQL
$conn->exec('CREATE TABLE books (id SERIAL, title text, read bool)'); $conn->exec('CREATE TABLE books (id SERIAL, title text, read bool)');
$conn->q('INSERT INTO books (title) VALUES ($1)', 'Revelation Space')->exec; $conn->sql('INSERT INTO books (title) VALUES ($1)', 'Revelation Space')->exec;
$conn->q('INSERT INTO books (title) VALUES ($1)', 'The Invincible')->exec; $conn->sql('INSERT INTO books (title) VALUES ($1)', 'The Invincible')->exec;
for my ($id, $title) ($conn->q('SELECT * FROM books')->flat->@*) { for my ($id, $title) ($conn->sql('SELECT * FROM books')->flat->@*) {
print "$id: $title\n"; print "$id: $title\n";
} }
@ -71,7 +77,7 @@ C<$string> can either be in key=value format or a URI, refer to L<the
PostgreSQL PostgreSQL
documentation|https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING> documentation|https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING>
for the full list of supported formats and options. You may also pass an empty for the full list of supported formats and options. You may also pass an empty
string and leave the configuration up L<environment string and leave the configuration up to L<environment
variables|https://www.postgresql.org/docs/current/libpq-envars.html>. variables|https://www.postgresql.org/docs/current/libpq-envars.html>.
=item $conn->server_version =item $conn->server_version
@ -141,7 +147,7 @@ a table, column, function, etc) in an SQL statement.
=item $conn->text($enable) =item $conn->text($enable)
Set the default settings for new statements created with B<< $conn->q() >>. Set the default settings for new statements created with B<< $conn->sql() >>.
=item $conn->cache_size($num) =item $conn->cache_size($num)
@ -169,7 +175,7 @@ Also worth noting that the subroutine is called from the context of the code
executing the query, but I<before> the query results have been returned. executing the query, but I<before> the query results have been returned.
The subroutine is (currently) only called for queries executed through C<< The subroutine is (currently) only called for queries executed through C<<
$conn->exec >>, C<< $conn->q >>, C<< $conn->Q >> and their C<$txn> variants; $conn->exec >>, C<< $conn->sql >>, C<< $conn->SQL >> and their C<$txn> variants;
C<< $conn->copy >> statements and internal queries performed by this module C<< $conn->copy >> statements and internal queries performed by this module
(such as for transaction management, querying type information, etc) do not (such as for transaction management, querying type information, etc) do not
trigger the callback. Statements that result in an error being thrown during or trigger the callback. Statements that result in an error being thrown during or
@ -193,7 +199,7 @@ Execute one or more SQL commands, separated by a semicolon. Returns the number
of rows affected by the last statement or I<undef> if that information is not of rows affected by the last statement or I<undef> if that information is not
available for the given command (like with C<CREATE TABLE>). available for the given command (like with C<CREATE TABLE>).
=item $conn->q($sql, @params) =item $conn->sql($sql, @params)
Create a new SQL statement with the given C<$sql> string and an optional list Create a new SQL statement with the given C<$sql> string and an optional list
of bind parameters. C<$sql> can only hold a single statement. of bind parameters. C<$sql> can only hold a single statement.
@ -209,15 +215,15 @@ Note that this method just creates a statement object, the query is not
prepared or executed until the appropriate statement methods (see below) are prepared or executed until the appropriate statement methods (see below) are
used. used.
=item $conn->Q(@args) =item $conn->SQL(@args)
Same as C<< $conn->q() >> but uses L<FU::SQL> to construct the query and bind Same as C<< $conn->sql() >> but uses L<FU::SQL> to construct the query and bind
parameters. Uses the 'pg' C<in_style> and C<< $conn->escape_identifier() >> for parameters. Uses the 'pg' C<in_style> and C<< $conn->escape_identifier() >> for
identifier quoting. identifier quoting.
=back =back
Statement objects returned by C<< $conn->q() >> support the following Statement objects returned by C<< $conn->sql() >> support the following
configuration parameters, which can be set before the statement is executed: configuration parameters, which can be set before the statement is executed:
=over =over
@ -252,7 +258,7 @@ depending on how you'd like to obtain the results:
Execute the query and return the number of rows affected. Similar to C<< Execute the query and return the number of rows affected. Similar to C<<
$conn->exec >>. $conn->exec >>.
my $v = $conn->q('UPDATE books SET read = true WHERE id = 1')->exec; my $v = $conn->sql('UPDATE books SET read = true WHERE id = 1')->exec;
# $v = 1 # $v = 1
=item $st->val =item $st->val
@ -261,7 +267,7 @@ Return the first column of the first row. Throws an error if the query does not
return exactly one column, or if multiple rows are returned. Returns I<undef> return exactly one column, or if multiple rows are returned. Returns I<undef>
if no rows are returned or if its value is I<NULL>. if no rows are returned or if its value is I<NULL>.
my $v = $conn->q('SELECT COUNT(*) FROM books')->val; my $v = $conn->sql('SELECT COUNT(*) FROM books')->val;
# $v = 2 # $v = 2
=item $st->rowl =item $st->rowl
@ -269,7 +275,7 @@ if no rows are returned or if its value is I<NULL>.
Return the first row as a list, or an empty list if no rows are returned. Return the first row as a list, or an empty list if no rows are returned.
Throws an error if the query returned more than one row. Throws an error if the query returned more than one row.
my($id, $title) = $conn->q('SELECT id, title FROM books LIMIT 1')->rowl; my($id, $title) = $conn->sql('SELECT id, title FROM books LIMIT 1')->rowl;
# ($id, $title) = (1, 'Revelation Space'); # ($id, $title) = (1, 'Revelation Space');
=item $st->rowa =item $st->rowa
@ -278,7 +284,7 @@ Return the first row as an arrayref, equivalent to C<< [$st->rowl] >> but might
be slightly more efficient. Returns C<undef> if the query did not generate any be slightly more efficient. Returns C<undef> if the query did not generate any
rows. rows.
my $row = $conn->q('SELECT id, title FROM books LIMIT 1')->rowa; my $row = $conn->sql('SELECT id, title FROM books LIMIT 1')->rowa;
# $row = [1, 'Revelation Space']; # $row = [1, 'Revelation Space'];
=item $st->rowh =item $st->rowh
@ -287,14 +293,14 @@ Return the first row as a hashref. Returns C<undef> if the query did not
generate any rows. Throws an error if the query returns multiple columns with generate any rows. Throws an error if the query returns multiple columns with
the same name. the same name.
my $row = $conn->q('SELECT id, title FROM books LIMIT 1')->rowh; my $row = $conn->sql('SELECT id, title FROM books LIMIT 1')->rowh;
# $row = { id => 1, title => 'Revelation Space' }; # $row = { id => 1, title => 'Revelation Space' };
=item $st->alla =item $st->alla
Return all rows as an arrayref of arrayrefs. Return all rows as an arrayref of arrayrefs.
my $data = $conn->q('SELECT id, title FROM books')->alla; my $data = $conn->sql('SELECT id, title FROM books')->alla;
# $data = [ # $data = [
# [ 1, 'Revelation Space' ], # [ 1, 'Revelation Space' ],
# [ 2, 'The Invincible' ], # [ 2, 'The Invincible' ],
@ -305,7 +311,7 @@ Return all rows as an arrayref of arrayrefs.
Return all rows as an arrayref of hashrefs. Throws an error if the query Return all rows as an arrayref of hashrefs. Throws an error if the query
returns multiple columns with the same name. returns multiple columns with the same name.
my $data = $conn->q('SELECT id, title FROM books')->allh; my $data = $conn->sql('SELECT id, title FROM books')->allh;
# $data = [ # $data = [
# { id => 1, title => 'Revelation Space' }, # { id => 1, title => 'Revelation Space' },
# { id => 2, title => 'The Invincible' }, # { id => 2, title => 'The Invincible' },
@ -315,7 +321,7 @@ returns multiple columns with the same name.
Return an arrayref with all rows flattened. Return an arrayref with all rows flattened.
my $data = $conn->q('SELECT id, title FROM books')->flat; my $data = $conn->sql('SELECT id, title FROM books')->flat;
# $data = [ # $data = [
# 1, 'Revelation Space', # 1, 'Revelation Space',
# 2, 'The Invincible', # 2, 'The Invincible',
@ -327,7 +333,7 @@ Return a hashref where the first result column is used as key and the second
column as value. If the query only returns a single column, C<true> is used as column as value. If the query only returns a single column, C<true> is used as
value instead. An error is thrown if the query returns 3 or more columns. value instead. An error is thrown if the query returns 3 or more columns.
my $data = $conn->q('SELECT id, title FROM books')->kvv; my $data = $conn->sql('SELECT id, title FROM books')->kvv;
# $data = { # $data = {
# 1 => 'Revelation Space', # 1 => 'Revelation Space',
# 2 => 'The Invincible', # 2 => 'The Invincible',
@ -338,7 +344,7 @@ value instead. An error is thrown if the query returns 3 or more columns.
Return a hashref where the first result column is used as key and the remaining Return a hashref where the first result column is used as key and the remaining
columns are stored as arrayref. columns are stored as arrayref.
my $data = $conn->q('SELECT id, title, read FROM books')->kva; my $data = $conn->sql('SELECT id, title, read FROM books')->kva;
# $data = { # $data = {
# 1 => [ 'Revelation Space', true ], # 1 => [ 'Revelation Space', true ],
# 2 => [ 'The Invincible', false ], # 2 => [ 'The Invincible', false ],
@ -349,7 +355,7 @@ columns are stored as arrayref.
Return a hashref where the first result column is used as key and the remaining Return a hashref where the first result column is used as key and the remaining
columns are stored as hashref. columns are stored as hashref.
my $data = $conn->q('SELECT id, title, read FROM books')->kvh; my $data = $conn->sql('SELECT id, title, read FROM books')->kvh;
# $data = { # $data = {
# 1 => { title => 'Revelation Space', read => true }, # 1 => { title => 'Revelation Space', read => true },
# 2 => { title => 'The Invincible', read => false }, # 2 => { title => 'The Invincible', read => false },
@ -361,7 +367,7 @@ The only time you actually need to assign a statement object to a variable is
when you want to inspect the statement using one of the methods below, in all when you want to inspect the statement using one of the methods below, in all
other cases you can chain the methods for more concise code. For example: other cases you can chain the methods for more concise code. For example:
my $data = $conn->q('SELECT a, b FROM table')->cache(0)->text->alla; my $data = $conn->sql('SELECT a, b FROM table')->cache(0)->text->alla;
Statement objects can be inspected with the following methods (many of which Statement objects can be inspected with the following methods (many of which
only make sense after the query has been executed): only make sense after the query has been executed):
@ -381,10 +387,10 @@ Returns the provided bind parameters as an arrayref.
Returns an arrayref of integers indicating the type (as I<oid>) of each Returns an arrayref of integers indicating the type (as I<oid>) of each
parameter in the given C<$sql> string. Example: parameter in the given C<$sql> string. Example:
my $oids = $conn->q('SELECT id FROM books WHERE id = $1 AND title = $2')->param_types; my $oids = $conn->sql('SELECT id FROM books WHERE id = $1 AND title = $2')->param_types;
# $oids = [23,25] # $oids = [23,25]
my $oids = $conn->q('SELECT id FROM books')->params; my $oids = $conn->sql('SELECT id FROM books')->params;
# $oids = [] # $oids = []
This method can be called before the query has been executed, but will then This method can be called before the query has been executed, but will then
@ -397,7 +403,7 @@ prepared statement caching is disabled and C<text_params> is enabled.
Returns an arrayref of hashrefs describing each column that the statement Returns an arrayref of hashrefs describing each column that the statement
returns. returns.
my $cols = $conn->q('SELECT id, title FROM books')->columns; my $cols = $conn->sql('SELECT id, title FROM books')->columns;
# $cols = [ # $cols = [
# { name => 'id', oid => 23 }, # { name => 'id', oid => 23 },
# { name => 'title', oid => 25 }, # { name => 'title', oid => 25 },
@ -446,7 +452,7 @@ fail while a transaction object is alive.
my $txn = $conn->txn; my $txn = $conn->txn;
# run queries # run queries
$txn->q('DELETE FROM books WHERE id = $1', 1)->exec; $txn->sql('DELETE FROM books WHERE id = $1', 1)->exec;
# run commands in a subtransaction # run commands in a subtransaction
{ {
@ -467,9 +473,9 @@ Transaction methods:
=item $txn->exec(..) =item $txn->exec(..)
=item $txn->q(..) =item $txn->sql(..)
=item $txn->Q(..) =item $txn->SQL(..)
Run a query inside the transaction. These work the same as the respective Run a query inside the transaction. These work the same as the respective
methods on the parent C<$conn> object. methods on the parent C<$conn> object.
@ -492,7 +498,7 @@ when the object goes out of scope.
=item $txn->text($enable) =item $txn->text($enable)
Set the default settings for new statements created with B<< $txn->q() >>. Set the default settings for new statements created with B<< $txn->sql() >>.
These settings are inherited from the main connection when the transaction is These settings are inherited from the main connection when the transaction is
created. Subtransactions inherit these settings from their parent transaction. created. Subtransactions inherit these settings from their parent transaction.
@ -702,7 +708,7 @@ While C<null> is a valid JSON value, there's currently no way to distinguish
that from SQL C<NULL>. When sending C<undef> as bind parameter, it is sent as that from SQL C<NULL>. When sending C<undef> as bind parameter, it is sent as
SQL C<NULL>. SQL C<NULL>.
If you prefer to work with JSON are raw text values instead, use: If you prefer to work with JSON as raw text values instead, use:
$conn->set_type(json => 'text'); $conn->set_type(json => 'text');

4
FU/SQL.pm
View file

@ -1,4 +1,4 @@
package FU::SQL 1.3; package FU::SQL 1.4;
use v5.36; use v5.36;
use Exporter 'import'; use Exporter 'import';
use Carp 'confess'; use Carp 'confess';
@ -121,7 +121,7 @@ FU::SQL - Small and Safe SQL Query Builder
my $sel = SQL 'SELECT id, name FROM table', WHERE { id => IN([1,2,3]) }; my $sel = SQL 'SELECT id, name FROM table', WHERE { id => IN([1,2,3]) };
my($sql, @params) = $sel->compile; my($sql, $params) = $sel->compile;
=head1 DESCRIPTION =head1 DESCRIPTION

2
FU/Util.pm
View file

@ -1,4 +1,4 @@
package FU::Util 1.3; package FU::Util 1.4;
use v5.36; use v5.36;
use FU::XS; use FU::XS;

2
FU/Validate.pm
View file

@ -1,4 +1,4 @@
package FU::Validate 1.3; package FU::Validate 1.4;
use v5.36; use v5.36;
use experimental 'builtin', 'for_list'; use experimental 'builtin', 'for_list';

2
FU/XMLWriter.pm
View file

@ -1,4 +1,4 @@
package FU::XMLWriter 1.3; package FU::XMLWriter 1.4;
use v5.36; use v5.36;
use Carp 'confess'; use Carp 'confess';
use Exporter 'import'; use Exporter 'import';

2
FU/XS.pm
View file

@ -1,5 +1,5 @@
# This module is for internal use by other FU modules. # This module is for internal use by other FU modules.
package FU::XS 1.3; package FU::XS 1.4;
use Carp; # may be called by XS. use Carp; # may be called by XS.
use XSLoader; use XSLoader;
XSLoader::load('FU'); XSLoader::load('FU');

143
bench.PL
View file

@ -3,6 +3,7 @@
# Can be invoked as: # Can be invoked as:
# ./bench.PL # generates FU/Benchmarks.pod, running new benchmarks as necessary # ./bench.PL # generates FU/Benchmarks.pod, running new benchmarks as necessary
# ./bench.PL id x y # invalidate cache for the (regex-)matching benchmark IDs, x and y and re-run them # ./bench.PL id x y # invalidate cache for the (regex-)matching benchmark IDs, x and y and re-run them
# ./bench.PL exec id x y # Run just the given benchmark and exit
# #
# This script obviously has more dependencies than the FU distribution itself. # This script obviously has more dependencies than the FU distribution itself.
# It's supposed to be used by maintainers, not users. # It's supposed to be used by maintainers, not users.
@ -30,9 +31,14 @@ my %modules = map +($_, eval "require $_; \$${_}::VERSION"), qw/
/; /;
use FU::Pg; use FU::Pg;
my @exec = $ARGV[0] && $ARGV[0] eq 'exec' ? @ARGV[1..3] : ();
my @run = !@exec && @ARGV && (qr/$ARGV[0]/i, $ARGV[1] ? qr/$ARGV[1]/i : qr/.*/, $ARGV[2] ? qr/$ARGV[2]/i : qr/.*/);
my %data; # "id x y" => { id x y rate exists } my %data; # "id x y" => { id x y rate exists }
my @bench; # [ id, text, [ x_1, .. ], [ [ y_1, mod_1, sub_1, .. ], .. ] ]
my %oldmodules; my %oldmodules;
{ if (open my $F, '<', 'FU/Benchmarks.pod') { if (!@exec) {
if (open my $F, '<', 'FU/Benchmarks.pod') {
my $indata; my $indata;
while (<$F>) { while (<$F>) {
chomp; chomp;
@ -43,17 +49,51 @@ my %oldmodules;
@d{qw/id x y rate/} = split /\t/; @d{qw/id x y rate/} = split /\t/;
$data{"$d{id} $d{x} $d{y}"} = \%d; $data{"$d{id} $d{x} $d{y}"} = \%d;
} }
} } }
if (@ARGV) {
my $idre = qr/$ARGV[0]/i;
my $xre = $ARGV[1] ? qr/$ARGV[1]/i : qr/.*/;
my $yre = $ARGV[2] ? qr/$ARGV[2]/i : qr/.*/;
delete $_->{rate} for grep $_->{id} =~ /$idre/ && $_->{x} =~ /$xre/ && $_->{y} =~ /$yre/, values %data;
} }
my @bench; # [ id, text, [ x_1, .. ], [ [ y_1, mod_1, sub_1, .. ], .. ] ] sub fmtbench($id, $text, $xs, $ys) {
my $r = "$text\n\n";
if (@$xs > 1) {
$r .= sprintf '%18s', '';
$r .= sprintf '%12s', $_ for @$xs;
$r .= "\n";
}
for my ($n, $yr) (builtin::indexed @$ys) {
my $x = $xs->[$n];
my ($y, $m, @ys) = @$yr;
$m ||= $y;
$r .= sprintf '%18s', $y;
for my $i (0..$#$xs) {
my $d = $data{"$id $xs->[$i] $y"};
$r .= $d && $d->{rate} ? sprintf '%10d/s', $d->{rate} : sprintf '%12s', '-';
}
$r .= "\n";
}
"$r\n"
}
$SIG{INT} = $SIG{HUP} = sub { exit };
END {
exit if @exec;
open my $F, '>FU/Benchmarks.pod' or die $!;
select $F;
while (<DATA>) {
s/^%/=/;
s#^:modules#join '', map sprintf("=item L<%s> %s\n\n", $_, $modules{$_}), sort keys %modules#e;
s#^:benches (.+)#join '', map fmtbench(@$_), grep $_->[0] =~ /$1/, @bench#e;
print;
}
for (sort keys %data) {
my $b = $data{$_};
print join("\t", map $_//'', @{$b}{qw/ id x y rate /})."\n";
}
}
sub def($id, $text, $xs, @ys) { sub def($id, $text, $xs, @ys) {
for my ($ya) (@ys) { for my ($ya) (@ys) {
my($y, $m, @sub) = @$ya; my($y, $m, @sub) = @$ya;
@ -64,12 +104,6 @@ sub def($id, $text, $xs, @ys) {
$data{$d} ||= { id => $id, x => $x, y => $y }; $data{$d} ||= { id => $id, x => $x, y => $y };
$d = $data{$d}; $d = $data{$d};
$d->{exists} = 1; $d->{exists} = 1;
delete $d->{rate} if !$oldmodules{$m} || $modules{$m} ne $oldmodules{$m};
if (!exists $d->{rate}) {
my $o = timethis -5, $sub[$i], 0, 'none';
$d->{rate} = sprintf '%.0f', $o->iters/$o->real;
printf "%-20s%-12s%-20s%10d/s\n", $id, $x, $y, $d->{rate};
}
} }
} }
push @bench, [ $id, $text, $xs, \@ys ]; push @bench, [ $id, $text, $xs, \@ys ];
@ -200,19 +234,19 @@ def 'xml/a', 'HTML fragment', [ 'Rate' ],
{ {
die "FU_TEST_DB not set.\n" if !$ENV{FU_TEST_DB}; die "FU_TEST_DB not set.\n" if @exec && !$ENV{FU_TEST_DB};
my $pq = Pg::PQ::Conn->new($ENV{FU_TEST_DB}); my $pq = @exec && Pg::PQ::Conn->new($ENV{FU_TEST_DB});
my $fu = FU::Pg->connect($ENV{FU_TEST_DB}); my $fu = @exec && FU::Pg->connect($ENV{FU_TEST_DB});
# XXX: Doesn't support all connection params this way # XXX: Doesn't support all connection params this way
my $dbi = DBI->connect("dbi:Pg:dbname=".$pq->db, $pq->user, $pq->pass, {RaiseError => 1, PrintError => 0}); my $dbi = @exec && DBI->connect("dbi:Pg:dbname=".$pq->db, $pq->user, $pq->pass, {RaiseError => 1, PrintError => 0});
my $small = 'SELECT x, x+1, x+2, x+3, x+4, x+5, x+6, x+7, x+8, x+9 FROM generate_series(-10000::smallint, 9999, 10) x(x)'; my $small = 'SELECT x, x+1, x+2, x+3, x+4, x+5, x+6, x+7, x+8, x+9 FROM generate_series(-10000::smallint, 9999, 10) x(x)';
my $big = 'SELECT x<<5, x<<10, x<<15, x<<20, x<<25, x<<30, x<<35, x<<40, x<<45, x<<50 FROM generate_series(1::bigint, 20000, 1) x(x)'; my $big = 'SELECT x<<5, x<<10, x<<15, x<<20, x<<25, x<<30, x<<35, x<<40, x<<45, x<<50 FROM generate_series(1::bigint, 20000, 1) x(x)';
my sub dbi { my $sum = 0; my $st = $dbi->prepare_cached($_[0]); for my $row ($dbi->selectall_arrayref($st)->@*) { $sum ^= $_ for @$row; } } my sub dbi { my $sum = 0; my $st = $dbi->prepare_cached($_[0]); for my $row ($dbi->selectall_arrayref($st)->@*) { $sum ^= $_ for @$row; } }
my sub pq { my $sum = 0; $pq->prepare('' => $_[0]); for my $row ($pq->execQueryPrepared('')->rows) { $sum ^= $_ for @$row; } } my sub pq { my $sum = 0; $pq->prepare('' => $_[0]); for my $row ($pq->execQueryPrepared('')->rows) { $sum ^= $_ for @$row; } }
my sub fub { my $sum = 0; for my $row ($fu->q($_[0])->alla->@*) { $sum ^= $_ for @$row; } } my sub fub { my $sum = 0; for my $row ($fu->sql($_[0])->alla->@*) { $sum ^= $_ for @$row; } }
my sub fut { my $sum = 0; for my $row ($fu->q($_[0])->text->alla->@*) { $sum ^= $_ for @$row; } } my sub fut { my $sum = 0; for my $row ($fu->sql($_[0])->text->alla->@*) { $sum ^= $_ for @$row; } }
def 'pg/ints', 'Fetch and bitwise-or 20k integers', [ 'Smallint', 'Bigint' ], def 'pg/ints', 'Fetch and bitwise-or 20k integers', [ 'Smallint', 'Bigint' ],
[ 'DBD::Pg', undef, sub { dbi($small) }, sub { dbi($big) } ], [ 'DBD::Pg', undef, sub { dbi($small) }, sub { dbi($big) } ],
@ -227,41 +261,48 @@ def 'xml/a', 'HTML fragment', [ 'Rate' ],
delete @data{ grep !$data{$_}{exists}, keys %data }; delete @data{ grep !$data{$_}{exists}, keys %data };
sub fmtbench($id, $text, $xs, $ys) {
my $r = "$text\n\n"; sub runbench($sub) {
if (@$xs > 1) { my $o = timethis -1, $sub, 0, 'none';
$r .= sprintf '%18s', ''; printf "%.2f\n", $o->iters/$o->real;
$r .= sprintf '%12s', $_ for @$xs; exit;
$r .= "\n";
}
for my ($n, $yr) (builtin::indexed @$ys) {
my $x = $xs->[$n];
my ($y, $m, @ys) = @$yr;
$m ||= $y;
$r .= sprintf '%18s', $y;
for my $i (0..$#$xs) {
my $d = $data{"$id $xs->[$i] $y"};
$r .= $d ? sprintf '%10d/s', $d->{rate} : sprintf '%12s', '-';
}
$r .= "\n";
}
"$r\n"
} }
{ sub execbench($d) {
open my $F, '>FU/Benchmarks.pod' or die $!; my $sum = 0;
select $F; my $num = 1;
while (<DATA>) { local $| = 1;
s/^%/=/; printf "%-20s%-12s%-20s", $d->{id}, $d->{x}, $d->{y};
s#^:modules#join '', map sprintf("=item L<%s> %s\n\n", $_, $modules{$_}), sort keys %modules#e; for (1..$num) {
s#^:benches (.+)#join '', map fmtbench(@$_), grep $_->[0] =~ /$1/, @bench#e; open my $P, '-|', $^X, (map "-I$_", @INC), $0, 'exec', $d->{id}, $d->{x}, $d->{y};
print; chomp(my $rate = <$P>);
printf "%10d", $rate;
$sum += $rate;
} }
for (sort keys %data) { printf " ->%10d\n", $sum/$num;
my $b = $data{$_}; $d->{rate} = sprintf '%.0f', $sum/$num;
print join("\t", @{$b}{qw/ id x y rate /})."\n"; }
for my $b (@bench) {
my ($id, $text, $xs, $ys) = @$b;
for my ($ya) (@$ys) {
my($y, $m, @sub) = @$ya;
$m ||= $y;
for my($i, $x) (builtin::indexed @$xs) {
next if !$sub[$i];
if (@exec) {
runbench $sub[$i] if $exec[0] eq $id && $exec[1] eq $x && $exec[2] eq $y;
} else {
my $d = $data{"$id $x $y"};
execbench $d if !$oldmodules{$m} || $modules{$m} ne $oldmodules{$m}
|| (@run && $id =~ /$run[0]/ && $x =~ /$run[1]/ && $y =~ /$run[2]/);
} }
} }
}
}
die if @exec;
# s/^=/%/ to prevent tools from interpreting the below as POD # s/^=/%/ to prevent tools from interpreting the below as POD
__DATA__ __DATA__

24
c/fcgi.c
View file

@ -18,6 +18,7 @@
#define FUFE_CLEN -5 #define FUFE_CLEN -5
#define FUFE_ABORT -6 /* explicit abort or client-level EOF */ #define FUFE_ABORT -6 /* explicit abort or client-level EOF */
#define FUFE_NOREQ -7 /* protocol-level EOF before we received anything */ #define FUFE_NOREQ -7 /* protocol-level EOF before we received anything */
#define FUFE_SEND -8 /* error in send() */
#define FUFCGI_MAX_DATA 65535 #define FUFCGI_MAX_DATA 65535
@ -177,8 +178,8 @@ static int fufcgi_write_record(fufcgi *ctx, fufcgi_rec *hdr, char *buf) {
buf[7] = 0; buf[7] = 0;
int len = hdr->len + 8; int len = hdr->len + 8;
while (len > 0) { while (len > 0) {
int r = write(ctx->fd, buf, len); int r = send(ctx->fd, buf, len, MSG_NOSIGNAL);
if (r <= 0) return r == 0 ? FUFE_EOF : FUFE_IO; if (r <= 0) return FUFE_SEND;
buf += r; buf += r;
len -= r; len -= r;
} }
@ -409,18 +410,19 @@ static int fufcgi_read_req(pTHX_ fufcgi *ctx, SV *headers, SV *params) {
} }
} }
static void fufcgi_flush(fufcgi *ctx) { static void fufcgi_flush(pTHX_ fufcgi *ctx) {
fufcgi_rec hdr; fufcgi_rec hdr;
if (ctx->len > 0) { if (ctx->len > 0) {
hdr.len = ctx->len; hdr.len = ctx->len;
hdr.type = FCGI_STDOUT; hdr.type = FCGI_STDOUT;
hdr.id = ctx->reqid; hdr.id = ctx->reqid;
fufcgi_write_record(ctx, &hdr, ctx->buf); if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK)
croak("%s\n", strerror(errno));
ctx->len = 0; ctx->len = 0;
} }
} }
static void fufcgi_print(fufcgi *ctx, const char *buf, int len) { static void fufcgi_print(pTHX_ fufcgi *ctx, const char *buf, int len) {
int r; int r;
while (len > 0) { while (len > 0) {
r = len > FUFCGI_MAX_DATA - ctx->len ? FUFCGI_MAX_DATA - ctx->len : len; r = len > FUFCGI_MAX_DATA - ctx->len ? FUFCGI_MAX_DATA - ctx->len : len;
@ -428,23 +430,25 @@ static void fufcgi_print(fufcgi *ctx, const char *buf, int len) {
ctx->len += r; ctx->len += r;
len -= r; len -= r;
buf += r; buf += r;
if (ctx->len >= FUFCGI_MAX_DATA) fufcgi_flush(ctx); if (ctx->len >= FUFCGI_MAX_DATA) fufcgi_flush(aTHX_ ctx);
} }
} }
static void fufcgi_done(fufcgi *ctx) { static void fufcgi_done(pTHX_ fufcgi *ctx) {
fufcgi_rec hdr; fufcgi_rec hdr;
fufcgi_flush(ctx); fufcgi_flush(aTHX_ ctx);
hdr.len = 0; hdr.len = 0;
hdr.type = FCGI_STDOUT; hdr.type = FCGI_STDOUT;
hdr.id = ctx->reqid; hdr.id = ctx->reqid;
fufcgi_write_record(ctx, &hdr, ctx->buf); if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK)
croak("%s\n", strerror(errno));
memcpy(ctx->buf+8, "\0\0\0\0\0\0\0\0", 8); /* FCGI_REQUEST_COMPLETE */ memcpy(ctx->buf+8, "\0\0\0\0\0\0\0\0", 8); /* FCGI_REQUEST_COMPLETE */
hdr.type = FCGI_END_REQUEST; hdr.type = FCGI_END_REQUEST;
hdr.len = 8; hdr.len = 8;
fufcgi_write_record(ctx, &hdr, ctx->buf); if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK)
croak("%s\n", strerror(errno));
ctx->reqid = ctx->len = ctx->off = 0; ctx->reqid = ctx->len = ctx->off = 0;
} }

2
c/pgst.c
View file

@ -76,7 +76,7 @@ static SV *fupg_exec(pTHX_ fupg_conn *c, const char *sql) {
return ret; return ret;
} }
static SV *fupg_q(pTHX_ fupg_conn *c, int stflags, const char *query, I32 ax, I32 argc) { static SV *fupg_sql(pTHX_ fupg_conn *c, int stflags, const char *query, I32 ax, I32 argc) {
fupg_st *st = safecalloc(1, sizeof(fupg_st)); fupg_st *st = safecalloc(1, sizeof(fupg_st));
st->conn = c; st->conn = c;
st->cookie = c->cookie; st->cookie = c->cookie;

7
t/fcgi.t
View file

@ -54,6 +54,11 @@ start;
begin 1, 2; begin 1, 2;
record 1, 4, ""; record 1, 4, "";
start;
begin 3, 2, 1;
$remote->close;
iserr -8;
start; start;
begin 3, 2, 1; begin 3, 2, 1;
begin 1, 1, 1; begin 1, 1, 1;
@ -173,6 +178,8 @@ record 1, 4, "\x13\x01HTTP_CONTENT_LENGTH3\x0e\x01CONTENT_LENGTH0\x13\x01HTTP_CO
record 1, 4, ""; record 1, 4, "";
record 1, 5, ""; record 1, 5, "";
isrec {'content-length','0'}, {body => ''}; isrec {'content-length','0'}, {body => ''};
$remote->close;
ok !eval { $f->flush; 1 };
start; start;
begin; begin;

190
t/pgconnect.t
View file

@ -37,7 +37,7 @@ subtest '$conn->exec', sub {
ok !defined $conn->exec(''); ok !defined $conn->exec('');
is $conn->exec('SELECT 1'), 1; is $conn->exec('SELECT 1'), 1;
ok !eval { $conn->q('SELEXT')->param_types; }; ok !eval { $conn->sql('SELEXT')->param_types; };
okerr ERROR => prepare => qr/syntax error/; okerr ERROR => prepare => qr/syntax error/;
is $conn->exec('SET client_encoding=utf8'), undef; is $conn->exec('SET client_encoding=utf8'), undef;
@ -46,7 +46,7 @@ subtest '$conn->exec', sub {
subtest '$st prepare & exec', sub { subtest '$st prepare & exec', sub {
{ {
my $st = $conn->q('SELECT 1'); my $st = $conn->sql('SELECT 1');
is_deeply $st->param_types, []; is_deeply $st->param_types, [];
is_deeply $st->columns, [{ name => '?column?', oid => 23 }]; is_deeply $st->columns, [{ name => '?column?', oid => 23 }];
@ -63,7 +63,7 @@ subtest '$st prepare & exec', sub {
} }
{ {
my $st = $conn->q("SELECT \$1::int AS a, \$2::char(5) AS \"\x{1F603}\"", 1, 2); my $st = $conn->sql("SELECT \$1::int AS a, \$2::char(5) AS \"\x{1F603}\"", 1, 2);
is_deeply $st->param_types, [ 23, 1042 ]; is_deeply $st->param_types, [ 23, 1042 ];
is_deeply $st->columns, [ is_deeply $st->columns, [
{ oid => 23, name => 'a' }, { oid => 23, name => 'a' },
@ -74,28 +74,28 @@ subtest '$st prepare & exec', sub {
is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 0; is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 0;
ok !eval { $conn->q('SELECT 1', 1)->exec; 1 }; ok !eval { $conn->sql('SELECT 1', 1)->exec; 1 };
like $@, qr/bind message supplies 1 parameters, but prepared statement/; like $@, qr/bind message supplies 1 parameters, but prepared statement/;
ok !eval { $conn->q('SELECT $1')->exec; 1 }; ok !eval { $conn->sql('SELECT $1')->exec; 1 };
like $@, qr/bind message supplies 0 parameters, but prepared statement/; like $@, qr/bind message supplies 0 parameters, but prepared statement/;
# prepare + describe won't let us detect empty queries, hmm... # prepare + describe won't let us detect empty queries, hmm...
is_deeply $conn->q('')->param_types, []; is_deeply $conn->sql('')->param_types, [];
is_deeply $conn->q('')->columns, []; is_deeply $conn->sql('')->columns, [];
ok !eval { $conn->q('')->exec; 1 }; ok !eval { $conn->sql('')->exec; 1 };
okerr FATAL => exec => qr/unexpected status code/; okerr FATAL => exec => qr/unexpected status code/;
is $conn->q('SET client_encoding=utf8')->exec, undef; is $conn->sql('SET client_encoding=utf8')->exec, undef;
ok !eval { $conn->q('select 1; select 2')->exec; 1 }; ok !eval { $conn->sql('select 1; select 2')->exec; 1 };
okerr ERROR => exec => qr/cannot insert multiple commands into a prepared statement/; okerr ERROR => exec => qr/cannot insert multiple commands into a prepared statement/;
# Interleaved # Interleaved
{ {
my $x = $conn->q('SELECT 1 as a'); my $x = $conn->sql('SELECT 1 as a');
my $y = $conn->q('SELECT 2 as b'); my $y = $conn->sql('SELECT 2 as b');
is_deeply $x->columns, [ { oid => 23, name => 'a' } ]; is_deeply $x->columns, [ { oid => 23, name => 'a' } ];
is_deeply $y->columns, [ { oid => 23, name => 'b' } ]; is_deeply $y->columns, [ { oid => 23, name => 'b' } ];
is $x->val, 1; is $x->val, 1;
@ -104,137 +104,137 @@ subtest '$st prepare & exec', sub {
}; };
subtest '$st->val', sub { subtest '$st->val', sub {
ok !eval { $conn->q('SELECT')->val; 1 }; ok !eval { $conn->sql('SELECT')->val; 1 };
like $@, qr/on query returning no data/; like $@, qr/on query returning no data/;
ok !eval { $conn->q('SELECT 1, 2')->val; 1 }; ok !eval { $conn->sql('SELECT 1, 2')->val; 1 };
like $@, qr/on query returning more than one column/; like $@, qr/on query returning more than one column/;
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->val; 1 }; ok !eval { $conn->sql('SELECT 1 UNION SELECT 2')->val; 1 };
like $@, qr/on query returning more than one row/; like $@, qr/on query returning more than one row/;
ok !defined $conn->q('SELECT 1 WHERE false')->val; ok !defined $conn->sql('SELECT 1 WHERE false')->val;
ok !defined $conn->q('SELECT null')->val; ok !defined $conn->sql('SELECT null')->val;
is $conn->q('SELECT $1::text', "\x{1F603}")->val, "\x{1F603}"; is $conn->sql('SELECT $1::text', "\x{1F603}")->val, "\x{1F603}";
}; };
subtest '$st->rowl', sub { subtest '$st->rowl', sub {
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowl; 1 }; ok !eval { $conn->sql('SELECT 1 UNION SELECT 2')->rowl; 1 };
like $@, qr/on query returning more than one row/; like $@, qr/on query returning more than one row/;
ok !eval { $conn->q('SELEXT')->rowl; 1; }; ok !eval { $conn->sql('SELEXT')->rowl; 1; };
is scalar $conn->q('SELECT')->rowl, 0; is scalar $conn->sql('SELECT')->rowl, 0;
is scalar $conn->q('SELECT 1, 2')->rowl, 2; is scalar $conn->sql('SELECT 1, 2')->rowl, 2;
is_deeply [$conn->q('SELECT')->rowl], []; is_deeply [$conn->sql('SELECT')->rowl], [];
is_deeply [$conn->q('SELECT 1, null')->rowl], [1, undef]; is_deeply [$conn->sql('SELECT 1, null')->rowl], [1, undef];
is_deeply [$conn->q('SELECT 1, $1', undef)->rowl], [1, undef]; is_deeply [$conn->sql('SELECT 1, $1', undef)->rowl], [1, undef];
is_deeply [$conn->q('SELECT 1, $1::int', undef)->text_params(0)->rowl], [1, undef]; is_deeply [$conn->sql('SELECT 1, $1::int', undef)->text_params(0)->rowl], [1, undef];
is_deeply [$conn->q('SELECT 1 WHERE false')->rowl], []; is_deeply [$conn->sql('SELECT 1 WHERE false')->rowl], [];
}; };
subtest '$st->rowa', sub { subtest '$st->rowa', sub {
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowa; 1 }; ok !eval { $conn->sql('SELECT 1 UNION SELECT 2')->rowa; 1 };
like $@, qr/on query returning more than one row/; like $@, qr/on query returning more than one row/;
ok !eval { $conn->q('SELEXT')->rowa; 1; }; ok !eval { $conn->sql('SELEXT')->rowa; 1; };
is $conn->q('SELECT 1 WHERE false')->rowa, undef; is $conn->sql('SELECT 1 WHERE false')->rowa, undef;
is_deeply $conn->q('SELECT')->rowa, []; is_deeply $conn->sql('SELECT')->rowa, [];
is_deeply $conn->q('SELECT 1, 2')->rowa, [1, 2]; is_deeply $conn->sql('SELECT 1, 2')->rowa, [1, 2];
is_deeply $conn->q('SELECT 1, null')->rowa, [1, undef]; is_deeply $conn->sql('SELECT 1, null')->rowa, [1, undef];
is_deeply $conn->q('SELECT 1, $1', undef)->rowa, [1, undef]; is_deeply $conn->sql('SELECT 1, $1', undef)->rowa, [1, undef];
is_deeply $conn->q('SELECT 1, $1::int', undef)->text_params(0)->rowa, [1, undef]; is_deeply $conn->sql('SELECT 1, $1::int', undef)->text_params(0)->rowa, [1, undef];
}; };
subtest '$st->rowh', sub { subtest '$st->rowh', sub {
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowh; 1 }; ok !eval { $conn->sql('SELECT 1 UNION SELECT 2')->rowh; 1 };
like $@, qr/on query returning more than one row/; like $@, qr/on query returning more than one row/;
ok !eval { $conn->q('SELECT 1 as a, 2 as a')->rowh; 1 }; ok !eval { $conn->sql('SELECT 1 as a, 2 as a')->rowh; 1 };
like $@, qr/Query returns multiple columns with the same name/; like $@, qr/Query returns multiple columns with the same name/;
is $conn->q('SELECT 1 WHERE false')->rowh, undef; is $conn->sql('SELECT 1 WHERE false')->rowh, undef;
is_deeply $conn->q('SELECT')->rowh, {}; is_deeply $conn->sql('SELECT')->rowh, {};
is_deeply $conn->q('SELECT 1 as a, 2 as b')->rowh, {a => 1, b => 2}; is_deeply $conn->sql('SELECT 1 as a, 2 as b')->rowh, {a => 1, b => 2};
is_deeply $conn->q('SELECT 1 as a, null as b')->rowh, {a => 1, b => undef}; is_deeply $conn->sql('SELECT 1 as a, null as b')->rowh, {a => 1, b => undef};
is_deeply $conn->q('SELECT 1 as a, $1::int as b', undef)->rowh, {a => 1, b => undef}; is_deeply $conn->sql('SELECT 1 as a, $1::int as b', undef)->rowh, {a => 1, b => undef};
}; };
subtest '$st->alla', sub { subtest '$st->alla', sub {
is_deeply $conn->q('SELECT 1 WHERE false')->alla, []; is_deeply $conn->sql('SELECT 1 WHERE false')->alla, [];
is_deeply $conn->q('SELECT')->alla, [[]]; is_deeply $conn->sql('SELECT')->alla, [[]];
is_deeply $conn->q('SELECT 1')->alla, [[1]]; is_deeply $conn->sql('SELECT 1')->alla, [[1]];
is_deeply $conn->q('SELECT 1, null UNION ALL SELECT NULL, 2')->alla, [[1,undef],[undef,2]]; is_deeply $conn->sql('SELECT 1, null UNION ALL SELECT NULL, 2')->alla, [[1,undef],[undef,2]];
}; };
subtest '$st->allh', sub { subtest '$st->allh', sub {
ok !eval { $conn->q('SELECT 1 as a, 2 as a')->allh; 1 }; ok !eval { $conn->sql('SELECT 1 as a, 2 as a')->allh; 1 };
like $@, qr/Query returns multiple columns with the same name/; like $@, qr/Query returns multiple columns with the same name/;
is_deeply $conn->q('SELECT 1 WHERE false')->allh, []; is_deeply $conn->sql('SELECT 1 WHERE false')->allh, [];
is_deeply $conn->q('SELECT')->allh, [{}]; is_deeply $conn->sql('SELECT')->allh, [{}];
is_deeply $conn->q('SELECT 1 a')->allh, [{a=>1}]; is_deeply $conn->sql('SELECT 1 a')->allh, [{a=>1}];
is_deeply $conn->q('SELECT 1 a, null b UNION ALL SELECT NULL, 2')->allh, [{a=>1,b=>undef},{a=>undef,b=>2}]; is_deeply $conn->sql('SELECT 1 a, null b UNION ALL SELECT NULL, 2')->allh, [{a=>1,b=>undef},{a=>undef,b=>2}];
}; };
subtest '$st->flat', sub { subtest '$st->flat', sub {
is_deeply $conn->q('SELECT 1 WHERE false')->flat, []; is_deeply $conn->sql('SELECT 1 WHERE false')->flat, [];
is_deeply $conn->q('SELECT')->flat, []; is_deeply $conn->sql('SELECT')->flat, [];
is_deeply $conn->q('SELECT 1')->flat, [1]; is_deeply $conn->sql('SELECT 1')->flat, [1];
is_deeply $conn->q('SELECT 1, null UNION ALL SELECT NULL, 2')->flat, [1,undef,undef,2]; is_deeply $conn->sql('SELECT 1, null UNION ALL SELECT NULL, 2')->flat, [1,undef,undef,2];
}; };
subtest '$st->kvv', sub { subtest '$st->kvv', sub {
ok !eval { $conn->q('SELECT')->kvv; 1; }; ok !eval { $conn->sql('SELECT')->kvv; 1; };
like $@, qr/returning no data/; like $@, qr/returning no data/;
ok !eval { $conn->q('SELECT 1, 2, 3')->kvv; 1; }; ok !eval { $conn->sql('SELECT 1, 2, 3')->kvv; 1; };
like $@, qr/returning more than two columns/; like $@, qr/returning more than two columns/;
ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kvv; 1; }; ok !eval { $conn->sql('SELECT 1 UNION ALL SELECT 1')->kvv; 1; };
like $@, qr/is duplicated/; like $@, qr/is duplicated/;
is_deeply $conn->q('SELECT 1 WHERE false')->kvv, {}; is_deeply $conn->sql('SELECT 1 WHERE false')->kvv, {};
is_deeply $conn->q('SELECT 1')->kvv, {1=>1}; is_deeply $conn->sql('SELECT 1')->kvv, {1=>1};
is_deeply $conn->q('SELECT 1, null UNION ALL SELECT 3, 2')->kvv, {1=>undef,3=>2}; is_deeply $conn->sql('SELECT 1, null UNION ALL SELECT 3, 2')->kvv, {1=>undef,3=>2};
$conn->q('SELECT 1')->kvv->{1} = 0; $conn->sql('SELECT 1')->kvv->{1} = 0;
}; };
subtest '$st->kva', sub { subtest '$st->kva', sub {
ok !eval { $conn->q('SELECT')->kva; 1; }; ok !eval { $conn->sql('SELECT')->kva; 1; };
like $@, qr/returning no data/; like $@, qr/returning no data/;
ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kva; 1; }; ok !eval { $conn->sql('SELECT 1 UNION ALL SELECT 1')->kva; 1; };
like $@, qr/is duplicated/; like $@, qr/is duplicated/;
is_deeply $conn->q('SELECT 1 WHERE false')->kva, {}; is_deeply $conn->sql('SELECT 1 WHERE false')->kva, {};
is_deeply $conn->q('SELECT 1')->kva, {1=>[]}; is_deeply $conn->sql('SELECT 1')->kva, {1=>[]};
is_deeply $conn->q("SELECT 1, null, 'hi' UNION ALL SELECT 3, 2, 'ok'")->kva, is_deeply $conn->sql("SELECT 1, null, 'hi' UNION ALL SELECT 3, 2, 'ok'")->kva,
{1=>[undef,'hi'], 3=>[2, 'ok']}; {1=>[undef,'hi'], 3=>[2, 'ok']};
}; };
subtest '$st->kvh', sub { subtest '$st->kvh', sub {
ok !eval { $conn->q('SELECT')->kvh; 1; }; ok !eval { $conn->sql('SELECT')->kvh; 1; };
like $@, qr/returning no data/; like $@, qr/returning no data/;
ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kvh; 1; }; ok !eval { $conn->sql('SELECT 1 UNION ALL SELECT 1')->kvh; 1; };
like $@, qr/is duplicated/; like $@, qr/is duplicated/;
ok !eval { $conn->q('SELECT 1, 2, 3')->kvh; 1; }; ok !eval { $conn->sql('SELECT 1, 2, 3')->kvh; 1; };
like $@, qr/Query returns multiple columns with the same name/; like $@, qr/Query returns multiple columns with the same name/;
is_deeply $conn->q('SELECT 1 WHERE false')->kvh, {}; is_deeply $conn->sql('SELECT 1 WHERE false')->kvh, {};
is_deeply $conn->q('SELECT 1')->kvh, {1=>{}}; is_deeply $conn->sql('SELECT 1')->kvh, {1=>{}};
is_deeply $conn->q("SELECT 1 as a , null as a, 'hi' as b UNION ALL SELECT 3, 2, 'ok'")->kvh, is_deeply $conn->sql("SELECT 1 as a , null as a, 'hi' as b UNION ALL SELECT 3, 2, 'ok'")->kvh,
{1=>{a=>undef,b=>'hi'}, 3=>{a=>2,b=>'ok'}}; {1=>{a=>undef,b=>'hi'}, 3=>{a=>2,b=>'ok'}};
}; };
subtest 'txn', sub { subtest 'txn', sub {
$conn->exec('CREATE TEMPORARY TABLE fupg_tst (id int)'); $conn->exec('CREATE TEMPORARY TABLE fupg_tst (id int)');
$conn->txn->exec('INSERT INTO fupg_tst VALUES (1)'); # rolled back $conn->txn->exec('INSERT INTO fupg_tst VALUES (1)'); # rolled back
is $conn->q('SELECT COUNT(*) FROM fupg_tst')->val, 0; is $conn->sql('SELECT COUNT(*) FROM fupg_tst')->val, 0;
my $st = $conn->q('SELECT COUNT(*) FROM fupg_tst'); my $st = $conn->sql('SELECT COUNT(*) FROM fupg_tst');
my $sst; my $sst;
{ {
my $txn = $conn->txn; my $txn = $conn->txn;
@ -246,13 +246,13 @@ subtest 'txn', sub {
ok !eval { $conn->exec('SELECT 1'); 1 }; ok !eval { $conn->exec('SELECT 1'); 1 };
like $@, qr/Invalid operation on the top-level connection/; like $@, qr/Invalid operation on the top-level connection/;
ok !eval { $conn->q('SELECT 1'); 1 }; ok !eval { $conn->sql('SELECT 1'); 1 };
like $@, qr/Invalid operation on the top-level connection/; like $@, qr/Invalid operation on the top-level connection/;
ok !eval { $conn->txn; 1 }; ok !eval { $conn->txn; 1 };
like $@, qr/Invalid operation on the top-level connection/; like $@, qr/Invalid operation on the top-level connection/;
$txn->exec('INSERT INTO fupg_tst VALUES (1)'); $txn->exec('INSERT INTO fupg_tst VALUES (1)');
$sst = $txn->q('SELECT 1'); $sst = $txn->sql('SELECT 1');
is $conn->status, 'txn_idle'; is $conn->status, 'txn_idle';
is $txn->status, 'idle'; is $txn->status, 'idle';
@ -268,7 +268,7 @@ subtest 'txn', sub {
like $@, qr/Invalid operation on a transaction that has already been marked as done/; like $@, qr/Invalid operation on a transaction that has already been marked as done/;
ok !eval { $txn->exec('select 1'); 1 }; ok !eval { $txn->exec('select 1'); 1 };
like $@, qr/Invalid operation on a transaction that has already been marked as done/; like $@, qr/Invalid operation on a transaction that has already been marked as done/;
ok !eval { $txn->q('select 1'); 1 }; ok !eval { $txn->sql('select 1'); 1 };
like $@, qr/Invalid operation on a transaction that has already been marked as done/; like $@, qr/Invalid operation on a transaction that has already been marked as done/;
ok !eval { $conn->exec('SELECT 1'); 1 }; ok !eval { $conn->exec('SELECT 1'); 1 };
@ -295,7 +295,7 @@ subtest 'txn', sub {
{ {
my $txn = $conn->txn; my $txn = $conn->txn;
my $st = $txn->q('SELECT count(*) FROM fupg_tst WHERE id = 2'); my $st = $txn->sql('SELECT count(*) FROM fupg_tst WHERE id = 2');
{ {
my $sub = $txn->txn; my $sub = $txn->txn;
is $conn->status, 'txn_idle'; is $conn->status, 'txn_idle';
@ -316,7 +316,7 @@ subtest 'txn', sub {
is $txn->status, 'idle'; is $txn->status, 'idle';
is $st->val, 0; is $st->val, 0;
$st = $txn->q('SELECT count(*) FROM fupg_tst WHERE id = 2'); $st = $txn->sql('SELECT count(*) FROM fupg_tst WHERE id = 2');
{ {
my $sub = $txn->txn; my $sub = $txn->txn;
$sub->exec('INSERT INTO fupg_tst VALUES (2)'); $sub->exec('INSERT INTO fupg_tst VALUES (2)');
@ -339,19 +339,19 @@ subtest 'txn', sub {
$sub->commit; $sub->commit;
} }
# We didn't commit $txn, so $sub got aborted as well # We didn't commit $txn, so $sub got aborted as well
is $conn->q('SELECT count(*) FROM fupg_tst WHERE id = 3')->val, 0; is $conn->sql('SELECT count(*) FROM fupg_tst WHERE id = 3')->val, 0;
}; };
{ {
local $_ = 'x'; local $_ = 'x';
my $st = $conn->q('SELECT $1', $_); my $st = $conn->sql('SELECT $1', $_);
$_ = 'y'; $_ = 'y';
is $st->val, 'x', 'shallow copy'; is $st->val, 'x', 'shallow copy';
} }
{ {
my $x = [1,2]; my $x = [1,2];
my $st = $conn->q('SELECT $1::int[]', $x)->text(0); my $st = $conn->sql('SELECT $1::int[]', $x)->text(0);
$x->[1] = 3; $x->[1] = 3;
is_deeply $st->val, [1,3], 'not deep copy'; is_deeply $st->val, [1,3], 'not deep copy';
} }
@ -360,7 +360,7 @@ subtest 'txn', sub {
{ {
# Exact format returned by escape_literal() can differ between Postgres versions and configurations. # Exact format returned by escape_literal() can differ between Postgres versions and configurations.
my $x = q{"' \" \\}; my $x = q{"' \" \\};
is $conn->q('SELECT '.$conn->escape_literal($x))->val, $x; is $conn->sql('SELECT '.$conn->escape_literal($x))->val, $x;
# Format can also change, but unsure how to test this otherwise. # Format can also change, but unsure how to test this otherwise.
is $conn->escape_identifier('hel\l"o'), '"hel\l""o"'; is $conn->escape_identifier('hel\l"o'), '"hel\l""o"';
@ -371,32 +371,32 @@ subtest 'Prepared statement cache', sub {
my $txn = $conn->txn; my $txn = $conn->txn;
$txn->cache; $txn->cache;
my $numexec = sub($sql) { my $numexec = sub($sql) {
$txn->q('SELECT generic_plans + custom_plans FROM pg_prepared_statements WHERE statement = $1', $sql)->cache(0)->val $txn->sql('SELECT generic_plans + custom_plans FROM pg_prepared_statements WHERE statement = $1', $sql)->cache(0)->val
}; };
is $txn->q('SELECT 1')->val, 1; is $txn->sql('SELECT 1')->val, 1;
is $numexec->('SELECT 1'), 1; is $numexec->('SELECT 1'), 1;
my $sql = 'SELECT $1::int as a, $2::text as b'; my $sql = 'SELECT $1::int as a, $2::text as b';
ok !defined $numexec->($sql); ok !defined $numexec->($sql);
my $params = $txn->q($sql)->param_types; my $params = $txn->sql($sql)->param_types;
is_deeply $params, [23, 25]; is_deeply $params, [23, 25];
is $numexec->($sql), 0; is $numexec->($sql), 0;
my $cparams = $txn->q($sql)->param_types; my $cparams = $txn->sql($sql)->param_types;
is_deeply $cparams, $params; is_deeply $cparams, $params;
my $cols = $txn->q($sql)->columns; my $cols = $txn->sql($sql)->columns;
is_deeply $cols, [{ name => 'a', oid => 23 }, { name => 'b', oid => 25 }]; is_deeply $cols, [{ name => 'a', oid => 23 }, { name => 'b', oid => 25 }];
my $ccols = $txn->q($sql)->columns; my $ccols = $txn->sql($sql)->columns;
is_deeply $ccols, $cols; is_deeply $ccols, $cols;
$txn->q($sql, 0, '')->exec; $txn->sql($sql, 0, '')->exec;
is $numexec->($sql), 1; is $numexec->($sql), 1;
$txn->q($sql, 0, '')->exec; $txn->sql($sql, 0, '')->exec;
is $numexec->($sql), 2; is $numexec->($sql), 2;
is $numexec->('SELECT 1'), 1; is $numexec->('SELECT 1'), 1;
$txn->q('SELECT 2')->exec; $txn->sql('SELECT 2')->exec;
ok !defined $numexec->('SELECT 1'); ok !defined $numexec->('SELECT 1');
is $numexec->('SELECT 2'), 1; is $numexec->('SELECT 2'), 1;
@ -415,7 +415,7 @@ subtest 'Tracing', sub {
my @log; my @log;
$conn->query_trace(sub($st) { push @log, $st }); $conn->query_trace(sub($st) { push @log, $st });
is_deeply $conn->q('SELECT 1 AS a, $1 AS b', 123)->text_params(0)->rowa, [ 1, 123 ]; is_deeply $conn->sql('SELECT 1 AS a, $1 AS b', 123)->text_params(0)->rowa, [ 1, 123 ];
is scalar @log, 1; is scalar @log, 1;
my $st = shift @log; my $st = shift @log;
is ref $st, 'FU::Pg::st'; is ref $st, 'FU::Pg::st';
@ -451,7 +451,7 @@ subtest 'Tracing', sub {
}; };
{ {
my $st = $conn->q("SELECT 1"); my $st = $conn->sql("SELECT 1");
undef $conn; # statement keeps the connection alive undef $conn; # statement keeps the connection alive
is $st->val, 1; is $st->val, 1;
} }

4
t/pgcopy.t
View file

@ -82,9 +82,9 @@ is $conn->status, 'idle';
$c->write($bin); $c->write($bin);
$c->close; $c->close;
is $txn->q('SELECT sum(v) FROM fupg_copy_test')->val, 1+1+2+2+3+3; is $txn->sql('SELECT sum(v) FROM fupg_copy_test')->val, 1+1+2+2+3+3;
$txn->rollback; $txn->rollback;
} }
is $conn->q('SELECT sum(v) FROM fupg_copy_test')->val, 1+2+3; is $conn->sql('SELECT sum(v) FROM fupg_copy_test')->val, 1+2+3;
done_testing; done_testing;

100
t/pgtypes-dynamic.t
View file

@ -10,31 +10,31 @@ my $conn = FU::Pg->connect($ENV{FU_TEST_DB});
$conn->_debug_trace(0); $conn->_debug_trace(0);
is_deeply $conn->Q('SELECT', 1, '::int')->param_types, [23]; is_deeply $conn->SQL('SELECT', 1, '::int')->param_types, [23];
is_deeply $conn->Q('SELECT 1', IN([1,2,3]))->param_types, [1007]; is_deeply $conn->SQL('SELECT 1', IN([1,2,3]))->param_types, [1007];
is $conn->Q('SELECT 1', IN([1,2,3]))->val, 1; is $conn->SQL('SELECT 1', IN([1,2,3]))->val, 1;
ok !eval { $conn->q('SELECT $1::aclitem', '')->exec; 1 }; ok !eval { $conn->sql('SELECT $1::aclitem', '')->exec; 1 };
like $@, qr/Unable to send type/; like $@, qr/Unable to send type/;
subtest 'type overrides', sub { subtest 'type overrides', sub {
$conn->set_type(int4 => recv => 'bytea'); $conn->set_type(int4 => recv => 'bytea');
is $conn->q('SELECT 5::int4')->val, "\0\0\0\5"; is $conn->sql('SELECT 5::int4')->val, "\0\0\0\5";
is_deeply $conn->q('SELECT ARRAY[5::int4]')->val, ["\0\0\0\5"]; is_deeply $conn->sql('SELECT ARRAY[5::int4]')->val, ["\0\0\0\5"];
$conn->set_type(int4 => send => 'bytea'); $conn->set_type(int4 => send => 'bytea');
is $conn->q('SELECT $1::int4', "\0\0\0\5")->val, 5; is $conn->sql('SELECT $1::int4', "\0\0\0\5")->val, 5;
is_deeply $conn->q('SELECT $1::int4[]', ["\0\0\0\5"])->val, [5]; is_deeply $conn->sql('SELECT $1::int4[]', ["\0\0\0\5"])->val, [5];
$conn->set_type(int4 => 'int2'); $conn->set_type(int4 => 'int2');
ok !eval { $conn->q('SELECT 5::int4')->val }; ok !eval { $conn->sql('SELECT 5::int4')->val };
like $@, qr/Error parsing value/; like $@, qr/Error parsing value/;
ok !eval { $conn->q('SELECT $1::int4', 5)->val }; ok !eval { $conn->sql('SELECT $1::int4', 5)->val };
like $@, qr/insufficient data left in message/; like $@, qr/insufficient data left in message/;
$conn->set_type(int4 => undef); $conn->set_type(int4 => undef);
is $conn->q('SELECT 5::int4')->val, 5; is $conn->sql('SELECT 5::int4')->val, 5;
ok !eval { $conn->set_type(int4 => 1007); }; ok !eval { $conn->set_type(int4 => 1007); };
like $@, qr/Cannot set a type to array/; like $@, qr/Cannot set a type to array/;
@ -46,23 +46,23 @@ subtest 'type overrides', sub {
subtest 'type override callback', sub { subtest 'type override callback', sub {
$conn->set_type(text => recv => sub { length $_[0] }); $conn->set_type(text => recv => sub { length $_[0] });
is $conn->q('SELECT $1', 'a')->val, 1; is $conn->sql('SELECT $1', 'a')->val, 1;
is $conn->q('SELECT $1', 'ab')->val, 2; is $conn->sql('SELECT $1', 'ab')->val, 2;
is $conn->q('SELECT $1', 'abc')->val, 3; is $conn->sql('SELECT $1', 'abc')->val, 3;
is $conn->q('SELECT $1', 'abcd')->val, 4; is $conn->sql('SELECT $1', 'abcd')->val, 4;
$conn->set_type(text => send => sub { 'l'.length $_[0] }); $conn->set_type(text => send => sub { 'l'.length $_[0] });
is $conn->q('SELECT $1', 'a')->val, 'l1'; is $conn->sql('SELECT $1', 'a')->val, 'l1';
is $conn->q('SELECT $1', 'ab')->val, 'l2'; is $conn->sql('SELECT $1', 'ab')->val, 'l2';
is $conn->q('SELECT $1', 'abc')->val, 'l3'; is $conn->sql('SELECT $1', 'abc')->val, 'l3';
is $conn->q('SELECT $1', 'abcd')->val, 'l4'; is $conn->sql('SELECT $1', 'abcd')->val, 'l4';
}; };
subtest 'custom types', sub { subtest 'custom types', sub {
my $txn = $conn->txn; my $txn = $conn->txn;
is $txn->Q('SELECT 1', IN([1,2,3]))->val, 1; is $txn->SQL('SELECT 1', IN([1,2,3]))->val, 1;
$txn->exec(<<~_); $txn->exec(<<~_);
CREATE TYPE fupg_test_enum AS ENUM('aa', 'bb', 'ccccccccccccccccccc'); CREATE TYPE fupg_test_enum AS ENUM('aa', 'bb', 'ccccccccccccccccccc');
@ -73,21 +73,21 @@ subtest 'custom types', sub {
domain fupg_test_domain domain fupg_test_domain
); );
_ _
is $txn->q("SELECT 'aa'::fupg_test_enum")->val, 'aa'; is $txn->sql("SELECT 'aa'::fupg_test_enum")->val, 'aa';
is $txn->q('SELECT $1::fupg_test_enum', 'ccccccccccccccccccc')->val, 'ccccccccccccccccccc'; is $txn->sql('SELECT $1::fupg_test_enum', 'ccccccccccccccccccc')->val, 'ccccccccccccccccccc';
is_deeply $txn->q("SELECT '{aa,bb,null}'::fupg_test_enum[]")->val, ['aa','bb',undef]; is_deeply $txn->sql("SELECT '{aa,bb,null}'::fupg_test_enum[]")->val, ['aa','bb',undef];
is $txn->q('SELECT $1::fupg_test_enum[]', ['aa','bb',undef])->text_results->val, '{aa,bb,NULL}'; is $txn->sql('SELECT $1::fupg_test_enum[]', ['aa','bb',undef])->text_results->val, '{aa,bb,NULL}';
is $txn->q("SELECT 'aa'::fupg_test_domain")->val, 'aa'; is $txn->sql("SELECT 'aa'::fupg_test_domain")->val, 'aa';
is $txn->q('SELECT $1::fupg_test_domain', 'bb')->val, 'bb'; is $txn->sql('SELECT $1::fupg_test_domain', 'bb')->val, 'bb';
is_deeply $txn->q("SELECT '{aa,bb,null}'::fupg_test_domain[]")->val, ['aa','bb',undef]; is_deeply $txn->sql("SELECT '{aa,bb,null}'::fupg_test_domain[]")->val, ['aa','bb',undef];
is $txn->q('SELECT $1::fupg_test_domain[]', ['aa','bb',undef])->text_results->val, '{aa,bb,NULL}'; is $txn->sql('SELECT $1::fupg_test_domain[]', ['aa','bb',undef])->text_results->val, '{aa,bb,NULL}';
my $val = { a => undef, aenum => ['aa','bb'], domain => 'aa' }; my $val = { a => undef, aenum => ['aa','bb'], domain => 'aa' };
is_deeply $txn->q("SELECT '(,\"{aa,bb}\",aa)'::fupg_test_record")->val, $val; is_deeply $txn->sql("SELECT '(,\"{aa,bb}\",aa)'::fupg_test_record")->val, $val;
is $txn->q('SELECT $1::fupg_test_record', $val)->text_results->val, '(,"{aa,bb}",aa)'; is $txn->sql('SELECT $1::fupg_test_record', $val)->text_results->val, '(,"{aa,bb}",aa)';
$txn->exec(<<~_); $txn->exec(<<~_);
CREATE TEMPORARY TABLE fupg_test_table ( CREATE TEMPORARY TABLE fupg_test_table (
@ -96,7 +96,7 @@ subtest 'custom types', sub {
); );
_ _
$val = $txn->q(q{SELECT '{"(\"(2,{},bb)\",)","(\"(,,)\",bb)"}'::fupg_test_table[]})->val; $val = $txn->sql(q{SELECT '{"(\"(2,{},bb)\",)","(\"(,,)\",bb)"}'::fupg_test_table[]})->val;
is_deeply $val, [ is_deeply $val, [
{ rec => { a => 2, aenum => [], domain => 'bb' }, dom => undef }, { rec => { a => 2, aenum => [], domain => 'bb' }, dom => undef },
{ rec => { a => undef, aenum => undef, domain => undef }, dom => 'bb' }, { rec => { a => undef, aenum => undef, domain => undef }, dom => 'bb' },
@ -106,7 +106,7 @@ subtest 'custom types', sub {
$val->[1]{rec} = 0; $val->[1]{rec} = 0;
$val->[1]{dom} = 0; $val->[1]{dom} = 0;
is $txn->q('SELECT $1::fupg_test_table[]', [ is $txn->sql('SELECT $1::fupg_test_table[]', [
{ rec => { a => 2, aenum => [], domain => 'bb' }, dom => undef }, { rec => { a => 2, aenum => [], domain => 'bb' }, dom => undef },
{ rec => {}, dom => 'bb', extra => 1 }, { rec => {}, dom => 'bb', extra => 1 },
])->text_results->val, '{"(\"(2,{},bb)\",)","(\"(,,)\",bb)"}'; ])->text_results->val, '{"(\"(2,{},bb)\",)","(\"(,,)\",bb)"}';
@ -114,46 +114,46 @@ subtest 'custom types', sub {
# Wonky Postgres behavior: selecting a domain directly actually returns the # Wonky Postgres behavior: selecting a domain directly actually returns the
# underlying type, but going through an array does work. # underlying type, but going through an array does work.
$conn->set_type(fupg_test_domain => 21); $conn->set_type(fupg_test_domain => 21);
is_deeply $txn->q("SELECT ARRAY['aa'::fupg_test_domain]")->val, [0x6161]; is_deeply $txn->sql("SELECT ARRAY['aa'::fupg_test_domain]")->val, [0x6161];
# Bind param type doesn't match column type, argh. # Bind param type doesn't match column type, argh.
is $txn->q('SELECT $1::fupg_test_domain', 0x6161)->val, 'aa'; is $txn->sql('SELECT $1::fupg_test_domain', 0x6161)->val, 'aa';
# Same for selecting from a table :( # Same for selecting from a table :(
$txn->exec("INSERT INTO fupg_test_table VALUES (NULL, 'bb')"); $txn->exec("INSERT INTO fupg_test_table VALUES (NULL, 'bb')");
is $txn->q("SELECT dom FROM fupg_test_table")->val, 'bb'; is $txn->sql("SELECT dom FROM fupg_test_table")->val, 'bb';
$conn->set_type(fupg_test_enum => 21); $conn->set_type(fupg_test_enum => 21);
is $txn->q("SELECT dom FROM fupg_test_table")->val, 0x6262; is $txn->sql("SELECT dom FROM fupg_test_table")->val, 0x6262;
}; };
subtest 'identifier quoting', sub { subtest 'identifier quoting', sub {
my $txn = $conn->txn; my $txn = $conn->txn;
$txn->exec('CREATE TEMPORARY TABLE fupg_test_tbl ("desc" int, ok int, "hello world" int)'); $txn->exec('CREATE TEMPORARY TABLE fupg_test_tbl ("desc" int, ok int, "hello world" int)');
ok $txn->Q('INSERT INTO fupg_test_tbl', VALUES {desc => 5, ok => 10, 'hello world', 15})->exec; ok $txn->SQL('INSERT INTO fupg_test_tbl', VALUES {desc => 5, ok => 10, 'hello world', 15})->exec;
is $txn->Q('SELECT', IDENT 'hello world', 'FROM fupg_test_tbl')->val, 15; is $txn->SQL('SELECT', IDENT 'hello world', 'FROM fupg_test_tbl')->val, 15;
}; };
subtest 'vndbid', sub { subtest 'vndbid', sub {
plan skip_all => 'type not loaded in the database' if !$conn->q("SELECT 1 FROM pg_type WHERE typname = 'vndbtag'")->val; plan skip_all => 'type not loaded in the database' if !$conn->sql("SELECT 1 FROM pg_type WHERE typname = 'vndbtag'")->val;
for my $t (qw/a zz xxx/) { for my $t (qw/a zz xxx/) {
is $conn->q('SELECT $1::vndbtag', $t)->val, $t; is $conn->sql('SELECT $1::vndbtag', $t)->val, $t;
is $conn->q('SELECT $1::vndbtag', $t)->text_params->val, $t; is $conn->sql('SELECT $1::vndbtag', $t)->text_params->val, $t;
is $conn->q('SELECT $1::vndbtag', $t)->text_results->val, $t; is $conn->sql('SELECT $1::vndbtag', $t)->text_results->val, $t;
} }
ok !eval { $conn->q('SELECT $1::vndbtag', '')->val }; ok !eval { $conn->sql('SELECT $1::vndbtag', '')->val };
ok !eval { $conn->q('SELECT $1::vndbtag', 'abcd')->val }; ok !eval { $conn->sql('SELECT $1::vndbtag', 'abcd')->val };
for my $t (qw/a123 zz992883231 xxx18388123/) { for my $t (qw/a123 zz992883231 xxx18388123/) {
is $conn->q('SELECT $1::vndbid', $t)->val, $t; is $conn->sql('SELECT $1::vndbid', $t)->val, $t;
is $conn->q('SELECT $1::vndbid', $t)->text_params->val, $t; is $conn->sql('SELECT $1::vndbid', $t)->text_params->val, $t;
is $conn->q('SELECT $1::vndbid', $t)->text_results->val, $t; is $conn->sql('SELECT $1::vndbid', $t)->text_results->val, $t;
} }
ok !eval { $conn->q('SELECT $1::vndbid', '')->val }; ok !eval { $conn->sql('SELECT $1::vndbid', '')->val };
ok !eval { $conn->q('SELECT $1::vndbid', 'ab')->val }; ok !eval { $conn->sql('SELECT $1::vndbid', 'ab')->val };
ok !eval { $conn->q('SELECT $1::vndbid', 'ab1219229999999999')->val }; ok !eval { $conn->sql('SELECT $1::vndbid', 'ab1219229999999999')->val };
}; };
done_testing; done_testing;

20
t/pgtypes.t
View file

@ -22,7 +22,7 @@ sub v($type, $p_in, @args) {
my $oid; my $oid;
utf8::encode($test); utf8::encode($test);
{ {
my $st = $conn->q("SELECT \$1::$type", $s_in)->text_params; my $st = $conn->sql("SELECT \$1::$type", $s_in)->text_params;
$oid = $st->param_types->[0]; $oid = $st->param_types->[0];
my $array = $st->flat; my $array = $st->flat;
my $res = $array->[0]; my $res = $array->[0];
@ -32,11 +32,11 @@ sub v($type, $p_in, @args) {
$array->[0] = 0; # Must be writable $array->[0] = 0; # Must be writable
} }
{ {
my $res = $conn->q("SELECT \$1::$type", $p_in)->text_results->val; my $res = $conn->sql("SELECT \$1::$type", $p_in)->text_results->val;
is $res, $s_out, "$test bin->text"; is $res, $s_out, "$test bin->text";
} }
{ {
my $res = $conn->q("SELECT \$1::$type", $p_in)->val; my $res = $conn->sql("SELECT \$1::$type", $p_in)->val;
is_deeply $res, $p_out, "$test bin->bin"; is_deeply $res, $p_out, "$test bin->bin";
} }
{ {
@ -52,11 +52,11 @@ sub v($type, $p_in, @args) {
sub f($type, $p_in) { sub f($type, $p_in) {
my $test = "$type $p_in" =~ s/\n/\\n/rg; my $test = "$type $p_in" =~ s/\n/\\n/rg;
utf8::encode($test); utf8::encode($test);
ok !eval { $conn->q("SELECT \$1::$type", $p_in)->val; 1 }, "$test fail"; ok !eval { $conn->sql("SELECT \$1::$type", $p_in)->val; 1 }, "$test fail";
} }
{ # void { # void
my $array = $conn->q('SELECT pg_sleep(0)')->flat; my $array = $conn->sql('SELECT pg_sleep(0)')->flat;
ok !defined $array->[0]; ok !defined $array->[0];
$array->[0] = 0; $array->[0] = 0;
} }
@ -187,11 +187,11 @@ f 'oidvector', [undef];
# Example from https://www.postgresql.org/docs/17/arrays.html#ARRAYS-IO # Example from https://www.postgresql.org/docs/17/arrays.html#ARRAYS-IO
# Lower bounds are discarded. # Lower bounds are discarded.
is_deeply $conn->q("SELECT '[1:1][-2:-1][3:5]={{{1,2,3},{4,5,6}}}'::int[]")->val, [[[1,2,3],[4,5,6]]]; is_deeply $conn->sql("SELECT '[1:1][-2:-1][3:5]={{{1,2,3},{4,5,6}}}'::int[]")->val, [[[1,2,3],[4,5,6]]];
is $conn->q('SELECT ($1::int2[])[2]', [1,2,3,4])->val, 2; is $conn->sql('SELECT ($1::int2[])[2]', [1,2,3,4])->val, 2;
is $conn->q('SELECT ($1::int2vector)[1]', [1,2,3,4])->val, 2; is $conn->sql('SELECT ($1::int2vector)[1]', [1,2,3,4])->val, 2;
is $conn->q('SELECT ($1::oidvector)[1]', [1,2,3,4])->val, 2; is $conn->sql('SELECT ($1::oidvector)[1]', [1,2,3,4])->val, 2;
is_deeply [$conn->bin2text( is_deeply [$conn->bin2text(
16, $conn->perl2bin(16, 1), 16, $conn->perl2bin(16, 1),
@ -207,7 +207,7 @@ is_deeply [$conn->bin2text(
} }
{ {
my $v = $conn->q("SELECT '{t,f,NULL}'::bool[]")->val; my $v = $conn->sql("SELECT '{t,f,NULL}'::bool[]")->val;
is_deeply $v, [true, false, undef]; is_deeply $v, [true, false, undef];
$_ = 0 for @$v; $_ = 0 for @$v;
} }