Commit | Line | Data |
c3398f5b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More tests => 24; |
eab81545 |
5 | use Test::Exception; |
c3398f5b |
6 | |
7 | do { |
8 | package Person; |
9 | |
10 | sub new { |
11 | my $class = shift; |
12 | my %args = @_; |
13 | |
14 | bless \%args, $class; |
15 | } |
16 | |
17 | sub name { $_[0]->{name} = $_[1] if @_ > 1; $_[0]->{name} } |
18 | sub age { $_[0]->{age} = $_[1] if @_ > 1; $_[0]->{age} } |
19 | |
20 | package Class; |
21 | use Mouse; |
22 | |
23 | has person => ( |
24 | is => 'rw', |
25 | lazy => 1, |
26 | default => sub { Person->new(age => 37, name => "Chuck") }, |
27 | predicate => 'has_person', |
28 | handles => { |
29 | person_name => 'name', |
30 | person_age => 'age', |
31 | }, |
32 | ); |
33 | |
34 | has me => ( |
35 | is => 'rw', |
36 | default => sub { Person->new(age => 21, name => "Shawn") }, |
37 | predicate => 'quid', |
38 | handles => [qw/name age/], |
39 | ); |
40 | |
41 | ::throws_ok { |
42 | has error => ( |
43 | handles => "string", |
44 | ); |
af745d5a |
45 | } qr/Unable to canonicalize the 'handles' option with string/; |
c3398f5b |
46 | |
47 | ::throws_ok { |
48 | has error2 => ( |
49 | handles => \"ref_to_string", |
50 | ); |
af745d5a |
51 | } qr/Unable to canonicalize the 'handles' option with SCALAR\(\w+\)/; |
c3398f5b |
52 | |
53 | ::throws_ok { |
54 | has error3 => ( |
55 | handles => qr/regex/, |
56 | ); |
af745d5a |
57 | } qr/Unable to canonicalize the 'handles' option with \(\?-xism:regex\)/; |
c3398f5b |
58 | |
59 | ::throws_ok { |
60 | has error4 => ( |
61 | handles => sub { "code" }, |
62 | ); |
af745d5a |
63 | } qr/Unable to canonicalize the 'handles' option with CODE\(\w+\)/; |
c3398f5b |
64 | }; |
65 | |
66 | can_ok(Class => qw(person has_person person_name person_age name age quid)); |
67 | |
68 | my $object = Class->new; |
69 | ok(!$object->has_person, "don't have a person yet"); |
70 | $object->person_name("Todd"); |
71 | ok($object->has_person, "calling person_name instantiated person"); |
72 | ok($object->person, "we really do have a person"); |
73 | |
74 | is($object->person_name, "Todd", "handles method"); |
75 | is($object->person->name, "Todd", "traditional lookup"); |
76 | is($object->person_age, 37, "handles method"); |
77 | is($object->person->age, 37, "traditional lookup"); |
78 | |
79 | my $object2 = Class->new(person => Person->new(name => "Philbert")); |
80 | ok($object2->has_person, "we have a person from the constructor"); |
81 | is($object2->person_name, "Philbert", "handles method"); |
82 | is($object2->person->name, "Philbert", "traditional lookup"); |
83 | is($object2->person_age, undef, "no age because we didn't use the default"); |
84 | is($object2->person->age, undef, "no age because we didn't use the default"); |
85 | |
86 | |
87 | ok($object->quid, "we have a Shawn"); |
88 | is($object->name, "Shawn", "name handle"); |
89 | is($object->age, 21, "age handle"); |
90 | is($object->me->name, "Shawn", "me->name"); |
91 | is($object->me->age, 21, "me->age"); |
92 | |
93 | is_deeply( |
94 | $object->meta->get_attribute('me')->handles, |
c3cc3642 |
95 | [ 'name', 'age' ], |
c3398f5b |
96 | "correct handles layout for 'me'", |
97 | ); |
98 | |
99 | is_deeply( |
100 | $object->meta->get_attribute('person')->handles, |
101 | { person_name => 'name', person_age => 'age' }, |
102 | "correct handles layout for 'person'", |
103 | ); |
104 | |