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