File Coverage

blib/lib/Test/Ratchet.pm

Criterion	Covered	Total	%
statement	35	45	77.7
branch	7	10	70.0
condition			n/a
subroutine	8	11	72.7
pod	2	2	100.0
total	52	68	76.4

use strict;
use warnings;
package Test::Ratchet;

use Exporter::Easy ( OK => [ qw/ratchet clank/ ] );
use Data::Munge qw(rec);
use Scalar::Util qw(refaddr);

our $VERSION = '0.003';

# ABSTRACT: Mocking helper that swaps out implementations automatically


sub ratchet {
    my @subrefs = @_;

    my $ratchet = rec {
        my $recurse = shift;
        if (! @subrefs) {
            die "Tried to run a ratchet but there was nothing left to do!";
        }

        my $now = $subrefs[0];

        # simple scalar should be a number. Run the next item as a subref if
        # that number is not 0. If it's reached 0, shift them both off and redo.
        # Or it's an asterisk, in which case do the next subref forever.
        if (not ref $now) {
            if ($now eq '*') {
                return $subrefs[1]->(@_);
            }

            if ($now > 0) {
                $now = $subrefs[1];
                $subrefs[0]--;
                return $now->(@_);
            }
            else {
                shift @subrefs; shift @subrefs;
                # redo
                return $recurse->(@_);
            }
        }

        else {
            shift @subrefs;
        }

        $now->(@_);
    };
}


sub clank($) {
    my $subref = shift;
    my $clank = rec { my $rec = shift; $Test::Ratchet::Clank::CLANK{ refaddr $rec } = 1; &$subref };
    bless $clank, "Test::Ratchet::Clank";
}

package Test::Ratchet::Clank;

use Scalar::Util qw(refaddr);

our %CLANK;

sub DESTROY {
    my $self = shift;
    require Test::More;
    Test::More::fail("A Clank was never run!") unless $CLANK{ refaddr $self };
}


1;

__END__