File Coverage

blib/lib/Test/Ratchet.pm

Criterion	Covered	Total	%
statement	29	30	96.6
branch	7	8	87.5
condition			n/a
subroutine	6	6	100.0
pod	1	1	100.0
total	43	45	95.5

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

use Exporter::Easy ( EXPORT => [ qw/ratchet/ ] );
use Data::Munge qw(rec);

our $VERSION = '0.002';

# 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->(@_);
    };
}


1;

__END__