File Coverage

blib/lib/Test/Given/Aspect.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	8	8	100.0
condition			n/a
subroutine	13	13	100.0
pod	0	3	0.0
total	60	63	95.2

package Test::Given::Aspect;
use strict;
use warnings;

use Test::Given::Context qw(define_var);

sub new {
  my ($class, $sub, $name, $package) = @_;
  my $self = {
    real_sub    => $sub,
    var_name    => $name,
    var_package => $package,
  };
  $self->{wrapped_sub} = wrap_sub($self);
  bless $self, $class;
}

sub wrap_sub {
  my ($self) = @_;
  my $sub = $self->{real_sub};
  my $name = $self->{var_name};
  if ( defined $name ) {
    my $package = "$self->{var_package}::";
    if ( $name =~ s/^\@// ) {
      return sub {
        define_var($package, $name, [ $sub->() ]);
      }
    }
    elsif ( $name =~ s/^\%// ) {
      return sub {
        define_var($package, $name, { $sub->() });
      }
    }
    elsif ( $name =~ s/^\&// ) {
      return sub {
        define_var($package, $name, $sub->());
      }
    }
    $name =~ s/^\$//;
    return sub {
      define_var($package, $name, \$sub->());
    }
  }
  return $sub;
}

sub apply { shift->{wrapped_sub}->() };

package Test::Given::Given;
use parent 'Test::Given::Aspect';

package Test::Given::When;
use parent 'Test::Given::Aspect';

package Test::Given::Done;
use parent 'Test::Given::Aspect';

1;