t/019-handles.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 24;
   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
  40     TODO: {
  41         local our $TODO = "Mouse lacks this";
  42         eval {
  43             has error => (
  44                 handles => "string",
  45             );
  46         };
  47         ::ok(!$@, "handles => role");
  48     }
  49
  50     TODO: {
  51         local our $TODO = "Mouse lacks this";
  52         eval {
  53             has error2 => (
  54                 handles => \"ref_to_string",
  55             );
  56         };
  57         ::ok(!$@, "handles => \\str");
  58     }
  59
  60     TODO: {
  61         local our $TODO = "Mouse lacks this";
  62         eval {
  63             has error3 => (
  64                 handles => qr/regex/,
  65             );
  66         };
  67         ::ok(!$@, "handles => qr/re/");
  68     }
  69
  70     TODO: {
  71         local our $TODO = "Mouse lacks this";
  72         eval {
  73             has error4 => (
  74                 handles => sub { "code" },
  75             );
  76         };
  77         ::ok(!$@, "handles => sub { code }");
  78     }
  79 };
  80
  81 can_ok(Class => qw(person has_person person_name person_age name age quid));
  82
  83 my $object = Class->new;
  84 ok(!$object->has_person, "don't have a person yet");
  85 $object->person_name("Todd");
  86 ok($object->has_person, "calling person_name instantiated person");
  87 ok($object->person, "we really do have a person");
  88
  89 is($object->person_name, "Todd", "handles method");
  90 is($object->person->name, "Todd", "traditional lookup");
  91 is($object->person_age, 37, "handles method");
  92 is($object->person->age, 37, "traditional lookup");
  93
  94 my $object2 = Class->new(person => Person->new(name => "Philbert"));
  95 ok($object2->has_person, "we have a person from the constructor");
  96 is($object2->person_name, "Philbert", "handles method");
  97 is($object2->person->name, "Philbert", "traditional lookup");
  98 is($object2->person_age, undef, "no age because we didn't use the default");
  99 is($object2->person->age, undef, "no age because we didn't use the default");
 100
 101
 102 ok($object->quid, "we have a Shawn");
 103 is($object->name, "Shawn", "name handle");
 104 is($object->age, 21, "age handle");
 105 is($object->me->name, "Shawn", "me->name");
 106 is($object->me->age, 21, "me->age");
 107
 108 is_deeply(
 109     $object->meta->get_attribute('me')->handles,
 110     [ 'name', 'age' ],
 111     "correct handles layout for 'me'",
 112 );
 113
 114 is_deeply(
 115     $object->meta->get_attribute('person')->handles,
 116     { person_name => 'name', person_age => 'age' },
 117     "correct handles layout for 'person'",
 118 );
 119