From: Stevan Little Date: Mon, 6 Mar 2006 17:55:49 +0000 (+0000) Subject: uploadin X-Git-Tag: 0_05~107 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bc1e29b54ff0125b806ac32bffdcec96ec8a0102;p=gitmo%2FMoose.git uploadin --- diff --git a/lib/Moose.pm b/lib/Moose.pm index ebd2cd3..b70436a 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 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'); +} +