#!/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 @Docs = (
    "docs/source/markdown/podman-build.unit.5.md",
    "docs/source/markdown/podman-container.unit.5.md",
    "docs/source/markdown/podman-image.unit.5.md",
    "docs/source/markdown/podman-kube.unit.5.md",
    "docs/source/markdown/podman-network.unit.5.md",
    "docs/source/markdown/podman-pod.unit.5.md",
    "docs/source/markdown/podman-systemd.unit.5.md",
    "docs/source/markdown/podman-volume.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]: @Docs

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_docs(\@Docs, $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_docs  #  Read the markdown pages, cross-check against Truth
##################
sub crossref_docs {
    my $paths_ref = shift;             # in: array with paths to .md file
    my $true_keys = shift;              # in: AREF, list of keys from .go

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

    # 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 multiple 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";
        }
    };

    my $start_new_section = sub {
        my ($new_unit) = @_;
        $crossref_against_table->();
        $unit = $new_unit;
        @found_in_table = ();
        @described = ();
        $read_first_table = 0;
    };

    # foreach loop
    foreach my $path (@$paths_ref) {
        open my $fh, '<', $path
        or die "$ME: Cannot read $path: $!\n";;

        $start_new_section->($path);


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

            # A markdown section marks a new logical key namespace, each with
            # its own options table and description blocks.
            if ($line =~ /^##\s+/) {
                $start_new_section->("$path: $line");
                next;
            }

            # Table line
            if ($read_first_table == 0 && $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+`([A-Z][A-Za-z6]+)=.*`/) {
                my $key = $1;

                $read_first_table = 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/section '$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

    for my $k (@$true_keys) {
        $documented{$k}
            or warn "$ME: undocumented key: '$k' not found anywhere in @$paths_ref\n";
    }
}

1;
