use warnings;
use Carp 'confess';
+use Eval::Closure;
-our $VERSION = '1.08';
+our $VERSION = '1.11';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
confess __PACKAGE__ . " is an abstract base class, you must provide a constructor.";
}
-sub is_inline { $_[0]{is_inline} }
-
-sub definition_context { $_[0]{definition_context} }
-
sub _initialize_body {
confess "No body to initialize, " . __PACKAGE__ . " is an abstract base class";
}
-sub _eval_closure {
- my ($self, $__captures, $sub_body) = @_;
-
- my $code;
-
- my $e = do {
- local $@;
- local $SIG{__DIE__};
- my $source = join
- "\n", (
- map {
- /^([\@\%\$])/
- or die "capture key should start with \@, \% or \$: $_";
- q[my ]
- . $_ . q[ = ]
- . $1
- . q[{$__captures->{']
- . $_ . q['}};];
- } keys %$__captures
- ),
- $sub_body;
-
- $self->_dump_source($source) if $ENV{MOP_PRINT_SOURCE};
-
- $code = eval $source;
- $@;
- };
-
- return ( $code, $e );
-}
-
-sub _dump_source {
- my ( $self, $source ) = @_;
-
- my $output;
- if ( eval { require Perl::Tidy } ) {
- require File::Spec;
-
- my $rc_file = File::Spec->catfile(
- $INC{'Class/MOP/Method/Generated.pm'},
- ('..') x 5,
- 'perltidyrc'
- );
-
- my %p = (
- source => \$source,
- destination => \$output,
- );
- $p{perltidyrc} = $rc_file
- if -f $rc_file;
-
- Perl::Tidy::perltidy(%p);
- }
- else {
- $output = $source;
- }
-
- print STDERR "\n", $self->name, ":\n", $output, "\n";
-}
-
-sub _add_line_directive {
- my ( $self, %args ) = @_;
+sub _generate_description {
+ my ( $self, $context ) = @_;
+ $context ||= $self->definition_context;
- my ( $line, $file );
+ return "generated method (unknown origin)"
+ unless defined $context;
- if ( my $ctx = ( $args{context} || $self->definition_context ) ) {
- $line = $ctx->{line};
- if ( my $desc = $ctx->{description} ) {
- $file = "$desc defined at $ctx->{file}";
- } else {
- $file = $ctx->{file};
- }
+ if (defined $context->{description}) {
+ return "$context->{description} "
+ . "(defined at $context->{file} line $context->{line})";
} else {
- ( $line, $file ) = ( 0, "generated method (unknown origin)" );
+ return "$context->{file} (line $context->{line})";
}
-
- my $code = $args{code};
-
- # if it's an array of lines, join it up
- # don't use newlines so that the definition context is more meaningful
- $code = join(@$code, ' ') if ref $code;
-
- return qq{#line $line "$file"\n} . $code;
}
sub _compile_code {
- my ( $self, %args ) = @_;
-
- my $code = $self->_add_line_directive(%args);
-
- return $self->_eval_closure($args{environment}, $code);
+ my ( $self, @args ) = @_;
+ unshift @args, 'source' if @args % 2;
+ my %args = @args;
+
+ my $context = delete $args{context};
+ my $environment = $self->can('_eval_environment')
+ ? $self->_eval_environment
+ : {};
+
+ return eval_closure(
+ environment => $environment,
+ description => $self->_generate_description($context),
+ %args,
+ );
}
1;