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