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         @comm = split();
  39         push(@subcommlist, $comm[0]);
  40     }
  41     close HELPOUT;
  42     @subcommlist = sort(@subcommlist);
  43     return @subcommlist;
  44 }
  45
  46 # TAP test: test_command_man_pages
  47 #
  48 # Test if a man page exists for each command sub-command.
  49 # Runs one test per sub-command.
  50 #
  51 # Arguments:
  52 #
  53 #                builddir : A path to the OpenAFS build directory,
  54 #                           such as /tmp/1.4.14
  55 #
  56 #                 command : the name of the command (e.g. vos)
  57 #
  58 #             subcommlist : a list of sub-commands for command
  59 #
  60 sub test_command_man_pages {
  61     my ($builddir, $command, @subcommlist) = @_;
  62
  63     # The following is because File::Find makes no sense to me
  64     # for this purpose, and actually seems totally misnamed
  65     my $found = 0;
  66     my $subcommand = "";
  67     my $frex = "";
  68     # Since we don't know what man section it might be in,
  69     # search all existing man page files for a filename match
  70     my @mandirglob = glob("$builddir/doc/man-pages/man[1-8]/*");
  71     # For every subcommand, see if command_subcommand.[1-8] exists
  72     # in our man page build dir.
  73     foreach (@subcommlist) {
  74         my $subcommand = $_;
  75         $found = 0;
  76         my $frex = $command . '_' . $subcommand . '.[1-8]';
  77         # diag("Looking for $frex");
  78         foreach my $x (@mandirglob) {
  79             # diag("TRYING: $x");
  80             $x = basename($x);
  81             if ($x =~ /$frex$/) {
  82                 # diag("FOUND");
  83                 $found = 1;
  84                 last;
  85             }
  86         }
  87         ok($found eq 1, "existence of man page for $command" . "_$subcommand");
  88     }
  89 }
  90 1;