+use lib '/Users/stevan/CPAN/Class-MOP/Class-MOP/lib';
+
package Moose;
use strict;
use Scalar::Util 'blessed';
use Carp 'confess';
-use Class::MOP;
+use Moose::Meta::Class;
+use Moose::Meta::Attribute;
+
use Moose::Object;
sub import {
|| confess "Whoops, not møøsey enough";
}
else {
- $meta = Class::MOP::Class->initialize($pkg);
+ $meta = Moose::Meta::Class->initialize($pkg => (
+ ':attribute_metaclass' => 'Moose::Meta::Attribute'
+ ));
}
- $meta->alias_method('has' => sub {
- my ($name, %options) = @_;
- my ($init_arg) = ($name =~ /^[\$\@\%][\.\:](.*)$/);
- $meta->add_attribute($name => (
- init_arg => $init_arg,
- %options,
- ));
- });
+ # handle attributes
+ $meta->alias_method('has' => sub { $meta->add_attribute(@_) });
+ # handle method modifers
$meta->alias_method('before' => sub {
my $code = pop @_;
$meta->add_before_method_modifier($_, $code) for @_;
});
-
$meta->alias_method('after' => sub {
my $code = pop @_;
$meta->add_after_method_modifier($_, $code) for @_;
});
+ $meta->alias_method('around' => sub {
+ my $code = pop @_;
+ $meta->add_around_method_modifier($_, $code) for @_;
+ });
- $meta->alias_method('around' => sub { $meta->add_around_method_modifier(@_) });
-
+ # make sure they inherit from Moose::Object
$meta->superclasses('Moose::Object')
unless $meta->superclasses();
+ # we recommend using these things
+ # so export them for them
$meta->alias_method('confess' => \&confess);
$meta->alias_method('blessed' => \&blessed);
}
--- /dev/null
+
+package Moose::Meta::Attribute;
+
+use strict;
+use warnings;
+
+use base 'Class::MOP::Attribute';
+
+Moose::Meta::Attribute->meta->add_around_method_modifier('new' => sub {
+ my $cont = shift;
+ my ($class, $attribute_name, %options) = @_;
+
+ # extract the sigil and accessor name
+ my ($init_arg) = ($attribute_name =~ /^[\$\@\%][\.\:](.*)$/);
+
+ $cont->($class, $attribute_name, (init_arg => $init_arg, %options));
+});
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::Attribute -
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<new>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 CODE COVERAGE
+
+I use L<Devel::Cover> to test the code coverage of my tests, below is the
+L<Devel::Cover> report on this module's test suite.
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
\ No newline at end of file
--- /dev/null
+
+package Moose::Meta::Class;
+
+use strict;
+use warnings;
+
+use base 'Class::MOP::Class';
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::Class -
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 CODE COVERAGE
+
+I use L<Devel::Cover> to test the code coverage of my tests, below is the
+L<Devel::Cover> report on this module's test suite.
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
\ No newline at end of file
use metaclass;
sub new {
- my $class = shift;
- $class->meta->new_object(@_);
+ my $class = shift;
+ my %params = @_;
+ my $self = $class->meta->new_object(%params);
+ $self->BUILDALL(%params);
+ return $self;
}
+sub BUILDALL {
+ my ($self, %params) = @_;
+ foreach my $method ($self->meta->find_all_methods_by_name('BUILD')) {
+ $method->{method}->($self, %params);
+ }
+}
+
+sub DEMOLISHALL {
+ my $self = shift;
+ foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) {
+ $method->{method}->($self);
+ }
+}
+
+sub DESTROY { goto &DEMOLISHALL }
+
1;
__END__
=item B<new>
+=item B<BUILDALL>
+
+=item B<DEMOLISHALL>
+
=back
=head1 BUGS