File Coverage

blib/lib/Test/CallFlow.pm

Criterion	Covered	Total	%
statement	240	258	93.0
branch	80	148	54.0
condition	52	118	44.0
subroutine	42	42	100.0
pod	21	21	100.0
total	435	587	74.1

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);

=head1 NAME

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

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

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();

=head1 USAGE

C 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 C and use the provided
functions as object methods.

=head2 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

=head2 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

=head2 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

=head2 RECORDING

To make it easier to start refactoring existing complicated legacy code,
C 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();

=head2 OBJECT ORIENTED USAGE

C 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 C 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;

=cut

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], );

}

=head1 PACKAGE PROPERTIES

=over 4

=item %Test::CallFlow::state

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

  unknown, record, plan, execute, failed, succeeded.

=item @Test::CallFlow::state

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

=item %Test::CallFlow::prototype

Contains default values for instance properties.

=item @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.

=back

=cut

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

=head1 INSTANCE PROPERTIES

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

Template texts below may contain C<#{variablename}> placeholders that will be
replaced by context-specific or C object property values.

=head2 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.

=over 4

=item package_template

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

=over 8

=item C<#{packagename}> placeholders will be replaced by name of package to mock.

=item C<#{subs}> placeholders will be replaced by sub definitions.

=back

=item sub_template

Template for code to put into mocked subs.

=over 8

=item C<#{packagename}> placeholders will be replaced by name of package to mock.

=item C<#{subname}> placeholders will be replaced by name of sub to mock.

=back

=item autoload_template

Template for code to put into mocked AUTOLOAD subs.

=item package_definition_template

Template for package definition at C.

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

=back

=head2 INTERNAL PROPERTIES

These are set and used at planning and runtime.

=over 4

=item state

One of C<%Test::CallFlow::state> values.

Default is C.
C sets state to C.
C sets it to C - or C if more calls were expected.
Failure in a mock call sets it to C.
C and C unconditionally set it back to C.

=item id

Index of this object in C<@Test::CallFlow::instances>.

=item packages

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

=item plan

Call execution plan as a C object containing C objects.

=item record_calls_from

Hash of package names created by C for checking which calls to record during recording.

=back

=head2 DEBUGGING PROPERTIES

=over 4

=item debug

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

=item debug_mock

Controls whether to print debug info in this class.

=back

=head2 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.

=over 4

=item 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 C hiding any real implementations.

=item basedir

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

=item savedir

Template for name of subdirectory inside basedir to contain saved package file hierarchy.
Default is 'perl-mock--'.

=back

=cut

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}",
);

=head1 FUNCTIONS

=head2 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 C subs exported with C<:all> tag so that
the library can easily be used procedurally.

=cut

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);
}

=head2 new

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

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

=cut

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;
}

=head2 record_calls_from

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

Starts recording calls from specified packages.

Returns self.

=cut

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;
}

=head2 mock_run

  mock_run;

End planning mocked calls and start executing tests.

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

Returns self.

=cut

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;
}

=head2 mock_end

  mock_end;

End test execution.

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

Returns self.

=cut

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;
}

=head2 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 C
(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.

=cut

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;
}

=head2 mock_reset

  mock_reset;

Reset mock plan for re-run.

=cut

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

=head2 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.

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

=cut

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 $@;
}

=head2 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.

=cut

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

    bless $object, $name;
}

=head2 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 C object or

=over 4

=item subname

Name of sub being defined

=item packagename

Name of package being defined

=back

=cut

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
}

=head2 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.

=cut

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;
}

=head2 mock_plan

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

=cut

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

    $self->{plan};
}

=head2 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

=over 4

=item 1. The test: a regular expression, code reference or scalar

=item 2. minimum number of arguments to match: 0 for optional

=item 3. maximum number of arguments to match.

=back

=cut

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;
}

=head2 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.

=cut

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

=head1 INTERNAL METHODS

These are not exported with C<:all>.

=head2 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.

=cut

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;
}

=head2 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.

=cut

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
    );
}

=head2 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.

=cut

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;
}

=head2 mock_package_filename

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

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

=cut

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

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

=head2 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.

=cut

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;
}

=head2 execute_mock_call

Called from C when running tests against plan.

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

=cut

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

=head2 record_mock_call

Called from C when recording calls.

Returns result of call to original method.

=cut

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];
}

=head1 TODO

=over 4

=item * MockCommand

Integration to cover external command calls.

=item * Tied Variables

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

=item * Test::CallFlow::Package

Would allow for neat stuff like

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

=item * ArgCheck::Hash

ArgChecker for deep structure comparison. Add also C.

=item * ArgCheck::Array

ArgChecker for a match in a list; used as C.

=item * Ref Checking

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

=back

=head1 AUTHOR

Kalle Hallivuori, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

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

    perldoc Test::CallFlow


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 SEE ALSO

=head2 ALTERNATIVES

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

=over 4

=item * 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.

=item * Test::MockObject

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

=item * Test::MockModule

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

=item * Test::MockCommand

Mock external commands that your program calls.

=back

=head2 SUPPLEMENTARY MODULES

=over 4

=item * Test::CallFlow::Plan

A structure of calls the code under test should make.

=item * Test::CallFlow::Call

A single call that the code under test might make.

=item * Test::CallFlow::ArgCheck

Checkers for arguments to mocked function calls.

=item * Test::CallFlow::ArgCheck::Equals

Pass arguments that match given string or undef.

=item * Test::CallFlow::ArgCheck::Code

Pass arguments that given method returns true for.

=item * Test::CallFlow::ArgCheck::Regexp

Pass arguments that are defined and match given regexp.

=item * Test::CallFlow::ArgCheck::Any

Pass any arguments.

=back

=head1 ACKNOWLEDGEMENTS

=over 4

=item * chromatic, author of Test::MockObject

Perl namespace management details I got from his code.

=item * Simon Flack, author of Test::MockModule

Perl namespace management details I got from his code.

=back

=head1 COPYRIGHT & LICENSE

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.

=cut

1;    # End of Test::CallFlow