Monkey Patching
examples/mock/Monkey.pm
package Monkey; use strict; use warnings; sub new { my ($class, $count) = @_; return bless { bananas => $count }, $class; } sub is_hungry { my ($self) = @_; my $hungry = 1; # ... check if I am hungray. if ($hungry) { $self->eat(); } return $hungry; } sub eat { my ($self) = @_; $self->{bananas}--; } sub bananas { my ($self) = @_; return $self->{bananas}; } 1;
examples/mock/check_monkey.t
use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Monkey; use Test::More tests => 4; my $m = Monkey->new(10); is $m->bananas, 10, 'bananas'; ok $m->is_hungry, 'is_hungry'; is $m->bananas, 10, 'bananas'; $m->eat; is $m->bananas, 9, 'bananas';
1..4 ok 1 - bananas ok 2 - is_hungry not ok 3 - bananas # Failed test 'bananas' # at check_monkey.t line 13. # got: '9' # expected: '10' not ok 4 - bananas # Failed test 'bananas' # at check_monkey.t line 15. # got: '8' # expected: '9' # Looks like you failed 2 tests of 4.
examples/mock/patch_monkey.t
use strict; use warnings; use FindBin qw($Bin); use lib $Bin; use Monkey; use Test::More tests => 5; my $m = Monkey->new(10); is $m->bananas, 10, 'bananas'; { my $eat; no warnings 'redefine'; local *Monkey::eat = sub { $eat = 1;}; ok $m->is_hungry, 'is_hungry'; ok $eat, 'eat called'; } is $m->bananas, 10, 'bananas'; $m->eat; is $m->bananas, 9, 'bananas';
1..5 ok 1 - bananas ok 2 - is_hungry ok 3 - eat called ok 4 - bananas ok 5 - bananas