Devel::Events::Generator::SubTrace - generate C<executing_line> events using

Devel-Events documentation Contained in the Devel-Events distribution.

Index

Code Index:

NAME

Top

Devel::Events::Generator::SubTrace - generate executing_line events using the perl debugger api.

SYNOPSIS

Top

	my $g = Devel::Events::Generator::SubTrace->new( handler => $h );

	$g->enable();

	# every subroutine will have two events fired, on entry and exit

	$g->disable();

DESCRIPTION

Top

This Devel::Events generator will fire sub tracing events using DB::sub, a perl debugger hook.

Only one instance may be enabled at a given time. Use Devel::Events::Handler::Multiplex to deliver events to multiple handlers.

Subroutines inside the Devel::Events namespace or it's children will be skipped.

EVENTS

Top

enter_sub

When the generator is enabled, this event will fire for every subroutine, just before it is executed.

Subroutines in a package starting with Devel::Events:: will not be reported.

name

The name of the subroutine (or it's overload::StrVal if it has none).

code

A code reference to the subroutine.

args

A copy of the arguments list. \@_ causes segfaults but [ @_ ] does not. Bummer ;-)

depth

The current depth of the call stack.

wantarray

The context of the call as given by wantarray

leave_sub

Exactly like enter_sub, but fired just after leaving the subroutine.

All the fields of enter_sub are passed.

Additional fields:

ret

The return value of the subroutine.

METHODS

Top

enable

Enable this generator instance, disabling any other instance of Devel::Events::Generator::SubTrace.

disable

Stop firing events.

enter_sub

Called by DB::sub. Sends the enter_sub event.

leave_sub

Called by DB::sub. Sends the leave_sub event.

SEE ALSO

Top

perldebguts, Devel::CallTrace, DB, Devel::ebug, perl5db.pl

Devel-Events documentation Contained in the Devel-Events distribution. 
#!/usr/bin/perl

use Moose ();
use Moose::Role ();

BEGIN { $^P |= 0x01 }

package Devel::Events::Generator::SubTrace;
use Moose;

with qw/Devel::Events::Generator/;

use Scalar::Util ();

my ( $SINGLETON );
our ( $IGNORE, $DEPTH ); # can't local a lexical ;_;

BEGIN { $DEPTH = -1 };

{
	package DB;

	our $sub;

	sub sub {
		local $DEPTH = $DEPTH + 1;

		unless ( $SINGLETON
			and  !$IGNORE,
			and  $sub !~ /^Devel::Events::/
		) {
			no strict 'refs';
			goto &$sub;
		}

		my @ret;
		my $ret;

		my $tsub ="$sub";
		$tsub = 'main' unless $tsub;

		my @args = (
			'name'      => "$tsub",
			'code'      => \&$tsub,
			'args'      => [ @_ ],
			'depth'     => $DEPTH,
			'wantarray' => wantarray(),
		);

		push @args, autoload => do { no strict 'refs'; $$tsub }
			if (( length($tsub) > 10) && (substr( $tsub, -10, 10 ) eq '::AUTOLOAD' ));

		$SINGLETON->enter_sub(@args);

		{
			no strict 'refs';

			if (wantarray) {
				@ret = &$sub;
			}
			elsif (defined wantarray) {
				$ret = &$sub;
			}
			else {
				&$sub;
			}
		}

		$SINGLETON->leave_sub(
			@args,
			ret => (wantarray) ? \@ret : defined(wantarray) ? $ret : undef,
		);

		return (wantarray) ? @ret : defined(wantarray) ? $ret : undef;
	}
}

sub enter_sub {
	my ( $self, @data ) = @_;
	local $IGNORE = 1;

	$self->send_event( enter_sub => @data );
}

sub leave_sub {
	my ( $self, @data ) = @_;
	local $IGNORE = 1;

	$self->send_event( leave_sub => @data );
}

sub enable {
	my $self = shift;
	local $IGNORE = 1;
	$SINGLETON = $self;
	Scalar::Util::weaken($SINGLETON);
}

sub disable {
	$SINGLETON = undef;
}

__PACKAGE__;

__END__