-#!/usr/bin/perl
+#!/usr/bin/env perl
-# Copyright (C) 2008 Free Software Foundation, Inc.
+# Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
use strict;
use warnings;
+use constant true => 1;
+use constant false => 0;
use FindBin qw($Bin);
use File::Spec ();
+my $main_c_file = File::Spec->catfile($Bin, File::Spec->updir, 'src', 'main.c');
+my $init_c_file = File::Spec->catfile($Bin, File::Spec->updir, 'src', 'init.c');
+my $tex_file = File::Spec->catfile($Bin, File::Spec->updir, 'doc', 'wget.texi');
+
+my $main_content = read_file($main_c_file);
+my $init_content = read_file($init_c_file);
+my $tex_content = read_file($tex_file);
+
my @args = ([
- File::Spec->catfile($Bin, '..', 'src', 'main.c'),
+ $main_content,
qr/static \s+? struct \s+? cmdline_option \s+? option_data\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
[ qw(long_name short_name type data argtype) ],
], [
- File::Spec->catfile($Bin, '..', 'src', 'init.c'),
+ $init_content,
qr/commands\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
[ qw(name place action) ],
]);
{
- my (@lines, @opts, $source);
+ my @data;
+
foreach my $arg (@args) {
- my ($file, $regex, $names) = @$arg;
- $source = read_file($file);
- @lines = extract_opts_chunk($source, $regex);
- push @opts, extract_opts(\@lines, $names);
+ my ($source, $regex, $names) = @$arg;
+ my @chunks = extract_chunks($source, $regex);
+ push @data, extract_entries(\@chunks, $names);
}
- walk_opts(@opts);
+
+ output_results(@data);
}
sub read_file
{
my ($file) = @_;
+
open(my $fh, '<', $file) or die "Cannot open $file: $!";
+
return do { local $/; <$fh> };
}
-sub extract_opts_chunk
+sub extract_chunks
{
my ($source, $regex) = @_;
- my ($opts) = $source =~ $regex;
- return map { /\S/ && !/^\#/ ? $_ : () } split /(?<=\})/, $opts;
+
+ my ($raw_data) = $source =~ $regex;
+
+ return map { /\S/ && !/^\#/ ? $_ : () } split /(?<=\})/, $raw_data;
}
-sub extract_opts
+sub extract_entries
{
- my ($lines, $names) = @_;
- my @opts;
- foreach my $line (@$lines) {
- my ($args) = $line =~ /\{ \s+? (.*?) \s+? \}/sx;
+ my ($chunks, $names) = @_;
+
+ my (@entries, %index, $i);
+
+ foreach my $chunk (@$chunks) {
+ my ($args) = $chunk =~ /\{ \s+? (.*?) \s+? \}/sx;
next unless defined $args;
- my @args = map { tr/'"//d; $_ }
- map { /\((.*?)\)/ ? $1 : $_ }
- split /\,\s+/, $args;
- my $opt = { map { $_ => shift @args } @$names };
- ($opt->{line}) = $line =~ /.*? (\{.*)/;
- $opts[-1]->{is_deprecated} = 1 if $line =~ /deprecated/i;
- push @opts, $opt;
+
+ my @args = map {
+ tr/'"//d; $_
+ } map {
+ /\((.*?)\)/ ? $1 : $_
+ } split /\,\s+/, $args;
+
+ my $entry = { map { $_ => shift @args } @$names };
+
+ ($entry->{line}) = $chunk =~ /^ \s+? (\{.*)/mx;
+ if ($chunk =~ /deprecated/i) {
+ $entries[-1]->{deprecated} = true;
+ }
+
+ my $index_name = exists $entry->{data}
+ ? $entry->{data}
+ : $entry->{name};
+
+ $index{$index_name} = $i++;
+
+ push @entries, $entry;
}
- return \@opts;
+
+ push @entries, \%index;
+
+ return \@entries;
}
-sub walk_opts
+sub output_results
{
- emit_no_corresponding_cmds(@_);
+ my ($opts, $cmds) = @_;
+
+ my %index = (
+ opts => pop @$opts,
+ cmds => pop @$cmds,
+ );
+
+ emit_no_corresponding_cmds($opts);
+ print "\n";
+ emit_no_matching_long_cmds($opts);
print "\n";
- emit_no_matching_long_cmds(@_);
+ emit_no_corresponding_opts($opts, $cmds);
print "\n";
- emit_no_corresponding_opts(@_);
+ emit_deprecated_opts($opts);
print "\n";
- emit_deprecated_opts(@_);
+ emit_deprecated_cmds($cmds);
print "\n";
- emit_deprecated_cmds(@_);
+
+ emit_undocumented_opts($tex_content, $main_content, $opts);
+ print "\n";
+ emit_undocumented_cmds($tex_content, $opts, $cmds, \%index);
print "\n";
}
sub emit_no_corresponding_cmds
{
my ($opts) = @_;
- print <<EOT;
-No corresponding commands
-=========================
-EOT
+
+ my @options;
foreach my $opt (@$opts) {
unless ($opt->{type} =~ /^(?:OPT_BOOLEAN|OPT_VALUE)$/
&& $opt->{argtype} == -1)
{
- print $opt->{line}, "\n";
+ push @options, $opt->{line};
}
}
+
+ local $" = "\n";
+ print <<EOT;
+No corresponding commands
+=========================
+@options
+EOT
}
sub emit_no_matching_long_cmds
{
my ($opts) = @_;
- print <<EOT;
-Non-matching commands
-=====================
-EOT
+
+ my @options;
foreach my $opt (@$opts) {
my $long_name = $opt->{long_name};
$long_name =~ tr/-//d;
unless ($long_name eq $opt->{data}) {
- print $opt->{line}, "\n";
+ push @options, $opt->{line};
}
}
+
+ local $" = "\n";
+ print <<EOT;
+Non-matching commands
+=====================
+@options
+EOT
}
sub emit_no_corresponding_opts
{
my ($opts, $cmds) = @_;
- print <<EOT;
-No corresponding options
-========================
-EOT
+
+ my @commands;
foreach my $cmd (@$cmds) {
- my $found = 0;
+ my $found = false;
foreach my $opt (@$opts) {
my $long_name = $opt->{long_name};
$long_name =~ tr/-//d;
if ($cmd->{name} eq $opt->{data}
|| $cmd->{name} eq $long_name) {
- $found = 1;
+ $found = true;
last;
}
}
unless ($found) {
- print $cmd->{line}, "\n";
+ push @commands, $cmd->{line};
}
}
+
+ local $" = "\n";
+ print <<EOT;
+No corresponding options
+========================
+@commands
+EOT
}
sub emit_deprecated_opts
{
my ($opts) = @_;
+
+ my @options;
+ foreach my $opt (@$opts) {
+ if ($opt->{deprecated}) {
+ push @options, $opt->{line};
+ }
+ }
+
+ local $" = "\n";
print <<EOT;
Deprecated options
==================
+@options
EOT
- foreach my $opt (@$opts) {
- if ($opt->{is_deprecated}) {
- print $opt->{line}, "\n";
- }
- }
}
sub emit_deprecated_cmds
{
- my ($opts, $cmds) = @_;
+ my ($cmds) = @_;
+
+ my @commands;
+ foreach my $cmd (@$cmds) {
+ if ($cmd->{deprecated}) {
+ push @commands, $cmd->{line};
+ }
+ }
+
+ local $" = "\n";
print <<EOT;
Deprecated commands
===================
+@commands
EOT
+}
+
+sub find_documentation
+{
+ my ($options, $opt, $tex_items, $main_items) = @_;
+
+ my %found_in;
+ my %items = (
+ tex => $tex_items,
+ main => $main_items,
+ );
+ my $opt_name = $opt->{long_name};
+
+ foreach my $doc_type (qw(tex main)) {
+ my $doc = $items{$doc_type};
+ if ($doc->{$opt_name}
+ || ($opt_name !~ /^no/ && $doc->{"no-$opt_name"})) {
+ $found_in{$doc_type} = true;
+ }
+ else {
+ $found_in{$doc_type} = false;
+ }
+ }
+ if (scalar grep { $_ == false } values %found_in) {
+ push @$options, {
+ name => $opt_name,
+ tex => $found_in{tex},
+ main => $found_in{main},
+ }
+ }
+}
+
+sub emit_undocumented_opts
+{
+ my ($tex, $main, $opts) = @_;
+
+ my (%tex_items, %main_items);
+ while ($tex =~ /^\@item\w*? \s+? --([-a-z0-9]+)/gmx) {
+ $tex_items{$1} = true;
+ }
+ my ($help) = $main =~ /\n print_help .*? \{\n (.*) \n\} \n/sx;
+ while ($help =~ /--([-a-z0-9]+)/g) {
+ $main_items{$1} = true;
+ }
+
+ my @options;
+ foreach my $opt (@$opts) {
+ next if $opt->{deprecated};
+ find_documentation(\@options, $opt, \%tex_items, \%main_items);
+ }
+
+ my ($opt, $not_found_in);
+
+format STDOUT_TOP =
+Undocumented options Not In:
+==================== ==================
+.
+
+format STDOUT =
+@<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<
+$opt->{name}, $not_found_in
+.
+ foreach $opt (@options) {
+ $not_found_in = join ' ', (
+ ! $opt->{tex} ? 'texinfo' : (),
+ !($opt->{tex} || $opt->{main}) ? 'nor' : (),
+ ! $opt->{main} ? '--help' : (),
+ );
+ write;
+ }
+}
+
+sub emit_undocumented_cmds
+{
+ my ($tex, $opts, $cmds, $index) = @_;
+
+ my %items;
+ while ($tex =~ /^\@item\w*? \s+? ([_a-z0-9]+) \s+? = \s+? \S+?/gmx) {
+ my $cmd = $1;
+ $cmd =~ tr/_//d;
+ $items{$cmd} = true;
+ }
+ my @commands;
foreach my $cmd (@$cmds) {
- if ($cmd->{is_deprecated}) {
- print $cmd->{line}, "\n";
+ my $cmd_name = do {
+ local $_ = exists $index->{opts}->{$cmd->{name}}
+ ? $opts->[$index->{opts}->{$cmd->{name}}]->{long_name}
+ : $cmd->{name};
+ tr/-/_/;
+ $_;
+ };
+ if (not $items{$cmd->{name}} || $cmd->{deprecated}) {
+ push @commands, $cmd_name;
}
}
+
+ local $" = "\n";
+ print <<EOT;
+Undocumented commands
+=====================
+@commands
+EOT
}
projects / wget / blobdiff