3 # Copyright (C) 2008, 2009 Free Software Foundation, Inc.
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program. If not, see <http://www.gnu.org/licenses/>.
20 use constant true => 1;
21 use constant false => 0;
26 my $main_c_file = File::Spec->catfile($Bin, File::Spec->updir, 'src', 'main.c');
27 my $init_c_file = File::Spec->catfile($Bin, File::Spec->updir, 'src', 'init.c');
28 my $tex_file = File::Spec->catfile($Bin, File::Spec->updir, 'doc', 'wget.texi');
30 my $main_content = read_file($main_c_file);
31 my $init_content = read_file($init_c_file);
32 my $tex_content = read_file($tex_file);
36 qr/static \s+? struct \s+? cmdline_option \s+? option_data\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
37 [ qw(long_name short_name type data argtype) ],
40 qr/commands\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
41 [ qw(name place action) ],
47 foreach my $arg (@args) {
48 my ($source, $regex, $names) = @$arg;
49 my @chunks = extract_chunks($source, $regex);
50 push @data, extract_entries(\@chunks, $names);
53 output_results(@data);
60 open(my $fh, '<', $file) or die "Cannot open $file: $!";
62 return do { local $/; <$fh> };
67 my ($source, $regex) = @_;
69 my ($raw_data) = $source =~ $regex;
71 return map { /\S/ && !/^\#/ ? $_ : () } split /(?<=\})/, $raw_data;
76 my ($chunks, $names) = @_;
78 my (@entries, %index, $i);
80 foreach my $chunk (@$chunks) {
81 my ($args) = $chunk =~ /\{ \s+? (.*?) \s+? \}/sx;
82 next unless defined $args;
88 } split /\,\s+/, $args;
90 my $entry = { map { $_ => shift @args } @$names };
92 ($entry->{line}) = $chunk =~ /^ \s+? (\{.*)/mx;
93 if ($chunk =~ /deprecated/i) {
94 $entries[-1]->{deprecated} = true;
97 my $index_name = exists $entry->{data}
101 $index{$index_name} = $i++;
103 push @entries, $entry;
106 push @entries, \%index;
113 my ($opts, $cmds) = @_;
120 emit_no_corresponding_cmds($opts);
122 emit_no_matching_long_cmds($opts);
124 emit_no_corresponding_opts($opts, $cmds);
126 emit_deprecated_opts($opts);
128 emit_deprecated_cmds($cmds);
131 emit_undocumented_opts($tex_content, $main_content, $opts);
133 emit_undocumented_cmds($tex_content, $opts, $cmds, \%index);
137 sub emit_no_corresponding_cmds
142 foreach my $opt (@$opts) {
143 unless ($opt->{type} =~ /^(?:OPT_BOOLEAN|OPT_VALUE)$/
144 && $opt->{argtype} == -1)
146 push @options, $opt->{line};
152 No corresponding commands
153 =========================
158 sub emit_no_matching_long_cmds
163 foreach my $opt (@$opts) {
164 my $long_name = $opt->{long_name};
165 $long_name =~ tr/-//d;
166 unless ($long_name eq $opt->{data}) {
167 push @options, $opt->{line};
173 Non-matching commands
174 =====================
179 sub emit_no_corresponding_opts
181 my ($opts, $cmds) = @_;
184 foreach my $cmd (@$cmds) {
186 foreach my $opt (@$opts) {
187 my $long_name = $opt->{long_name};
188 $long_name =~ tr/-//d;
189 if ($cmd->{name} eq $opt->{data}
190 || $cmd->{name} eq $long_name) {
196 push @commands, $cmd->{line};
202 No corresponding options
203 ========================
208 sub emit_deprecated_opts
213 foreach my $opt (@$opts) {
214 if ($opt->{deprecated}) {
215 push @options, $opt->{line};
227 sub emit_deprecated_cmds
232 foreach my $cmd (@$cmds) {
233 if ($cmd->{deprecated}) {
234 push @commands, $cmd->{line};
246 sub find_documentation
248 my ($options, $opt, $tex_items, $main_items) = @_;
255 my $opt_name = $opt->{long_name};
257 foreach my $doc_type (qw(tex main)) {
258 my $doc = $items{$doc_type};
259 if ($doc->{$opt_name}
260 || ($opt_name !~ /^no/ && $doc->{"no-$opt_name"})) {
261 $found_in{$doc_type} = true;
264 $found_in{$doc_type} = false;
267 if (scalar grep { $_ == false } values %found_in) {
270 tex => $found_in{tex},
271 main => $found_in{main},
276 sub emit_undocumented_opts
278 my ($tex, $main, $opts) = @_;
280 my (%tex_items, %main_items);
281 while ($tex =~ /^\@item\w*? \s+? --([-a-z0-9]+)/gmx) {
282 $tex_items{$1} = true;
284 my ($help) = $main =~ /\n print_help .*? \{\n (.*) \n\} \n/sx;
285 while ($help =~ /--([-a-z0-9]+)/g) {
286 $main_items{$1} = true;
290 foreach my $opt (@$opts) {
291 next if $opt->{deprecated};
292 find_documentation(\@options, $opt, \%tex_items, \%main_items);
295 my ($opt, $not_found_in);
298 Undocumented options Not In:
299 ==================== ==================
303 @<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<
304 $opt->{name}, $not_found_in
306 foreach $opt (@options) {
307 $not_found_in = join ' ', (
308 ! $opt->{tex} ? 'texinfo' : (),
309 !($opt->{tex} || $opt->{main}) ? 'nor' : (),
310 ! $opt->{main} ? '--help' : (),
316 sub emit_undocumented_cmds
318 my ($tex, $opts, $cmds, $index) = @_;
321 while ($tex =~ /^\@item\w*? \s+? ([_a-z0-9]+) \s+? = \s+? \S+?/gmx) {
327 foreach my $cmd (@$cmds) {
329 local $_ = exists $index->{opts}->{$cmd->{name}}
330 ? $opts->[$index->{opts}->{$cmd->{name}}]->{long_name}
335 if (not $items{$cmd->{name}} || $cmd->{deprecated}) {
336 push @commands, $cmd_name;
342 Undocumented commands
343 =====================