From 2e9a40da69ee11b1e081e0136667dede19ca03f6 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Fri, 22 Aug 2025 09:21:06 +0200 Subject: [PATCH 01/11] More strict UTF-8 validation on input --- FU.pm | 2 +- FU/Util.pm | 6 +++++- t/query.t | 3 +++ 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/FU.pm b/FU.pm index 3a8c94c..f43dbaf 100644 --- a/FU.pm +++ b/FU.pm @@ -1267,7 +1267,7 @@ handler being run. Any other exception is passed to the C<500> error handler. While the C namespace is used for global configuration and utility functions, the C object is intended for methods that deal with request -processing (although some are useful used outside of request handlers as well). +processing (although some are useful outside of request handlers as well). The C object itself can be used to store request-local data. For example, the following is a valid approach to handle user authentication: diff --git a/FU/Util.pm b/FU/Util.pm index 3228694..2074ada 100644 --- a/FU/Util.pm +++ b/FU/Util.pm @@ -4,6 +4,7 @@ use v5.36; use FU::XS; use Carp 'confess'; use Exporter 'import'; +use Encode (); use POSIX (); use experimental 'builtin'; @@ -19,7 +20,10 @@ our @EXPORT_OK = qw/ sub utf8_decode :prototype($) { return if !defined $_[0]; - confess 'Invalid UTF-8' if !utf8::decode($_[0]); + eval { + $_[0] = Encode::decode('UTF-8', $_[0], Encode::FB_CROAK); + 1 + } || confess($@ =~ s/ at .+\n$//r); confess 'Invalid control character' if $_[0] =~ /[\x00-\x08\x0b\x0c\x0e-\x1f\x7f]/; $_[0] } diff --git a/t/query.t b/t/query.t index 80f2b00..9d1ca4a 100644 --- a/t/query.t +++ b/t/query.t @@ -10,6 +10,9 @@ is_deeply ok !eval { query_decode('%10'); 1 }; like $@, qr/Invalid control character/; +ok !eval { query_decode('a=%fe%83%bf%bf%bf%bf%bf%0a'); 1 }; +like $@, qr/does not map to Unicode/; + is_deeply query_decode('&&&a=b'), { a => 'b' }; is query_encode From a8ac435f85724acd2caef107e907abcebc7c6e1b Mon Sep 17 00:00:00 2001 From: Yorhel Date: Fri, 22 Aug 2025 09:51:56 +0200 Subject: [PATCH 02/11] Move control character checking to FU::Validate, deprecate FU::Util::utf8_decode() URI, JSON and formdata decoding no longer checks for control characters, but FU::Validate now rejects control characters by default. This decouples semantic validation from format parsing and gives better control over when control characters are allowed. --- FU.pm | 2 +- FU/MultipartFormData.pm | 4 +--- FU/Util.pm | 35 ++++++++++------------------------- FU/Validate.pm | 23 +++++++++++++++++++---- c/jsonparse.c | 11 +++-------- t/json_parse.t | 6 +----- t/query.t | 3 --- t/validate.t | 4 ++++ 8 files changed, 39 insertions(+), 49 deletions(-) diff --git a/FU.pm b/FU.pm index f43dbaf..2fabf2a 100644 --- a/FU.pm +++ b/FU.pm @@ -312,7 +312,7 @@ sub _read_req($c) { ($REQ->{path}, my $qs) = split /\?/, $REQ->{path}//'', 2; $REQ->{qs} //= $qs; - eval { $REQ->{path} = FU::Util::uri_unescape($REQ->{path}); 1; } || fu->error(400, $@); + eval { $REQ->{path} = FU::Util::uri_unescape($REQ->{path}); FU::Util::check_control($REQ->{path}); 1; } || fu->error(400, $@); fu->error(400, 'Invalid character in path') if $REQ->{path} =~ /[\r\n\t]/; # There are plenty other questionable characters, but newlines and tabs are definitely out } diff --git a/FU/MultipartFormData.pm b/FU/MultipartFormData.pm index e6b44e2..14ce323 100644 --- a/FU/MultipartFormData.pm +++ b/FU/MultipartFormData.pm @@ -175,9 +175,7 @@ this on large fields. =item value -Returns a copy of the field value as a Unicode string. Uses C -from L, so also throws an error if the value contains control -characters. +Returns a copy of the field value as a Unicode string. =item substr($off, $len) diff --git a/FU/Util.pm b/FU/Util.pm index 2074ada..77635a2 100644 --- a/FU/Util.pm +++ b/FU/Util.pm @@ -11,20 +11,26 @@ use experimental 'builtin'; our @EXPORT_OK = qw/ to_bool json_format json_parse - utf8_decode uri_escape uri_unescape + has_control check_control utf8_decode + uri_escape uri_unescape query_decode query_encode httpdate_format httpdate_parse gzip_lib gzip_compress brotli_compress fdpass_send fdpass_recv /; + +# Internal utility function +sub has_control :prototype($) ($s) { defined $s && $s =~ /[\x00-\x08\x0b\x0c\x0e-\x1f\x7f]/ } +sub check_control :prototype($) ($s) { confess 'Invalid control character' if has_control $s; } + +# Deprecated, call Encode::decode() directly. sub utf8_decode :prototype($) { return if !defined $_[0]; eval { $_[0] = Encode::decode('UTF-8', $_[0], Encode::FB_CROAK); 1 } || confess($@ =~ s/ at .+\n$//r); - confess 'Invalid control character' if $_[0] =~ /[\x00-\x08\x0b\x0c\x0e-\x1f\x7f]/; $_[0] } @@ -175,13 +181,6 @@ Supported C<%options>: =over -=item allow_control - -Boolean, set to true to allow (encoded) ASCII control characters in JSON -strings, such as C<\u0000>, C<\b>, C<\u007f>, etc. These characters are -permitted per RFC-8259, but disallowed by this parser by default. See -C below. - =item utf8 Boolean, interpret the input C<$string> as a UTF-8 encoded byte string instead @@ -296,18 +295,6 @@ inputs, at the cost of flexibility. =over -=item utf8_decode($bytes) - -Convert a (perl-UTF-8 encoded) byte string into a sanitized perl Unicode -string. The conversion is performed in-place, so the C<$bytes> argument is -turned into a Unicode string. Returns the same string for convenience. - -This function throws an error if the input is not valid UTF-8 or if it contains -ASCII control characters - that is, any character between C<0x00> and C<0x1f> -except for tab, newline and carriage return. - -(This is a tiny wrapper around C with some extra checks) - =item uri_escape($string) Takes an Unicode string and returns a percent-encoded ASCII string, suitable @@ -316,8 +303,7 @@ for use in a query parameter. =item uri_unescape($string) Takes an Unicode string potentially containing percent-encoding and returns a -decoded Unicode string. Also checks for ASCII control characters as per -C. +decoded Unicode string. =item query_decode($string) @@ -334,8 +320,7 @@ have a value are decoded as C. Example: # } The input C<$string> is assumed to be a perl Unicode string. An error is thrown -if the resulting data decodes into invalid UTF-8 or contains control -characters, as per C. +if the resulting data decodes into invalid UTF-8. =item query_encode($hashref) diff --git a/FU/Validate.pm b/FU/Validate.pm index adca929..fa3bdcc 100644 --- a/FU/Validate.pm +++ b/FU/Validate.pm @@ -4,7 +4,7 @@ use v5.36; use experimental 'builtin', 'for_list'; use builtin qw/true false blessed trim/; use Carp 'confess'; -use FU::Util 'to_bool'; +use FU::Util 'to_bool', 'has_control'; # Unavailable as custom validation names @@ -12,7 +12,7 @@ my %builtin = map +($_,1), qw/ type default onerror - trim + trim allow_control elems sort unique accept_scalar accept_array keys values unknown missing @@ -296,8 +296,13 @@ sub _validate_input { $_[1] = $_[1]->@* == 0 ? undef : $c->{accept_array} eq 'first' ? $_[1][0] : $_[1][ $#{$_[1]} ] if $c->{accept_array} && ref $_[1] eq 'ARRAY'; - # trim (needs to be done before the 'default' test) - $_[1] = trim $_[1] =~ s/\r//rg if defined $_[1] && !ref $_[1] && $type eq 'scalar' && (!exists $c->{trim} || $c->{trim}); + # early scalar checks + if (defined $_[1] && !ref $_[1] && $type eq 'scalar') { + # trim needs to be done before the 'default' test + $_[1] = trim $_[1] =~ s/\r//rg if !exists $c->{trim} || $c->{trim}; + + return { validation => 'allow_control' } if !$c->{allow_control} && has_control $_[1]; + } # default if (!defined $_[1] || (!ref $_[1] && $_[1] eq '')) { @@ -403,6 +408,7 @@ sub _inval($t,$v) { sprintf 'invalid %s: %s', $t, _fmtval $v } # TODO: document. our %error_format = ( required => sub { 'required value missing' }, + allow_control => sub { 'invalid control character' }, type => sub($e) { "invalid type, expected '$e->{expected}' but got '$e->{got}'" }, unknown => sub($e) { sprintf 'unknown key%s: %s', $e->{keys}->@* == 1 ? '' : 's', join ', ', map _fmtkey($_), $e->{keys}->@* }, minlength => sub($e) { sprintf "input too short, expected minimum of %d but got %d", $e->{expected}, $e->{got} }, @@ -590,6 +596,9 @@ Upon failure, the error object will look something like: got => 'scalar' } +Beware: setting the type to I causes the I and I +validations to be skipped. + =item default => $val If not set, or set to C<\'required'> (note: scalarref), then a value is required @@ -623,6 +632,12 @@ By default, any whitespace around scalar-type input is removed before testing any other validations. Setting I to a false value will disable this behavior. +=item allow_control => 0/1 + +By default, ASCII control characters in the input are not permitted for scalar +values and trigger a validation error. Set this to a positive value to disable +the check. + =item keys => $hashref Implies C<< type => 'hash' >>, this option specifies which keys are permitted, diff --git a/c/jsonparse.c b/c/jsonparse.c index bf46557..136034a 100644 --- a/c/jsonparse.c +++ b/c/jsonparse.c @@ -2,7 +2,6 @@ typedef struct { const unsigned char *buf; const unsigned char *end; UV depth; - int allow_control; } fujson_parse_ctx; static SV *fujson_parse(pTHX_ fujson_parse_ctx *); @@ -24,10 +23,10 @@ static inline int fujson_parse_string_escape(pTHX_ fujson_parse_ctx *ctx, fustr case '"': *(r->cur++) = '\"'; break; case '\\':*(r->cur++) = '\\'; break; case '/': *(r->cur++) = '/'; break; /* We don't escape this one */ - case 'b': if (!ctx->allow_control) return 1; *(r->cur++) = 0x08; break; + case 'b': *(r->cur++) = 0x08; break; case 't': *(r->cur++) = 0x09; break; case 'n': *(r->cur++) = 0x0a; break; - case 'f': if (!ctx->allow_control) return 1; *(r->cur++) = 0x0c; break; + case 'f': *(r->cur++) = 0x0c; break; case 'r': *(r->cur++) = 0x0d; break; case 'u': /* (awful code adapted from ncdu) */ @@ -44,9 +43,6 @@ static inline int fujson_parse_string_escape(pTHX_ fujson_parse_ctx *ctx, fustr n = 0x10000 + (((n & 0x03ff) << 10) | (s & 0x03ff)); ctx->buf += 6; } - if (!ctx->allow_control && - (n <= 8 || n == 0x0b || n == 0x0c || (n >= 0x0e && n <= 0x1f) || n == 0x7f)) - return 1; r->cur = (char *)uvchr_to_utf8((U8 *)r->cur, n); if (n >= 0x80) r->setutf8 = 1; break; @@ -269,7 +265,6 @@ static SV *fujson_parse_xs(pTHX_ I32 ax, I32 argc, SV *val) { fujson_parse_ctx ctx; ctx.depth = 0; - ctx.allow_control = 0; while (i < argc) { arg = SvPV_nolen(ST(i)); i++; @@ -280,7 +275,7 @@ static SV *fujson_parse_xs(pTHX_ I32 ax, I32 argc, SV *val) { if (strcmp(arg, "utf8") == 0) decutf8 = SvTRUEx(r); else if (strcmp(arg, "max_size") == 0) maxlen = SvUV(r); else if (strcmp(arg, "max_depth") == 0) ctx.depth = SvUV(r); - else if (strcmp(arg, "allow_control") == 0) ctx.allow_control = SvTRUE(r); + else if (strcmp(arg, "allow_control") == 0) {} else if (strcmp(arg, "offset") == 0) offset = r; else croak("Unknown flag: '%s'", arg); } diff --git a/t/json_parse.t b/t/json_parse.t index 3ad3838..686a1e6 100644 --- a/t/json_parse.t +++ b/t/json_parse.t @@ -24,11 +24,6 @@ my @error = ( '"\udc12\u1234"', "\"\x{110000}\"", - '"\u0000"', - '"\b"', - '"\f"', - '"\u007f"', - '1.', '01', '1e', @@ -87,6 +82,7 @@ sub str($in, $exp) { } str '""', ''; str '"hello, world"', 'hello, world'; +str '"\u0000\b"', "\x00\b"; str '"\u0099\u0234\u1234"', "\x{99}\x{234}\x{1234}"; str "\"\x{99}\x{234}\x{1234}\x{12345}\"", "\x{99}\x{234}\x{1234}\x{12345}"; str '"\/\"\\\\\t\n\r"', "/\"\\\x{09}\x{0a}\x{0d}"; diff --git a/t/query.t b/t/query.t index 9d1ca4a..96ae403 100644 --- a/t/query.t +++ b/t/query.t @@ -7,9 +7,6 @@ is_deeply query_decode('a&a&%c3%be=%26%3d%c3%be&a=3'), { a => [ builtin::true, builtin::true, 3 ], "\xfe" => "&=\xfe" }; -ok !eval { query_decode('%10'); 1 }; -like $@, qr/Invalid control character/; - ok !eval { query_decode('a=%fe%83%bf%bf%bf%bf%bf%0a'); 1 }; like $@, qr/does not map to Unicode/; diff --git a/t/validate.t b/t/validate.t index 26704cd..46dc173 100644 --- a/t/validate.t +++ b/t/validate.t @@ -79,6 +79,10 @@ t { trim => 0 }, " Va\rl id \n ", " Va\rl id \n "; f {}, ' ', { validation => 'required' }, 'required value missing'; t { trim => 0 }, ' ', ' '; +# allow_control +f {}, "\b", { validation => 'allow_control' }, 'invalid control character'; +t { allow_control => 1 }, "\b", "\b"; + # accept_array t { default => undef, accept_array => 'first' }, [], undef; t { default => undef, accept_array => 'first' }, [' x '], 'x'; From 715f4a748b705456db479f4b44d01a4049fb95a3 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Thu, 4 Sep 2025 11:30:24 +0200 Subject: [PATCH 03/11] Version 1.3 --- ChangeLog | 8 ++++++++ FU.pm | 2 +- FU/DebugImpl.pm | 2 +- FU/Log.pm | 2 +- FU/MultipartFormData.pm | 2 +- FU/Pg.pm | 2 +- FU/SQL.pm | 2 +- FU/Util.pm | 2 +- FU/Validate.pm | 2 +- FU/XMLWriter.pm | 2 +- FU/XS.pm | 2 +- 11 files changed, 18 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index a5cb275..f5ecc19 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +1.3 - 2025-09-04 + - FU::Validate: Scalar validations now reject control characters by default + - FU::Validate: Add `allow_control` option to override above behavior + - FU::Util: JSON and URI parsing now always permit control characters + - FU::Util: More strict UTF-8 validation on path & URI decoding + - FU::Util: Deprecate `decode_utf8()` + - FU::Util: Deprecate `allow_control` option in `json_parse()` + 1.2 - 2025-07-06 - FU::Pg: Throw error on non-boolean-looking Perl values for boolean bind parameters diff --git a/FU.pm b/FU.pm index 2fabf2a..f1493a7 100644 --- a/FU.pm +++ b/FU.pm @@ -1,4 +1,4 @@ -package FU 1.2; +package FU 1.3; use v5.36; use Carp 'confess', 'croak'; use IO::Socket; diff --git a/FU/DebugImpl.pm b/FU/DebugImpl.pm index 7e8ddac..13e4eb4 100644 --- a/FU/DebugImpl.pm +++ b/FU/DebugImpl.pm @@ -1,5 +1,5 @@ # Internal module used by FU.pm -package FU::DebugImpl 1.2; +package FU::DebugImpl 1.3; use v5.36; use utf8; use experimental 'for_list'; diff --git a/FU/Log.pm b/FU/Log.pm index 64f95c8..f3b1fcf 100644 --- a/FU/Log.pm +++ b/FU/Log.pm @@ -1,4 +1,4 @@ -package FU::Log 1.2; +package FU::Log 1.3; use v5.36; use Exporter 'import'; use POSIX 'strftime'; diff --git a/FU/MultipartFormData.pm b/FU/MultipartFormData.pm index 14ce323..ca21512 100644 --- a/FU/MultipartFormData.pm +++ b/FU/MultipartFormData.pm @@ -1,4 +1,4 @@ -package FU::MultipartFormData 1.2; +package FU::MultipartFormData 1.3; use v5.36; use Carp 'confess'; use FU::Util 'utf8_decode'; diff --git a/FU/Pg.pm b/FU/Pg.pm index cd48ab2..75bc3af 100644 --- a/FU/Pg.pm +++ b/FU/Pg.pm @@ -1,4 +1,4 @@ -package FU::Pg 1.2; +package FU::Pg 1.3; use v5.36; use FU::XS; diff --git a/FU/SQL.pm b/FU/SQL.pm index 7ff1242..3e0869c 100644 --- a/FU/SQL.pm +++ b/FU/SQL.pm @@ -1,4 +1,4 @@ -package FU::SQL 1.2; +package FU::SQL 1.3; use v5.36; use Exporter 'import'; use Carp 'confess'; diff --git a/FU/Util.pm b/FU/Util.pm index 77635a2..da8b869 100644 --- a/FU/Util.pm +++ b/FU/Util.pm @@ -1,4 +1,4 @@ -package FU::Util 1.2; +package FU::Util 1.3; use v5.36; use FU::XS; diff --git a/FU/Validate.pm b/FU/Validate.pm index fa3bdcc..f170bfc 100644 --- a/FU/Validate.pm +++ b/FU/Validate.pm @@ -1,4 +1,4 @@ -package FU::Validate 1.2; +package FU::Validate 1.3; use v5.36; use experimental 'builtin', 'for_list'; diff --git a/FU/XMLWriter.pm b/FU/XMLWriter.pm index 33cdea4..5364c5e 100644 --- a/FU/XMLWriter.pm +++ b/FU/XMLWriter.pm @@ -1,4 +1,4 @@ -package FU::XMLWriter 1.2; +package FU::XMLWriter 1.3; use v5.36; use Carp 'confess'; use Exporter 'import'; diff --git a/FU/XS.pm b/FU/XS.pm index a3d5337..b22fbbb 100644 --- a/FU/XS.pm +++ b/FU/XS.pm @@ -1,5 +1,5 @@ # This module is for internal use by other FU modules. -package FU::XS 1.2; +package FU::XS 1.3; use Carp; # may be called by XS. use XSLoader; XSLoader::load('FU'); From 144d88fc8b042df25a2b45112d461f837a98b5d5 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Thu, 4 Dec 2025 11:19:40 +0100 Subject: [PATCH 04/11] Misc doc fixes --- FU/Pg.pm | 4 ++-- FU/SQL.pm | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/FU/Pg.pm b/FU/Pg.pm index 75bc3af..5c81b6b 100644 --- a/FU/Pg.pm +++ b/FU/Pg.pm @@ -71,7 +71,7 @@ C<$string> can either be in key=value format or a URI, refer to L for the full list of supported formats and options. You may also pass an empty -string and leave the configuration up L. =item $conn->server_version @@ -702,7 +702,7 @@ While C is a valid JSON value, there's currently no way to distinguish that from SQL C. When sending C as bind parameter, it is sent as SQL C. -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'); diff --git a/FU/SQL.pm b/FU/SQL.pm index 3e0869c..218a034 100644 --- a/FU/SQL.pm +++ b/FU/SQL.pm @@ -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($sql, @params) = $sel->compile; + my($sql, $params) = $sel->compile; =head1 DESCRIPTION From 876613d03f09fdec7ebe3431d25dd63e63334bea Mon Sep 17 00:00:00 2001 From: Yorhel Date: Thu, 4 Dec 2025 11:20:09 +0100 Subject: [PATCH 05/11] FU: Fix useless warning on empty cookie sections --- FU.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/FU.pm b/FU.pm index f1493a7..002fec3 100644 --- a/FU.pm +++ b/FU.pm @@ -705,7 +705,8 @@ sub cookie { my %c; for my $c (split /; /, fu->header('cookie')||'') { 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 } else { $c{$n} = [ $c{$n}, $v ] } } From 8140fefbca29702a5a39841007aad34de92ef734 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Thu, 4 Dec 2025 14:05:51 +0100 Subject: [PATCH 06/11] 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. --- FU.pm | 8 +- FU.xs | 8 +- FU/DebugImpl.pm | 2 +- FU/Pg.pm | 68 ++++++++-------- bench.PL | 4 +- c/pgst.c | 2 +- t/pgconnect.t | 190 ++++++++++++++++++++++---------------------- t/pgcopy.t | 4 +- t/pgtypes-dynamic.t | 100 +++++++++++------------ t/pgtypes.t | 20 ++--- 10 files changed, 206 insertions(+), 200 deletions(-) diff --git a/FU.pm b/FU.pm index 002fec3..e4f4ac1 100644 --- a/FU.pm +++ b/FU.pm @@ -646,8 +646,8 @@ sub db { }; } -sub sql { shift->db->q(@_) } -sub SQL { shift->db->Q(@_) } +sub sql { shift->db->sql(@_) } +sub SQL { shift->db->SQL(@_) } sub _fmt_section($s) { $s =~ s/^\s*/ /r =~ s/\s+$//r =~ s/\n/\n /rg } @@ -1306,11 +1306,11 @@ has successfully been processed, or rolled back if there was an error. =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) -Convenient short-hand for C<< fu->db->Q(@args) >>. +Convenient short-hand for C<< fu->db->SQL(@args) >>. =item fu->log_verbose($message) diff --git a/FU.xs b/FU.xs index 7a387f9..60ef7a6 100644 --- a/FU.xs +++ b/FU.xs @@ -277,10 +277,10 @@ void exec(fupg_conn *c, SV *sv) FUPG_CONN_COOKIE; ST(0) = fupg_exec(aTHX_ c, SvPVutf8_nolen(sv)); -void q(fupg_conn *c, SV *sv, ...) +void sql(fupg_conn *c, SV *sv, ...) CODE: 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) CODE: @@ -353,10 +353,10 @@ void exec(fupg_txn *t, SV *sv) FUPG_TXN_COOKIE; 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: 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 void copy(fupg_txn *t, SV *sv) diff --git a/FU/DebugImpl.pm b/FU/DebugImpl.pm index 13e4eb4..0ffe8cf 100644 --- a/FU/DebugImpl.pm +++ b/FU/DebugImpl.pm @@ -283,7 +283,7 @@ my @sections = ( pgst => sub { 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' )->cache(0)->alla } || do { warn "Unable to collect prepared statement list: $@"; return () }; return () if !@$lst; diff --git a/FU/Pg.pm b/FU/Pg.pm index 5c81b6b..294481c 100644 --- a/FU/Pg.pm +++ b/FU/Pg.pm @@ -7,7 +7,7 @@ _load_libpq(); package FU::Pg::conn { sub lib_version { FU::Pg::lib_version() } - sub Q { + sub SQL { require FU::SQL; my $s = shift; my($sql, $params) = FU::SQL::SQL(@_)->compile( @@ -15,7 +15,7 @@ package FU::Pg::conn { in_style => 'pg', quote_identifier => sub { $s->conn->escape_identifier(@_) }, ); - $s->q($sql, @$params); + $s->sql($sql, @$params); } 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 { 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->q('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)', 'Revelation Space')->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"; } @@ -141,7 +147,7 @@ a table, column, function, etc) in an SQL statement. =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) @@ -169,7 +175,7 @@ Also worth noting that the subroutine is called from the context of the code executing the query, but I the query results have been returned. 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 (such as for transaction management, querying type information, etc) do not 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 if that information is not available for the given command (like with C). -=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 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 used. -=item $conn->Q(@args) +=item $conn->SQL(@args) -Same as C<< $conn->q() >> but uses L to construct the query and bind +Same as C<< $conn->sql() >> but uses L to construct the query and bind parameters. Uses the 'pg' C and C<< $conn->escape_identifier() >> for identifier quoting. =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: =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<< $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 =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 if no rows are returned or if its value is I. - my $v = $conn->q('SELECT COUNT(*) FROM books')->val; + my $v = $conn->sql('SELECT COUNT(*) FROM books')->val; # $v = 2 =item $st->rowl @@ -269,7 +275,7 @@ if no rows are returned or if its value is I. 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. - 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'); =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 if the query did not generate any 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']; =item $st->rowh @@ -287,14 +293,14 @@ Return the first row as a hashref. Returns C if the query did not generate any rows. Throws an error if the query returns multiple columns with 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' }; =item $st->alla 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 = [ # [ 1, 'Revelation Space' ], # [ 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 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 = [ # { id => 1, title => 'Revelation Space' }, # { id => 2, title => 'The Invincible' }, @@ -315,7 +321,7 @@ returns multiple columns with the same name. 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 = [ # 1, 'Revelation Space', # 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 is used as 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 = { # 1 => 'Revelation Space', # 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 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 = { # 1 => [ 'Revelation Space', true ], # 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 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 = { # 1 => { title => 'Revelation Space', read => true }, # 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 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 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) of each 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] - my $oids = $conn->q('SELECT id FROM books')->params; + my $oids = $conn->sql('SELECT id FROM books')->params; # $oids = [] 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 is enabled. Returns an arrayref of hashrefs describing each column that the statement returns. - my $cols = $conn->q('SELECT id, title FROM books')->columns; + my $cols = $conn->sql('SELECT id, title FROM books')->columns; # $cols = [ # { name => 'id', oid => 23 }, # { name => 'title', oid => 25 }, @@ -446,7 +452,7 @@ fail while a transaction object is alive. my $txn = $conn->txn; # 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 { @@ -467,9 +473,9 @@ Transaction methods: =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 methods on the parent C<$conn> object. @@ -492,7 +498,7 @@ when the object goes out of scope. =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 created. Subtransactions inherit these settings from their parent transaction. diff --git a/bench.PL b/bench.PL index f4309c9..4bee131 100755 --- a/bench.PL +++ b/bench.PL @@ -211,8 +211,8 @@ def 'xml/a', 'HTML fragment', [ 'Rate' ], 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 fub { my $sum = 0; for my $row ($fu->q($_[0])->alla->@*) { $sum ^= $_ for @$row; } } - my sub fut { my $sum = 0; for my $row ($fu->q($_[0])->text->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->sql($_[0])->text->alla->@*) { $sum ^= $_ for @$row; } } def 'pg/ints', 'Fetch and bitwise-or 20k integers', [ 'Smallint', 'Bigint' ], [ 'DBD::Pg', undef, sub { dbi($small) }, sub { dbi($big) } ], diff --git a/c/pgst.c b/c/pgst.c index e943450..21de36b 100644 --- a/c/pgst.c +++ b/c/pgst.c @@ -76,7 +76,7 @@ static SV *fupg_exec(pTHX_ fupg_conn *c, const char *sql) { 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)); st->conn = c; st->cookie = c->cookie; diff --git a/t/pgconnect.t b/t/pgconnect.t index cec597d..a1717ab 100644 --- a/t/pgconnect.t +++ b/t/pgconnect.t @@ -37,7 +37,7 @@ subtest '$conn->exec', sub { ok !defined $conn->exec(''); 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/; is $conn->exec('SET client_encoding=utf8'), undef; @@ -46,7 +46,7 @@ subtest '$conn->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->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->columns, [ { oid => 23, name => 'a' }, @@ -74,28 +74,28 @@ subtest '$st prepare & exec', sub { 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/; - 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/; # prepare + describe won't let us detect empty queries, hmm... - is_deeply $conn->q('')->param_types, []; - is_deeply $conn->q('')->columns, []; + is_deeply $conn->sql('')->param_types, []; + is_deeply $conn->sql('')->columns, []; - ok !eval { $conn->q('')->exec; 1 }; + ok !eval { $conn->sql('')->exec; 1 }; 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/; # Interleaved { - my $x = $conn->q('SELECT 1 as a'); - my $y = $conn->q('SELECT 2 as b'); + my $x = $conn->sql('SELECT 1 as a'); + my $y = $conn->sql('SELECT 2 as b'); is_deeply $x->columns, [ { oid => 23, name => 'a' } ]; is_deeply $y->columns, [ { oid => 23, name => 'b' } ]; is $x->val, 1; @@ -104,137 +104,137 @@ subtest '$st prepare & exec', 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/; - 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/; - 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/; - ok !defined $conn->q('SELECT 1 WHERE false')->val; - ok !defined $conn->q('SELECT null')->val; - is $conn->q('SELECT $1::text', "\x{1F603}")->val, "\x{1F603}"; + ok !defined $conn->sql('SELECT 1 WHERE false')->val; + ok !defined $conn->sql('SELECT null')->val; + is $conn->sql('SELECT $1::text', "\x{1F603}")->val, "\x{1F603}"; }; 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/; - ok !eval { $conn->q('SELEXT')->rowl; 1; }; - is scalar $conn->q('SELECT')->rowl, 0; - is scalar $conn->q('SELECT 1, 2')->rowl, 2; - is_deeply [$conn->q('SELECT')->rowl], []; - is_deeply [$conn->q('SELECT 1, null')->rowl], [1, undef]; - is_deeply [$conn->q('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->q('SELECT 1 WHERE false')->rowl], []; + ok !eval { $conn->sql('SELEXT')->rowl; 1; }; + is scalar $conn->sql('SELECT')->rowl, 0; + is scalar $conn->sql('SELECT 1, 2')->rowl, 2; + is_deeply [$conn->sql('SELECT')->rowl], []; + is_deeply [$conn->sql('SELECT 1, null')->rowl], [1, undef]; + is_deeply [$conn->sql('SELECT 1, $1', undef)->rowl], [1, undef]; + is_deeply [$conn->sql('SELECT 1, $1::int', undef)->text_params(0)->rowl], [1, undef]; + is_deeply [$conn->sql('SELECT 1 WHERE false')->rowl], []; }; 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/; - ok !eval { $conn->q('SELEXT')->rowa; 1; }; - is $conn->q('SELECT 1 WHERE false')->rowa, undef; - is_deeply $conn->q('SELECT')->rowa, []; - is_deeply $conn->q('SELECT 1, 2')->rowa, [1, 2]; - is_deeply $conn->q('SELECT 1, null')->rowa, [1, undef]; - is_deeply $conn->q('SELECT 1, $1', undef)->rowa, [1, undef]; - is_deeply $conn->q('SELECT 1, $1::int', undef)->text_params(0)->rowa, [1, undef]; + ok !eval { $conn->sql('SELEXT')->rowa; 1; }; + is $conn->sql('SELECT 1 WHERE false')->rowa, undef; + is_deeply $conn->sql('SELECT')->rowa, []; + is_deeply $conn->sql('SELECT 1, 2')->rowa, [1, 2]; + is_deeply $conn->sql('SELECT 1, null')->rowa, [1, undef]; + is_deeply $conn->sql('SELECT 1, $1', undef)->rowa, [1, undef]; + is_deeply $conn->sql('SELECT 1, $1::int', undef)->text_params(0)->rowa, [1, undef]; }; 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/; - 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/; - is $conn->q('SELECT 1 WHERE false')->rowh, undef; - is_deeply $conn->q('SELECT')->rowh, {}; - is_deeply $conn->q('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->q('SELECT 1 as a, $1::int as b', undef)->rowh, {a => 1, b => undef}; + is $conn->sql('SELECT 1 WHERE false')->rowh, undef; + is_deeply $conn->sql('SELECT')->rowh, {}; + is_deeply $conn->sql('SELECT 1 as a, 2 as b')->rowh, {a => 1, b => 2}; + is_deeply $conn->sql('SELECT 1 as a, null as b')->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 { - is_deeply $conn->q('SELECT 1 WHERE false')->alla, []; - is_deeply $conn->q('SELECT')->alla, [[]]; - is_deeply $conn->q('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 WHERE false')->alla, []; + is_deeply $conn->sql('SELECT')->alla, [[]]; + is_deeply $conn->sql('SELECT 1')->alla, [[1]]; + is_deeply $conn->sql('SELECT 1, null UNION ALL SELECT NULL, 2')->alla, [[1,undef],[undef,2]]; }; 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/; - is_deeply $conn->q('SELECT 1 WHERE false')->allh, []; - is_deeply $conn->q('SELECT')->allh, [{}]; - is_deeply $conn->q('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 WHERE false')->allh, []; + is_deeply $conn->sql('SELECT')->allh, [{}]; + is_deeply $conn->sql('SELECT 1 a')->allh, [{a=>1}]; + 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 { - is_deeply $conn->q('SELECT 1 WHERE false')->flat, []; - is_deeply $conn->q('SELECT')->flat, []; - is_deeply $conn->q('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 WHERE false')->flat, []; + is_deeply $conn->sql('SELECT')->flat, []; + is_deeply $conn->sql('SELECT 1')->flat, [1]; + is_deeply $conn->sql('SELECT 1, null UNION ALL SELECT NULL, 2')->flat, [1,undef,undef,2]; }; subtest '$st->kvv', sub { - ok !eval { $conn->q('SELECT')->kvv; 1; }; + ok !eval { $conn->sql('SELECT')->kvv; 1; }; 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/; - 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/; - is_deeply $conn->q('SELECT 1 WHERE false')->kvv, {}; - is_deeply $conn->q('SELECT 1')->kvv, {1=>1}; - is_deeply $conn->q('SELECT 1, null UNION ALL SELECT 3, 2')->kvv, {1=>undef,3=>2}; - $conn->q('SELECT 1')->kvv->{1} = 0; + is_deeply $conn->sql('SELECT 1 WHERE false')->kvv, {}; + is_deeply $conn->sql('SELECT 1')->kvv, {1=>1}; + is_deeply $conn->sql('SELECT 1, null UNION ALL SELECT 3, 2')->kvv, {1=>undef,3=>2}; + $conn->sql('SELECT 1')->kvv->{1} = 0; }; subtest '$st->kva', sub { - ok !eval { $conn->q('SELECT')->kva; 1; }; + ok !eval { $conn->sql('SELECT')->kva; 1; }; 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/; - is_deeply $conn->q('SELECT 1 WHERE false')->kva, {}; - is_deeply $conn->q('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 WHERE false')->kva, {}; + is_deeply $conn->sql('SELECT 1')->kva, {1=>[]}; + is_deeply $conn->sql("SELECT 1, null, 'hi' UNION ALL SELECT 3, 2, 'ok'")->kva, {1=>[undef,'hi'], 3=>[2, 'ok']}; }; subtest '$st->kvh', sub { - ok !eval { $conn->q('SELECT')->kvh; 1; }; + ok !eval { $conn->sql('SELECT')->kvh; 1; }; 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/; - 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/; - is_deeply $conn->q('SELECT 1 WHERE false')->kvh, {}; - is_deeply $conn->q('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 WHERE false')->kvh, {}; + is_deeply $conn->sql('SELECT 1')->kvh, {1=>{}}; + 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'}}; }; subtest 'txn', sub { $conn->exec('CREATE TEMPORARY TABLE fupg_tst (id int)'); $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 $txn = $conn->txn; @@ -246,13 +246,13 @@ subtest 'txn', sub { ok !eval { $conn->exec('SELECT 1'); 1 }; 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/; ok !eval { $conn->txn; 1 }; like $@, qr/Invalid operation on the top-level connection/; $txn->exec('INSERT INTO fupg_tst VALUES (1)'); - $sst = $txn->q('SELECT 1'); + $sst = $txn->sql('SELECT 1'); is $conn->status, 'txn_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/; ok !eval { $txn->exec('select 1'); 1 }; 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/; ok !eval { $conn->exec('SELECT 1'); 1 }; @@ -295,7 +295,7 @@ subtest 'txn', sub { { 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; is $conn->status, 'txn_idle'; @@ -316,7 +316,7 @@ subtest 'txn', sub { is $txn->status, 'idle'; 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; $sub->exec('INSERT INTO fupg_tst VALUES (2)'); @@ -339,19 +339,19 @@ subtest 'txn', sub { $sub->commit; } # 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'; - my $st = $conn->q('SELECT $1', $_); + my $st = $conn->sql('SELECT $1', $_); $_ = 'y'; is $st->val, 'x', 'shallow copy'; } { 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; 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. 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. is $conn->escape_identifier('hel\l"o'), '"hel\l""o"'; @@ -371,32 +371,32 @@ subtest 'Prepared statement cache', sub { my $txn = $conn->txn; $txn->cache; 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; my $sql = 'SELECT $1::int as a, $2::text as b'; ok !defined $numexec->($sql); - my $params = $txn->q($sql)->param_types; + my $params = $txn->sql($sql)->param_types; is_deeply $params, [23, 25]; is $numexec->($sql), 0; - my $cparams = $txn->q($sql)->param_types; + my $cparams = $txn->sql($sql)->param_types; 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 }]; - my $ccols = $txn->q($sql)->columns; + my $ccols = $txn->sql($sql)->columns; is_deeply $ccols, $cols; - $txn->q($sql, 0, '')->exec; + $txn->sql($sql, 0, '')->exec; is $numexec->($sql), 1; - $txn->q($sql, 0, '')->exec; + $txn->sql($sql, 0, '')->exec; is $numexec->($sql), 2; is $numexec->('SELECT 1'), 1; - $txn->q('SELECT 2')->exec; + $txn->sql('SELECT 2')->exec; ok !defined $numexec->('SELECT 1'); is $numexec->('SELECT 2'), 1; @@ -415,7 +415,7 @@ subtest 'Tracing', sub { my @log; $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; my $st = shift @log; 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 is $st->val, 1; } diff --git a/t/pgcopy.t b/t/pgcopy.t index 9c81349..5bd82cb 100644 --- a/t/pgcopy.t +++ b/t/pgcopy.t @@ -82,9 +82,9 @@ is $conn->status, 'idle'; $c->write($bin); $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; } -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; diff --git a/t/pgtypes-dynamic.t b/t/pgtypes-dynamic.t index 79abd92..56d41eb 100644 --- a/t/pgtypes-dynamic.t +++ b/t/pgtypes-dynamic.t @@ -10,31 +10,31 @@ my $conn = FU::Pg->connect($ENV{FU_TEST_DB}); $conn->_debug_trace(0); -is_deeply $conn->Q('SELECT', 1, '::int')->param_types, [23]; -is_deeply $conn->Q('SELECT 1', IN([1,2,3]))->param_types, [1007]; -is $conn->Q('SELECT 1', IN([1,2,3]))->val, 1; +is_deeply $conn->SQL('SELECT', 1, '::int')->param_types, [23]; +is_deeply $conn->SQL('SELECT 1', IN([1,2,3]))->param_types, [1007]; +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/; subtest 'type overrides', sub { $conn->set_type(int4 => recv => 'bytea'); - is $conn->q('SELECT 5::int4')->val, "\0\0\0\5"; - is_deeply $conn->q('SELECT ARRAY[5::int4]')->val, ["\0\0\0\5"]; + is $conn->sql('SELECT 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'); - is $conn->q('SELECT $1::int4', "\0\0\0\5")->val, 5; - is_deeply $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->sql('SELECT $1::int4[]', ["\0\0\0\5"])->val, [5]; $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/; - 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/; $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); }; like $@, qr/Cannot set a type to array/; @@ -46,23 +46,23 @@ subtest 'type overrides', sub { subtest 'type override callback', sub { $conn->set_type(text => recv => sub { length $_[0] }); - is $conn->q('SELECT $1', 'a')->val, 1; - is $conn->q('SELECT $1', 'ab')->val, 2; - is $conn->q('SELECT $1', 'abc')->val, 3; - is $conn->q('SELECT $1', 'abcd')->val, 4; + is $conn->sql('SELECT $1', 'a')->val, 1; + is $conn->sql('SELECT $1', 'ab')->val, 2; + is $conn->sql('SELECT $1', 'abc')->val, 3; + is $conn->sql('SELECT $1', 'abcd')->val, 4; $conn->set_type(text => send => sub { 'l'.length $_[0] }); - is $conn->q('SELECT $1', 'a')->val, 'l1'; - is $conn->q('SELECT $1', 'ab')->val, 'l2'; - is $conn->q('SELECT $1', 'abc')->val, 'l3'; - is $conn->q('SELECT $1', 'abcd')->val, 'l4'; + is $conn->sql('SELECT $1', 'a')->val, 'l1'; + is $conn->sql('SELECT $1', 'ab')->val, 'l2'; + is $conn->sql('SELECT $1', 'abc')->val, 'l3'; + is $conn->sql('SELECT $1', 'abcd')->val, 'l4'; }; subtest 'custom types', sub { 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(<<~_); CREATE TYPE fupg_test_enum AS ENUM('aa', 'bb', 'ccccccccccccccccccc'); @@ -73,21 +73,21 @@ subtest 'custom types', sub { domain fupg_test_domain ); _ - is $txn->q("SELECT 'aa'::fupg_test_enum")->val, 'aa'; - is $txn->q('SELECT $1::fupg_test_enum', 'ccccccccccccccccccc')->val, 'ccccccccccccccccccc'; + is $txn->sql("SELECT 'aa'::fupg_test_enum")->val, 'aa'; + 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 $txn->q('SELECT $1::fupg_test_enum[]', ['aa','bb',undef])->text_results->val, '{aa,bb,NULL}'; + is_deeply $txn->sql("SELECT '{aa,bb,null}'::fupg_test_enum[]")->val, ['aa','bb',undef]; + 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->q('SELECT $1::fupg_test_domain', 'bb')->val, 'bb'; + is $txn->sql("SELECT 'aa'::fupg_test_domain")->val, 'aa'; + 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 $txn->q('SELECT $1::fupg_test_domain[]', ['aa','bb',undef])->text_results->val, '{aa,bb,NULL}'; + is_deeply $txn->sql("SELECT '{aa,bb,null}'::fupg_test_domain[]")->val, ['aa','bb',undef]; + 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' }; - is_deeply $txn->q("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_deeply $txn->sql("SELECT '(,\"{aa,bb}\",aa)'::fupg_test_record")->val, $val; + is $txn->sql('SELECT $1::fupg_test_record', $val)->text_results->val, '(,"{aa,bb}",aa)'; $txn->exec(<<~_); 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, [ { rec => { a => 2, aenum => [], domain => 'bb' }, dom => undef }, { rec => { a => undef, aenum => undef, domain => undef }, dom => 'bb' }, @@ -106,7 +106,7 @@ subtest 'custom types', sub { $val->[1]{rec} = 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 => {}, dom => 'bb', extra => 1 }, ])->text_results->val, '{"(\"(2,{},bb)\",)","(\"(,,)\",bb)"}'; @@ -114,46 +114,46 @@ subtest 'custom types', sub { # Wonky Postgres behavior: selecting a domain directly actually returns the # underlying type, but going through an array does work. $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. - 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 :( $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); - 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 { my $txn = $conn->txn; $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; - is $txn->Q('SELECT', IDENT 'hello world', 'FROM fupg_test_tbl')->val, 15; + ok $txn->SQL('INSERT INTO fupg_test_tbl', VALUES {desc => 5, ok => 10, 'hello world', 15})->exec; + is $txn->SQL('SELECT', IDENT 'hello world', 'FROM fupg_test_tbl')->val, 15; }; 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/) { - is $conn->q('SELECT $1::vndbtag', $t)->val, $t; - is $conn->q('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)->val, $t; + is $conn->sql('SELECT $1::vndbtag', $t)->text_params->val, $t; + is $conn->sql('SELECT $1::vndbtag', $t)->text_results->val, $t; } - ok !eval { $conn->q('SELECT $1::vndbtag', '')->val }; - ok !eval { $conn->q('SELECT $1::vndbtag', 'abcd')->val }; + ok !eval { $conn->sql('SELECT $1::vndbtag', '')->val }; + ok !eval { $conn->sql('SELECT $1::vndbtag', 'abcd')->val }; for my $t (qw/a123 zz992883231 xxx18388123/) { - is $conn->q('SELECT $1::vndbid', $t)->val, $t; - is $conn->q('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)->val, $t; + is $conn->sql('SELECT $1::vndbid', $t)->text_params->val, $t; + is $conn->sql('SELECT $1::vndbid', $t)->text_results->val, $t; } - ok !eval { $conn->q('SELECT $1::vndbid', '')->val }; - ok !eval { $conn->q('SELECT $1::vndbid', 'ab')->val }; - ok !eval { $conn->q('SELECT $1::vndbid', 'ab1219229999999999')->val }; + ok !eval { $conn->sql('SELECT $1::vndbid', '')->val }; + ok !eval { $conn->sql('SELECT $1::vndbid', 'ab')->val }; + ok !eval { $conn->sql('SELECT $1::vndbid', 'ab1219229999999999')->val }; }; done_testing; diff --git a/t/pgtypes.t b/t/pgtypes.t index 662de33..9d5f6d9 100644 --- a/t/pgtypes.t +++ b/t/pgtypes.t @@ -22,7 +22,7 @@ sub v($type, $p_in, @args) { my $oid; 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]; my $array = $st->flat; my $res = $array->[0]; @@ -32,11 +32,11 @@ sub v($type, $p_in, @args) { $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"; } { - 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"; } { @@ -52,11 +52,11 @@ sub v($type, $p_in, @args) { sub f($type, $p_in) { my $test = "$type $p_in" =~ s/\n/\\n/rg; 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 - my $array = $conn->q('SELECT pg_sleep(0)')->flat; + my $array = $conn->sql('SELECT pg_sleep(0)')->flat; ok !defined $array->[0]; $array->[0] = 0; } @@ -187,11 +187,11 @@ f 'oidvector', [undef]; # Example from https://www.postgresql.org/docs/17/arrays.html#ARRAYS-IO # 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->q('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::int2[])[2]', [1,2,3,4])->val, 2; +is $conn->sql('SELECT ($1::int2vector)[1]', [1,2,3,4])->val, 2; +is $conn->sql('SELECT ($1::oidvector)[1]', [1,2,3,4])->val, 2; is_deeply [$conn->bin2text( 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]; $_ = 0 for @$v; } From d300f4d791c80cdf091c1f9d2ddb50ed36a6c42a Mon Sep 17 00:00:00 2001 From: Yorhel Date: Sun, 4 Jan 2026 10:46:46 +0100 Subject: [PATCH 07/11] 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. --- FU.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/FU.pm b/FU.pm index e4f4ac1..8e47c1d 100644 --- a/FU.pm +++ b/FU.pm @@ -491,6 +491,8 @@ sub _supervisor($c) { if (!$err && (!$childs{$pid} || $childs{$pid} != 2)) { $err = 1; log_write "Script exited before calling FU::run()\n"; + } elsif ($?) { + log_write "Unclean shutdown of worker PID $pid status $?\n"; } delete $childs{$pid}; } From 48fe393d5f05e9cec8ddb0c502d1a8e8c47d4c13 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Mon, 5 Jan 2026 08:57:48 +0100 Subject: [PATCH 08/11] 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. --- FU.pm | 11 +++++++++-- FU.xs | 6 +++--- c/fcgi.c | 24 ++++++++++++++---------- t/fcgi.t | 8 ++++++++ 4 files changed, 34 insertions(+), 15 deletions(-) diff --git a/FU.pm b/FU.pm index 8e47c1d..7d5df3b 100644 --- a/FU.pm +++ b/FU.pm @@ -292,7 +292,8 @@ sub _read_req($c) { : $r == -2 ? "I/O error while reading from FastCGI socket\n" : $r == -3 ? "FastCGI protocol error\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}; fu->error(-1); } @@ -400,7 +401,13 @@ sub _do_req($c) { } $REQ->{trace_end} = clock_gettime(CLOCK_MONOTONIC); - fu->_flush($c->{fcgi_obj} || $c->{client_sock}); + eval { + 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}) { require FU::DebugImpl; diff --git a/FU.xs b/FU.xs index 60ef7a6..1477a0a 100644 --- a/FU.xs +++ b/FU.xs @@ -3,7 +3,7 @@ #include /* struct timespec & clock_gettime() */ #include /* strerror() */ #include /* inet_ntop(), inet_ntoa() */ -#include /* fd passing */ +#include /* send(), fd passing */ #include /* fd passing */ #include /* dlopen() etc */ @@ -170,11 +170,11 @@ void print(fufcgi *ctx, SV *sv) CODE: STRLEN len; const char *buf = SvPVbyte(sv, len); - fufcgi_print(ctx, buf, len); + fufcgi_print(aTHX_ ctx, buf, len); void flush(fufcgi *ctx) CODE: - fufcgi_done(ctx); + fufcgi_done(aTHX_ ctx); void DESTROY(fufcgi *ctx) CODE: diff --git a/c/fcgi.c b/c/fcgi.c index 4f886dd..efcce6e 100644 --- a/c/fcgi.c +++ b/c/fcgi.c @@ -18,6 +18,7 @@ #define FUFE_CLEN -5 #define FUFE_ABORT -6 /* explicit abort or client-level EOF */ #define FUFE_NOREQ -7 /* protocol-level EOF before we received anything */ +#define FUFE_SEND -8 /* error in send() */ #define FUFCGI_MAX_DATA 65535 @@ -177,8 +178,8 @@ static int fufcgi_write_record(fufcgi *ctx, fufcgi_rec *hdr, char *buf) { buf[7] = 0; int len = hdr->len + 8; while (len > 0) { - int r = write(ctx->fd, buf, len); - if (r <= 0) return r == 0 ? FUFE_EOF : FUFE_IO; + int r = send(ctx->fd, buf, len, MSG_NOSIGNAL); + if (r <= 0) return FUFE_SEND; buf += 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; if (ctx->len > 0) { hdr.len = ctx->len; hdr.type = FCGI_STDOUT; hdr.id = ctx->reqid; - fufcgi_write_record(ctx, &hdr, ctx->buf); + if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK) + croak("write error: %s", strerror(errno)); 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; while (len > 0) { 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; len -= 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_flush(ctx); + fufcgi_flush(aTHX_ ctx); hdr.len = 0; hdr.type = FCGI_STDOUT; hdr.id = ctx->reqid; - fufcgi_write_record(ctx, &hdr, ctx->buf); + if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK) + croak("write error: %s", strerror(errno)); memcpy(ctx->buf+8, "\0\0\0\0\0\0\0\0", 8); /* FCGI_REQUEST_COMPLETE */ hdr.type = FCGI_END_REQUEST; hdr.len = 8; - fufcgi_write_record(ctx, &hdr, ctx->buf); + if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK) + croak("write error: %s", strerror(errno)); ctx->reqid = ctx->len = ctx->off = 0; } diff --git a/t/fcgi.t b/t/fcgi.t index d7860dc..85636e3 100644 --- a/t/fcgi.t +++ b/t/fcgi.t @@ -54,6 +54,11 @@ start; begin 1, 2; record 1, 4, ""; +start; +begin 3, 2, 1; +$remote->close; +iserr -8; + start; begin 3, 2, 1; begin 1, 1, 1; @@ -173,6 +178,9 @@ record 1, 4, "\x13\x01HTTP_CONTENT_LENGTH3\x0e\x01CONTENT_LENGTH0\x13\x01HTTP_CO record 1, 4, ""; record 1, 5, ""; isrec {'content-length','0'}, {body => ''}; +$remote->close; +ok !eval { $f->flush; 1 }; +like $@, qr/write error/; start; begin; From a7e9fa1866d70edab049b33893975701dd473f1d Mon Sep 17 00:00:00 2001 From: Yorhel Date: Mon, 5 Jan 2026 13:20:59 +0100 Subject: [PATCH 09/11] FU: Less verbose and cryptic error message on write error --- c/fcgi.c | 6 +++--- t/fcgi.t | 1 - 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/c/fcgi.c b/c/fcgi.c index efcce6e..c7cf306 100644 --- a/c/fcgi.c +++ b/c/fcgi.c @@ -417,7 +417,7 @@ static void fufcgi_flush(pTHX_ fufcgi *ctx) { hdr.type = FCGI_STDOUT; hdr.id = ctx->reqid; if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK) - croak("write error: %s", strerror(errno)); + croak("%s\n", strerror(errno)); ctx->len = 0; } } @@ -442,13 +442,13 @@ static void fufcgi_done(pTHX_ fufcgi *ctx) { hdr.type = FCGI_STDOUT; hdr.id = ctx->reqid; if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK) - croak("write error: %s", strerror(errno)); + croak("%s\n", strerror(errno)); memcpy(ctx->buf+8, "\0\0\0\0\0\0\0\0", 8); /* FCGI_REQUEST_COMPLETE */ hdr.type = FCGI_END_REQUEST; hdr.len = 8; if (fufcgi_write_record(ctx, &hdr, ctx->buf) != FUFE_OK) - croak("write error: %s", strerror(errno)); + croak("%s\n", strerror(errno)); ctx->reqid = ctx->len = ctx->off = 0; } diff --git a/t/fcgi.t b/t/fcgi.t index 85636e3..806182c 100644 --- a/t/fcgi.t +++ b/t/fcgi.t @@ -180,7 +180,6 @@ record 1, 5, ""; isrec {'content-length','0'}, {body => ''}; $remote->close; ok !eval { $f->flush; 1 }; -like $@, qr/write error/; start; begin; From f50da04ba53244d9c5fad5ecdb027865dbca965b Mon Sep 17 00:00:00 2001 From: Yorhel Date: Sat, 10 Jan 2026 16:18:15 +0100 Subject: [PATCH 10/11] Benchmarks: Improve accuracy + re-run with latest versions --- FU/Benchmarks.pod | 448 +++++++++++++++++++++++----------------------- bench.PL | 165 ++++++++++------- 2 files changed, 327 insertions(+), 286 deletions(-) diff --git a/FU/Benchmarks.pod b/FU/Benchmarks.pod index e23571f..e611832 100644 --- a/FU/Benchmarks.pod +++ b/FU/Benchmarks.pod @@ -26,25 +26,25 @@ The following module versions were used: =over -=item L 4.39 +=item L 4.40 =item L 3.18.0 -=item L 1.2 +=item L 1.3 =item L 1.08 =item L 4.16 -=item L 1.06 +=item L 1.07 =item L 0.58 -=item L 4.03 +=item L 4.04 =item L 0.15 -=item L 1.5 +=item L 1.6 =item L 0.900 @@ -66,102 +66,102 @@ L, the SIMD parts are only used for parsing. API object from L documentation. Encode Canonical Decode - JSON::PP 5312/s 5119/s 1290/s - JSON::Tiny 7757/s - 3426/s - Cpanel::JSON::XS 114802/s 104141/s 107274/s - JSON::SIMD 130137/s 118948/s 115123/s - JSON::XS 128421/s 120243/s 117940/s - FU::Util 132067/s 111328/s 117781/s + JSON::PP 5136/s 4943/s 1240/s + JSON::Tiny 7617/s - 3474/s + Cpanel::JSON::XS 108128/s 98734/s 105811/s + JSON::SIMD 125105/s 114822/s 118410/s + JSON::XS 128749/s 117518/s 120190/s + FU::Util 126909/s 109166/s 113983/s Object (small) Encode Canonical Decode - JSON::PP 907/s 829/s 202/s - JSON::Tiny 1224/s - 499/s - Cpanel::JSON::XS 45732/s 30862/s 20102/s - JSON::SIMD 49019/s 30699/s 23267/s - JSON::XS 49814/s 31326/s 25336/s - FU::Util 39684/s 24971/s 17998/s + JSON::PP 896/s 826/s 194/s + JSON::Tiny 1216/s - 519/s + Cpanel::JSON::XS 44184/s 28190/s 19449/s + JSON::SIMD 52633/s 31157/s 23587/s + JSON::XS 50314/s 34276/s 25294/s + FU::Util 42121/s 25618/s 19203/s Object (large) Encode Canonical Decode - JSON::PP 927/s 747/s 104/s - JSON::Tiny 1108/s - 392/s - Cpanel::JSON::XS 30587/s 11875/s 15515/s - JSON::SIMD 24418/s 12388/s 22895/s - JSON::XS 23192/s 13174/s 23553/s - FU::Util 35489/s 13247/s 16571/s + JSON::PP 910/s 734/s 98/s + JSON::Tiny 1068/s - 404/s + Cpanel::JSON::XS 27626/s 12484/s 15333/s + JSON::SIMD 34106/s 12808/s 23674/s + JSON::XS 35738/s 13099/s 22637/s + FU::Util 37663/s 13366/s 16292/s Object (large, mixed unicode) Encode Canonical Decode - JSON::PP 817/s 679/s 86/s - JSON::Tiny 1036/s - 402/s - Cpanel::JSON::XS 25333/s 1459/s 7480/s - JSON::SIMD 25031/s 1331/s 15997/s - JSON::XS 23580/s 1375/s 8526/s - FU::Util 32519/s 12488/s 9290/s + JSON::PP 835/s 664/s 82/s + JSON::Tiny 1028/s - 427/s + Cpanel::JSON::XS 24123/s 1352/s 8694/s + JSON::SIMD 26008/s 1413/s 19707/s + JSON::XS 25444/s 1391/s 10442/s + FU::Util 33132/s 12006/s 11861/s Small integers Encode Decode - JSON::PP 113/s 29/s - JSON::Tiny 160/s 86/s - Cpanel::JSON::XS 7345/s 6151/s - JSON::SIMD 7963/s 4361/s - JSON::XS 7915/s 6058/s - FU::Util 7851/s 5828/s + JSON::PP 116/s 30/s + JSON::Tiny 158/s 86/s + Cpanel::JSON::XS 7426/s 5774/s + JSON::SIMD 8294/s 4375/s + JSON::XS 8526/s 6179/s + FU::Util 7996/s 5962/s Large integers Encode Decode - JSON::PP 2176/s 329/s - JSON::Tiny 2999/s 1638/s - Cpanel::JSON::XS 32545/s 50162/s - JSON::SIMD 37201/s 51719/s - JSON::XS 36722/s 50110/s - FU::Util 109163/s 63176/s + JSON::PP 2213/s 341/s + JSON::Tiny 2910/s 1661/s + Cpanel::JSON::XS 32616/s 53053/s + JSON::SIMD 37749/s 53032/s + JSON::XS 38644/s 55004/s + FU::Util 109930/s 63358/s ASCII strings Encode Decode - JSON::PP 2934/s 336/s - JSON::Tiny 4126/s 1439/s - Cpanel::JSON::XS 116721/s 44560/s - JSON::SIMD 134711/s 50429/s - JSON::XS 135419/s 43976/s - FU::Util 162246/s 44216/s + JSON::PP 2811/s 312/s + JSON::Tiny 3924/s 1506/s + Cpanel::JSON::XS 129468/s 51536/s + JSON::SIMD 140393/s 64499/s + JSON::XS 141149/s 56913/s + FU::Util 165938/s 55034/s Unicode strings Encode Decode - JSON::PP 5113/s 253/s - JSON::Tiny 6603/s 2585/s - Cpanel::JSON::XS 97039/s 67669/s - JSON::SIMD 106928/s 102440/s - JSON::XS 105473/s 60558/s - FU::Util 201648/s 57397/s + JSON::PP 5138/s 248/s + JSON::Tiny 6501/s 2677/s + Cpanel::JSON::XS 91004/s 64101/s + JSON::SIMD 101185/s 80941/s + JSON::XS 106312/s 61104/s + FU::Util 205716/s 52041/s String escaping (few) Encode Decode - JSON::PP 4251/s 352/s - JSON::Tiny 4704/s 1869/s - Cpanel::JSON::XS 136755/s 118059/s - JSON::SIMD 158171/s 153692/s - JSON::XS 157261/s 97676/s - FU::Util 225259/s 92515/s + JSON::PP 4269/s 329/s + JSON::Tiny 4878/s 2101/s + Cpanel::JSON::XS 152958/s 105597/s + JSON::SIMD 165340/s 130074/s + JSON::XS 165863/s 87872/s + FU::Util 228511/s 81599/s String escaping (many) Encode Decode - JSON::PP 3963/s 561/s - JSON::Tiny 4463/s 2175/s - Cpanel::JSON::XS 197154/s 133102/s - JSON::SIMD 199955/s 152557/s - JSON::XS 231905/s 125191/s - FU::Util 215367/s 118073/s + JSON::PP 4052/s 573/s + JSON::Tiny 4575/s 2274/s + Cpanel::JSON::XS 201958/s 102800/s + JSON::SIMD 242806/s 146341/s + JSON::XS 209689/s 98420/s + FU::Util 210713/s 100255/s @@ -173,10 +173,10 @@ templating modules will perform better, though. HTML fragment - TUWF::XML 795/s - XML::Writer 833/s - HTML::Tiny 423/s - FU::XMLWriter 5327/s + TUWF::XML 787/s + XML::Writer 832/s + HTML::Tiny 403/s + FU::XMLWriter 5192/s @@ -189,165 +189,165 @@ bottleneck where there shouldn't be one. Fetch and bitwise-or 20k integers Smallint Bigint - DBD::Pg 194/s 22/s - Pg::PQ 226/s 19/s - FU::Pg (bin) 245/s 22/s - FU::Pg (text) 217/s 20/s + DBD::Pg 346/s 33/s + Pg::PQ 270/s 24/s + FU::Pg (bin) 476/s 46/s + FU::Pg (text) 273/s 23/s =cut # 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 FU::Util 111328 -json/api Canonical JSON::PP 5119 -json/api Canonical JSON::SIMD 118948 -json/api Canonical JSON::XS 120243 -json/api Decode Cpanel::JSON::XS 107274 -json/api Decode FU::Util 117781 -json/api Decode JSON::PP 1290 -json/api Decode JSON::SIMD 115123 -json/api Decode JSON::Tiny 3426 -json/api Decode JSON::XS 117940 -json/api Encode Cpanel::JSON::XS 114802 -json/api Encode FU::Util 132067 -json/api Encode JSON::PP 5312 -json/api Encode JSON::SIMD 130137 -json/api Encode JSON::Tiny 7757 -json/api Encode JSON::XS 128421 -json/intl Decode Cpanel::JSON::XS 50162 -json/intl Decode FU::Util 63176 -json/intl Decode JSON::PP 329 -json/intl Decode JSON::SIMD 51719 -json/intl Decode JSON::Tiny 1638 -json/intl Decode JSON::XS 50110 -json/intl Encode Cpanel::JSON::XS 32545 -json/intl Encode FU::Util 109163 -json/intl Encode JSON::PP 2176 -json/intl Encode JSON::SIMD 37201 -json/intl Encode JSON::Tiny 2999 -json/intl Encode JSON::XS 36722 -json/ints Decode Cpanel::JSON::XS 6151 -json/ints Decode FU::Util 5828 -json/ints Decode JSON::PP 29 -json/ints Decode JSON::SIMD 4361 +json/api Canonical Cpanel::JSON::XS 98734 +json/api Canonical FU::Util 109166 +json/api Canonical JSON::PP 4943 +json/api Canonical JSON::SIMD 114822 +json/api Canonical JSON::XS 117518 +json/api Decode Cpanel::JSON::XS 105811 +json/api Decode FU::Util 113983 +json/api Decode JSON::PP 1240 +json/api Decode JSON::SIMD 118410 +json/api Decode JSON::Tiny 3474 +json/api Decode JSON::XS 120190 +json/api Encode Cpanel::JSON::XS 108128 +json/api Encode FU::Util 126909 +json/api Encode JSON::PP 5136 +json/api Encode JSON::SIMD 125105 +json/api Encode JSON::Tiny 7617 +json/api Encode JSON::XS 128749 +json/intl Decode Cpanel::JSON::XS 53053 +json/intl Decode FU::Util 63358 +json/intl Decode JSON::PP 341 +json/intl Decode JSON::SIMD 53032 +json/intl Decode JSON::Tiny 1661 +json/intl Decode JSON::XS 55004 +json/intl Encode Cpanel::JSON::XS 32616 +json/intl Encode FU::Util 109930 +json/intl Encode JSON::PP 2213 +json/intl Encode JSON::SIMD 37749 +json/intl Encode JSON::Tiny 2910 +json/intl Encode JSON::XS 38644 +json/ints Decode Cpanel::JSON::XS 5774 +json/ints Decode FU::Util 5962 +json/ints Decode JSON::PP 30 +json/ints Decode JSON::SIMD 4375 json/ints Decode JSON::Tiny 86 -json/ints Decode JSON::XS 6058 -json/ints Encode Cpanel::JSON::XS 7345 -json/ints Encode FU::Util 7851 -json/ints Encode JSON::PP 113 -json/ints Encode JSON::SIMD 7963 -json/ints Encode JSON::Tiny 160 -json/ints Encode JSON::XS 7915 -json/objl Canonical Cpanel::JSON::XS 11875 -json/objl Canonical FU::Util 13247 -json/objl Canonical JSON::PP 747 -json/objl Canonical JSON::SIMD 12388 -json/objl Canonical JSON::XS 13174 -json/objl Decode Cpanel::JSON::XS 15515 -json/objl Decode FU::Util 16571 -json/objl Decode JSON::PP 104 -json/objl Decode JSON::SIMD 22895 -json/objl Decode JSON::Tiny 392 -json/objl Decode JSON::XS 23553 -json/objl Encode Cpanel::JSON::XS 30587 -json/objl Encode FU::Util 35489 -json/objl Encode JSON::PP 927 -json/objl Encode JSON::SIMD 24418 -json/objl Encode JSON::Tiny 1108 -json/objl Encode JSON::XS 23192 -json/objs Canonical Cpanel::JSON::XS 30862 -json/objs Canonical FU::Util 24971 -json/objs Canonical JSON::PP 829 -json/objs Canonical JSON::SIMD 30699 -json/objs Canonical JSON::XS 31326 -json/objs Decode Cpanel::JSON::XS 20102 -json/objs Decode FU::Util 17998 -json/objs Decode JSON::PP 202 -json/objs Decode JSON::SIMD 23267 -json/objs Decode JSON::Tiny 499 -json/objs Decode JSON::XS 25336 -json/objs Encode Cpanel::JSON::XS 45732 -json/objs Encode FU::Util 39684 -json/objs Encode JSON::PP 907 -json/objs Encode JSON::SIMD 49019 -json/objs Encode JSON::Tiny 1224 -json/objs Encode JSON::XS 49814 -json/obju Canonical Cpanel::JSON::XS 1459 -json/obju Canonical FU::Util 12488 -json/obju Canonical JSON::PP 679 -json/obju Canonical JSON::SIMD 1331 -json/obju Canonical JSON::XS 1375 -json/obju Decode Cpanel::JSON::XS 7480 -json/obju Decode FU::Util 9290 -json/obju Decode JSON::PP 86 -json/obju Decode JSON::SIMD 15997 -json/obju Decode JSON::Tiny 402 -json/obju Decode JSON::XS 8526 -json/obju Encode Cpanel::JSON::XS 25333 -json/obju Encode FU::Util 32519 -json/obju Encode JSON::PP 817 -json/obju Encode JSON::SIMD 25031 -json/obju Encode JSON::Tiny 1036 -json/obju Encode JSON::XS 23580 -json/strel Decode Cpanel::JSON::XS 133102 -json/strel Decode FU::Util 118073 -json/strel Decode JSON::PP 561 -json/strel Decode JSON::SIMD 152557 -json/strel Decode JSON::Tiny 2175 -json/strel Decode JSON::XS 125191 -json/strel Encode Cpanel::JSON::XS 197154 -json/strel Encode FU::Util 215367 -json/strel Encode JSON::PP 3963 -json/strel Encode JSON::SIMD 199955 -json/strel Encode JSON::Tiny 4463 -json/strel Encode JSON::XS 231905 -json/stres Decode Cpanel::JSON::XS 118059 -json/stres Decode FU::Util 92515 -json/stres Decode JSON::PP 352 -json/stres Decode JSON::SIMD 153692 -json/stres Decode JSON::Tiny 1869 -json/stres Decode JSON::XS 97676 -json/stres Encode Cpanel::JSON::XS 136755 -json/stres Encode FU::Util 225259 -json/stres Encode JSON::PP 4251 -json/stres Encode JSON::SIMD 158171 -json/stres Encode JSON::Tiny 4704 -json/stres Encode JSON::XS 157261 -json/strs Decode Cpanel::JSON::XS 44560 -json/strs Decode FU::Util 44216 -json/strs Decode JSON::PP 336 -json/strs Decode JSON::SIMD 50429 -json/strs Decode JSON::Tiny 1439 -json/strs Decode JSON::XS 43976 -json/strs Encode Cpanel::JSON::XS 116721 -json/strs Encode FU::Util 162246 -json/strs Encode JSON::PP 2934 -json/strs Encode JSON::SIMD 134711 -json/strs Encode JSON::Tiny 4126 -json/strs Encode JSON::XS 135419 -json/stru Decode Cpanel::JSON::XS 67669 -json/stru Decode FU::Util 57397 -json/stru Decode JSON::PP 253 -json/stru Decode JSON::SIMD 102440 -json/stru Decode JSON::Tiny 2585 -json/stru Decode JSON::XS 60558 -json/stru Encode Cpanel::JSON::XS 97039 -json/stru Encode FU::Util 201648 -json/stru Encode JSON::PP 5113 -json/stru Encode JSON::SIMD 106928 -json/stru Encode JSON::Tiny 6603 -json/stru Encode JSON::XS 105473 -pg/ints Bigint DBD::Pg 22 -pg/ints Bigint FU::Pg (bin) 22 -pg/ints Bigint FU::Pg (text) 20 -pg/ints Bigint Pg::PQ 19 -pg/ints Smallint DBD::Pg 194 -pg/ints Smallint FU::Pg (bin) 245 -pg/ints Smallint FU::Pg (text) 217 -pg/ints Smallint Pg::PQ 226 -xml/a Rate FU::XMLWriter 5327 -xml/a Rate HTML::Tiny 423 -xml/a Rate TUWF::XML 795 -xml/a Rate XML::Writer 833 +json/ints Decode JSON::XS 6179 +json/ints Encode Cpanel::JSON::XS 7426 +json/ints Encode FU::Util 7996 +json/ints Encode JSON::PP 116 +json/ints Encode JSON::SIMD 8294 +json/ints Encode JSON::Tiny 158 +json/ints Encode JSON::XS 8526 +json/objl Canonical Cpanel::JSON::XS 12484 +json/objl Canonical FU::Util 13366 +json/objl Canonical JSON::PP 734 +json/objl Canonical JSON::SIMD 12808 +json/objl Canonical JSON::XS 13099 +json/objl Decode Cpanel::JSON::XS 15333 +json/objl Decode FU::Util 16292 +json/objl Decode JSON::PP 98 +json/objl Decode JSON::SIMD 23674 +json/objl Decode JSON::Tiny 404 +json/objl Decode JSON::XS 22637 +json/objl Encode Cpanel::JSON::XS 27626 +json/objl Encode FU::Util 37663 +json/objl Encode JSON::PP 910 +json/objl Encode JSON::SIMD 34106 +json/objl Encode JSON::Tiny 1068 +json/objl Encode JSON::XS 35738 +json/objs Canonical Cpanel::JSON::XS 28190 +json/objs Canonical FU::Util 25618 +json/objs Canonical JSON::PP 826 +json/objs Canonical JSON::SIMD 31157 +json/objs Canonical JSON::XS 34276 +json/objs Decode Cpanel::JSON::XS 19449 +json/objs Decode FU::Util 19203 +json/objs Decode JSON::PP 194 +json/objs Decode JSON::SIMD 23587 +json/objs Decode JSON::Tiny 519 +json/objs Decode JSON::XS 25294 +json/objs Encode Cpanel::JSON::XS 44184 +json/objs Encode FU::Util 42121 +json/objs Encode JSON::PP 896 +json/objs Encode JSON::SIMD 52633 +json/objs Encode JSON::Tiny 1216 +json/objs Encode JSON::XS 50314 +json/obju Canonical Cpanel::JSON::XS 1352 +json/obju Canonical FU::Util 12006 +json/obju Canonical JSON::PP 664 +json/obju Canonical JSON::SIMD 1413 +json/obju Canonical JSON::XS 1391 +json/obju Decode Cpanel::JSON::XS 8694 +json/obju Decode FU::Util 11861 +json/obju Decode JSON::PP 82 +json/obju Decode JSON::SIMD 19707 +json/obju Decode JSON::Tiny 427 +json/obju Decode JSON::XS 10442 +json/obju Encode Cpanel::JSON::XS 24123 +json/obju Encode FU::Util 33132 +json/obju Encode JSON::PP 835 +json/obju Encode JSON::SIMD 26008 +json/obju Encode JSON::Tiny 1028 +json/obju Encode JSON::XS 25444 +json/strel Decode Cpanel::JSON::XS 102800 +json/strel Decode FU::Util 100255 +json/strel Decode JSON::PP 573 +json/strel Decode JSON::SIMD 146341 +json/strel Decode JSON::Tiny 2274 +json/strel Decode JSON::XS 98420 +json/strel Encode Cpanel::JSON::XS 201958 +json/strel Encode FU::Util 210713 +json/strel Encode JSON::PP 4052 +json/strel Encode JSON::SIMD 242806 +json/strel Encode JSON::Tiny 4575 +json/strel Encode JSON::XS 209689 +json/stres Decode Cpanel::JSON::XS 105597 +json/stres Decode FU::Util 81599 +json/stres Decode JSON::PP 329 +json/stres Decode JSON::SIMD 130074 +json/stres Decode JSON::Tiny 2101 +json/stres Decode JSON::XS 87872 +json/stres Encode Cpanel::JSON::XS 152958 +json/stres Encode FU::Util 228511 +json/stres Encode JSON::PP 4269 +json/stres Encode JSON::SIMD 165340 +json/stres Encode JSON::Tiny 4878 +json/stres Encode JSON::XS 165863 +json/strs Decode Cpanel::JSON::XS 51536 +json/strs Decode FU::Util 55034 +json/strs Decode JSON::PP 312 +json/strs Decode JSON::SIMD 64499 +json/strs Decode JSON::Tiny 1506 +json/strs Decode JSON::XS 56913 +json/strs Encode Cpanel::JSON::XS 129468 +json/strs Encode FU::Util 165938 +json/strs Encode JSON::PP 2811 +json/strs Encode JSON::SIMD 140393 +json/strs Encode JSON::Tiny 3924 +json/strs Encode JSON::XS 141149 +json/stru Decode Cpanel::JSON::XS 64101 +json/stru Decode FU::Util 52041 +json/stru Decode JSON::PP 248 +json/stru Decode JSON::SIMD 80941 +json/stru Decode JSON::Tiny 2677 +json/stru Decode JSON::XS 61104 +json/stru Encode Cpanel::JSON::XS 91004 +json/stru Encode FU::Util 205716 +json/stru Encode JSON::PP 5138 +json/stru Encode JSON::SIMD 101185 +json/stru Encode JSON::Tiny 6501 +json/stru Encode JSON::XS 106312 +pg/ints Bigint DBD::Pg 33 +pg/ints Bigint FU::Pg (bin) 46 +pg/ints Bigint FU::Pg (text) 23 +pg/ints Bigint Pg::PQ 24 +pg/ints Smallint DBD::Pg 346 +pg/ints Smallint FU::Pg (bin) 476 +pg/ints Smallint FU::Pg (text) 273 +pg/ints Smallint Pg::PQ 270 +xml/a Rate FU::XMLWriter 5192 +xml/a Rate HTML::Tiny 403 +xml/a Rate TUWF::XML 787 +xml/a Rate XML::Writer 832 diff --git a/bench.PL b/bench.PL index 4bee131..fb95fb1 100755 --- a/bench.PL +++ b/bench.PL @@ -1,8 +1,9 @@ #!/usr/bin/perl # Can be invoked as: -# ./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 # 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 exec id x y # Run just the given benchmark and exit # # This script obviously has more dependencies than the FU distribution itself. # It's supposed to be used by maintainers, not users. @@ -30,30 +31,69 @@ my %modules = map +($_, eval "require $_; \$${_}::VERSION"), qw/ /; use FU::Pg; -my %data; # "id x y" => { id x y rate exists } -my %oldmodules; -{ if (open my $F, '<', 'FU/Benchmarks.pod') { - my $indata; - while (<$F>) { - chomp; - $oldmodules{$1} = $2 if /^=item L<([a-zA-Z0-9:]+)> ([0-9.]+)/; - $indata = 1 if /^# Cached data used by bench\.PL/; - next if !$indata || !$_ || /^#/; - my %d; - @d{qw/id x y rate/} = split /\t/; - $data{"$d{id} $d{x} $d{y}"} = \%d; - } -} } +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/.*/); -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 %data; # "id x y" => { id x y rate exists } +my @bench; # [ id, text, [ x_1, .. ], [ [ y_1, mod_1, sub_1, .. ], .. ] ] +my %oldmodules; +if (!@exec) { + if (open my $F, '<', 'FU/Benchmarks.pod') { + my $indata; + while (<$F>) { + chomp; + $oldmodules{$1} = $2 if /^=item L<([a-zA-Z0-9:]+)> ([0-9.]+)/; + $indata = 1 if /^# Cached data used by bench\.PL/; + next if !$indata || !$_ || /^#/; + my %d; + @d{qw/id x y rate/} = split /\t/; + $data{"$d{id} $d{x} $d{y}"} = \%d; + } + } } -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 () { + 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) { for my ($ya) (@ys) { my($y, $m, @sub) = @$ya; @@ -64,12 +104,6 @@ sub def($id, $text, $xs, @ys) { $data{$d} ||= { id => $id, x => $x, y => $y }; $d = $data{$d}; $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 ]; @@ -200,11 +234,11 @@ def 'xml/a', 'HTML fragment', [ 'Rate' ], { - die "FU_TEST_DB not set.\n" if !$ENV{FU_TEST_DB}; - my $pq = Pg::PQ::Conn->new($ENV{FU_TEST_DB}); - my $fu = FU::Pg->connect($ENV{FU_TEST_DB}); + die "FU_TEST_DB not set.\n" if @exec && !$ENV{FU_TEST_DB}; + my $pq = @exec && Pg::PQ::Conn->new($ENV{FU_TEST_DB}); + my $fu = @exec && FU::Pg->connect($ENV{FU_TEST_DB}); # 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 $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)'; @@ -227,42 +261,49 @@ def 'xml/a', 'HTML fragment', [ 'Rate' ], delete @data{ grep !$data{$_}{exists}, keys %data }; -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 ? sprintf '%10d/s', $d->{rate} : sprintf '%12s', '-'; - } - $r .= "\n"; - } - "$r\n" + +sub runbench($sub) { + my $o = timethis -1, $sub, 0, 'none'; + printf "%.2f\n", $o->iters/$o->real; + exit; } -{ - open my $F, '>FU/Benchmarks.pod' or die $!; - select $F; - while () { - 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; +sub execbench($d) { + my $sum = 0; + my $num = 1; + local $| = 1; + printf "%-20s%-12s%-20s", $d->{id}, $d->{x}, $d->{y}; + for (1..$num) { + open my $P, '-|', $^X, (map "-I$_", @INC), $0, 'exec', $d->{id}, $d->{x}, $d->{y}; + chomp(my $rate = <$P>); + printf "%10d", $rate; + $sum += $rate; } - for (sort keys %data) { - my $b = $data{$_}; - print join("\t", @{$b}{qw/ id x y rate /})."\n"; + printf " ->%10d\n", $sum/$num; + $d->{rate} = sprintf '%.0f', $sum/$num; +} + +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 __DATA__ %head1 NAME From 7980af731ecceb4ef58bf97af5e77ea1743bc6b0 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Sat, 10 Jan 2026 17:30:41 +0100 Subject: [PATCH 11/11] Version 1.4 --- ChangeLog | 7 +++++++ FU.pm | 2 +- FU/Benchmarks.pod | 2 +- FU/DebugImpl.pm | 2 +- FU/Log.pm | 2 +- FU/MultipartFormData.pm | 2 +- FU/Pg.pm | 2 +- FU/SQL.pm | 2 +- FU/Util.pm | 2 +- FU/Validate.pm | 2 +- FU/XMLWriter.pm | 2 +- FU/XS.pm | 2 +- 12 files changed, 18 insertions(+), 11 deletions(-) diff --git a/ChangeLog b/ChangeLog index f5ecc19..0774d6b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -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 - FU::Validate: Scalar validations now reject control characters by default - FU::Validate: Add `allow_control` option to override above behavior diff --git a/FU.pm b/FU.pm index 7d5df3b..cb73e10 100644 --- a/FU.pm +++ b/FU.pm @@ -1,4 +1,4 @@ -package FU 1.3; +package FU 1.4; use v5.36; use Carp 'confess', 'croak'; use IO::Socket; diff --git a/FU/Benchmarks.pod b/FU/Benchmarks.pod index e611832..b4b9182 100644 --- a/FU/Benchmarks.pod +++ b/FU/Benchmarks.pod @@ -30,7 +30,7 @@ The following module versions were used: =item L 3.18.0 -=item L 1.3 +=item L 1.4 =item L 1.08 diff --git a/FU/DebugImpl.pm b/FU/DebugImpl.pm index 0ffe8cf..4fd2a26 100644 --- a/FU/DebugImpl.pm +++ b/FU/DebugImpl.pm @@ -1,5 +1,5 @@ # Internal module used by FU.pm -package FU::DebugImpl 1.3; +package FU::DebugImpl 1.4; use v5.36; use utf8; use experimental 'for_list'; diff --git a/FU/Log.pm b/FU/Log.pm index f3b1fcf..44f881c 100644 --- a/FU/Log.pm +++ b/FU/Log.pm @@ -1,4 +1,4 @@ -package FU::Log 1.3; +package FU::Log 1.4; use v5.36; use Exporter 'import'; use POSIX 'strftime'; diff --git a/FU/MultipartFormData.pm b/FU/MultipartFormData.pm index ca21512..46c6a6d 100644 --- a/FU/MultipartFormData.pm +++ b/FU/MultipartFormData.pm @@ -1,4 +1,4 @@ -package FU::MultipartFormData 1.3; +package FU::MultipartFormData 1.4; use v5.36; use Carp 'confess'; use FU::Util 'utf8_decode'; diff --git a/FU/Pg.pm b/FU/Pg.pm index 294481c..465d076 100644 --- a/FU/Pg.pm +++ b/FU/Pg.pm @@ -1,4 +1,4 @@ -package FU::Pg 1.3; +package FU::Pg 1.4; use v5.36; use FU::XS; diff --git a/FU/SQL.pm b/FU/SQL.pm index 218a034..c33d680 100644 --- a/FU/SQL.pm +++ b/FU/SQL.pm @@ -1,4 +1,4 @@ -package FU::SQL 1.3; +package FU::SQL 1.4; use v5.36; use Exporter 'import'; use Carp 'confess'; diff --git a/FU/Util.pm b/FU/Util.pm index da8b869..84f10d7 100644 --- a/FU/Util.pm +++ b/FU/Util.pm @@ -1,4 +1,4 @@ -package FU::Util 1.3; +package FU::Util 1.4; use v5.36; use FU::XS; diff --git a/FU/Validate.pm b/FU/Validate.pm index f170bfc..74a50ce 100644 --- a/FU/Validate.pm +++ b/FU/Validate.pm @@ -1,4 +1,4 @@ -package FU::Validate 1.3; +package FU::Validate 1.4; use v5.36; use experimental 'builtin', 'for_list'; diff --git a/FU/XMLWriter.pm b/FU/XMLWriter.pm index 5364c5e..f80c20d 100644 --- a/FU/XMLWriter.pm +++ b/FU/XMLWriter.pm @@ -1,4 +1,4 @@ -package FU::XMLWriter 1.3; +package FU::XMLWriter 1.4; use v5.36; use Carp 'confess'; use Exporter 'import'; diff --git a/FU/XS.pm b/FU/XS.pm index b22fbbb..f6ed1f7 100644 --- a/FU/XS.pm +++ b/FU/XS.pm @@ -1,5 +1,5 @@ # 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 XSLoader; XSLoader::load('FU');