use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.01';
+our $VERSION = '0.56';
our $AUTHORITY = 'cpan:STEVAN';
-use base 'Moose::Meta::Method';
+use base 'Moose::Meta::Method',
+ 'Class::MOP::Method::Generated';
sub new {
my $class = shift;
(exists $options{options} && ref $options{options} eq 'HASH')
|| confess "You must pass a hash of options";
+
+ ($options{package_name} && $options{name})
+ || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
my $self = bless {
# from our superclass
- '&!body' => undef,
+ '&!body' => undef,
+ '$!package_name' => $options{package_name},
+ '$!name' => $options{name},
# ...
'%!options' => $options{options},
'$!associated_metaclass' => $options{metaclass},
# needed
weaken($self->{'$!associated_metaclass'});
- $self->intialize_body;
+ $self->initialize_body;
return $self;
}
## method
-sub is_needed { defined $_[0]->{'&!body'} ? 1 : 0 }
+sub is_needed {
+ my $self = shift;
+ # if called as a class method
+ # then must pass in a class name
+ unless (blessed $self) {
+ (blessed $_[0] && $_[0]->isa('Class::MOP::Class'))
+ || confess "When calling is_needed as a class method you must pass a class name";
+ return $_[0]->meta->can('DEMOLISH');
+ }
+ defined $self->{'&!body'} ? 1 : 0
+}
-sub intialize_body {
+sub initialize_body {
my $self = shift;
# TODO:
# the %options should also include a both
# of the possible use cases (even if it
# requires some adaption on the part of
# the author, after all, nothing is free)
+
+ my @DEMOLISH_methods = $self->associated_metaclass->find_all_methods_by_name('DEMOLISH');
+
+ return unless @DEMOLISH_methods;
+
my $source = 'sub {';
my @DEMOLISH_calls;
- foreach my $method ($self->associated_metaclass->find_all_methods_by_name('DEMOLISH')) {
+ foreach my $method (@DEMOLISH_methods) {
push @DEMOLISH_calls => '$_[0]->' . $method->{class} . '::DEMOLISH()';
}
- $source .= join "\n" => @DEMOLISH_calls;
+ $source .= join ";\n" => @DEMOLISH_calls;
$source .= ";\n" . '}';
warn $source if $self->options->{debug};
=item B<is_needed>
-=item B<intialize_body>
+=item B<initialize_body>
=item B<associated_metaclass>
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>