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 # TAP test: test_command_man_pages
  23 #
  24 # Gather a list of a command's subcommands (like listvol for vos)
  25 # by running a command with the "help" argument.  From that list
  26 # of subcommands spit out, see if a man page exists for that
  27 # command_subcommand
  28 #
  29 # Arguments: two scalars:
  30 #
  31 #                builddir : A path to the OpenAFS build directory,
  32 #                           such as /tmp/1.4.14
  33 #
  34 #         fullpathcommand : The full path to the actual command's
  35 #                           binary, such as /tmp/1.4.14/src/volser/vos
  36 #
  37 # Returns: the number of tests run
  38 #
  39 sub test_command_man_pages {
  40     my ($builddir, $fullpathcommand) = @_;
  41
  42     my $command = basename($fullpathcommand);
  43
  44     # build up our list of available commands from the help output
  45     open(HELPOUT, "$fullpathcommand help 2>&1 |") or BAIL_OUT("can't fork: $!");
  46     my @subcommlist;
  47     my @comm;
  48     while (<HELPOUT>) {
  49         # Skip the header thingy
  50         next if /Commands are/;
  51         @comm = split();
  52         push(@subcommlist, $comm[0]);
  53     }
  54     close HELPOUT;
  55     @subcommlist = sort(@subcommlist);
  56
  57     # The following is because File::Find makes no sense to me
  58     # for this purpose, and actually seems totally misnamed
  59     my $found = 0;
  60     my $subcommand = "";
  61     my $frex = "";
  62     # Since we don't know what man section it might be in,
  63     # search all existing man page files for a filename match
  64     my @mandirglob = glob("$builddir/doc/man-pages/man[1-8]/*");
  65     # For every subcommand, see if command_subcommand.[1-8] exists
  66     # in our man page build dir.
  67     foreach (@subcommlist) {
  68         my $subcommand = $_;
  69         $found = 0;
  70         my $frex = $command . '_' . $subcommand . '.[1-8]';
  71         # diag("Looking for $frex");
  72         foreach my $x (@mandirglob) {
  73             # diag("TRYING: $x");
  74             $x = basename($x);
  75             if ($x =~ /$frex$/) {
  76                 # diag("FOUND");
  77                 $found = 1;
  78                 last;
  79             }
  80         }
  81         $testcount = $testcount + 1;
  82         ok($found eq 1, "existence of man page for $command" . "_$subcommand");
  83     }
  84     return $testcount;
  85 }
  86 1;