split accessor generator from the Meta::Attribute.
[gitmo/Mouse.git] / t / 044-attribute-metaclass.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 2;
5 use lib 't/lib';
6
7 do {
8     package MouseX::AttributeHelpers::Number;
9     use Mouse;
10     extends 'Mouse::Meta::Attribute';
11
12     sub create {
13         my ($self, @args) = @_;
14         my $attr = $self->SUPER::create(@args);
15         my %provides = %{$attr->{provides}};
16         my $method_constructors = {
17             add => sub {
18                 my ($attr, $name) = @_;
19                 return sub {
20                     $_[0]->$name( $_[0]->$name() + $_[1])
21                 };
22             },
23         };
24         while (my ($name, $aliased) = each %provides) {
25             $attr->associated_class->add_method(
26                 $aliased => $method_constructors->{$name}->($attr, $attr->name)
27             );
28         }
29         return $attr;
30     };
31
32     package # hide me from search.cpan.org
33         Mouse::Meta::Attribute::Custom::Number;
34     sub register_implementation { 'MouseX::AttributeHelpers::Number' }
35
36     1;
37
38     package Klass;
39     use Mouse;
40
41     has 'i' => (
42         metaclass => 'Number',
43         is => 'rw',
44         isa => 'Int',
45         provides => {
46             'add' => 'add_number'
47         },
48     );
49 };
50
51 can_ok 'Klass', 'add_number';
52 my $k = Klass->new(i=>3);
53 $k->add_number(4);
54 is $k->i, 7;
55