view release on metacpan or  search on metacpan

FU/DebugImpl.pm  view on Meta::CPAN

                                td_ $k;
                                td_ $_;
                            } for ref $formdata->{$k} ? $formdata->{$k}->@* : ($formdata->{$k});
                        }
                    };
                } if $formdata;
                my $multipart = eval { fu->multipart };
                details_ name => 'reqbody', open => !0, sub {
                    summary_ 'Multipart';
                    pre_ join "\n", map $_->describe, @$multipart;
                } if $multipart;
                details_ name => 'reqbody', open => !0,sub {
                    my($lbl, $data) = raw_data $r->{body};
                    summary_ "Raw ($lbl)";
                    pre_ $data;
                };
            }
        }
        ('Request')
    },

    res => sub {
        my $r = $FU::REQ;
        return () if !exists $r->{trace_end};
        table_ sub {
            tr_ sub { td_ 'Status'; td_ $r->{status} };
            tr_ sub {
                td_ 'Handler';
                td_ $r->{trace_han} ? sub {
                    txt_ clean_re $r->{trace_han}[0];
                    br_;
                    loc_ $r->{trace_han}[1];
                } : 'N/A';
            };
            my $exn = $r->{trace_exn};
            tr_ sub {
                td_ 'Exception';
                td_ !defined $exn ? 'N/A' : ref $exn eq 'FU::err' ? sub {
                    txt_ $exn->[0];
                    txt_ " $exn->[1]" if $exn->[1] ne $exn->[0];
                    br_;
                    loc_ $exn->[2];
                } : $exn;
            };
            tr_ sub { td_ 'Timing'; td_ sprintf '%.1f ms', ($r->{trace_end}-$r->{trace_start})*1000 };
        };
        h2_ 'Headers';
        table_ sub {
            for my $k (sort keys $r->{reshdr}->%*) {
                my $v = $r->{reshdr}{$k};
                tr_ sub {
                    td_ $k;
                    td_ $_;
                } for !defined $v ? () : ref $v ? @$v : ($v);
            }
        };
        my $body = $r->{resbody_orig} // $r->{resbody};
        if (length $body) {
            h2_ 'Body';
            section_ class => 'tabs', sub {
                my $json = ($r->{reshdr}{'content-type'}||'') =~ /^application\/json/ && eval { FU::Util::json_parse($body, utf8 => 1) };
                details_ name => 'resbody', open => !0, sub {
                    summary_ 'JSON';
                    pre_ FU::Util::json_format($json, pretty => 1, canonical => 1);
                } if $json;
                details_ name => 'resbody', open => !0,sub {
                    my($lbl, $data) = raw_data $body;
                    summary_ "Raw ($lbl)";
                    pre_ $data;
                };
            }
        }
        ('Response')
    },

    sql => sub {
        my $queries = $FU::REQ->{trace_sql};
        return () if !$queries;

        # Convert binary params to text.
        # For queries with text_params, assume the params are already valid for the text format.
        my @binparams = grep $_->{type} && !exists $_->{text}, map $_->{params}->@*, @$queries;
        my @arg = map +($_->{type}, $_->{bin}), @binparams;
        my @text;
        my $ok = !@arg || eval { @text = $FU::DB->bin2text(@arg); 1 };
        $binparams[$_]{text} = $text[$_] for 0..$#text;
        pre_ "Error converting binary parameters:\n$@" if !$ok;

        input_ type => 'checkbox', id => "row${_}_c" for 0..$#{$queries};
        table_ class => 'sqlt', sub {
            thead_ sub { tr_ sub {
                td_ class => 'num', 'Exec';
                td_ class => 'num', 'Prep';
                td_ class => 'num', 'Rows';
                td_ 'Query';
            } };
            my $rows = 0;
            for my($i, $st) (builtin::indexed $queries->@*) {
                $rows += $st->{nrows};
                tr_ sub {
                    td_ class => 'num', sprintf '%.1f ms', $st->{exec_time}*1000;
                    td_ class => 'num', !defined $st->{prepare_time} ? '-' : $st->{prepare_time} ? sprintf '%.1f ms', $st->{prepare_time}*1000 : 'cache';
                    td_ class => 'num', $st->{nrows};
                    td_ class => 'sum', sub {
                        label_ for => "row${i}_c", sub {
                            span_ class => 'closed', 'â–¶';
                            span_ class => 'open', 'â–¼';
                            txt_ $st->{query} =~ s/[\r\n]/ /rg =~ s/\s\s+/ /rg =~ s/^\s+//r;
                        };
                    };
                };
                tr_ class => 'details', id => "row$i", sub {
                    td_ '';
                    td_ colspan => 3, sub {
                        pre_ $st->{query};
                        if ($st->{params}->@*) {
                            strong_ 'Parameters:';
                            table_ sub {
                                tr_ sub {
                                    td_ class => 'num', sprintf '$%d =', $_+1;
                                    td_ class => 'code', sub {

FU/DebugImpl.pm  view on Meta::CPAN

            } if @$data;
            main_ sub {
                for (@$data) {
                    h1_ id => $_->{id}, $_->{title};
                    lit_ $_->{html};
                }
            };
        };
    };
}

sub listing {
    opendir my $dh, $FU::debug_info->{storage} or do {
        warn "Error opening '$FU::debug_info->{storage}': $!\n";
        return;
    };
    my @f;
    /^fu-([0-9a-f]{22})\.txt$/ && push @f, $1 while (readdir $dh);
    return [sort @f];
}

sub listing_ {
    my $lst = listing;
    return p_ 'Request logging disabled.' if !$FU::debug_info->{storage} || !$FU::debug_info->{history};
    return p_ 'No requests logged.' if !@$lst;
    table_ sub {
        tr_ sub {
            open my $fh, '<:utf8', "$FU::debug_info->{storage}/fu-$_.txt" or return;
            my($ts, $time, $status, $method, $uri) = split / /, scalar <$fh>, 5;
            td_ sub { a_ href => "?$_", $_ };
            td_ class => 'num', fmtts $ts;
            td_ class => 'num', sprintf '%.0f ms', $time*1000;
            td_ class => 'num', $status;
            td_ $method;
            td_ $uri;
        } for reverse @$lst;
    }
}

sub load($id) {
    open my $fn, '<', "$FU::debug_info->{storage}/fu-$id.txt" or fu->notfound;
    scalar <$fn>;
    local $/=undef;
    fu->set_body(scalar <$fn>);
}

sub css {
    # Awful CSS row hiding hack. I'm not sorry.
    state $css = join '', <DATA>, map qq{
        #row${_}_c:checked ~ * label[for=row${_}_c] .closed { display: none }
        #row${_}_c:not(:checked) ~ * label[for=row${_}_c] .open { display: none }
        #row${_}_c:not(:checked) ~ * #row${_} { display: none }
    }, 0..1000;
}

sub render {
    my $q = fu->query;
    if (!$q) {
        fu->set_body(framework_ [{id => 'lst', title => 'Recent Requests', html => fragment \&listing_ }]);
    } elsif ($q eq 'css') {
        fu->set_header('content-type', 'text/css');
        fu->set_header('cache-control', 'max-age=86400');
        fu->set_body(css());
    } elsif ($q eq 'cur') {
        fu->set_body(framework_ collect);
    } elsif ($q eq 'last') {
        my $lst = listing;
        fu->notfound if !@$lst;
        load $lst->[$#$lst];
    } elsif ($FU::debug_info->{storage} && $q =~ /^[0-9a-f]{22}$/) {
        load $q;
    } else {
        fu->notfound
    }
}

sub save {
    my $files = listing;
    unlink sprintf '%s/fu-%s.txt', $FU::debug_info->{storage}, shift @$files while @$files >= $FU::debug_info->{history};

    delete $FU::REQ->{txn};

    my $fn = "$FU::debug_info->{storage}/fu-$FU::REQ->{trace_id}.txt";
    open my $fh, '>', $fn or do {
        warn "Error opening '$fn': $!\n";
        return;
    };
    my $line = sprintf "%d %f %s %s %s\n",
        time, $FU::REQ->{trace_end} - $FU::REQ->{trace_start}, $FU::REQ->{status},
        fu->method, fu->path.(fu->query?'?'.fu->query:'');
    utf8::encode($line);
    print $fh $line;
    print $fh framework_ collect;
}

1;

__DATA__
html { box-sizing: border-box; color: #000; background: #fff }
*, *:before, *:after { box-sizing: inherit }
* { margin: 0; padding: 0; font: inherit; color: inherit }

/* Ugh, fixed positioning */
header { position: fixed; top: 0; left: 0; width: 100%; height: 40px; z-index: 2 }
nav { position: fixed; top: 38px; left: 0; width: 200px; z-index: 2 }
main { margin: 0 0 0 200px }

header, nav { background: #eee }
header { border-bottom: 2px solid #009 }
nav { border-bottom: 2px solid #009; border-right: 2px solid #009 }

header { display: flex; justify-content: space-between; align-items: baseline; padding: 5px 10px }
header h1 { font-size: 120%; font-weight: bold }
header menu { list-style-type: none; display: flex; gap: 15px }

body > input { display: none }
nav { padding-top: 20px }
nav menu { list-style-type: none }
nav a { display: block; width: 100%; text-decoration: none; padding: 2px 10px; cursor: pointer; white-space: nowrap }
nav a:hover { background-color: #fff }
nav a span { float: right; font-size: 80% }