view release on metacpan or  search on metacpan

lib/Catalyst/Controller/LeakTracker.pm  view on Meta::CPAN

#!/usr/bin/perl

package Catalyst::Controller::LeakTracker;
use parent qw(Catalyst::Controller);

use Moose;

our $VERSION = "0.08";

use Data::Dumper ();
use Devel::Cycle ();
use Devel::Size ();
use Tie::RefHash::Weak ();
use YAML::XS ();
use Scalar::Util qw(weaken);

use namespace::clean -except => "meta";

{
    package Catalyst::Controller::LeakTracker::Template;

    use Template::Declare::Tags 'HTML'; # conflicts with Moose
}

my $size_of_empty_array = Devel::Size::total_size([]);

sub end : Private { } # don't get Root's one

sub order_by {
    my ( $self, $objects, $field, $mode ) = @_;
    return () unless @$objects;

    my $order_by_meth = {
        num => sub {
            sort { $a->{$field} <=> $b->{$field} } @{$_[0]}
        },
        num_desc => sub {
            sort { $b->{$field} <=> $a->{$field} } @{$_[0]}
        },
        lex => sub {
            sort { $a->{$field} cmp $b->{$field} } @{$_[0]}
        },
        lex_desc => sub {
            sort { $b->{$field} cmp $a->{$field} } @{$_[0]}
        },
    };
    my $order_by_map;
    if ( $mode && $mode eq 'desc' ) {
        $order_by_map = {
            ( map {
                $_ => $order_by_meth->{'num_desc'}
              } qw/id time leaks size/ ),
            ( map {
                $_ => $order_by_meth->{'lex_desc'}
              } qw/action uri class/ ),
        };
    }
    else {
        $order_by_map = {
            ( map {
                $_ => $order_by_meth->{'num'}
              } qw/id time leaks size/ ),
            ( map {
                $_ => $order_by_meth->{'lex'}
              } qw/action uri class/ ),
        };
    }
    if ( my $meth = $order_by_map->{$field} ) {
        return $meth->($objects);
    }
    else {
        return @$objects;
    }
}

lib/Catalyst/Controller/LeakTracker.pm  view on Meta::CPAN

                        };
                        a {
                            attr {
                                href => $c->req->uri_with({
                                    order_by => $_,
                                    order_by_desc => $desc,
                                })
                            } $_
                        };
                    }
                } @fields
            };

            foreach my $leak ( @leaks ) {
                row {
                    foreach my $field ( @fields ) {
                        my $formatter = $fmt{$field};

                        cell {
                            attr { style => "padding: 0.2em" }
                            $formatter->($leak->{$field});
                        }
                    }
                }
            }
        }
    };

    $c->res->content_type("text/html");

    $c->res->body( "" . do { package Catalyst::Controller::LeakTracker::Template;
        html {
            head { }
            body {
                h1 { "Leaks" }
                pre { $leaks->() }

                $log ? (
                    h1 { "Events" }
                    pre { $log_output }
                ) : ()
            }
        }
    });
}

sub make_leak : Chained {
    my ( $self, $c, $n ) = @_;

    $n ||= 1;

    $n = 300 if $n > 300;

    for ( 1 .. $n ) {
        my $object = bless {}, "class::a";
        $object->{foo}{self} = $object;
    }

    my $object2 = bless {}, "class::b";
    $object2->{foo}{self} = $object2;
    weaken($object2->{foo}{self});

    my $object3 = bless [], "class::c";
    push @$object3, $object3, map { [ 1 .. $n ] } 1 .. $n;

    $c->res->body("it leaks " . ( $n + 1 ) . " objects");
}

__PACKAGE__;

__END__

=pod

=head1 NAME

Catalyst::Controller::LeakTracker - Inspect leaks found by L<Catalyst::Plugin::LeakTracker>

=head1 SYNOPSIS

    # in MyApp.pm

	package MyApp;

	use Catalyst qw(
		LeakTracker
	);

	#### in SomeController.pm

	package MyApp::Controller::Leaks;
    use Moose;

    use parent qw(Catalyst::Controller::LeakTracker);

    sub index :Path :Args(0) {
        my ( $self, $c ) = @_;
        $c->forward("list_requests"); # redirect to request listing view
    }

=head1 DESCRIPTION

This controller uses L<Catalyst::Controller::LeakTracker> to display leak info
on a per request basis.

=head1 ACTIONS

=over 4

=item list_requests

List the leaking requests this process has handled so far.

If the C<all> parameter is set to a true value, then all requests (even non
leaking ones) are listed.

=item request $request_id

Detail the leaks for a given request, and also dump the event log for that request.

=item object $request_id $event_id