1#!perl 2 3## Some basic checks on the documentation 4 5use 5.008; 6use strict; 7use warnings; 8use Data::Dumper; 9use Test::More; 10 11plan tests => 4; 12 13## Make sure the POD actions are in the correct order (same as --help) 14my $file = 'check_postgres.pl'; 15my ($fh, $slurp); 16if (!open $fh, '<', $file) { 17 if (!open $fh, '<', "../$file") { 18 die "Could not find $file!\n"; 19 } 20} 21{ 22 local $/; 23 $slurp = <$fh>; 24} 25close $fh or warn qq{Could not close "$file": $!\n}; 26 27if ($slurp !~ /\$action_info = (.+?)\}/s) { 28 fail q{Could not find the 'action_info' section}; 29} 30my $chunk = $1; 31my @actions; 32for my $line (split /\n/ => $chunk) { 33 push @actions => $1 if $line =~ /^\s*(\w+)/; 34} 35 36## Make sure each of those still exists as a subroutine 37for my $action (@actions) { 38 next if $action =~ /last_auto/; 39 40 my $match = $action; 41 $match = 'relation_size' if $match =~ /^(index|table|indexes|total_relation)_size/; 42 $match = 'pgb_pool' if $match =~ /pgb_pool/; 43 44 if ($slurp !~ /\n\s*sub check_$match/) { 45 fail qq{Could not find a check sub for the action '$action' ($match)!}; 46 } 47} 48pass 'Found matching check subroutines for each action inside of action_info'; 49 50## Make sure each check subroutine is documented 51while ($slurp =~ /\n\s*sub check_(\w+)/g) { 52 my $match = $1; 53 54 ## Skip known exceptions: 55 next if $match eq 'last_vacuum_analyze' or $match eq 'pgb_pool'; 56 57 if (! grep { $match eq $_ } @actions) { 58 fail qq{The check subroutine check_$match was not found in the help!}; 59 } 60} 61pass 'Found matching help for each check subroutine'; 62 63## Make sure each item in the top help is in the POD 64my @pods; 65while ($slurp =~ /\n=head2 B<(\w+)>/g) { 66 my $match = $1; 67 68 ## Skip known exceptions: 69 next if $match =~ /symlinks/; 70 71 if (! grep { $match eq $_ } @actions) { 72 fail qq{The check subroutine check_$match was not found in the POD!}; 73 } 74 75 push @pods => $match; 76} 77pass 'Found matching POD for each check subroutine'; 78 79## Make sure things are in the same order for both top (--help) and bottom (POD) 80for my $action (@actions) { 81 my $pod = shift @pods; 82 if ($action ne $pod) { 83 fail qq{Docs out of order: expected $action in POD section, but got $pod instead!}; 84 } 85} 86pass 'POD actions appear in the correct order'; 87 88exit; 89