Refactor regular class method modifier addition to go through the metaclass
[gitmo/Mouse.git] / t / 019-handles.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 24;
5 use Test::Exception;
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         );
45     } qr/Unable to canonicalize the 'handles' option with string/;
46
47     ::throws_ok {
48         has error2 => (
49             handles => \"ref_to_string",
50         );
51     } qr/Unable to canonicalize the 'handles' option with SCALAR\(\w+\)/;
52
53     ::throws_ok {
54         has error3 => (
55             handles => qr/regex/,
56         );
57     } qr/Unable to canonicalize the 'handles' option with \(\?-xism:regex\)/;
58
59     ::throws_ok {
60         has error4 => (
61             handles => sub { "code" },
62         );
63     } qr/Unable to canonicalize the 'handles' option with CODE\(\w+\)/;
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,
95     [ 'name', 'age' ],
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