File Coverage

blib/lib/Aspect/Library/ZoneTimer.pm

Criterion	Covered	Total	%
statement	73	75	97.3
branch	8	10	80.0
condition	4	6	66.6
subroutine	12	12	100.0
pod	0	1	0.0
total	97	104	93.2

package Aspect::Library::ZoneTimer;

use 5.008002;
use strict;
use warnings;
use Carp                   ();
use Params::Util      1.00 ();
use Aspect::Modular   1.00 ();
use Aspect::Advice::Around ();
use Time::HiRes     1.9718 ();

use vars qw{$VERSION @ISA};
BEGIN {
	$VERSION = '1.10';
	@ISA     = 'Aspect::Modular';
}

sub get_advice {
	my $self    = shift;
	my %params  = @_;
	my $zones   = $params{zones};
	my $handler = $params{handler};

	# Check params
	unless ( Params::Util::_HASH($zones) ) {
		Carp::croak("Did not provide a set of zones");
	}
	unless ( Params::Util::_CODELIKE($handler) ) {
		Carp::croak("Did not provide a handler function");
	}

	# Variables to be shared between all advice closures
	my @STACK   = (); # Storage for timing data
	my $DISABLE = 0;  # Prevent recursion in the report handler

	# Create one advice for each zone
	my @advice = ();
	foreach ( sort keys %$zones ) {
		my $zone     = $_;
		my $pointcut = $zones->{$zone};
		push @advice, Aspect::Advice::Around->new(
			lexical  => $self->lexical,
			pointcut => $pointcut,
			code     => sub {
				# Shortcut if we are inside the same zone
				# or inside the handler.
				if ( $DISABLE or @STACK and $STACK[-1]->[0] eq $zone ) {
					$_->proceed;
					return;
				}

				# Execute the function and capture timing
				my $error = '';
				SCOPE: {
					local $@;
					push @STACK, [ $zone, { } ];
					my @start = Time::HiRes::gettimeofday();
					eval {
						$_->proceed;
					};
					$error = $@;
					my @stop  = Time::HiRes::gettimeofday();
					my $frame = pop @STACK;
					my $total = $frame->[1];

					# Use our own interval math, generating a value
					# in integer microseconds, to avoid potential
					# floating point bugs in Time::HiRes::tv_interval.
					my $interval = ( $stop[0]  * 1000000 + $stop[1]  )
						     - ( $start[0] * 1000000 + $start[1] );

					if ( @STACK ) {
						# Calculate the exclusive time for the
						# current stack frame and merge up to
						# the totals already in our parent.
						my $parent = $STACK[-1]->[1];
						foreach my $z ( keys %$total ) {
							$interval -= $total->{$z};
							$parent->{$z} += $total->{$z};
						}
						$parent->{$zone} += $interval;

					} else {
						# Calculate the exclusive time for the current
						# zone and add it to any reentered zone
						# beneath us.
						foreach my $z ( keys %$total ) {
							$interval -= $total->{$z};
						}
						$total->{$zone} += $interval;

						# Send the report to the handler, including
						# our start and stop times in case they are
						# handy for the report.
						$DISABLE++;
						eval {
							$handler->(
								$zone,
								\@start,
								\@stop,
								$total,
							);
						};
						$DISABLE--;
					}
				}

				# Pass through any exceptions
				die $error if $error;
				return;
			},
		);
	}

	return @advice;
}

1;

__END__