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');
29 my $main_content = read_file($main_c_file);
30 my $init_content = read_file($init_c_file);
31 my $tex_content = read_file($tex_file);
35 qr/static \s+? struct \s+? cmdline_option \s+? option_data\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
36 [ qw(long_name short_name type data argtype) ],
39 qr/commands\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
40 [ qw(name place action) ],
46 foreach my $arg (@args) {
47 my ($source, $regex, $names) = @$arg;
48 my @chunks = extract_chunks($source, $regex);
49 push @data, extract_entries(\@chunks, $names);
52 output_results(@data);
59 open(my $fh, '<', $file) or die "Cannot open $file: $!";
61 return do { local $/; <$fh> };
66 my ($source, $regex) = @_;
68 my ($raw_data) = $source =~ $regex;
70 return map { /\S/ && !/^\#/ ? $_ : () } split /(?<=\})/, $raw_data;
75 my ($chunks, $names) = @_;
77 my (@entries, %index, $i);
79 foreach my $chunk (@$chunks) {
80 my ($args) = $chunk =~ /\{ \s+? (.*?) \s+? \}/sx;
81 next unless defined $args;
87 } split /\,\s+/, $args;
89 my $entry = { map { $_ => shift @args } @$names };
91 ($entry->{line}) = $chunk =~ /^ \s+? (\{.*)/mx;
92 if ($chunk =~ /deprecated/i) {
93 $entries[-1]->{deprecated} = true;
96 my $index_name = exists $entry->{data}
100 $index{$index_name} = $i++;
102 push @entries, $entry;
105 push @entries, \%index;
112 my ($opts, $cmds) = @_;
119 emit_no_corresponding_cmds($opts);
121 emit_no_matching_long_cmds($opts);
123 emit_no_corresponding_opts($opts, $cmds);
125 emit_deprecated_opts($opts);
127 emit_deprecated_cmds($cmds);
130 emit_undocumented_opts($tex_content, $main_content, $opts);
132 emit_undocumented_cmds($tex_content, $opts, $cmds, \%index);
136 sub emit_no_corresponding_cmds
141 foreach my $opt (@$opts) {
142 unless ($opt->{type} =~ /^(?:OPT_BOOLEAN|OPT_VALUE)$/
143 && $opt->{argtype} == -1)
145 push @options, $opt->{line};
151 No corresponding commands
152 =========================
157 sub emit_no_matching_long_cmds
162 foreach my $opt (@$opts) {
163 my $long_name = $opt->{long_name};
164 $long_name =~ tr/-//d;
165 unless ($long_name eq $opt->{data}) {
166 push @options, $opt->{line};
172 Non-matching commands
173 =====================
178 sub emit_no_corresponding_opts
180 my ($opts, $cmds) = @_;
183 foreach my $cmd (@$cmds) {
185 foreach my $opt (@$opts) {
186 my $long_name = $opt->{long_name};
187 $long_name =~ tr/-//d;
188 if ($cmd->{name} eq $opt->{data}
189 || $cmd->{name} eq $long_name) {
195 push @commands, $cmd->{line};
201 No corresponding options
202 ========================
207 sub emit_deprecated_opts
212 foreach my $opt (@$opts) {
213 if ($opt->{deprecated}) {
214 push @options, $opt->{line};
226 sub emit_deprecated_cmds
231 foreach my $cmd (@$cmds) {
232 if ($cmd->{deprecated}) {
233 push @commands, $cmd->{line};
245 sub find_documentation
247 my ($push, $opt) = (shift, shift);
250 my $opt_name = $opt->{'long_name'};
252 next if $opt->{'deprecated'};
253 if ($doc->{$opt_name}
254 || ($opt_name !~ /^no/ && $doc->{"no-$opt_name"})) {
260 push @$push, [$opt_name, @$info] if grep {$_ eq 0} @$info;
263 sub emit_undocumented_opts
265 my ($tex, $main, $opts) = @_;
267 my (%tex_items, %main_items);
268 while ($tex =~ /^\@item\w*? \s+? --([\w\-]+)/gmx) {
269 $tex_items{$1} = true;
271 ($main) = $main =~ /(\nprint_help.*\n}\n)/s;
272 while ($main =~ /--([-a-z0-9]+)/g) {
273 $main_items{$1} = true;
276 foreach my $opt (@$opts) {
277 find_documentation (\@options, $opt, \%tex_items, \%main_items);
282 Undocumented options Not In:
283 ==================== ==================
285 for my $opt (@options) {
286 printf("%-29s ", $opt->[0]);
287 print 'texinfo ' unless $opt->[1];
288 print 'nor ' unless $opt->[1] or $opt->[2];
289 print '--help ' unless $opt->[2];
294 sub emit_undocumented_cmds
296 my ($tex, $opts, $cmds, $index) = @_;
299 while ($tex =~ /^\@item\w*? \s+? ([\w\_]+) \s+? = \s+? \S+?/gmx) {
305 foreach my $cmd (@$cmds) {
307 local $_ = exists $index->{opts}->{$cmd->{name}}
308 ? $opts->[$index->{opts}->{$cmd->{name}}]->{long_name}
313 if (not $items{$cmd->{name}} || $cmd->{deprecated}) {
314 push @commands, $cmd_name;
320 Undocumented commands
321 =====================