X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FGenerated.pm;h=abdeb65aa11f5d7a419d6ea8e79c6045ca12df5a;hb=15961c86cfd845e6f46b6c362cc1a4b94ffb45db;hp=76e2dfc8333f9c6cc732924d791f575b52c3533b;hpb=c808e3d5c3b5fa953d6b9a3ee7ce4cd2b7925f6c;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Generated.pm b/lib/Class/MOP/Method/Generated.pm index 76e2dfc..abdeb65 100644 --- a/lib/Class/MOP/Method/Generated.pm +++ b/lib/Class/MOP/Method/Generated.pm @@ -5,46 +5,55 @@ use strict; use warnings; use Carp 'confess'; +use Eval::Closure; -our $VERSION = '0.67'; +our $VERSION = '1.11'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Method'; +## accessors + 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; + confess __PACKAGE__ . " is an abstract base class, you must provide a constructor."; } -sub _new { - my $class = shift; - my $options = @_ == 1 ? $_[0] : {@_}; - - $options->{is_inline} ||= 0; - $options->{body} ||= undef; - - bless $options, $class; +sub _initialize_body { + confess "No body to initialize, " . __PACKAGE__ . " is an abstract base class"; } -## accessors +sub _generate_description { + my ( $self, $context ) = @_; + $context ||= $self->definition_context; -sub is_inline { (shift)->{'is_inline'} } + return "generated method (unknown origin)" + unless defined $context; -sub initialize_body { - confess "No body to initialize, " . __PACKAGE__ . " is an abstract base class"; + if (defined $context->{description}) { + return "$context->{description} " + . "(defined at $context->{file} line $context->{line})"; + } else { + return "$context->{file} (line $context->{line})"; + } } - +sub _compile_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; @@ -58,36 +67,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 @@ -95,7 +79,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