package Test::Qcmbr;
use Exporter;
our @ISA = ('Exporter');
our @EXPORT = qw/
spec
execute_scenario
execute_scenarios
given
when
then
next_scenario
parse_feature
parse_feature_file
/;
our $DATA = {};
=head1 NAME
Test::Qcmbr - Cucumber inspired Feature Specification Parser
=head1 SYNOPSIS
use Test::More;
use Test::Qcmbr;
parse_feature_file $filename;
given qr(.*) => sub {
my ($spec, $action, $data, @captured) = @_;
};
when qr(.*) => sub {
...
};
then qr(.*) => sub {
...
};
execute_scenarios && done_testing;
=head1 DESCRIPTION
Test::Qcmbr is centered around the parse_specification method which is a homegrown
Cucumber-like feature specification parser which takes a string in the form of a
Gherkin (cucumber feature specification) and produces a Perl hashref representing
that spec.
Input:
my $spec = parse_specification <<'GHERKIN'
# comments are ignored
Feature: Parameter Handling
In order to test getting and setting
As a package using MyApp::Class
I want to check parameter values
Scenario TrueValues: Assigning True Values
Given I am the package MyApp
And I am accessing values using the param method
When I assign the parameter :name a value of :value
Then the parameter hash element :name should match the :result
Example TrueValues:
| name | value | result |
| test | 001 | 001 |
Scenario NullValues: Assigning Null Values
Given I am the package MyApp
And I am accessing values using the param method
When I assign the parameter :name a value of :value
Then the parameter hash element :name (is) :result
Example NullValues:
| name | value | result |
| test | null | defined |
| test | null | exists |
Scenario: Testing FunnyBone
When I set the accessor humor to politics
Then the method funny will return null
GHERKIN
Output:
$spec = {
'name' => 'Parameter Handling',
'description' => [
'In order to test getting and setting',
'As a package using Validation::Class',
'I want to check parameter values'
],
'scenarios' => [
{
'actions' => [
'And I am accessing values using the param method',
'When I assign the parameter :name a value of :value',
'Then the parameter hash element :name should match the :result'
],
'example' => 'TrueValues',
'name' => 'Assigning True Values'
},
{
'actions' => [
'And I am accessing values using the param method',
'When I assign the parameter :name a value of :value',
'Then the parameter hash element :name (is) :result'
],
'example' => 'NullValues',
'name' => 'Assigning Null Values'
},
{
'actions' => [
'When I assign the parameter :name a value of :value',
'Then the parameter hash element :name (is) :result'
],
'example' => undef,
'name' => 'Testing The Mexican'
}
],
'examples' => {
'NullValues' => [
[ 'test', 'null', 'defined' ],
[ 'test', 'null', 'exists' ]
],
'TrueValues' => [
[ 'test', '001', '001' ]
]
}
};
The parse method is responsible for turing a feature spec into a Perl data
structure.
=cut
sub spec {
$DATA->{specification}
}
sub given {
my ($re, $code) = @_;
push @{$DATA->{'criteria'}->{'given'}}, {
cond => $re,
code => $code
}
}
sub when {
my ($re, $code) = @_;
push @{$DATA->{'criteria'}->{'when'}}, {
cond => $re,
code => $code
}
}
sub then {
my ($re, $code) = @_;
push @{$DATA->{'criteria'}->{'then'}}, {
cond => $re,
code => $code
}
}
sub execute_scenario {
my $scenario = shift;
if ($scenario) {
my $last;
my $spec = $DATA->{specification};
my $data = $spec->{examples}->{$scenario->{example}}
if $scenario->{example};
foreach my $action (@{$scenario->{actions}}) {
my $type;
$type = 'given' if $action =~ /^given/i;
$type = 'when' if $action =~ /^when/i;
$type = 'then' if $action =~ /^then/i;
$type = $last if $action =~ /^and/i;
my $tests = $DATA->{'criteria'}->{$type};
my $match = 0;
foreach my $test (@{$tests}) {
if ($action =~ $test->{cond}) {
my $i = 0;
my @args = ($action =~ $test->{cond});
@args = () unless $1;
$i = $#$data if $action =~ /\s:\w+/; # placeholders?
$i ||= 1; # run-once at-least
my $this_action = $action;
for (my $z=0; $z<$i; $z++) {
my $row = "ARRAY" eq ref $data ? $data->[$z] : {};
my @keys = $this_action =~ /:(\w+)/g;
foreach my $key (@keys) {
if (exists $row->{$key}) {
my $value = $row->{$key};
$this_action =~ s/:$key/'$value'/g;
push @args, $value;
}
}
$test->{code}->($spec, $this_action, $row, @args);
$this_action = $action;
}
$match++;
}
}
die __PACKAGE__ . " could not match: $action" unless $match;
$last = $type;
$match = 0;
}
}
return 1;
}
sub execute_scenarios {
my $before_hook = shift;
while (my $scenario = next_scenario()) {
$before_hook->($scenario) if "CODE" eq ref $before_hook;
execute_scenario $scenario;
}
return 1;
}
sub next_scenario {
if (defined $DATA->{specification}) {
my $position = $DATA->{current_scenario} =
defined $DATA->{current_scenario} ? ++$DATA->{current_scenario} : 0;
if (defined $DATA->{specification}->{scenarios}->[$position]) {
return $DATA->{specification}->{scenarios}->[$position];
}
}
return undef;
}
sub parse_feature {
my $feat = shift;
sub trim {
if (length $_[0]) {
$_[0] =~ s/^\s+//;
$_[0] =~ s/\s+$//;
}
$_[0]
}
my $spec = {};
# parse and return specification
my @statements = split /\n/, $feat;
my $section;
foreach my $statement (@statements) {
# skip comments
unless ($statement =~ /^(?:[\n\s\t]+)?#/) {
# start section parsing
if ($section) {
# parse feature
if ($section eq 'feature') {
if ($statement =~ /^(?:[\n\s\t]+)?([iI]n\s|[aA]s\s|[iI]\s)/) {
push @{$spec->{description}}, trim $statement;
}
}
# parse scenario
if ($section eq 'scenario') {
#Given I am the package MyApp
#And I am accessing values using the param method
#When I assign the parameter :name a value of :value
#Then the parameter hash element :name should match the :result
my @opening_lines = (
'[aA]nd ',
'[gG]iven ',
'[wWtT]hen ',
);
my $opening = join "|", @opening_lines;
if ($statement =~ /^(?:[\n\s\t]+)?($opening)/) {
my $scenario = $spec->{scenarios}->[-1];
push @{$scenario->{actions}}, trim $statement;
}
}
# parse example data
if ($section eq 'example') {
if ($statement =~ /^(?:[\n\s\t]+)?(\|)/) {
my $example = $spec->{examples}->[-1];
push @{$example->{data}}, [
grep { defined $_ } map { trim $_ }
($statement =~ /(?:\|[^\n])([^\|]+)/g)
];
}
}
}
# start feature parsing
unless ($section) {
if ($statement =~ /[Ff]eature\:(\s?(.*))/) {
$section = 'feature';
$spec->{name} = trim (my $name = $2);
}
}
# start scenario parsing
if ($statement =~ /[Ss]cenario(\s?(\w+)?)\:(.*)/) {
$section = 'scenario';
my $meta = {};
$meta->{name} = trim (my $name = $3);
$meta->{example} = trim (my $data = $2);
push @{$spec->{scenarios}}, $meta;
}
# start example data parsing
if ($statement =~ /[Ee]xample(\s?(\w+))\:/) {
$section = 'example';
my $meta = {};
$meta->{name} = trim (my $name = $2);
push @{$spec->{examples}}, $meta;
}
}
}
# key examples by name and header
if ($spec->{examples}) {
foreach my $example (@{$spec->{examples}}) {
my $records = $spec->{keyed_examples}->{$example->{name}} = [];
my $headers = $example->{data}->[0];
for (my $i=1; $i<@{$example->{data}}; $i++) {
my $record = {};
$record->{$headers->[$_]} = $example->{data}->[$i]->[$_]
for 0..$#$headers;
push @{$records}, $record;
}
}
$spec->{examples} = delete $spec->{keyed_examples}
if defined $spec->{keyed_examples};
}
if (keys %$DATA) {
# remove all but the criteria
for (keys %$DATA) {
delete $DATA->{$_} unless $_ eq 'criteria'
}
}
return $DATA->{specification} = $spec;
}
sub parse_feature_file {
my $file = shift;
open my $fh, "<:encoding(UTF-8)", $file or die "error opening $file: $!";
return parse_feature(join('', (<$fh>)));
}
1;