moparisthebest/wget
1
0
Fork 0
mirror of https://github.com/moparisthebest/wget synced 2024-07-03 16:38:41 -04:00
Code Issues Releases Wiki Activity

Automated merge.

Browse Source
This commit is contained in:
Micah Cowan 2009-07-01 11:10:42 -07:00
commit a9da78c6d8
1 changed files with 185 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

245
util/paramcheck.pl
View File

@ -1,6 +1,6 @@
#!/usr/bin/perl #!/usr/bin/perl
# Copyright (C) 2008 Free Software Foundation, Inc. # Copyright (C) 2008, 2009 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify # 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 # it under the terms of the GNU General Public License as published by
@ -17,157 +17,286 @@
use strict; use strict;
use warnings; use warnings;
use constant true => 1;
use constant false => 0;
use FindBin qw($Bin); use FindBin qw($Bin);
use File::Spec (); use File::Spec ();
my @args = ([ my @args = ([
File::Spec->catfile($Bin, '..', 'src', 'main.c'), File::Spec->catfile($Bin, File::Spec->updir, 'src', 'main.c'),
qr/static \s+? struct \s+? cmdline_option \s+? option_data\[\] \s+? = \s+? \{ (.*?) \}\;/sx, qr/static \s+? struct \s+? cmdline_option \s+? option_data\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
[ qw(long_name short_name type data argtype) ], [ qw(long_name short_name type data argtype) ],
], [ ], [
File::Spec->catfile($Bin, '..', 'src', 'init.c'), File::Spec->catfile($Bin, File::Spec->updir, 'src', 'init.c'),
qr/commands\[\] \s+? = \s+? \{ (.*?) \}\;/sx, qr/commands\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
[ qw(name place action) ], [ qw(name place action) ],
]); ]);
my $tex_file = File::Spec->catfile($Bin, File::Spec->updir, 'doc', 'wget.texi');
{ {
my (@lines, @opts, $source); my @data;
foreach my $arg (@args) { foreach my $arg (@args) {
my ($file, $regex, $names) = @$arg; my ($file, $regex, $names) = @$arg;
$source = read_file($file); my $source = read_file($file);
@lines = extract_opts_chunk($source, $regex); my @chunks = extract_chunks($source, $regex);
push @opts, extract_opts(\@lines, $names); push @data, extract_entries(\@chunks, $names);
} }
walk_opts(@opts);
output_results(@data);
} }
sub read_file sub read_file
{ {
my ($file) = @_; my ($file) = @_;
open(my $fh, '<', $file) or die "Cannot open $file: $!"; open(my $fh, '<', $file) or die "Cannot open $file: $!";
return do { local $/; <$fh> }; return do { local $/; <$fh> };
} }
sub extract_opts_chunk sub extract_chunks
{ {
my ($source, $regex) = @_; 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 ($chunks, $names) = @_;
my @opts;
foreach my $line (@$lines) { my (@entries, %index, $i);
my ($args) = $line =~ /\{ \s+? (.*?) \s+? \}/sx;
foreach my $chunk (@$chunks) {
my ($args) = $chunk =~ /\{ \s+? (.*?) \s+? \}/sx;
next unless defined $args; next unless defined $args;
my @args = map { tr/'"//d; $_ }
map { /\((.*?)\)/ ? $1 : $_ } my @args = map {
split /\,\s+/, $args; tr/'"//d; $_
my $opt = { map { $_ => shift @args } @$names }; } map {
($opt->{line}) = $line =~ /.*? (\{.*)/; /\((.*?)\)/ ? $1 : $_
$opts[-1]->{is_deprecated} = 1 if $line =~ /deprecated/i; } split /\,\s+/, $args;
push @opts, $opt;
my $entry = { map { $_ => shift @args } @$names };
($entry->{line}) = $chunk =~ /^ \s+? (\{.*)/mx;
if ($chunk =~ /deprecated/i) {
$entries[-1]->{deprecated} = true;
} }
return \@opts;
my $index_name = exists $entry->{data}
? $entry->{data}
: $entry->{name};
$index{$index_name} = $i++;
push @entries, $entry;
}
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"; print "\n";
emit_no_matching_long_cmds(@_); emit_no_matching_long_cmds($opts);
print "\n"; print "\n";
emit_no_corresponding_opts(@_); emit_no_corresponding_opts($opts, $cmds);
print "\n"; print "\n";
emit_deprecated_opts(@_); emit_deprecated_opts($opts);
print "\n"; print "\n";
emit_deprecated_cmds(@_); emit_deprecated_cmds($cmds);
print "\n";
my $tex = read_file($tex_file);
emit_undocumented_opts($tex, $opts);
print "\n";
emit_undocumented_cmds($tex, $opts, $cmds, \%index);
print "\n"; print "\n";
} }
sub emit_no_corresponding_cmds sub emit_no_corresponding_cmds
{ {
my ($opts) = @_; my ($opts) = @_;
print <<EOT;
No corresponding commands my @options;
=========================
EOT
foreach my $opt (@$opts) { foreach my $opt (@$opts) {
unless ($opt->{type} =~ /^(?:OPT_BOOLEAN|OPT_VALUE)$/ unless ($opt->{type} =~ /^(?:OPT_BOOLEAN|OPT_VALUE)$/
&& $opt->{argtype} == -1) && $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 sub emit_no_matching_long_cmds
{ {
my ($opts) = @_; my ($opts) = @_;
print <<EOT;
Non-matching commands my @options;
=====================
EOT
foreach my $opt (@$opts) { foreach my $opt (@$opts) {
my $long_name = $opt->{long_name}; my $long_name = $opt->{long_name};
$long_name =~ tr/-//d; $long_name =~ tr/-//d;
unless ($long_name eq $opt->{data}) { 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 sub emit_no_corresponding_opts
{ {
my ($opts, $cmds) = @_; my ($opts, $cmds) = @_;
print <<EOT;
No corresponding options my @commands;
========================
EOT
foreach my $cmd (@$cmds) { foreach my $cmd (@$cmds) {
my $found = 0; my $found = false;
foreach my $opt (@$opts) { foreach my $opt (@$opts) {
my $long_name = $opt->{long_name}; my $long_name = $opt->{long_name};
$long_name =~ tr/-//d; $long_name =~ tr/-//d;
if ($cmd->{name} eq $opt->{data} if ($cmd->{name} eq $opt->{data}
|| $cmd->{name} eq $long_name) { || $cmd->{name} eq $long_name) {
$found = 1; $found = true;
last; last;
} }
} }
unless ($found) { unless ($found) {
print $cmd->{line}, "\n"; push @commands, $cmd->{line};
} }
} }
local $" = "\n";
print <<EOT;
No corresponding options
========================
@commands
EOT
} }
sub emit_deprecated_opts sub emit_deprecated_opts
{ {
my ($opts) = @_; my ($opts) = @_;
my @options;
foreach my $opt (@$opts) {
if ($opt->{deprecated}) {
push @options, $opt->{line};
}
}
local $" = "\n";
print <<EOT; print <<EOT;
Deprecated options Deprecated options
================== ==================
@options
EOT EOT
foreach my $opt (@$opts) {
if ($opt->{is_deprecated}) {
print $opt->{line}, "\n";
}
}
} }
sub emit_deprecated_cmds 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; print <<EOT;
Deprecated commands Deprecated commands
=================== ===================
@commands
EOT
}
sub emit_undocumented_opts
{
my ($tex, $opts) = @_;
my %items;
while ($tex =~ /^\@item\w*? \s+? --([\w\-]+)/gmx) {
my $opt = $1;
$items{$opt} = true;
}
my @options;
foreach my $opt (@$opts) {
my $opt_name = $opt->{long_name};
if (not $items{$opt_name}
|| ($opt_name !~ /^no/
? $items{"no-$opt_name"}
: false)
|| $opt->{deprecated})
{
push @options, $opt_name;
}
}
local $" = "\n";
print <<EOT;
Undocumented options
====================
@options
EOT
}
sub emit_undocumented_cmds
{
my ($tex, $opts, $cmds, $index) = @_;
my %items;
while ($tex =~ /^\@item\w*? \s+? ([\w\_]+) \s+? = \s+? \S+?/gmx) {
my $cmd = $1;
$cmd =~ tr/_//d;
$items{$cmd} = true;
}
my @commands;
foreach my $cmd (@$cmds) {
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 EOT
foreach my $cmd (@$cmds) {
if ($cmd->{is_deprecated}) {
print $cmd->{line}, "\n";
}
}
} }