File Coverage

blib/lib/Venus/Role/Mockable.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch			n/a
condition	2	3	66.6
subroutine	8	8	100.0
pod	1	2	50.0
total	35	37	94.5

package Venus::Role::Mockable;

use 5.018;

use strict;
use warnings;

use Venus::Role 'with';

# METHODS

sub mock {
  my ($self, $name, $code) = @_;

  no strict 'refs';
  no warnings 'redefine';

  my $class = ref $self || $self;

  my $orig = $class->can($name);

  *{"${class}::${name}"} = my $mock = $code->($orig);

  return $mock;
}

# EXPORTS

sub EXPORT {
  ['mock']
}

1;



=head1 NAME

Venus::Role::Mockable - Mockable Role

=cut

=head1 ABSTRACT

Mockable Role for Perl 5

=cut

=head1 SYNOPSIS

  package Example;

  use Venus::Class 'with';

  with 'Venus::Role::Mockable';

  sub execute {
    [1..4];
  }

  package main;

  my $example = Example->new;

  # my $mock = $example->mock(execute => sub {
  #   my ($next) = @_;
  #
  #   return sub {
  #     [@{$next->()}, @_]
  #   }
  # });

  # sub { ... }

=cut

=head1 DESCRIPTION

This package provides a mechanism for mocking subroutines.

=cut

=head1 METHODS

This package provides the following methods:

=cut

=head2 mock

  mock(string $name, coderef $code) (coderef)

The mock method mocks the subroutine specified using the callback given. The
coderef provided will be passed the original subroutine coderef as its first
argument. The coderef provided should always return a coderef that will serve
as the subroutine mock.

I>

=over 4

=item mock example 1

  package main;

  my $example = Example->new;

  my $mock = $example->mock(execute => sub {
    my ($next) = @_;

    return sub {
      [@{$next->()}, @_]
    }
  });

  # sub { ... }

  # $example->execute;

  # [1..4]

  # $example->execute(5, 6);

  # [1..6]

=back

=cut

=head1 AUTHORS

Awncorp, C

=cut

=head1 LICENSE

Copyright (C) 2000, Awncorp, C.

This program is free software, you can redistribute it and/or modify it under
the terms of the Apache license version 2.0.

=cut