diff --git a/FU.pm b/FU.pm index 9a0d70a..e8da148 100644 --- a/FU.pm +++ b/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. This method sets an appropriate C header and supports conditional requests with C. +=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 Setting cookies. I JSON output. -I Redirection responses. - =head2 Running the Site diff --git a/FU/Log.pm b/FU/Log.pm index fce9b71..f93b8d6 100644 --- a/FU/Log.pm +++ b/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) diff --git a/FU/Pg.pm b/FU/Pg.pm index 25fa5b1..9db55a4 100644 --- a/FU/Pg.pm +++ b/FU/Pg.pm @@ -237,24 +237,26 @@ if no rows are returned or if its value is I. =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 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 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' }; diff --git a/FU/SQL.pm b/FU/SQL.pm index 56027e0..c3ff97f 100644 --- a/FU/SQL.pm +++ b/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' } diff --git a/FU/Util.pm b/FU/Util.pm index 34d61d8..6a176e4 100644 --- a/FU/Util.pm +++ b/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 ] } diff --git a/c/pgst.c b/c/pgst.c index 1442297..a9e3448 100644 --- a/c/pgst.c +++ b/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; infields; i++) mPUSHs(fupg_st_getval(aTHX_ st, 0, i)); - return st->nfields; + for (i=0; iresult) == 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; diff --git a/t/pgconnect.t b/t/pgconnect.t index 2a77cf6..5e40638 100644 --- a/t/pgconnect.t +++ b/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}; diff --git a/t/query.t b/t/query.t index 599f50f..5b37cec 100644 --- a/t/query.t +++ b/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 diff --git a/t/sql.t b/t/sql.t index b035a19..e6b7378 100644 --- a/t/sql.t +++ b/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];