#!/usr/bin/env perl # Copyright (c) 2014, IIS (The Internet Infrastructure Foundation) # Copyright (c) 2014, AFNIC # All rights reserved. # # Redistribution and use in source and binary forms, with or without modification, # are permitted provided that the following conditions are met: # # Redistributions of source code must retain the above copyright notice, this # list of conditions and the following disclaimer. # # Redistributions in binary form must reproduce the above copyright notice, this # list of conditions and the following disclaimer in the documentation and/or # other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE # DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON # ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. use strict; use warnings; use Pod::Usage; use Getopt::Long; use File::Basename; # command line options my $dirloc = '.'; # directory for searching test cases my $help; my $DEBUG = 0; # global variables my $tcCounter = 0; sub main { GetOptions( 'help|?' => \$help, 'dir|d=s' => \$dirloc, 'debug' => \$DEBUG, ) or pod2usage(2); if ($help) { pod2usage(1); exit; } opendir(my $dir, $dirloc) || die "cannot open directory $dirloc"; print "\n\n"; # Table header print '|Test Plan/Test Case |Test Case Description|', "\n"; print '|:-------------------|:--------------------|', "\n"; my @files = readdir $dir; @files = sort {$a cmp $b} @files; foreach my $f (@files) { print "$dirloc/$f\n" if $DEBUG; next if $f =~ /^\./; if (-d "$dirloc/$f") { tcList("$dirloc/$f"); } } print "No test cases found\nUse -d to specify directory\n" if !$tcCounter; } sub tcList { my $tcDir = shift; my $tcLevel = basename($tcDir); # For each level print '|**',$tcLevel,'**| |', "\n"; opendir(my $dir, $tcDir); my @files = readdir $dir; @files = sort {$a cmp $b} @files; foreach my $f (@files) { next if $f =~ /^\./; next if $f eq "README.md"; unless ($f =~ /^[a-z]+[0-9]+\.md$/) { warn "Skip file with unknown file name pattern: $f\n"; next; } tcName("$tcDir/$f", $tcLevel); } } sub tcName { my $tcPath = shift; my $tcLevel = shift; my $basename = basename($tcPath); my $testcase = uc (basename($tcPath, ".md")); open my $file, $tcPath or die "Cannot open file $tcPath: $!"; my $header = <$file>; if (defined $header) { if ($header =~ /^#+ +([A-Z]+[0-9]+): +(.*)/) { # For each test case print "|[$testcase]($tcLevel/$basename)|$2|\n"; warn "$tcPath: Test case ID does not match on first line\n" unless $1 eq $testcase; } else { warn "$tcPath: mismatch on first line\n"; }; } else { warn "$tcPath: empty file or empty first line\n"; } $tcCounter++; # increase the global counter close $file; } main(); =head1 NAME testcase.pl =head1 DESCRIPTION This tools extracts all implemented test cases and prints the header of each. =head1 USAGE testcase.pl --dir . Optional arguments: --dir Directory path of the test case directory --help This help text =head1 AUTHOR Patrik Wallstrom =cut