adding meta moose
Stevan Little [Mon, 6 Mar 2006 17:06:24 +0000 (17:06 +0000)]
lib/Moose.pm
lib/Moose/Meta/Attribute.pm [new file with mode: 0644]
lib/Moose/Meta/Class.pm [new file with mode: 0644]
lib/Moose/Object.pm

index 8813e6d..ebd2cd3 100644 (file)
@@ -1,4 +1,6 @@
 
+use lib '/Users/stevan/CPAN/Class-MOP/Class-MOP/lib';
+
 package Moose;
 
 use strict;
@@ -9,7 +11,9 @@ our $VERSION = '0.01';
 use Scalar::Util 'blessed';
 use Carp         'confess';
 
-use Class::MOP;
+use Moose::Meta::Class;
+use Moose::Meta::Attribute;
+
 use Moose::Object;
 
 sub import {
@@ -23,33 +27,34 @@ 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);                            
 }
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
new file mode 100644 (file)
index 0000000..f3c9c63
--- /dev/null
@@ -0,0 +1,68 @@
+
+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
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
new file mode 100644 (file)
index 0000000..5d5f1af
--- /dev/null
@@ -0,0 +1,55 @@
+
+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
index 6835bd2..6df798f 100644 (file)
@@ -6,10 +6,29 @@ use warnings;
 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__
@@ -32,6 +51,10 @@ Moose::Object -
 
 =item B<new>
 
+=item B<BUILDALL>
+
+=item B<DEMOLISHALL>
+
 =back
 
 =head1 BUGS