podman

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

9
use v5.14;
10
use utf8;
11

12
use strict;
13
use warnings;
14

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

18
###############################################################################
19
# BEGIN user-customizable section
20

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

24
# END   user-customizable section
25
###############################################################################
26

27
###############################################################################
28
# BEGIN boilerplate args checking, usage messages
29

30
sub usage {
31
    print  <<"END_USAGE";
32
Usage: $ME [OPTIONS]
33

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

37
 [Go]: $Go
38
 [MD]: $Doc
39

40
We check that:
41

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

48
OPTIONS:
49

50
  --help         display this message
51
  --version      display program name and version
52
END_USAGE
53

54
    exit;
55
}
56

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

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

70
# END   boilerplate args checking, usage messages
71
###############################################################################
72

73
############################## CODE BEGINS HERE ###############################
74

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

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

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

88
    my $errs = 0;
89
    $SIG{__WARN__} = sub {
90
        print STDERR "@_";
91
        ++$errs;
92
    };
93

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

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

100
    exit $errs;
101
}
102

103

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

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

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

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

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

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

134
            push @found, $keystring
135
                unless $deprecated;
136
        }
137
    }
138
    close $fh;
139

140
    \@found;
141
}
142

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

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

153
    my $unit = '';
154
    my %documented;
155
    my @found_in_table;
156
    my @described;
157

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

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

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

179
            $crossref_against_table->();
180

181
            $unit = $new_unit;
182

183
            # Reset, because each section has its own table & blocks
184
            @found_in_table = ();
185
            @described = ();
186
            next;
187
        }
188

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

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

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

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

207
                push @found_in_table, $key;
208
                $documented{$key}++;
209
            }
210
            else {
211
                warn "$ME: $path:$.: cannot grok table line '$line'\n";
212
            }
213
        }
214

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

219
            # Check for dups and for out-of-order
220
            if (@described) {
221
                if (lc($key) lt lc($described[-1])) {
222
                    warn "$ME: $path:$.: out-of-order key '$key'\n";
223
                }
224
                if (grep { lc($_) eq lc($key) } @described) {
225
                    warn "$ME: $path:$.: duplicate key '$key'\n";
226
                }
227
            }
228

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

232
            push @described, $key;
233
            $documented{$key}++;
234
        }
235
    }
236

237
    close $fh;
238

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

242
    # Check that no Go keys are missing
243

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

251
1;
252