Commit | Line | Data |
a09601ab |
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 | local $SIG{__WARN__} = sub{ $_[0] =~ /deprecated/ or warn @_ }; |
9 | |
10 | package MouseX::AttributeHelpers::Number; |
11 | use Mouse; |
12 | extends 'Mouse::Meta::Attribute'; |
13 | |
14 | sub create { |
15 | my ($self, @args) = @_; |
16 | my $attr = $self->SUPER::create(@args); |
17 | my %provides = %{$attr->{provides}}; |
18 | my $method_constructors = { |
19 | add => sub { |
20 | my ($attr, $name) = @_; |
21 | return sub { |
22 | $_[0]->$name( $_[0]->$name() + $_[1]) |
23 | }; |
24 | }, |
25 | }; |
26 | while (my ($name, $aliased) = each %provides) { |
27 | $attr->associated_class->add_method( |
28 | $aliased => $method_constructors->{$name}->($attr, $attr->name) |
29 | ); |
30 | } |
31 | return $attr; |
32 | }; |
33 | |
34 | package # hide me from search.cpan.org |
35 | Mouse::Meta::Attribute::Custom::Number; |
36 | sub register_implementation { 'MouseX::AttributeHelpers::Number' } |
37 | |
38 | 1; |
39 | |
40 | package Klass; |
41 | use Mouse; |
42 | |
43 | has 'i' => ( |
44 | metaclass => 'Number', |
45 | is => 'rw', |
46 | isa => 'Int', |
47 | provides => { |
48 | 'add' => 'add_number' |
49 | }, |
50 | ); |
51 | }; |
52 | |
53 | can_ok 'Klass', 'add_number'; |
54 | my $k = Klass->new(i=>3); |
55 | $k->add_number(4); |
56 | is $k->i, 7; |
57 | |