Make the new method in CMOP::Method::Generated throw an error. This is an abstract...
[gitmo/Class-MOP.git] / lib / Class / MOP / Method / Generated.pm
CommitLineData
565f0cbb 1
2package Class::MOP::Method::Generated;
3
4use strict;
5use warnings;
6
7use Carp 'confess';
8
eca95e04 9our $VERSION = '0.78';
d519662a 10$VERSION = eval $VERSION;
565f0cbb 11our $AUTHORITY = 'cpan:STEVAN';
12
13use base 'Class::MOP::Method';
14
cfde7a47 15## accessors
e3a72dbc 16
cfde7a47 17sub new {
18 confess __PACKAGE__ . " is an abstract base class, you must provide a constructor.";
e3a72dbc 19}
20
d9d99689 21sub is_inline { $_[0]{is_inline} }
22
23sub definition_context { $_[0]{definition_context} }
565f0cbb 24
25sub initialize_body {
26 confess "No body to initialize, " . __PACKAGE__ . " is an abstract base class";
27}
28
7f8de9b4 29sub _eval_closure {
0c6f3280 30 # my ($self, $captures, $sub_body) = @_;
31 my $__captures = $_[1];
a6eef5a3 32 eval join(
0c6f3280 33 "\n",
2507ef3a 34 (
35 map {
36 /^([\@\%\$])/
37 or die "capture key should start with \@, \% or \$: $_";
38 q[my ]
39 . $_ . q[ = ]
40 . $1
41 . q[{$__captures->{']
42 . $_
43 . q['}};];
44 } keys %$__captures
45 ),
0c6f3280 46 $_[2]
47 );
7f8de9b4 48}
565f0cbb 49
12f7b801 50sub _add_line_directive {
51 my ( $self, %args ) = @_;
52
53 my ( $line, $file );
54
55 if ( my $ctx = ( $args{context} || $self->definition_context ) ) {
56 $line = $ctx->{line};
57 if ( my $desc = $ctx->{description} ) {
58 $file = "$desc defined at $ctx->{file}";
59 } else {
60 $file = $ctx->{file};
61 }
62 } else {
63 ( $line, $file ) = ( 0, "generated method (unknown origin)" );
64 }
65
66 my $code = $args{code};
67
68 # if it's an array of lines, join it up
69 # don't use newlines so that the definition context is more meaningful
70 $code = join(@$code, ' ') if ref $code;
71
72 return qq{#line $line "$file"\n} . $code;
73}
74
75sub _compile_code {
76 my ( $self, %args ) = @_;
77
78 my $code = $self->_add_line_directive(%args);
79
80 $self->_eval_closure($args{environment}, $code);
81}
82
565f0cbb 831;
84
85__END__
86
87=pod
88
89=head1 NAME
90
91Class::MOP::Method::Generated - Abstract base class for generated methods
92
93=head1 DESCRIPTION
94
95This is a C<Class::MOP::Method> subclass which is used interally
96by C<Class::MOP::Method::Accessor> and C<Class::MOP::Method::Constructor>.
97
98=head1 METHODS
99
100=over 4
101
102=item B<new (%options)>
103
104This creates the method based on the criteria in C<%options>,
105these options are:
106
107=over 4
108
109=item I<is_inline>
110
111This is a boolean to indicate if the method should be generated
112as a closure, or as a more optimized inline version.
113
114=back
115
116=item B<is_inline>
117
118This returns the boolean which was passed into C<new>.
119
120=item B<initialize_body>
121
122This is an abstract method and will throw an exception if called.
123
124=back
125
126=head1 AUTHORS
127
128Stevan Little E<lt>stevan@iinteractive.comE<gt>
129
130=head1 COPYRIGHT AND LICENSE
131
070bb6c9 132Copyright 2006-2009 by Infinity Interactive, Inc.
565f0cbb 133
134L<http://www.iinteractive.com>
135
136This library is free software; you can redistribute it and/or modify
137it under the same terms as Perl itself.
138
139=cut
140