Test::CallFlow - trivial planning of sub call flows for fast unit test writing.

Test-CallFlow documentation Contained in the Test-CallFlow distribution.

Index

Code Index:

NAME

Top

Test::CallFlow - trivial planning of sub call flows for fast unit test writing.

VERSION

Top

Version 0.03

SYNOPSIS

Top

Mock packages for planning expected interactions in tests:

    use Test::CallFlow qw(:all);

    my $mocked = mock_object( 'My::Mocked::Package::Name' );
    $mocked->my_method( arg_any(0,9) )->result( 'return value' );

    mock_run();

    die "test did not return right value"
      if $mocked->my_method( 'any', 'arguments' ) ne 'return value';

    mock_end();

USAGE

Top

Test::CallFlow functions are used here in a procedural manner because straightforward test scripts are seen as primary use case. As well you may create objects with new() and use the provided functions as object methods.

DECLARING

    use Test::More plan_tests => 1;
    use Test::CallFlow qw(:all);

    # just mock a package
    mock_package( 'Just::Mocked' );

    # mock a package and make an object of it
    my $mocked = mock_object(
        'My::Mocked::Package::Name',          # must specify package name
        { 'optional' => 'content' } );        # may specify what to bless

PLANNING

    Just::Mocked->new()                       # no arguments
                ->result( $mocked );          # return the mock object

    my $get_call =                            # refer to this Test::CallFlow::Call object
        $mocked->get( "FieldX" )              # one equal string argument
             ->result( 1, 2, 3 )              # return array ( 1, 2, 3 ) on first call
             ->result( 4, 5, 6 )              # return array ( 4, 5, 6 ) on second call
             ->result( 7, 8, 9 )              # return array ( 7, 8, 9 ) on any subsequent calls
             ->min(0)                         # this call is optional
             ->max(9)                         # this call can be made at most 9 times
             ->anytime;                       # may be called at this step or any time later

    $mocked->set( arg_check( qr/^Field/ ),    # first argument matching regular expression
                  arg_any( 1, 99 ) );         # 1-99 arguments with any values
                                              # return nothing (undef or empty array)

    $mocked->save( arg_check( \&ok_file ) )   # use own code to check argument
             ->end( $get_call );              # end scope: $get_call can be made no more

    # if you wish to use parts of the real package unmocked as is,
    # load it after planning but before running:
    use My::Mocked::Package::Name;

    # remember that nothing keeps you from still just adding your own:

    package My::Mocked::Package::Name;

    sub really_customized {} # skipping mock system

    package main; # remember to end your own package definition

RUNNING

    mock_run();  # flow of calls from test planned, now prepare to run the test(s)

    eval {

      # package was already declared as loaded at mock_run()
      # so code under test may freely try to 'use' it
      use My::Mocked::Package::Name;

      code_under_test();  # dies on any unplanned call to a mocked package or sub

      mock_end(); # dies if any expected calls were not made and reports them
    };

    is( $@, '', "code_under_test() executed according to prepared plan" );

    mock_clear(); # flush state, plan and mocks so you may plan another test call flow

RECORDING

To make it easier to start refactoring existing complicated legacy code, Test::CallFlow also provides preliminary sub call recording functionality:

    # load the packages used by code under test first
    use My::Mocked::Package::Name;
    use Other::Mocked::Package;

    # then declare them for mocking; this saves the original subs aside
    mock_package( 'My::Mocked::Package::Name', 'Other::Mocked::Package' );

    # start recording
    record_calls_from( 'Package::Under::Test' );

    # now calls to mocked packages will be made and recorded with their args and results
    use Package::Under::Test;
    Package::Under::Test->code_under_test();

    # generate code to serve as basis for your test run
    print join ";\n", map { $_->name() } mock_plan()->list_calls();

OBJECT ORIENTED USAGE

Test::CallFlow is actually object-oriented; default instance creation is hidden. Usability of multiple simultaneous mock objects is hindered by Perl global package namespace. Only one object may be used for recording, planning or running at a time. A separate object can be used for each of those tasks simultaneously as long as they don't mock same packages. Just do one thing at a time and mock_clear() straight after to steer clear of any problems.

  use Test::CallFlow;

  my $flow = Test::CallFlow->new(
        autoload_template => '' # do not declare AUTOLOAD, use explicit mock_call()s only
  );

  $flow->mock_package( 'Just::Mocked' );
  $flow->mock_call( 'Just::Mocked::new', 'Just::Mocked' )->result( bless( {}, 'Just::Mocked' ) );
  $flow->mock_run;
  print Just::Mocked->new;
  $flow->mock_end;

PACKAGE PROPERTIES

Top

%Test::CallFlow::state

Map of state names to state IDs. Used to refer to flow object states:

  unknown, record, plan, execute, failed, succeeded.
@Test::CallFlow::state

List of state names. Used to get printable name for state IDs.

%Test::CallFlow::prototype

Contains default values for instance properties.

@Test::CallFlow::instance

Array of created instances. Used by mocked methods to locate the related instance responsible of building and following the plan, ie. checking the call and providing right result to return.

INSTANCE PROPERTIES

Top

Default properties are defined in %Test::CallFlow::prototype. They may be specified as parameters for new or environment variables with prefix mock_, such as mock_save.

Template texts below may contain #{variablename} placeholders that will be replaced by context-specific or Test::CallFlow object property values.

TEMPLATE PROPERTIES

These may be useful for heavier customizations, although it'll probably be easier to just define more hairy mock package parts straight in the test script.

package_template

Template text for mock package definitions. See code for contents.

#{packagename} placeholders will be replaced by name of package to mock.
#{subs} placeholders will be replaced by sub definitions.

sub_template

Template for code to put into mocked subs.

#{packagename} placeholders will be replaced by name of package to mock.
#{subname} placeholders will be replaced by name of sub to mock.

autoload_template

Template for code to put into mocked AUTOLOAD subs.

package_definition_template

Template for package definition at mock_run.

Default value contains redefinition warning suppression and expects #{packagebody} variable to contain actual mock package definition.

INTERNAL PROPERTIES

These are set and used at planning and runtime.

state

One of %Test::CallFlow::state values.

Default is plan. mock_run() sets state to execute. mock_end sets it to succeeded - or failed if more calls were expected. Failure in a mock call sets it to failed. mock_clear and mock_reset unconditionally set it back to plan.

id

Index of this object in @Test::CallFlow::instances.

packages

Contains data about packages and subs to mock gathered from calls in planning mode.

plan

Call execution plan as a Test::CallFlow::Plan object containing Test::CallFlow::Call objects.

record_calls_from

Hash of package names created by record_calls_from() for checking which calls to record during recording.

DEBUGGING PROPERTIES

debug

Controls debug information printing. Class names in this string cause debugging info to be printed from them. Options are: Mock, Plan, Call, ArgCheck. Derived from $ENV{DEBUG}.

debug_mock

Controls whether to print debug info in this class.

PACKAGE SAVING PROPERTIES

Sometimes it might be nice to put the files into a temporary directory included in @INC, or to keep them around for debugging or faster loading later.

save

Whether to save package definitions into files. Default is not to save.

If set at construction, the temporary directory will be prepended to @INC so that the mocks will load with use hiding any real implementations.

basedir

Base directory for saving packages. Default is system temporary directory.

savedir

Template for name of subdirectory inside basedir to contain saved package file hierarchy. Default is 'perl-mock-<process-id>-<mock-instance-number>'.

FUNCTIONS

Top

instance

  $mocker = Test::CallFlow::instance;

Returns the first instance of this class created with given properties. Creates one if there isn't.

This is called from each of the mock_ subs exported with :all tag so that the library can easily be used procedurally.

new

	my $mocker = Test::CallFlow->new( %properties );

Returns a new Test::CallFlow object with given properties. Properties not given are taken from %Test::CallFlow::prototype.

record_calls_from

   record_calls_from( 'Package::Under::Test', 'Supplementary::Package::Under::Same::Test', );

Starts recording calls from specified packages.

Returns self.

mock_run

  mock_run;

End planning mocked calls and start executing tests.

If compilation of a package fails, confesses its whole source.

Returns self.

mock_end

  mock_end;

End test execution.

If any expected calls have not been made, dies with a list of unsatisfied calls.

Returns self.

mock_clear

  mock_clear;

Clears plan. Restores any original subs covered by mocks. Resets state unconditionally back to planning.

Does not touch any other properties of mocked packages than subs mocked with mock_sub() (that's used implicitly during normal planning or recording).

Does not currenctly remove any files created by requesting packages to be saved. Maybe that should some day be a configurable option.

Returns self.

mock_reset

  mock_reset;

Reset mock plan for re-run.

mock_package

  mock_package( 'Package::Name' );

Declares package of given name to be mocked. Returns nothing. Dies if the package declaration fails - ie. when invalid templates were specified for this mock object.

AUTOLOAD method gets declared to enable building plan by mock calls.

mock_object

  my $mocked = mock_object( 'Package::Name' );
  my $mocked_scalar = mock_object( 'Scalar::Blessed', "bless this scalar" );

Returns an object of given mocked package. Declares that package for mocking if necessary.

mock_sub

  my $props_ref = mock_sub( 'Package::Name', 'sub_name', 'sub #{subname} { warn "#{subname}(@_) called" }' );

Declares given package to contain given sub such that it will actually execute Test::CallFlow::mock_call - or alternatively given template text.

Template may contain placeholders marked as #{name} to be substituted with values of any property of the Test::CallFlow object or

subname

Name of sub being defined

packagename

Name of package being defined

mock_call

   mock_call( 'Mocked::Package::sub_name', @args );

Called from mocked packages.

During plan buildup, adds calls to mock call plan list.

During test execution, tries to find a planned mock call matching given call. Returns planned value. Dies on mismatch.

During recording calls the original method. If caller is a record candidate, records the call and result.

mock_plan

Returns reference to the Test::CallFlow::Plan object.

arg_check

  $mocked->method( arg_check(qr/../), arg_check( sub { $_[2]->[$_[1]] < 5 }, 0, 99 ) );

Instantiates an object of correct subclass of Test::CallFlow::ArgCheck for given test; either Regexp or Code reference.

Arguments are

1. The test: a regular expression, code reference or scalar
2. minimum number of arguments to match: 0 for optional
3. maximum number of arguments to match.

arg_any

  $mocked->method( arg_any, 'X', arg_any( 0, -1 ) );

Returns an argument checker that passes any arguments. Optional arguments specify minimum (default 1) and maximum (default same as minimum) possible number of arguments to pass.

INTERNAL METHODS

Top

These are not exported with :all.

save_mock_package

Saves given package if saving is not disabled for it and enabled for it or by default. Location is basedir/savedir/containingpackage/packagename.pm.

Dies on I/O failures.

plan_mock_package

  my $package_definition = plan_mock_package( 'My::Mocked::Package::Name' );

Returns a string containing the perl code for a package with mock versions of all methods called so far.

embed

  my $text = $mocker->embed( 'sub #{subname} { "mocked sub of #{packagename}" }', subname => 'my_mock' );

Embeds given values and object properties as referred by placeholders in given text.

Does not recurse indefinitely, but gives silently up after 15 recursions.

mock_package_filename

  my $filename = mock_package_filename( 'My::Mocked::Package::Name' );

Returns relative path and filename combination string for given package name.

plan_mock_call

  $mocker->plan_mock_call( 'Mocked::Package::sub_name', @args );

Adds a call with given package::sub name and arguments to call plan.

execute_mock_call

Called from mock_call when running tests against plan.

Returns result from planned mock call matching given executed call if one exists.

record_mock_call

Called from mock_call when recording calls.

Returns result of call to original method.

TODO

Top

* MockCommand

Integration to cover external command calls.

* Tied Variables

Provide easy methods for recording, restricting and testing data access.

* Test::CallFlow::Package

Would allow for neat stuff like

  mock_package( 'Bar' )->vars( ISA => [ 'Foo' ], VERSION => 0.01 );
* ArgCheck::Hash

ArgChecker for deep structure comparison. Add also arg_deep.

* ArgCheck::Array

ArgChecker for a match in a list; used as arg_check( \@in ).

* Ref Checking

Document the fact that Regexp /^Type::Name=/ may be used for reference type checks.

AUTHOR

Top

Kalle Hallivuori, <kato at iki.fi>

BUGS

Top

Please report any bugs or feature requests to bug-test-callflow at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-CallFlow. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Test::CallFlow

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-CallFlow

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Test-CallFlow

* CPAN Ratings

http://cpanratings.perl.org/d/Test-CallFlow

* Search CPAN

http://search.cpan.org/dist/Test-CallFlow/

SEE ALSO

Top

ALTERNATIVES

Test::CallFlow provides a very simple way to plan mocks. Other solutions are available, each with their strong points.

* Test::MockClass

Very clearly named methods are used to create and control mocks. Supports explicit call order. Does not provide unified flexible argument checking. Call tracking can be disabled.

* Test::MockObject

Collects calls made so that you can check them in your own code afterwards.

* Test::MockModule

You provide the code for each mocked method separately. No flow checks. Original methods are remembered and can be restored later.

* Test::MockCommand

Mock external commands that your program calls.

SUPPLEMENTARY MODULES

* Test::CallFlow::Plan

A structure of calls the code under test should make.

* Test::CallFlow::Call

A single call that the code under test might make.

* Test::CallFlow::ArgCheck

Checkers for arguments to mocked function calls.

* Test::CallFlow::ArgCheck::Equals

Pass arguments that match given string or undef.

* Test::CallFlow::ArgCheck::Code

Pass arguments that given method returns true for.

* Test::CallFlow::ArgCheck::Regexp

Pass arguments that are defined and match given regexp.

* Test::CallFlow::ArgCheck::Any

Pass any arguments.

ACKNOWLEDGEMENTS

Top

* chromatic, author of Test::MockObject

Perl namespace management details I got from his code.

* Simon Flack, author of Test::MockModule

Perl namespace management details I got from his code.

COPYRIGHT & LICENSE

Top

Copyright 2008 Kalle Hallivuori, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Test-CallFlow documentation Contained in the Test-CallFlow distribution. 
package Test::CallFlow;

use warnings;
use strict;
use UNIVERSAL qw(can isa);
use Carp;
use Exporter;
use File::Spec;
use Test::CallFlow::Plan;
use Test::CallFlow::Call;
use Test::CallFlow::ArgCheck::Any;
use vars
    qw(@ISA @EXPORT_OK %EXPORT_TAGS $recording $planning $running @instances %state @state);


our $VERSION = '0.03';


BEGIN {
    @ISA = qw(Exporter);
    @EXPORT_OK =
        qw(mock_package mock_object mock_run mock_end mock_reset mock_clear mock_call mock_plan arg_check arg_any record_calls_from);
    %EXPORT_TAGS = ( all => [@EXPORT_OK], );

}


my $i = 0;
%state = map { $_ => $i++ } @state =
    qw(unknown record plan execute failed succeeded);


my %prototype = (

    'state' => $state{plan},

    # package instantiation stuff:

    'package_template' => '
package #{packagename};

#{subs}

1;
',

    'autoload_template' => '
sub #{subname} {
        @_ = ($Test::CallFlow::instances[#{id}], $#{packagename}::#{subname}, @_);
        goto \&Test::CallFlow::mock_call
                unless $#{packagename}::#{subname} eq \'#{packagename}::DESTROY\'
}
',

    'sub_template' => '
sub #{subname} {
        @_ = ($Test::CallFlow::instances[#{id}], \'#{packagename}::#{subname}\', @_);
        goto \&Test::CallFlow::mock_call
}
',

    # runtime package definition string
    'package_definition_template' =>
        "no warnings \'redefine\';\n#{packagebody}",

    # future Test::CallFlow::Package stuff:

    'save'    => 0,
    'basedir' => File::Spec->tmpdir,
    'savedir' => "perl-test-callflow-$$-\#{id}",
);


sub instance {
    my %properties = @_;

    for my $instance (@instances) {
        return $instance
            unless grep {
            defined $properties{$_}
                ? $instance->{$_} ne $properties{$_}
                : defined $instance->{$_}
            } keys %properties;
    }

    Test::CallFlow->new(%properties);
}


sub new {
    my ( $class, %self ) = @_;
    $class = ref $class if ref $class;
    $self{id} = @instances;

    for ( keys %prototype ) {
        $self{$_} = exists $ENV{"mock_$_"} ? $ENV{"mock_$_"} : $prototype{$_}
            unless exists $self{$_};
    }

    $self{packages} ||= {};
    $self{debug} = $ENV{DEBUG}
        if not exists $self{debug} and exists $ENV{DEBUG};
    $self{debug_mock} = $self{debug} =~ /\bMock\b/ if $self{debug};

    if ( $self{save} ) {
        $self{savedir} =~ s/\#{(\w+)}/$self{$1}/g;
        my $dir = File::Spec->catdir( $self{basedir}, $self{savedir} );
        unshift @INC, $dir unless grep { $_ eq $dir } @INC;
    }

    my $self = bless \%self, $class;
    push @instances, $self;

    $recording = $self if $self{state} == $state{record};
    $planning  = $self if $self{state} == $state{plan};
    $running   = $self if $self{state} == $state{execute};

    return $self;
}


sub record_calls_from {
    my $self =
           isa( $_[0], 'Test::CallFlow' ) ? shift : $recording
        || $planning
        || instance;
    croak( "record_calls_from called in wrong state: ",
           $state[ $self->{state} || 0 ] )
        unless $self->{state} == $state{plan}
            or $self->{state} == $state{record};

    $self->{record_calls_from}{$_} = 1 for @_;

    $self->{state} = $state{record};
    $running  = undef if ( $running  || 0 ) == $self;
    $planning = undef if ( $planning || 0 ) == $self;
    $recording = $self;
}


sub mock_run {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : $planning
        || instance;
    $self->save_mock_package($_)
        for grep { !$self->{packages}{$_}{saved} }
        sort keys %{ $self->{packages} };
    for ( sort keys %{ $self->{packages} } ) {
        $INC{ mock_package_filename($_) } = "mocked by $self";
        my $plan = $self->embed( $self->{package_definition_template},
                                 packagebody => $self->plan_mock_package($_) );
        eval $plan;
        confess
"### FAILED MOCK PACKAGE DEFINITION ($@):\n$plan\n### END FAILED MOCK PACKAGE DEFINITION ($@)\n"
            if $@;
    }
    $self->{state} = $state{execute};
    $planning = undef if ( $planning || 0 ) == $self;
    $running = $self;
}


sub mock_end {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : $running
        || instance;
    $planning  = undef if ( $planning  || 0 ) == $self;
    $running   = undef if ( $running   || 0 ) == $self;
    $recording = undef if ( $recording || 0 ) == $self;

    if (     $self->{state} != $state{execute}
         and $self->{state} != $state{failed} )
    {
        $self->{state} = $state{failed};
        confess "End mock in a bad state: ", $state[ $self->{state} ];
    }

    my @unsatisfied = $self->{plan}->unsatisfied;
    if (@unsatisfied) {
        $self->{state} = $state{failed};
        confess "End mock with ", scalar(@unsatisfied),
            " calls remaining:\n" . join("\n"),
            map { "\t" . $_->name } @unsatisfied;
    }

    $self->{state} = $state{succeeded};

    $self;
}


sub mock_clear {
    my $self =
           isa( $_[0], 'Test::CallFlow' ) ? shift : $running
        || $planning
        || $recording
        || instance;

    # unmock mocked subs
    no strict 'refs';
    for my $package_name ( keys %{ $self->{packages} || {} } ) {
        my $package       = $self->{packages}{$package_name};
        my $mocked_subs   = $package->{subs} || {};
        my $original_subs = $package->{original_subs} || {};
        my $namespace     = $package_name . '::';
        for my $mocked_sub_name ( keys %{$mocked_subs} ) {
            my $full_sub_name = $namespace . $mocked_sub_name;
            my $original_sub  = $original_subs->{$mocked_sub_name};
            if ($original_sub) {
                no warnings 'redefine';
                *{$full_sub_name} = $original_sub;
            } else {
                undef *{$full_sub_name};
            }
        }
    }
    use strict 'refs';

    delete $self->{record_calls_from};
    delete $self->{packages};
    delete $self->{plan};
    $self->{state} = $state{plan};

    $running   = undef if ( $running   || 0 ) == $self;
    $recording = undef if ( $recording || 0 ) == $self;

    $planning = $self;
}


sub mock_reset {
    my $self = shift || instance;
    $self->{plan}->reset;
    delete $self->{record_calls_from};
    $self->{state} = $state{plan};
}


sub mock_package {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : $planning
        || instance;
    my $name = shift or confess "Can't mock a package without a name";
    return if exists $self->{packages}{$name};

    $self->{packages}{$name} = {@_};
    unless ( exists $self->{packages}{$name}{subs}{AUTOLOAD} ) {
        $self->mock_sub( $name, 'AUTOLOAD', $self->{autoload_template} );
    }

    no strict 'refs';
    my $namespace_name = $name . '::';
    my %namespace      = %{$namespace_name};
    for my $sub_name ( keys %namespace ) {
        my $sub = *{ $namespace{$sub_name} }{CODE} or next;
        $self->{packages}{$name}{original_subs}{$sub_name} ||= $sub;
        $self->mock_sub( $name, $sub_name );
    }
    use strict 'refs';

    my $plan = $self->embed( $self->{package_definition_template},
                             packagebody => $self->plan_mock_package($name) );

    warn $plan if $self->{debug_mock};
    eval $plan;
    die $@ if $@;
}


sub mock_object {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : $planning
        || instance;
    my $name = shift;
    my $object = @_ ? shift : {};
    mock_package($name);

    bless $object, $name;
}


sub mock_sub {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : $planning
        || instance;
    my ( $package, $sub, $code ) = @_;
    $self->mock_package($package)
        unless exists $self->{packages}{$package};
    delete $self->{packages}{$package}{saved};
    $self->{packages}{$package}{subs}{$sub} =
        $code;    # undef ok, default sub_template will be used
}


sub mock_call {
    my $self =
           isa( $_[0], 'Test::CallFlow' ) ? $_[0] : $planning
        || $running
        || instance;

    my $target = {
                   $state{plan}    => \&plan_mock_call,
                   $state{execute} => \&execute_mock_call,
                   $state{record}  => \&record_mock_call
        }->{ $self->{state} || 0 }
        or croak "Mock call in a bad state: ", $state[ $self->{state} || 0 ];
    warn "mock_call in $state[$self->{state}] state" if $self->{debug_mock};

    goto $target;
}


sub mock_plan {
    my $self =
           isa( $_[0], 'Test::CallFlow' ) ? $_[0] : $recording
        || $planning
        || $running
        || instance;

    $self->{plan};
}


sub arg_check {
    my @args = qw(test min max);
    my %checker = map { shift(@args), $_ } @_;
    $checker{min} ||= 1 unless defined $checker{min};
    $checker{max} ||= $checker{min} || 1;
    my $class = "Test::CallFlow::ArgCheck::"
        . ucfirst( lc( ref( $checker{test} ) || 'equals' ) );
    my $checker;
    eval "use $class; \$checker = $class->new(\%checker)";
    confess $@ if $@;
    $checker;
}


sub arg_any {
    my %args;
    $args{min} = shift if @_ and $_[0] =~ /^\d+$/;
    $args{max} = shift if @_ and $_[0] =~ /^\d+$/;
    Test::CallFlow::ArgCheck::Any->new( %args, @_ );
}


sub save_mock_package {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : $planning
        || instance;
    my ($package_name) = shift;

    # package must exist and be set to be saved, not be set to not save
    return
        unless exists $self->{packages}{$package_name}
            and exists $self->{packages}{$package_name}{save}
        ? $self->{packages}{$package_name}{save}
        : $self->{save};

    my $plan = $self->plan_mock_package( $package_name, @_ );

    my $dir      = $self->{basedir};
    my @dir      = ( $self->{savedir}, split /::/, $package_name );
    my $filename = pop(@dir) . ".pm";
    for (@dir) {
        $dir = File::Spec->catdir( $dir, $_ );
        mkdir $dir unless -d $dir;
    }
    my $fullfile = File::Spec->catdir( $dir, $filename );
    warn "Save '$fullfile'" if $self->{debug_mock};
    my $fh = IO::File->open( $fullfile, 'w' ) or die $!;
    $fh->print($plan);
    $fh->close or die $!;
    $self->{packages}{$package_name}{saved} = 1;
}


sub plan_mock_package {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : instance;
    my ($package_name) = @_;
    return unless defined $self->{packages}{$package_name};
    my $subs = $self->{packages}{$package_name}{subs} || {};

    $self->embed(
        $self->{package_template} || $self->{sub_template},
        packagename => $package_name,
        subs        => join '',
        map {
            $self->embed(
                          $subs->{$_} || $self->{sub_template},
                          packagename => $package_name,
                          subname     => $_,
                )
            } sort grep /^\w+$/,
        keys %$subs
    );
}


sub embed {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : $planning
        || instance;
    my $text = shift;
    my (%embeddable) = ( %$self, @_ );
    my $embeddable_keys = join '|', keys %embeddable;
    my $depth = 16;
    1 while --$depth and $text =~ s/#{($embeddable_keys)}/$embeddable{$1}/g;
    $text;
}


sub mock_package_filename {
    my $self = isa( $_[0], 'Test::CallFlow' ) ? shift : $planning
        || instance;
    my ($package_name) = shift;

    File::Spec->catdir( split /::/, $package_name ) . '.pm';
}


sub plan_mock_call {
    my $self = shift;
    my $sub = shift or confess "No sub";
    unless ( ref $sub ) {
        my ( $package, $method ) = $sub =~ /(.+)::([^:]+)$/;
        $self->mock_sub( $package, $method )
            unless $self->{packages}{$package}
                and $self->{packages}{$package}{subs}{$sub};
    }
    my $call_plan =
        Test::CallFlow::Call->new(
                                   args => [ $sub, @_ ],
                                   ( $self->{debug} || '' ) =~ /\bCall\b/
                                   ? ( debug => $self->{debug} )
                                   : ()
        );
    $self->{plan} ||=
        Test::CallFlow::Plan->new(
                                     ( $self->{debug} || '' ) =~ /\bPlan\b/
                                   ? ( debug => $self->{debug} )
                                   : ()
        );
    $self->{plan}->add_call($call_plan);
    warn "Planned call $sub(@_)" if $self->{debug_mock};

    $call_plan;
}


sub execute_mock_call {
    my $self = shift;
    my @result;
    eval { @result = $self->{plan}->call(@_); };
    if ($@) {
        $self->{state} = $state{failed};
        die $@;
    }
    wantarray ? @result : $result[0];
}


sub record_mock_call {
    my $self = shift;
    my $sub = shift or confess "No sub";
    my ( $package_name, $sub_name ) = $sub =~ /(.+)::([^:]+)$/;

    my $package = $self->{packages}{$package_name}
        or confess "No package '$package_name' for $sub(@_)";

    my $orig = $package->{original_subs}{$sub_name}
        or confess "No such original sub $sub(@_)";

    my @result = wantarray ? ( $orig->(@_) ) : ( scalar $orig->(@_) );

    my ( $caller_package, $caller_file, $caller_line ) = caller(0);
    if ( $self->{record_calls_from}{$caller_package} ) {
        my $caller_sub = ( caller 1 )[3];
        my $called     = "$caller_sub at $caller_file line $caller_line";
        $self->plan_mock_call( $sub, @_ )->result(@result)
            ->called_from($called);
    }

    wantarray ? @result : $result[0];
}


1;    # End of Test::CallFlow