tests/tests-lib/perl5/mancheck_utils.pm

   1 #
   2 # This is probably horrific code to any Perl coder.  I'm sorry,
   3 # I'm not one.  It runs.
   4 #
   5 # Proposed Coding Standard:
   6 #
   7 #     * Subroutines starting with test_ should be TAP tests
   8 #       utilizing ok(), is(), etc... and return the number
   9 #       of tests run if they get that far (could exit early
  10 #       from a BAIL_OUT())
  11 #
  12 use File::Basename;
  13 use Test::More;
  14
  15 sub check_command_binary {
  16     my $c = shift(@_);
  17     if (! -e "$c") {
  18         BAIL_OUT("Cannot find $c");
  19     }
  20 }
  21
  22 #
  23 # Run the command help to determine the list of sub-commands.
  24 #
  25 sub lookup_sub_commands {
  26     my ($srcdir, $command) = @_;
  27
  28     my $fullpathcommand = "$srcdir/$command";
  29     check_command_binary($fullpathcommand);
  30
  31     # build up our list of available commands from the help output
  32     open(HELPOUT, "$fullpathcommand help 2>&1 |") or BAIL_OUT("can't fork: $!");
  33     my @subcommlist;
  34     my @comm;
  35     while (<HELPOUT>) {
  36         # Skip the header thingy
  37         next if /Commands are/;
  38         # Skip the version subcommand, it's always present but not interesting
  39         next if /^version/;
  40         @comm = split();
  41         push(@subcommlist, $comm[0]);
  42     }
  43     close HELPOUT;
  44     @subcommlist = sort(@subcommlist);
  45     return @subcommlist;
  46 }
  47
  48 # TAP test: test_command_man_pages
  49 #
  50 # Test if a man page exists for each command sub-command.
  51 # Runs one test per sub-command.
  52 #
  53 # Arguments:
  54 #
  55 #                builddir : A path to the OpenAFS build directory,
  56 #                           such as /tmp/1.4.14
  57 #
  58 #                 command : the name of the command (e.g. vos)
  59 #
  60 #             subcommlist : a list of sub-commands for command
  61 #
  62 sub test_command_man_pages {
  63     my ($builddir, $command, @subcommlist) = @_;
  64
  65     # The following is because File::Find makes no sense to me
  66     # for this purpose, and actually seems totally misnamed
  67     my $found = 0;
  68     my $subcommand = "";
  69     my $frex = "";
  70     # Since we don't know what man section it might be in,
  71     # search all existing man page files for a filename match
  72     my @mandirglob = glob("$builddir/doc/man-pages/man[1-8]/*");
  73     # For every subcommand, see if command_subcommand.[1-8] exists
  74     # in our man page build dir.
  75     foreach (@subcommlist) {
  76         my $subcommand = $_;
  77         $found = 0;
  78         my $frex = $command . '_' . $subcommand . '.[1-8]';
  79         # diag("Looking for $frex");
  80         foreach my $x (@mandirglob) {
  81             # diag("TRYING: $x");
  82             $x = basename($x);
  83             if ($x =~ /$frex$/) {
  84                 # diag("FOUND");
  85                 $found = 1;
  86                 last;
  87             }
  88         }
  89         ok($found eq 1, "existence of man page for $command" . "_$subcommand");
  90     }
  91 }
  92 1;