for my $klass (qw/Moose Mouse/) {
eval qq{
package ${klass}One;
- use $klass;\r
+ use $klass;
use ${klass}::Util::TypeConstraints;
-\r
+
subtype 'NaturalNumber', as 'Int', where { \$_ > 0 };
coerce 'NaturalNumber',
from 'Str', via { 42 },
- ;\r
-\r
+ ;
+
has n => (
is => 'rw',
isa => 'NaturalNumber',
for my $klass (qw/Moose Mouse/) {
eval qq{
package ${klass}One;
- use $klass;\r
+ use $klass;
use ${klass}::Util::TypeConstraints;
-\r
- subtype 'NaturalNumber', as 'Int', where { \$_ > 0 };\r
-\r
+
+ subtype 'NaturalNumber', as 'Int', where { \$_ > 0 };
+
has n => (
is => 'rw',
isa => 'NaturalNumber',
}
else{
$self->{_compiled_type_coercion} = sub {
- my($thing) = @_;\r
- foreach my $pair (@{$coercions}) {\r
- #my ($constraint, $converter) = @$pair;\r
- if ($pair->[0]->check($thing)) {\r
+ my($thing) = @_;
+ foreach my $pair (@{$coercions}) {
+ #my ($constraint, $converter) = @$pair;
+ if ($pair->[0]->check($thing)) {
local $_ = $thing;
return $pair->[1]->($thing);
- }\r
- }\r
- return $thing;\r
+ }
+ }
+ return $thing;
};
}
return;
=item *
-L<Moose::Cookbook::Basics::Recipe2> - A simple B<BankAccount> example\r
+L<Moose::Cookbook::Basics::Recipe2> - A simple B<BankAccount> example
=item *
=item *
-L<Moose::Cookbook::Basics::Recipe5> - More subtypes, coercion in a B<Request> class\r
+L<Moose::Cookbook::Basics::Recipe5> - More subtypes, coercion in a B<Request> class
=item *
-L<Moose::Cookbook::Basics::Recipe6> - The augment/inner example\r
+L<Moose::Cookbook::Basics::Recipe6> - The augment/inner example
=item *
-L<Moose::Cookbook::Basics::Recipe7> - Making Moose fast with immutable\r
+L<Moose::Cookbook::Basics::Recipe7> - Making Moose fast with immutable
=item *
-L<Moose::Cookbook::Basics::Recipe8> - Builder methods and lazy_build\r
+L<Moose::Cookbook::Basics::Recipe8> - Builder methods and lazy_build
=item *
-L<Moose::Cookbook::Basics::Recipe9> - Operator overloading, subtypes, and coercion\r
+L<Moose::Cookbook::Basics::Recipe9> - Operator overloading, subtypes, and coercion
=item *
-L<Moose::Cookbook::Basics::Recipe10> - Using BUILDARGS and BUILD to hook into object construction\r
+L<Moose::Cookbook::Basics::Recipe10> - Using BUILDARGS and BUILD to hook into object construction
=item *
-L<Moose::Cookbook::Roles::Recipe1> - The Moose::Role example\r
+L<Moose::Cookbook::Roles::Recipe1> - The Moose::Role example
=item *
=item *
-L<Moose::Cookbook::Roles::Recipe3> - Applying a role to an object instance\r
+L<Moose::Cookbook::Roles::Recipe3> - Applying a role to an object instance
=item *
-L<Moose::Cookbook::Meta::Recipe2> - A meta-attribute, attributes with labels\r
+L<Moose::Cookbook::Meta::Recipe2> - A meta-attribute, attributes with labels
=item *
-L<Moose::Cookbook::Meta::Recipe3> - Labels implemented via attribute traits\r
+L<Moose::Cookbook::Meta::Recipe3> - Labels implemented via attribute traits
=item *
-L<Moose::Cookbook::Extending::Recipe3> - Providing an alternate base object class\r
+L<Moose::Cookbook::Extending::Recipe3> - Providing an alternate base object class
=back
}
return $type eq 'c3'
? [calculateMRO($classname)]
- : $_get_linear_isa_dfs->($classname);\r
+ : $_get_linear_isa_dfs->($classname);
};
}
sub helper_type { 'Num' }
- has 'method_constructors' => (\r
- is => 'ro',\r
- isa => 'HashRef',\r
- lazy => 1,\r
- default => sub {\r
- return +{\r
- set => sub {\r
- my ( $attr, $reader, $writer ) = @_;\r
- return sub { $writer->( $_[0], $_[1] ) };\r
+ has 'method_constructors' => (
+ is => 'ro',
+ isa => 'HashRef',
+ lazy => 1,
+ default => sub {
+ return +{
+ set => sub {
+ my ( $attr, $reader, $writer ) = @_;
+ return sub { $writer->( $_[0], $_[1] ) };
+ },
+ get => sub {
+ my ( $attr, $reader, $writer ) = @_;
+ return sub { $reader->( $_[0] ) };
+ },
+ add => sub {
+ my ( $attr, $reader, $writer ) = @_;
+ return sub { $writer->( $_[0], $reader->( $_[0] ) + $_[1] ) };
},
- get => sub {\r
- my ( $attr, $reader, $writer ) = @_;\r
- return sub { $reader->( $_[0] ) };\r
+ sub => sub {
+ my ( $attr, $reader, $writer ) = @_;
+ return sub { $writer->( $_[0], $reader->( $_[0] ) - $_[1] ) };
},
- add => sub {\r
- my ( $attr, $reader, $writer ) = @_;\r
- return sub { $writer->( $_[0], $reader->( $_[0] ) + $_[1] ) };\r
- },\r
- sub => sub {\r
- my ( $attr, $reader, $writer ) = @_;\r
- return sub { $writer->( $_[0], $reader->( $_[0] ) - $_[1] ) };\r
- },\r
- mul => sub {\r
- my ( $attr, $reader, $writer ) = @_;\r
- return sub { $writer->( $_[0], $reader->( $_[0] ) * $_[1] ) };\r
- },\r
- div => sub {\r
- my ( $attr, $reader, $writer ) = @_;\r
- return sub { $writer->( $_[0], $reader->( $_[0] ) / $_[1] ) };\r
- },\r
- mod => sub {\r
- my ( $attr, $reader, $writer ) = @_;\r
- return sub { $writer->( $_[0], $reader->( $_[0] ) % $_[1] ) };\r
- },\r
- abs => sub {\r
- my ( $attr, $reader, $writer ) = @_;\r
- return sub { $writer->( $_[0], abs( $reader->( $_[0] ) ) ) };\r
- },\r
- };\r
- }\r
- );\r
-\r
+ mul => sub {
+ my ( $attr, $reader, $writer ) = @_;
+ return sub { $writer->( $_[0], $reader->( $_[0] ) * $_[1] ) };
+ },
+ div => sub {
+ my ( $attr, $reader, $writer ) = @_;
+ return sub { $writer->( $_[0], $reader->( $_[0] ) / $_[1] ) };
+ },
+ mod => sub {
+ my ( $attr, $reader, $writer ) = @_;
+ return sub { $writer->( $_[0], $reader->( $_[0] ) % $_[1] ) };
+ },
+ abs => sub {
+ my ( $attr, $reader, $writer ) = @_;
+ return sub { $writer->( $_[0], abs( $reader->( $_[0] ) ) ) };
+ },
+ };
+ }
+ );
+
package MouseX::AttributeHelpers::Number;
use Mouse;
-#!perl\r
-use strict;\r
-use warnings;\r
-use Test::More tests => 14;\r
-\r
-use Mouse ();\r
-\r
-BEGIN{\r
- package MyMouse;\r
- use Mouse;\r
- Mouse::Exporter->setup_import_methods(\r
- as_is => [qw(foo)],\r
- also => [qw(Mouse)],\r
- );\r
-\r
- sub foo{ 100 }\r
-\r
- $INC{'MyMouse.pm'}++;\r
-\r
- package MyMouseEx;\r
- use Mouse;\r
- Mouse::Exporter->setup_import_methods(\r
- as_is => [\&bar],\r
- also => [qw(MyMouse)],\r
-\r
-# groups => {\r
-# foobar_only => [qw(foo bar)],\r
-# },\r
- );\r
-\r
- sub bar{ 200 }\r
-\r
- $INC{'MyMouseEx.pm'}++;\r
-}\r
-\r
-can_ok 'MyMouse', qw(import unimport);\r
-can_ok 'MyMouseEx', qw(import unimport);\r
-\r
-{\r
- package MyApp;\r
- use Test::More;\r
- use MyMouse;\r
-\r
- can_ok __PACKAGE__, 'meta';\r
- ok defined(&foo), 'foo is imported';\r
- ok defined(&has), 'has is also imported';\r
-\r
- no MyMouse;\r
-\r
- ok !defined(&foo), 'foo is unimported';\r
- ok !defined(&has), 'has is also unimported';\r
-}\r
-{\r
- package MyAppEx;\r
- use Test::More;\r
- use MyMouseEx;\r
-\r
- can_ok __PACKAGE__, 'meta';\r
- ok defined(&foo), 'foo is imported';\r
- ok defined(&bar), 'foo is also imported';\r
- ok defined(&has), 'has is also imported';\r
-\r
- no MyMouseEx;\r
-\r
- ok !defined(&foo), 'foo is unimported';\r
- ok !defined(&bar), 'foo is also unimported';\r
- ok !defined(&has), 'has is also unimported';\r
-}\r
-\r
-# exporting groups are not implemented in Moose::Exporter\r
-#{\r
-# package MyAppExTags;\r
-# use Test::More;\r
-# use MyMouseEx qw(:foobar_only);\r
-#\r
-# can_ok __PACKAGE__, 'meta';\r
-# ok defined(&foo);\r
-# ok defined(&bar);\r
-# ok!defined(&has), "export tags";\r
-#}\r
-\r
+#!perl
+use strict;
+use warnings;
+use Test::More tests => 14;
+
+use Mouse ();
+
+BEGIN{
+ package MyMouse;
+ use Mouse;
+ Mouse::Exporter->setup_import_methods(
+ as_is => [qw(foo)],
+ also => [qw(Mouse)],
+ );
+
+ sub foo{ 100 }
+
+ $INC{'MyMouse.pm'}++;
+
+ package MyMouseEx;
+ use Mouse;
+ Mouse::Exporter->setup_import_methods(
+ as_is => [\&bar],
+ also => [qw(MyMouse)],
+
+# groups => {
+# foobar_only => [qw(foo bar)],
+# },
+ );
+
+ sub bar{ 200 }
+
+ $INC{'MyMouseEx.pm'}++;
+}
+
+can_ok 'MyMouse', qw(import unimport);
+can_ok 'MyMouseEx', qw(import unimport);
+
+{
+ package MyApp;
+ use Test::More;
+ use MyMouse;
+
+ can_ok __PACKAGE__, 'meta';
+ ok defined(&foo), 'foo is imported';
+ ok defined(&has), 'has is also imported';
+
+ no MyMouse;
+
+ ok !defined(&foo), 'foo is unimported';
+ ok !defined(&has), 'has is also unimported';
+}
+{
+ package MyAppEx;
+ use Test::More;
+ use MyMouseEx;
+
+ can_ok __PACKAGE__, 'meta';
+ ok defined(&foo), 'foo is imported';
+ ok defined(&bar), 'foo is also imported';
+ ok defined(&has), 'has is also imported';
+
+ no MyMouseEx;
+
+ ok !defined(&foo), 'foo is unimported';
+ ok !defined(&bar), 'foo is also unimported';
+ ok !defined(&has), 'has is also unimported';
+}
+
+# exporting groups are not implemented in Moose::Exporter
+#{
+# package MyAppExTags;
+# use Test::More;
+# use MyMouseEx qw(:foobar_only);
+#
+# can_ok __PACKAGE__, 'meta';
+# ok defined(&foo);
+# ok defined(&bar);
+# ok!defined(&has), "export tags";
+#}
+
-#!perl\r
-use strict;\r
-use warnings;\r
-use Test::More tests => 2;\r
-use Test::Exception;\r
-{\r
- package RoleA;\r
- use Mouse::Role;\r
-\r
- sub foo { }\r
- sub bar { }\r
-}\r
-{\r
- package RoleB;\r
- use Mouse::Role;\r
-\r
- sub foo { }\r
- sub bar { }\r
-}\r
-{\r
- package Class;\r
- use Mouse;\r
- use Test::More;\r
- use Test::Exception;\r
-\r
- throws_ok {\r
- with qw(RoleA RoleB);\r
- } qr/Due to method name conflicts in roles 'RoleA' and 'RoleB', the methods 'bar' and 'foo' must be/;\r
-\r
- lives_ok {\r
- with RoleA => { -excludes => ['foo'] },\r
- RoleB => { -excludes => ['bar'] },\r
- ;\r
- };\r
-}\r
+#!perl
+use strict;
+use warnings;
+use Test::More tests => 2;
+use Test::Exception;
+{
+ package RoleA;
+ use Mouse::Role;
+
+ sub foo { }
+ sub bar { }
+}
+{
+ package RoleB;
+ use Mouse::Role;
+
+ sub foo { }
+ sub bar { }
+}
+{
+ package Class;
+ use Mouse;
+ use Test::More;
+ use Test::Exception;
+
+ throws_ok {
+ with qw(RoleA RoleB);
+ } qr/Due to method name conflicts in roles 'RoleA' and 'RoleB', the methods 'bar' and 'foo' must be/;
+
+ lives_ok {
+ with RoleA => { -excludes => ['foo'] },
+ RoleB => { -excludes => ['bar'] },
+ ;
+ };
+}
-#!/usr/bin/perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-\r
-{\r
- package Foo;\r
- use Mouse;\r
-\r
- sub DEMOLISH {\r
- my $self = shift;\r
- my ($igd) = @_;\r
-\r
- print $igd;\r
- }\r
-}\r
-\r
-{\r
- package Bar;\r
- use Mouse;\r
-\r
- sub DEMOLISH {\r
- my $self = shift;\r
- my ($igd) = @_;\r
-\r
- print $igd;\r
- }\r
-\r
- __PACKAGE__->meta->make_immutable;\r
-}\r
-\r
-our $foo = Foo->new;\r
-our $bar = Bar->new;\r
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+
+{
+ package Foo;
+ use Mouse;
+
+ sub DEMOLISH {
+ my $self = shift;
+ my ($igd) = @_;
+
+ print $igd;
+ }
+}
+
+{
+ package Bar;
+ use Mouse;
+
+ sub DEMOLISH {
+ my $self = shift;
+ my ($igd) = @_;
+
+ print $igd;
+ }
+
+ __PACKAGE__->meta->make_immutable;
+}
+
+our $foo = Foo->new;
+our $bar = Bar->new;
-#!/usr/bin/perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use Test::More tests => 19;\r
-use Test::Exception;\r
-\r
-BEGIN {\r
- use_ok("Mouse::Util::TypeConstraints");\r
-}\r
-\r
-lives_ok {\r
- subtype 'MyCollections' => as 'ArrayRef | HashRef';\r
-} '... created the subtype special okay';\r
-\r
-{\r
- my $t = find_type_constraint('MyCollections');\r
- isa_ok($t, 'Mouse::Meta::TypeConstraint');\r
-\r
- is($t->name, 'MyCollections', '... name is correct');\r
-\r
- my $p = $t->parent;\r
-# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union');\r
- isa_ok($p, 'Mouse::Meta::TypeConstraint');\r
-\r
- is($p->name, 'ArrayRef|HashRef', '... parent name is correct');\r
-\r
- ok($t->check([]), '... validated it correctly');\r
- ok($t->check({}), '... validated it correctly');\r
- ok(!$t->check(1), '... validated it correctly');\r
-}\r
-\r
-lives_ok {\r
- subtype 'MyCollectionsExtended'\r
- => as 'ArrayRef|HashRef'\r
- => where {\r
- if (ref($_) eq 'ARRAY') {\r
- return if scalar(@$_) < 2;\r
- }\r
- elsif (ref($_) eq 'HASH') {\r
- return if scalar(keys(%$_)) < 2;\r
- }\r
- 1;\r
- };\r
-} '... created the subtype special okay';\r
-\r
-{\r
- my $t = find_type_constraint('MyCollectionsExtended');\r
- isa_ok($t, 'Mouse::Meta::TypeConstraint');\r
-\r
- is($t->name, 'MyCollectionsExtended', '... name is correct');\r
-\r
- my $p = $t->parent;\r
-# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union');\r
- isa_ok($p, 'Mouse::Meta::TypeConstraint');\r
-\r
- is($p->name, 'ArrayRef|HashRef', '... parent name is correct');\r
-\r
- ok(!$t->check([]), '... validated it correctly');\r
- ok($t->check([1, 2]), '... validated it correctly');\r
-\r
- ok(!$t->check({}), '... validated it correctly');\r
- ok($t->check({ one => 1, two => 2 }), '... validated it correctly');\r
-\r
- ok(!$t->check(1), '... validated it correctly');\r
-}\r
-\r
-\r
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 19;
+use Test::Exception;
+
+BEGIN {
+ use_ok("Mouse::Util::TypeConstraints");
+}
+
+lives_ok {
+ subtype 'MyCollections' => as 'ArrayRef | HashRef';
+} '... created the subtype special okay';
+
+{
+ my $t = find_type_constraint('MyCollections');
+ isa_ok($t, 'Mouse::Meta::TypeConstraint');
+
+ is($t->name, 'MyCollections', '... name is correct');
+
+ my $p = $t->parent;
+# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union');
+ isa_ok($p, 'Mouse::Meta::TypeConstraint');
+
+ is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
+
+ ok($t->check([]), '... validated it correctly');
+ ok($t->check({}), '... validated it correctly');
+ ok(!$t->check(1), '... validated it correctly');
+}
+
+lives_ok {
+ subtype 'MyCollectionsExtended'
+ => as 'ArrayRef|HashRef'
+ => where {
+ if (ref($_) eq 'ARRAY') {
+ return if scalar(@$_) < 2;
+ }
+ elsif (ref($_) eq 'HASH') {
+ return if scalar(keys(%$_)) < 2;
+ }
+ 1;
+ };
+} '... created the subtype special okay';
+
+{
+ my $t = find_type_constraint('MyCollectionsExtended');
+ isa_ok($t, 'Mouse::Meta::TypeConstraint');
+
+ is($t->name, 'MyCollectionsExtended', '... name is correct');
+
+ my $p = $t->parent;
+# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union');
+ isa_ok($p, 'Mouse::Meta::TypeConstraint');
+
+ is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
+
+ ok(!$t->check([]), '... validated it correctly');
+ ok($t->check([1, 2]), '... validated it correctly');
+
+ ok(!$t->check({}), '... validated it correctly');
+ ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
+
+ ok(!$t->check(1), '... validated it correctly');
+}
+
+
return $attr;
};
- around 'canonicalize_args' => sub {\r
- my ($next, $self, $name, %args) = @_;\r
-\r
- %args = $next->($self, $name, %args);\r
- $args{is} = 'rw' unless exists $args{is};\r
-\r
- return %args;\r
- };\r
+ around 'canonicalize_args' => sub {
+ my ($next, $self, $name, %args) = @_;
+
+ %args = $next->($self, $name, %args);
+ $args{is} = 'rw' unless exists $args{is};
+
+ return %args;
+ };
package # hide me from search.cpan.org
Mouse::Meta::Attribute::Custom::Number;
sv_rvweaken(HeVAL(he));
}
}
-\r
+
MODULE = Mouse::Meta::Method::Accessor::XS PACKAGE = Mouse::Meta::Method::Accessor::XS
PROTOTYPES: DISABLE
projects / gitmo/Mouse.git / commitdiff