Devel::Events::Generator::Require - Event generator for loading of code using

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

Index

Code Index:

NAME

Top

Devel::Events::Generator::Require - Event generator for loading of code using require.

SYNOPSIS

Top

	use Devel::Events::Generator::Require;

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

	$g->enable();

	# all calls to require() will generate a try_require and a require_finished event

	$g->disable();

	# events disabled

DESCRIPTION

Top

This generator allows instrumentation of module/file loading via require. This includes use statements.

EVENTS

Top

try_require

Fired before require actually happens.

file

The file that require was given.

Note that when doing <require Foo::Bar>, the parameter passed into CORE::require is actually <Foo/Bar.pm>, and not the module name.

require_finished

Fired at the end of every require, successful and unsuccessful.

file

The file that require was given.

matched_file

The entry of file in %INC.

error

The load error, if any.

return_value

The value returend by the file. This is always a scalar.

METHODS

Top

enable

Make this instance the enabled one (disabling any other instance which is enabled).

This only applies to the object_bless method.

disable

Disable this instance. Will stop generating object_bless events. =item try_require

Generates the try_require event.

require_finished

Generates the require_finished event.

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

package Devel::Events::Generator::Require;

use strict;
use warnings;

use Try::Tiny;
use Sub::Uplevel;
use Scalar::Util qw(weaken);

my $SINGLETON;

BEGIN {
	# before Moose or anything else is parsed, we overload CORE::GLOBAL::require

	require Carp::Heavy;

	*CORE::GLOBAL::require = sub {
		my $file = shift;

		if ( defined $SINGLETON ) {
			$SINGLETON->try_require( file => $file );
		}

		# require is always in scalar context
		my $ret = try {
			uplevel 5, sub { CORE::require($file) };
		} catch {
			unless ( ref ) {
				my $this_file = quotemeta(__FILE__);
				my ( $caller_file, $caller_line ) = (caller(2))[1,2];
				s/at $this_file line \d+\.$/at $caller_file line $caller_line./os;
			}

			if ( defined $SINGLETON ) {
				$SINGLETON->require_finished(
					file         => $file,
					matched_file => $INC{$file},
					error        => $_,
				);
			}

			die $_;
		};

		if ( defined $SINGLETON ) {
			$SINGLETON->require_finished(
				file         => $file,
				matched_file => $INC{$file},
				return_value => $ret,
			);
		}

		return $ret;
	}
}

use Moose;

with qw(Devel::Events::Generator);

sub enable {
	my $self = shift;
	$SINGLETON = $self;
	weaken($SINGLETON);
}

sub disable {
	$SINGLETON = undef;
}

sub try_require {
	my ( $self, @args ) = @_;

	$self->send_event( try_require => @args );
}

sub require_finished {
	my ( $self, @args ) = @_;

	$self->send_event( require_finished => @args );
}


__PACKAGE__;

__END__