t/001_mouse/016-trigger.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Exception;
   6
   7 my @trigger;
   8
   9 do {
  10     package Class;
  11     use Mouse;
  12
  13     has attr => (
  14         is => 'rw',
  15         default => 10,
  16         trigger => sub {
  17             my ($self, $value) = @_;
  18             push @trigger, [$self, $value];
  19         },
  20     );
  21
  22     has foobar => ( # from Net::Google::DataAPI
  23         is  => 'rw',
  24         isa => 'Str',
  25
  26         lazy => 1,
  27         trigger => sub{ $_[0]->update },
  28         default => sub{ 'piyo' },
  29
  30         clearer => 'clear_foobar',
  31     );
  32
  33     sub update {
  34         my($self) = @_;
  35         $self->clear_foobar;
  36     }
  37
  38     ::lives_ok {
  39         has not_error => (
  40             is => 'ro',
  41             trigger => sub { },
  42         );
  43     } "it's no longer an error to have trigger on a readonly attribute";
  44
  45     ::throws_ok {
  46         has error => (
  47             is => 'ro',
  48             trigger => [],
  49         );
  50     } qr/Trigger must be a CODE ref on attribute \(error\)/;
  51 };
  52
  53 can_ok(Class => 'attr');
  54
  55 my $object = Class->new;
  56 is(@trigger, 0, "trigger not called yet");
  57
  58 is($object->attr, 10, "default value");
  59 is(@trigger, 0, "trigger not called on read");
  60
  61 is($object->attr(50), 50, "setting the value");
  62 is(@trigger, 1, "trigger was called on read");
  63 is_deeply([splice @trigger], [[$object, 50]], "correct arguments to trigger in the accessor");
  64
  65 is($object->foobar,        'piyo');
  66 lives_ok { $object->foobar('baz') } "triggers that clear the attr";
  67
  68 is($object->foobar,        'piyo', "call clearer in triggers");
  69
  70 my $object2 = Class->new(attr => 100);
  71 is(@trigger, 1, "trigger was called on new with the attribute specified");
  72 is_deeply([splice @trigger], [[$object2, 100]], "correct arguments to trigger in the constructor");
  73
  74 done_testing;