uploadin

diff --git a/lib/Moose.pm b/lib/Moose.pm
index ebd2cd3..b70436a 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -10,6 +10,7 @@ our $VERSION = '0.01';
 
 use Scalar::Util 'blessed';
 use Carp         'confess';
+use Sub::Name    'subname';
 
 use Moose::Meta::Class;
 use Moose::Meta::Attribute;
@@ -29,22 +30,29 @@ sub import {
        else {
                $meta = Moose::Meta::Class->initialize($pkg => (
                        ':attribute_metaclass' => 'Moose::Meta::Attribute'
-               ));
+               ));             
        }
        
+       # NOTE:
+       # &alias_method will install the method, but it 
+       # will not name it with 
+       
+       # handle superclasses
+       $meta->alias_method('extends' => subname 'Moose::extends' => sub { $meta->superclasses(@_) });
+       
        # handle attributes
-       $meta->alias_method('has' => sub { $meta->add_attribute(@_) });
+       $meta->alias_method('has' => subname 'Moose::has' => sub { $meta->add_attribute(@_) });
 
        # handle method modifers
-       $meta->alias_method('before' => sub { 
+       $meta->alias_method('before' => subname 'Moose::before' => sub { 
                my $code = pop @_;
                $meta->add_before_method_modifier($_, $code) for @_; 
        });
-       $meta->alias_method('after'  => sub { 
+       $meta->alias_method('after'  => subname 'Moose::after' => sub { 
                my $code = pop @_;
                $meta->add_after_method_modifier($_, $code)  for @_;
        });     
-       $meta->alias_method('around' => sub { 
+       $meta->alias_method('around' => subname 'Moose::around' => sub { 
                my $code = pop @_;
                $meta->add_around_method_modifier($_, $code)  for @_;   
        });     
@@ -72,6 +80,8 @@ Moose -
 =head1 SYNOPSIS
 
   package Point;
+  use strict;
+  use warnings;
   use Moose;
   
   has '$.x' => (reader   => 'x');
@@ -84,9 +94,11 @@ Moose -
   }
   
   package Point3D;
+  use strict;
+  use warnings;
   use Moose;
   
-  use base 'Point';
+  extends 'Point';
   
   has '$:z';
   

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index f3c9c63..0d4f30b 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -4,13 +4,15 @@ package Moose::Meta::Attribute;
 use strict;
 use warnings;
 
+our $VERSION = '0.01';
+
 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
+    # extract the init_arg
     my ($init_arg) = ($attribute_name =~ /^[\$\@\%][\.\:](.*)$/);     
     
     $cont->($class, $attribute_name, (init_arg => $init_arg, %options));

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 5d5f1af..058b9ed 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -4,6 +4,8 @@ package Moose::Meta::Class;
 use strict;
 use warnings;
 
+our $VERSION = '0.01';
+
 use base 'Class::MOP::Class';
 
 1;

diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm
index 6df798f..5d4de68 100644 (file)
--- a/lib/Moose/Object.pm
+++ b/lib/Moose/Object.pm
@@ -3,7 +3,12 @@ package Moose::Object;
 
 use strict;
 use warnings;
-use metaclass;
+
+use metaclass 'Moose::Meta::Class' => (
+       ':attribute_metaclass' => 'Moose::Meta::Attribute'
+);
+
+our $VERSION = '0.01';
 
 sub new {
     my $class  = shift;

diff --git a/t/001_basic.t b/t/001_basic.t
index 93fb3b7..2d072a2 100644 (file)
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -3,7 +3,8 @@
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More tests => 32;
+use Test::Exception;
 
 BEGIN {
     use_ok('Moose');           
@@ -29,7 +30,7 @@ BEGIN {
        use warnings;
        use Moose;
        
-       use base 'Point';
+       extends 'Point';
        
        has '$:z';
        
@@ -42,14 +43,17 @@ BEGIN {
 
 my $point = Point->new(x => 1, y => 2);        
 isa_ok($point, 'Point');
+isa_ok($point, 'Moose::Object');
 
 is($point->x, 1, '... got the right value for x');
 is($point->y, 2, '... got the right value for y');
 
 $point->y(10);
-
 is($point->y, 10, '... got the right (changed) value for y');
 
+$point->x(1000);
+is($point->x, 1, '... got the right (un-changed) value for x');
+
 $point->clear();
 
 is($point->x, 0, '... got the right (cleared) value for x');
@@ -58,13 +62,66 @@ is($point->y, 0, '... got the right (cleared) value for y');
 my $point3d = Point3D->new(x => 10, y => 15, z => 3);
 isa_ok($point3d, 'Point3D');
 isa_ok($point3d, 'Point');
+isa_ok($point3d, 'Moose::Object');
 
 is($point3d->x, 10, '... got the right value for x');
 is($point3d->y, 15, '... got the right value for y');
 is($point3d->{'$:z'}, 3, '... got the right value for z');
 
+dies_ok {
+       $point3d->z;
+} '... there is no method for z';
+
 $point3d->clear();
 
 is($point3d->x, 0, '... got the right (cleared) value for x');
 is($point3d->y, 0, '... got the right (cleared) value for y');
 is($point3d->{'$:z'}, 0, '... got the right (cleared) value for z');
+
+# test some class introspection
+
+can_ok('Point', 'meta');
+isa_ok(Point->meta, 'Moose::Meta::Class');
+
+can_ok('Point3D', 'meta');
+isa_ok(Point3D->meta, 'Moose::Meta::Class');
+
+isnt(Point->meta, Point3D->meta, '... they are different metaclasses as well');
+
+# poke at Point
+
+is_deeply(
+       [ Point->meta->superclasses ],
+       [ 'Moose::Object' ],
+       '... Point got the automagic base class');
+
+my @Point_methods = qw(x y clear);
+
+is_deeply(
+       [ sort @Point_methods                 ],
+       [ sort Point->meta->get_method_list() ],
+       '... we match the method list for Point');
+
+foreach my $method (@Point_methods) {
+       ok(Point->meta->has_method($method), '... Point has the method "' . $method . '"');
+}
+
+# poke at Point3D
+
+is_deeply(
+       [ Point3D->meta->superclasses ],
+       [ 'Point' ],
+       '... Point3D gets the parent given to it');
+
+my @Point3D_methods = qw(clear);
+
+is_deeply(
+       [ sort @Point3D_methods                 ],
+       [ sort Point3D->meta->get_method_list() ],
+       '... we match the method list for Point3D');
+
+foreach my $method (@Point3D_methods) {
+       ok(Point3D->meta->has_method($method), '... Point3D has the method "' . $method . '"');
+}
+
+

diff --git a/t/002_basic.t b/t/002_basic.t
index d3053e7..e5e772f 100644 (file)
--- a/t/002_basic.t
+++ b/t/002_basic.t
@@ -36,7 +36,7 @@ BEGIN {
        use warnings;   
        use Moose;
 
-       use base 'BankAccount';
+       extends 'BankAccount';
        
     has '$.overdraft_account' => (accessor => 'overdraft_account');    
 

diff --git a/t/010_basic_class_setup.t b/t/010_basic_class_setup.t
new file mode 100644 (file)
index 0000000..af03108
--- /dev/null
+++ b/t/010_basic_class_setup.t
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+{
+    package Foo;
+    use Moose;
+}
+
+can_ok('Foo', 'meta');
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+
+ok(!Foo->meta->has_method('meta'), '... we get the &meta method from Moose::Object');
+ok(Foo->isa('Moose::Object'), '... Foo is automagically a Moose::Object');
+
+foreach my $function (qw(
+                                                extends
+                        has 
+                            before after around
+                            blessed confess
+                            )) {
+    ok(!Foo->meta->has_method($function), '... the meta does not treat "' . $function . '" as a method');
+}
+