#!/usr/bin/perl use YAML::Syck; use Data::Dumper; use Getopt::Long; our $opt_tag = undef; our $verbose; GetOptions( 'tag=s' => $opt_tag, 'verbose' => $verbose ); our $testcase_string; { local $/ = undef; $testcase_string = <>; } my @testcases; eval { @testcases = Load($testcase_string); }; if ($@ and $testcase_string =~ /\{\{\{/) { die " This test case looks like a legacy one; I don't understand how to parse it\n"; } elsif ($@) { die " There was an error parsing this test case: $@\n"; } foreach my $tc (@testcases) { check_testcase($tc); } sub check_testcase { my ($tc) = @_; next if exists $tc->{TESTLINK_ID}; die " A test case was found with no name\n" unless exists($tc->{NAME}); if ($opt_tag) { if (ref($tc->{TAGS}) ne 'ARRAY' or ! grep /$opt_tag/, @{ $tc->{TAGS} }) { print " Skipping testcase \"$tc->{NAME}\" since it doesn't have the tag \"$opt_tag\"\n"; return; } } print " Checking testcase \"$tc->{NAME}\"\n"; if (ref($tc->{INSTRUCTIONS}) ne 'ARRAY') { print " ** This is not automated; skipping\n"; return; } my @test_cases = @{ $tc->{INSTRUCTIONS} }; while (my $test = shift @test_cases) { my ($name) = keys %$test; my ($value) = values %$test; if (ref($value) eq 'ARRAY') { unshift(@test_cases, @{ $value }); next; } check_fixture($name, $value); } print " Testcase looks okay!\n"; } sub check_fixture { my ($name, @args) = @_; print "\t$name\n" if $verbose; # Magic happens here }