[Catalyst-commits] r6862 - in trunk: . Catalyst-Plugin-LeakTracker Catalyst-Plugin-LeakTracker/lib Catalyst-Plugin-LeakTracker/lib/Catalyst Catalyst-Plugin-LeakTracker/lib/Catalyst/Plugin

[nothingmuch at dev.catalyst.perl.org]

Author: nothingmuch
Date: 2007-09-10 13:26:18 +0100 (Mon, 10 Sep 2007)
New Revision: 6862

Added:
   trunk/Catalyst-Plugin-LeakTracker/
   trunk/Catalyst-Plugin-LeakTracker/lib/
   trunk/Catalyst-Plugin-LeakTracker/lib/Catalyst/
   trunk/Catalyst-Plugin-LeakTracker/lib/Catalyst/Plugin/
   trunk/Catalyst-Plugin-LeakTracker/lib/Catalyst/Plugin/LeakTracker.pm
Log:
Add Catalyst::Plugin::LeakTracker

Added: trunk/Catalyst-Plugin-LeakTracker/lib/Catalyst/Plugin/LeakTracker.pm
===================================================================
--- trunk/Catalyst-Plugin-LeakTracker/lib/Catalyst/Plugin/LeakTracker.pm	                        (rev 0)
+++ trunk/Catalyst-Plugin-LeakTracker/lib/Catalyst/Plugin/LeakTracker.pm	2007-09-10 12:26:18 UTC (rev 6862)
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+package Catalyst::Plugin::LeakTracker;
+
+use strict;
+use warnings;
+
+use Devel::Events::Handler::ObjectTracker;
+use Devel::Events::Filter::Stamp;
+use Devel::Events::Filter::RemoveFields;
+use Devel::Events::Generator::Objects;
+
+use base qw/Class::Data::Inheritable/;
+
+__PACKAGE__->mk_classdata(qw/object_trackers devel_events_handler devel_events_generator/);
+
+sub setup {
+    my ( $app, @args ) = @_;
+
+    $app->object_trackers([]);
+
+    my $handler = $self->create_devel_events_handler();
+
+    my $generator = $self->create_devel_events_object_event_generator(
+        $sel->create_devel_events_filter_chain( $handler )
+    );
+
+    $self->devel_events_handler($handler);
+    $self->devel_events_generator($generator);
+
+    $app->NEXT::setup(@args);
+}
+
+# FIXME add events to prepare, dispatch and finalize
+
+sub handle_request {
+    my ( $app, @args ) = @_;
+
+    my $tracker = $self->create_devel_events_object_tracker;
+
+    push @{ $self->object_trackers }, $tracker;
+    
+    $handler->add_handler( $tracker );
+
+    my $handler = $self->devel_events_handler;
+
+    my $generator = $self->devel_events_generator;
+
+    $generator->handle_global_bless;
+
+    my $ret = $app->NEXT::dispatch(@args);
+
+    $generator->clear_global_bless;
+    
+    $handler->remove_handler( $tracker );
+
+    $ret;
+}
+
+sub create_devel_events_object_tracker {
+    my ( $self, @args ) = @_;
+
+    Devel::Events::Handler::ObjectTracker->new();
+}
+
+sub create_devel_events_object_event_generator {
+    my ( $self, @args ) = @_;
+
+    @args = ( hander => @args ) if @args == 1;
+
+    Devel::Events::Generator::Objects->new(
+        @args,
+    );
+}
+
+sub create_devel_events_filter_chain {
+    my ( $self, @args ) = @_;
+
+    @args = ( hander => @args ) if @args == 1;
+
+    Devel::Events::Filter::Stamp->new(
+        handler => Devel::Events::Filter::RemoveFields->new(
+            fields => [qw/generator/],
+            @args,
+        ),
+    );
+}
+
+
+__PACKAGE__;
+
+__END__
+
+