# define some basic types
-type 'Any' => where { 1 };
+type 'Any' => where { 1 }; # meta-type including all
+type 'Item' => where { 1 }; # base-type
-subtype 'Value' => as 'Any' => where { !ref($_) };
-subtype 'Ref' => as 'Any' => where { ref($_) };
+subtype 'Undef' => as 'Item' => where { !defined($_) };
+subtype 'Defined' => as 'Item' => where { defined($_) };
-subtype 'Bool' => as 'Any' => where { "$_" eq '1' || "$_" eq '0' };
+subtype 'Value' => as 'Item' => where { !ref($_) };
+subtype 'Ref' => as 'Item' => where { ref($_) };
+
+subtype 'Bool' => as 'Item' => where { "$_" eq '1' || "$_" eq '0' };
subtype 'Int' => as 'Value' => where { Scalar::Util::looks_like_number($_) };
subtype 'Str' => as 'Value' => where { !Scalar::Util::looks_like_number($_) };
could probably use some work, but it works for me at the moment.
Any
+
+ Item
+ Undef
+ Defined
Bool
Value
Int
use strict;
use warnings;
-use Test::More tests => 16;
+use Test::More tests => 17;
use Test::Exception;
BEGIN {
use_ok('Moose');
}
+=pod
+
+This test demonstrates the ability to extend
+Moose meta-level classes using Moose itself.
+
+=cut
+
{
package My::Meta::Class;
use strict;
use Moose;
extends 'Moose::Meta::Class';
+
+ around 'create_anon_class' => sub {
+ my $next = shift;
+ my ($self, %options) = @_;
+ $options{superclasses} = [ 'Moose::Object' ]
+ unless exists $options{superclasses};
+ $next->($self, %options);
+ };
}
my $anon = My::Meta::Class->create_anon_class();
isa_ok($anon, 'Moose::Meta::Class');
isa_ok($anon, 'Class::MOP::Class');
+is_deeply(
+ [ $anon->superclasses ],
+ [ 'Moose::Object' ],
+ '... got the default superclasses');
+
{
package My::Meta::Attribute::DefaultReadOnly;
use strict;
around 'new' => sub {
my $next = shift;
- my $self = shift;
- my $name = shift;
- $next->($self, $name, (is => 'ro'), @_);
+ my ($self, $name, %options) = @_;
+ $options{is} = 'ro'
+ unless exists $options{is};
+ $next->($self, $name, %options);
};
}