podman/hack/xref-quadlet-docs

#!/usr/bin/perl
#
# xref-quadlet-docs - cross-validate quadlet man page vs actual source
#
# $Id: .perl-template,v 1.2 2020/03/03 20:08:31 esm Exp esm $
#
package Podman::CrossrefQuadletDocs;

use v5.14;
use utf8;

use strict;
use warnings;

(our $ME = $0) =~ s|.*/||;
our $VERSION = '0.1';

###############################################################################
# BEGIN user-customizable section

our $Go  = 'pkg/systemd/quadlet/quadlet.go';
our $Doc = 'docs/source/markdown/podman-systemd.unit.5.md';

# END   user-customizable section
###############################################################################

###############################################################################
# BEGIN boilerplate args checking, usage messages

sub usage {
    print  <<"END_USAGE";
Usage: $ME [OPTIONS]

$ME cross-checks quadlet documentation between the Go source[Go]
and the man page[MD].

 [Go]: $Go
 [MD]: $Doc

We check that:

  * all keys in [Go] are documented in [MD]
  * all keys in [MD] exist in [Go]
    * any keys listed in [MD] tables also have a description block
      and vice-versa
  * all keys everywhere are in sorted order

OPTIONS:

  --help         display this message
  --version      display program name and version
END_USAGE

    exit;
}

# Command-line options.  Note that this operates directly on @ARGV !
our $debug   = 0;
sub handle_opts {
    use Getopt::Long;
    GetOptions(
        'debug!'     => \$debug,

        help         => \&usage,
        man          => \&man,
        version      => sub { print "$ME version $VERSION\n"; exit 0 },
    ) or die "Try `$ME --help' for help\n";
}

# END   boilerplate args checking, usage messages
###############################################################################

############################## CODE BEGINS HERE ###############################

# The term is "modulino".
__PACKAGE__->main()                                     unless caller();

# Main code.
sub main {
    # Note that we operate directly on @ARGV, not on function parameters.
    # This is deliberate: it's because Getopt::Long only operates on @ARGV
    # and there's no clean way to make it use @_.
    handle_opts();                      # will set package globals

    # No command-line args
    die "$ME: Too many arguments; try $ME --help\n"                 if @ARGV;

    my $errs = 0;
    $SIG{__WARN__} = sub {
        print STDERR "@_";
        ++$errs;
    };

    # Assume that Go source file has Truth
    my $true_keys = read_go($Go);

    # Read md file, compare against Truth
    crossref_doc($Doc, $true_keys);

    exit $errs;
}


#############
#  read_go  #  Returns list of key strings found in quadlet.go
#############
sub read_go {
    my $path = shift;
    open my $fh, '<', $path
        or die "$ME: Cannot read $path: $!\n";;

    my @found;                          # List of key strings
    my $last_constname;                 # Most recently seen const name

    while (my $line = <$fh>) {
        # Only interested in lines of the form   KeyFoo = "Foo"
        if ($line =~ /^\s+Key(\S+)\s+=\s+"(\S+)"/) {
            my ($constname, $keystring) = ($1, $2);

            my $deprecated = ($line =~ m!\s//\s+deprecated!i);

            # const name must be the same as the string
            $constname eq $keystring
                or warn "$ME: $path:$.: mismatched strings: Key$constname = \"$keystring\"\n";

            # Sorting check.
            if ($last_constname) {
                if (lc($constname) lt lc($last_constname)) {
                    warn "$ME: $path:$.: out-of-order variable name 'Key$constname' should precede 'Key$last_constname'\n";
                }
            }
            $last_constname = $constname;

            push @found, $keystring
                unless $deprecated;
        }
    }
    close $fh;

    \@found;
}

##################
#  crossref_doc  #  Read the markdown page, cross-check against Truth
##################
sub crossref_doc {
    my $path      = shift;              # in: path to .md file
    my $true_keys = shift;              # in: AREF, list of keys from .go

    open my $fh, '<', $path
        or die "$ME: Cannot read $path: $!\n";;

    my $unit = '';
    my %documented;
    my @found_in_table;
    my @described;

    # Helper function: when done reading description blocks,
    # make sure that there's one block for each key listed
    # in the table. Defined as a local function because we
    # need to call it from two different places.
    my $crossref_against_table = sub {
        for my $k (@found_in_table) {
            grep { $_ eq $k } @described
                or warn "$ME: key not documented: '$k' listed in table for unit '$unit' but not actually documented\n";
        }
    };

    # Main loop: read the docs line by line
    while (my $line = <$fh>) {
        chomp $line;

        # New section, with its own '| table |' and '### Keyword blocks'
        if ($line =~ /^##\s+(\S+)\s+units\s+\[(\S+)\]/) {
            my $new_unit = $1;
            $new_unit eq $2
                or warn "$ME: $path:$.: inconsistent block names in '$line'\n";

            $crossref_against_table->();

            $unit = $new_unit;

            # Reset, because each section has its own table & blocks
            @found_in_table = ();
            @described = ();
            next;
        }

        # Table line
        if ($line =~ s/^\|\s+//) {
            next if $line =~ /^\*\*/;           # title
            next if $line =~ /^-----/;          # divider

            if ($line =~ /^([A-Z][A-Za-z6]+)=/) {
                my $key = $1;

                grep { $_ eq $key } @$true_keys
                    or warn "$ME: $path:$.: unknown key '$key' (not present in $Go)\n";

                # Sorting check
                if (@found_in_table) {
                    if (lc($key) lt lc($found_in_table[-1])) {
                        warn "$ME: $path:$.: out-of-order key '$key' in table\n";
                    }
                }

                push @found_in_table, $key;
                $documented{$key}++;
            }
            else {
                warn "$ME: $path:$.: cannot grok table line '$line'\n";
            }
        }

        # Description block
        elsif ($line =~ /^###\s+`(\S+)=`/) {
            my $key = $1;

            # Check for dups and for out-of-order
            if (@described) {
                if (lc($key) lt lc($described[-1])) {
                    warn "$ME: $path:$.: out-of-order key '$key'\n";
                }
                if (grep { lc($_) eq lc($key) } @described) {
                    warn "$ME: $path:$.: duplicate key '$key'\n";
                }
            }

            grep { $_ eq $key } @found_in_table
                or warn "$ME: $path:$.: key '$key' is not listed in table for unit '$unit'\n";

            push @described, $key;
            $documented{$key}++;
        }
    }

    close $fh;

    # Final cross-check between table and description blocks
    $crossref_against_table->();

    # Check that no Go keys are missing

    (my $md_basename = $path) =~ s|^.*/||;
    for my $k (@$true_keys) {
        $documented{$k}
            or warn "$ME: undocumented key: '$k' not found anywhere in $md_basename\n";
    }
}

1;