Add fu->redirect, change $st->row behavior on 0 results, minor fixes
And with this, I have a working rewrite of the manned.org backend into FU. \o/ The $st->row methods are very useful even for queries that may not return anything, so their old behavior was unhelpful. Interestingly enough, the error-on-multiple-rows did catch an actual bug in Manned.org, so I'm keeping that behavior.
This commit is contained in:
Yorhel
parent
fbbaa23842
commit
06e2f950fe
9 changed files with 62 additions and 34 deletions
32
FU.pm
32
FU.pm
|
|
@ -26,7 +26,7 @@ sub fu() { $fu }
|
|||
FU::Log::capture_warn(1);
|
||||
FU::Log::set_fmt(sub($msg) {
|
||||
FU::Log::default_fmt($msg,
|
||||
fu->path && fu->method ? fu->method.' '.fu->path.(fu->query?'?'.fu->query:'') : '[init]',
|
||||
fu->path && fu->method ? fu->method.' '.fu->path.(fu->query?'?'.fu->query:'') : '[global]',
|
||||
);
|
||||
});
|
||||
|
||||
|
|
@ -292,10 +292,12 @@ sub _log_err($e) {
|
|||
return if !debug && ref $@ eq 'FU::err' && $@->[0] != 500;
|
||||
if (!$REQ->{full_err} && (ref $@ ne 'FU::err' || $@->[0] == 500)) {
|
||||
$REQ->{full_err}++;
|
||||
$e =~ s/^\s+//;
|
||||
$e =~ s/\s+$//;
|
||||
log_write join "\n",
|
||||
'IP: '.($REQ->{ip}||'-'),
|
||||
'Headers:', (map " $_: $REQ->{hdr}{$_}", sort keys $REQ->{hdr}->%*),
|
||||
'ERROR:', $e =~ s/(^|\n)/\n /rg;
|
||||
'ERROR:'.($e =~ s/(^|\n)/\n /rg);
|
||||
# TODO: decoded body, if we have that.
|
||||
} else {
|
||||
log_write $e;
|
||||
|
|
@ -667,6 +669,7 @@ sub send_file($, $root, $path) {
|
|||
return if $path =~ /\.\./;
|
||||
|
||||
my $fn = "$root/$path";
|
||||
return if !-f $fn;
|
||||
my $m = (stat $fn)[9];
|
||||
return if !defined $m;
|
||||
|
||||
|
|
@ -690,6 +693,16 @@ sub send_file($, $root, $path) {
|
|||
fu->done;
|
||||
}
|
||||
|
||||
sub redirect($, $code, $location) {
|
||||
state $alias = {qw/ perm 301 temp 302 tempget 303 tempsame 307 permsame 308 /};
|
||||
fu->reset;
|
||||
fu->status($alias->{$code} // $code);
|
||||
fu->set_header(location => "$location");
|
||||
fu->set_header('content-type', 'text/plain');
|
||||
fu->set_body("Redirecting to $location\n");
|
||||
fu->done;
|
||||
}
|
||||
|
||||
sub _error_page($, $code, $title, $msg) {
|
||||
fu->reset;
|
||||
fu->status($code);
|
||||
|
|
@ -1236,14 +1249,25 @@ C<application/octet-stream>.
|
|||
This method sets an appropriate C<last-modified> header and supports
|
||||
conditional requests with C<if-modified-since>.
|
||||
|
||||
=item fu->redirect($code, $location)
|
||||
|
||||
Generates a HTTP redirect response and calls C<< fu->done >>. C<$code> can be
|
||||
one of the following status codes or an alias:
|
||||
|
||||
Status Alias Semantics
|
||||
----------------------------------------
|
||||
301 perm Permanent, method may or may not change to GET
|
||||
302 temp Temporary, method may or may not change to GET
|
||||
303 tempget Temporary to GET
|
||||
307 tempsame Temporary without changing method
|
||||
308 permsame Permanent without changing method
|
||||
|
||||
=back
|
||||
|
||||
I<TODO:> Setting cookies.
|
||||
|
||||
I<TODO:> JSON output.
|
||||
|
||||
I<TODO:> Redirection responses.
|
||||
|
||||
|
||||
=head2 Running the Site
|
||||
|
||||
|
|
|
|||
|
|
@ -12,6 +12,8 @@ our $in_log = 0;
|
|||
|
||||
sub default_fmt($msg, @extra) {
|
||||
my $pre = '';
|
||||
$msg =~ s/^\s+//;
|
||||
$msg =~ s/\s+$//;
|
||||
if ($msg =~ /\n/) {
|
||||
$msg =~ s/(^|\n)/\n# /g;
|
||||
$msg .= "\n";
|
||||
|
|
@ -25,7 +27,6 @@ sub default_fmt($msg, @extra) {
|
|||
sub log_write($msg) {
|
||||
local $SIG{__WARN__} = undef if $capture_warn;
|
||||
|
||||
chomp $msg;
|
||||
my $line = (!$in_log && eval {
|
||||
local $in_log = 1;
|
||||
$fmt->($msg)
|
||||
|
|
|
|||
14
FU/Pg.pm
14
FU/Pg.pm
|
|
@ -237,24 +237,26 @@ if no rows are returned or if its value is I<NULL>.
|
|||
|
||||
=item $st->rowl
|
||||
|
||||
Return the first row as a list. Throws an error if the query does not return
|
||||
exactly one row.
|
||||
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;
|
||||
# ($id, $title) = (1, 'Revelation Space');
|
||||
|
||||
=item $st->rowa
|
||||
|
||||
Return the first row as an arrayref, equivalent to C<< [$st->rowl] >> but
|
||||
might be slightly more efficient.
|
||||
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
|
||||
rows.
|
||||
|
||||
my $row = $conn->q('SELECT id, title FROM books LIMIT 1')->rowa;
|
||||
# $row = [1, 'Revelation Space'];
|
||||
|
||||
=item $st->rowh
|
||||
|
||||
Return the first row as a hashref. Also throws an error if the query returns
|
||||
multiple columns with the same name.
|
||||
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
|
||||
the same name.
|
||||
|
||||
my $row = $conn->q('SELECT id, title FROM books LIMIT 1')->rowh;
|
||||
# $row = { id => 1, title => 'Revelation Space' };
|
||||
|
|
|
|||
|
|
@ -51,7 +51,7 @@ sub VALUES {
|
|||
: SQL 'VALUES (', COMMA(@_), ')';
|
||||
}
|
||||
|
||||
sub IN($a) {
|
||||
sub IN :prototype($) ($a) {
|
||||
confess "Expected arrayref" if ref $a ne 'ARRAY';
|
||||
bless \$a, 'FU::SQL::in'
|
||||
}
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ sub uri_unescape :prototype($) ($s) {
|
|||
sub query_decode :prototype($) ($s) {
|
||||
my %o;
|
||||
for (split /&/, $s//'') {
|
||||
my($k,$v) = map uri_unescape($_), split /=/;
|
||||
my($k,$v) = map uri_unescape($_), split /=/, $_, 2;
|
||||
$v //= builtin::true;
|
||||
if (ref $o{$k}) { push $o{$k}->@*, $v }
|
||||
elsif (exists $o{$k}) { $o{$k} = [ $o{$k}, $v ] }
|
||||
|
|
|
|||
14
c/pgst.c
14
c/pgst.c
|
|
@ -363,23 +363,23 @@ static SV *fupg_st_val(pTHX_ fupg_st *st) {
|
|||
static I32 fupg_st_rowl(pTHX_ fupg_st *st, I32 ax) {
|
||||
dSP;
|
||||
fupg_st_execute(aTHX_ st);
|
||||
if (PQntuples(st->result) == 0) fu_confess("Invalid use of $st->rowl() on query returning zero rows");
|
||||
if (PQntuples(st->result) > 1) fu_confess("Invalid use of $st->rowl() on query returning more than one row");
|
||||
int nfields = PQntuples(st->result) == 0 ? 0 : st->nfields;
|
||||
if (GIMME_V != G_LIST) {
|
||||
ST(0) = sv_2mortal(newSViv(st->nfields));
|
||||
ST(0) = sv_2mortal(newSViv(nfields));
|
||||
return 1;
|
||||
}
|
||||
(void)POPs;
|
||||
EXTEND(SP, st->nfields);
|
||||
EXTEND(SP, nfields);
|
||||
int i;
|
||||
for (i=0; i<st->nfields; i++) mPUSHs(fupg_st_getval(aTHX_ st, 0, i));
|
||||
return st->nfields;
|
||||
for (i=0; i<nfields; i++) mPUSHs(fupg_st_getval(aTHX_ st, 0, i));
|
||||
return nfields;
|
||||
}
|
||||
|
||||
static SV *fupg_st_rowa(pTHX_ fupg_st *st) {
|
||||
fupg_st_execute(aTHX_ st);
|
||||
if (PQntuples(st->result) == 0) fu_confess("Invalid use of $st->rowl() on query returning zero rows");
|
||||
if (PQntuples(st->result) > 1) fu_confess("Invalid use of $st->rowl() on query returning more than one row");
|
||||
if (PQntuples(st->result) == 0) return &PL_sv_undef;
|
||||
AV *av = st->nfields == 0 ? newAV() : newAV_alloc_x(st->nfields);
|
||||
SV *sv = sv_2mortal(newRV_noinc((SV *)av));
|
||||
int i;
|
||||
|
|
@ -390,8 +390,8 @@ static SV *fupg_st_rowa(pTHX_ fupg_st *st) {
|
|||
static SV *fupg_st_rowh(pTHX_ fupg_st *st) {
|
||||
fupg_st_execute(aTHX_ st);
|
||||
fupg_st_check_dupcols(aTHX_ st, 0);
|
||||
if (PQntuples(st->result) == 0) fu_confess("Invalid use of $st->rowh() on query returning zero rows");
|
||||
if (PQntuples(st->result) > 1) fu_confess("Invalid use of $st->rowh() on query returning more than one row");
|
||||
if (PQntuples(st->result) == 0) return &PL_sv_undef;
|
||||
HV *hv = newHV();
|
||||
SV *sv = sv_2mortal(newRV_noinc((SV *)hv));
|
||||
int i;
|
||||
|
|
|
|||
|
|
@ -117,9 +117,6 @@ subtest '$st->val', sub {
|
|||
};
|
||||
|
||||
subtest '$st->rowl', sub {
|
||||
ok !eval { $conn->q('SELECT 1 WHERE false')->rowl; 1 };
|
||||
like $@, qr/on query returning zero rows/;
|
||||
|
||||
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowl; 1 };
|
||||
like $@, qr/on query returning more than one row/;
|
||||
|
||||
|
|
@ -130,34 +127,31 @@ subtest '$st->rowl', sub {
|
|||
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], [];
|
||||
};
|
||||
|
||||
subtest '$st->rowa', sub {
|
||||
ok !eval { $conn->q('SELECT 1 WHERE false')->rowa; 1 };
|
||||
like $@, qr/on query returning zero rows/;
|
||||
|
||||
ok !eval { $conn->q('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];
|
||||
|
||||
};
|
||||
|
||||
subtest '$st->rowh', sub {
|
||||
ok !eval { $conn->q('SELECT 1 WHERE false')->rowh; 1 };
|
||||
like $@, qr/on query returning zero rows/;
|
||||
|
||||
ok !eval { $conn->q('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 };
|
||||
like $@, qr/Query returns multiple columns with the same name/;
|
||||
|
||||
ok !eval { $conn->q('SELEXT')->rowh; 1; };
|
||||
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};
|
||||
|
|
|
|||
|
|
@ -18,6 +18,13 @@ is query_encode
|
|||
{ "\xfe" => [ 1, undef, 3, builtin::false, builtin::true ] },
|
||||
"%c3%be=1&%c3%be=3&%c3%be";
|
||||
|
||||
is_deeply
|
||||
query_decode('a=&a=&b=&c==x&d=x='),
|
||||
{ a => ['', ''], b => '', c => '=x', d => 'x=' };
|
||||
|
||||
is query_encode { a => ['', ''], b => '', c => '=x', d => 'x=' }, 'a=&a=&b=&c=%3dx&d=x%3d';
|
||||
|
||||
|
||||
sub FUTILTEST::TO_QUERY { '&'.($_[0][0] + 1) }
|
||||
|
||||
is query_encode
|
||||
|
|
|
|||
8
t/sql.t
8
t/sql.t
|
|
@ -62,11 +62,11 @@ t VALUES([1, $x, 'NOW()', RAW 'NOW()']), 'VALUES ( ? , ? , ? , NOW() )', [1, $x,
|
|||
t VALUES(P {}), 'VALUES ( ? )', [{}];
|
||||
t VALUES(P []), 'VALUES ( ? )', [[]];
|
||||
|
||||
t IN([1,2,'a',undef,$x]), 'IN(?,?,?,?,?)', [1,2,'a',undef,$x];
|
||||
t IN([1,2,'a',undef,$x]), '= ANY(?)', [[1,2,'a',undef,$x]], in_style => 'pg';
|
||||
t IN([]), '= ANY($1)', [[]], in_style => 'pg', placeholder_style => 'pg';
|
||||
t IN [1,2,'a',undef,$x], 'IN(?,?,?,?,?)', [1,2,'a',undef,$x];
|
||||
t IN [1,2,'a',undef,$x], '= ANY(?)', [[1,2,'a',undef,$x]], in_style => 'pg';
|
||||
t IN [], '= ANY($1)', [[]], in_style => 'pg', placeholder_style => 'pg';
|
||||
|
||||
t WHERE({ id => IN([1,2]) }), 'WHERE ( id IN(?,?) )', [1,2];
|
||||
t WHERE({ id => IN [1,2] }), 'WHERE ( id IN(?,?) )', [1,2];
|
||||
|
||||
sub somefunc { 'not actually const' }
|
||||
t SQL(somefunc), '?', [somefunc];
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue