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.

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
 

FU/Log.pm

@@ -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)

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
+Return the first row as a list, or an empty list if no rows are returned.
-exactly one row.
+Throws an error if the query returned more than one row.
 
   my($id, $title) = $conn->q('SELECT id, title FROM books LIMIT 1')->rowl;
   # ($id, $title) = (1, 'Revelation Space');
 
 =item $st->rowa
 
-Return the first row as an arrayref, equivalent to C<< [$st->rowl] >> but
+Return the first row as an arrayref, equivalent to C<< [$st->rowl] >> but might
-might be slightly more efficient.
+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
+Return the first row as a hashref. Returns C<undef> if the query did not
-multiple columns with the same name.
+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' };

FU/SQL.pm

@@ -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'
 }

FU/Util.pm

@@ -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 ] }

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));
+    for (i=0; i<nfields; i++) mPUSHs(fupg_st_getval(aTHX_ st, 0, i));
-    return st->nfields;
+    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;

t/pgconnect.t

@@ -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};

t/query.t

@@ -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

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], 'IN(?,?,?,?,?)', [1,2,'a',undef,$x];
-t IN([1,2,'a',undef,$x]), '= ANY(?)', [[1,2,'a',undef,$x]], in_style => 'pg';
+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 [], '= 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];