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

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