X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FGenerated.pm;h=53a90110f766fbd941f2ef5759344351b5dde3ec;hb=4fbd4b9bca7c0d3fead3f42a49e3671a6e7fc54f;hp=fca4cc9b85b85acd4d09d4e6438288c312e76de9;hpb=5d10c516c73e34da6e350bc567aaf8c272428c9b;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Generated.pm b/lib/Class/MOP/Method/Generated.pm index fca4cc9..53a9011 100644 --- a/lib/Class/MOP/Method/Generated.pm +++ b/lib/Class/MOP/Method/Generated.pm @@ -6,65 +6,56 @@ use warnings; use Carp 'confess'; -our $VERSION = '0.76'; +our $VERSION = '0.98'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Method'; -sub new { - my $class = shift; - my %options = @_; - - ($options{package_name} && $options{name}) - || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; - - my $self = $class->_new(\%options); - - $self->initialize_body; - - return $self; -} - -sub _new { - my $class = shift; - my $options = @_ == 1 ? $_[0] : {@_}; +use constant _PRINT_SOURCE => $ENV{MOP_PRINT_SOURCE} ? 1 : 0; - $options->{is_inline} ||= 0; - $options->{body} ||= undef; +## accessors - bless $options, $class; +sub new { + confess __PACKAGE__ . " is an abstract base class, you must provide a constructor."; } -## accessors - sub is_inline { $_[0]{is_inline} } sub definition_context { $_[0]{definition_context} } -sub initialize_body { +sub _initialize_body { confess "No body to initialize, " . __PACKAGE__ . " is an abstract base class"; } sub _eval_closure { # my ($self, $captures, $sub_body) = @_; my $__captures = $_[1]; - eval join( - "\n", - ( + + 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 - ), - $_[2] - ); + q[my ] + . $_ . q[ = ] + . $1 + . q[{$__captures->{'] + . $_ . q['}};]; + } keys %$__captures + ), + $_[2]; + print STDERR "\n", $_[0]->name, ":\n", $source, "\n" if _PRINT_SOURCE; + $code = eval $source; + $@; + }; + + return ( $code, $e ); } sub _add_line_directive { @@ -97,7 +88,7 @@ sub _compile_code { my $code = $self->_add_line_directive(%args); - $self->_eval_closure($args{environment}, $code); + return $self->_eval_closure($args{environment}, $code); } 1; @@ -112,36 +103,11 @@ Class::MOP::Method::Generated - Abstract base class for generated methods =head1 DESCRIPTION -This is a C subclass which is used interally -by C and C. - -=head1 METHODS - -=over 4 - -=item B - -This creates the method based on the criteria in C<%options>, -these options are: - -=over 4 - -=item I - -This is a boolean to indicate if the method should be generated -as a closure, or as a more optimized inline version. - -=back - -=item B - -This returns the boolean which was passed into C. - -=item B - -This is an abstract method and will throw an exception if called. +This is a C subclass which is subclassed by +C and +C. -=back +It is not intended to be used directly. =head1 AUTHORS @@ -149,7 +115,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L