lib/Class/MOP/Method/Generated.pm

   1
   2 package Class::MOP::Method::Generated;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp 'confess';
   8 use Eval::Closure;
   9
  10 our $VERSION   = '1.11';
  11 $VERSION = eval $VERSION;
  12 our $AUTHORITY = 'cpan:STEVAN';
  13
  14 use base 'Class::MOP::Method';
  15
  16 ## accessors
  17
  18 sub new {
  19     confess __PACKAGE__ . " is an abstract base class, you must provide a constructor.";
  20 }
  21
  22 sub _initialize_body {
  23     confess "No body to initialize, " . __PACKAGE__ . " is an abstract base class";
  24 }
  25
  26 sub _generate_description {
  27     my ( $self, $context ) = @_;
  28     $context ||= $self->definition_context;
  29
  30     return "generated method (unknown origin)"
  31         unless defined $context;
  32
  33     if (defined $context->{description}) {
  34         return "$context->{description} "
  35              . "(defined at $context->{file} line $context->{line})";
  36     } else {
  37         return "$context->{file} (line $context->{line})";
  38     }
  39 }
  40
  41 sub _compile_code {
  42     my ( $self, @args ) = @_;
  43     unshift @args, 'source' if @args % 2;
  44     my %args = @args;
  45
  46     my $context = delete $args{context};
  47     my $environment = $self->can('_eval_environment')
  48         ? $self->_eval_environment
  49         : {};
  50
  51     return eval_closure(
  52         environment => $environment,
  53         description => $self->_generate_description($context),
  54         %args,
  55     );
  56 }
  57
  58 1;
  59
  60 __END__
  61
  62 =pod
  63
  64 =head1 NAME
  65
  66 Class::MOP::Method::Generated - Abstract base class for generated methods
  67
  68 =head1 DESCRIPTION
  69
  70 This is a C<Class::MOP::Method> subclass which is subclassed by
  71 C<Class::MOP::Method::Accessor> and
  72 C<Class::MOP::Method::Constructor>.
  73
  74 It is not intended to be used directly.
  75
  76 =head1 AUTHORS
  77
  78 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  79
  80 =head1 COPYRIGHT AND LICENSE
  81
  82 Copyright 2006-2010 by Infinity Interactive, Inc.
  83
  84 L<http://www.iinteractive.com>
  85
  86 This library is free software; you can redistribute it and/or modify
  87 it under the same terms as Perl itself.
  88
  89 =cut
  90