sjero.net Git - wget/blob - util/paramcheck.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) 2008 Free Software Foundation, Inc.
   4
   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.
   9
  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.
  14
  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/>.
  17
  18 use strict;
  19 use warnings;
  20
  21 use FindBin qw($Bin);
  22 use File::Spec ();
  23
  24 my @args = ([
  25     File::Spec->catfile($Bin, '..', 'src', 'main.c'),
  26     qr/static \s+? struct \s+? cmdline_option \s+? option_data\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
  27     [ qw(long_name short_name type data argtype) ],
  28 ], [
  29     File::Spec->catfile($Bin, '..', 'src', 'init.c'),
  30     qr/commands\[\] \s+? = \s+? \{ (.*?) \}\;/sx,
  31     [ qw(name place action) ],
  32 ]);
  33
  34 {
  35     my (@lines, @opts, $source);
  36     foreach my $arg (@args) {
  37         my ($file, $regex, $names) = @$arg;
  38         $source = read_file($file);
  39         @lines = extract_opts_chunk($source, $regex);
  40         push @opts, extract_opts(\@lines, $names);
  41     }
  42     walk_opts(@opts);
  43 }
  44
  45 sub read_file
  46 {
  47     my ($file) = @_;
  48     open(my $fh, '<', $file) or die "Cannot open $file: $!";
  49     return do { local $/; <$fh> };
  50 }
  51
  52 sub extract_opts_chunk
  53 {
  54     my ($source, $regex) = @_;
  55     my ($opts) = $source =~ $regex;
  56     return map { /\S/ && !/^\#/ ? $_ : () } split /(?<=\})/, $opts;
  57 }
  58
  59 sub extract_opts
  60 {
  61     my ($lines, $names) = @_;
  62     my @opts;
  63     foreach my $line (@$lines) {
  64         my ($args) = $line =~ /\{ \s+? (.*?) \s+? \}/sx;
  65         next unless defined $args;
  66         my @args = map { tr/'"//d; $_ }
  67                    map { /\((.*?)\)/ ? $1 : $_ }
  68                    split /\,\s+/, $args;
  69         my $opt = { map { $_ => shift @args } @$names };
  70         ($opt->{line}) = $line =~ /.*? (\{.*)/;
  71         $opts[-1]->{is_deprecated} = 1 if $line =~ /deprecated/i;
  72         push @opts, $opt;
  73     }
  74     return \@opts;
  75 }
  76
  77 sub walk_opts
  78 {
  79     emit_no_corresponding_cmds(@_);
  80     print "\n";
  81     emit_no_matching_long_cmds(@_);
  82     print "\n";
  83     emit_no_corresponding_opts(@_);
  84     print "\n";
  85     emit_deprecated_opts(@_);
  86     print "\n";
  87     emit_deprecated_cmds(@_);
  88     print "\n";
  89 }
  90
  91 sub emit_no_corresponding_cmds
  92 {
  93     my ($opts) = @_;
  94     print <<EOT;
  95 No corresponding commands
  96 =========================
  97 EOT
  98     foreach my $opt (@$opts) {
  99         unless ($opt->{type} =~ /^(?:OPT_BOOLEAN|OPT_VALUE)$/
 100              && $opt->{argtype} == -1)
 101         {
 102             print $opt->{line}, "\n";
 103         }
 104     }
 105 }
 106
 107 sub emit_no_matching_long_cmds
 108 {
 109     my ($opts) = @_;
 110     print <<EOT;
 111 Non-matching commands
 112 =====================
 113 EOT
 114     foreach my $opt (@$opts) {
 115         my $long_name = $opt->{long_name};
 116         $long_name =~ tr/-//d;
 117         unless ($long_name eq $opt->{data}) {
 118             print $opt->{line}, "\n";
 119         }
 120     }
 121 }
 122
 123 sub emit_no_corresponding_opts
 124 {
 125     my ($opts, $cmds) = @_;
 126     print <<EOT;
 127 No corresponding options
 128 ========================
 129 EOT
 130     foreach my $cmd (@$cmds) {
 131         my $found = 0;
 132         foreach my $opt (@$opts) {
 133             my $long_name = $opt->{long_name};
 134             $long_name =~ tr/-//d;
 135             if ($cmd->{name} eq $opt->{data}
 136              || $cmd->{name} eq $long_name) {
 137                 $found = 1;
 138                 last;
 139             }
 140         }
 141         unless ($found) {
 142             print $cmd->{line}, "\n";
 143         }
 144     }
 145 }
 146
 147 sub emit_deprecated_opts
 148 {
 149     my ($opts) = @_;
 150     print <<EOT;
 151 Deprecated options
 152 ==================
 153 EOT
 154     foreach my $opt (@$opts) {
 155         if ($opt->{is_deprecated}) {
 156             print $opt->{line}, "\n";
 157         }
 158     }
 159 }
 160
 161 sub emit_deprecated_cmds
 162 {
 163     my ($opts, $cmds) = @_;
 164     print <<EOT;
 165 Deprecated commands
 166 ===================
 167 EOT
 168     foreach my $cmd (@$cmds) {
 169         if ($cmd->{is_deprecated}) {
 170             print $cmd->{line}, "\n";
 171         }
 172     }
 173 }