tools/winapi_check/winapi_options.pm

   1 package winapi_options;
   2
   3 use strict;
   4
   5 sub parser_comma_list {
   6     my $prefix = shift;
   7     my $value = shift;
   8     if(defined($prefix) && $prefix eq "no") {
   9         return { active => 0, filter => 0, hash => {} };
  10     } elsif(defined($value)) {
  11         my %names;
  12         for my $name (split /,/, $value) {
  13             $names{$name} = 1;
  14         }
  15         return { active => 1, filter => 1, hash => \%names };
  16     } else {
  17         return { active => 1, filter => 0, hash => {} };
  18     }
  19 }
  20
  21 my %options = (
  22     "debug" => { default => 0, description => "debug mode" },
  23     "help" => { default => 0, description => "help mode" },
  24     "verbose" => { default => 0, description => "verbose mode" },
  25
  26     "progress" => { default => 1, description => "show progress" },
  27
  28     "win16" => { default => 1, description => "Win16 checking" },
  29     "win32" => { default => 1, description => "Win32 checking" },
  30
  31     "shared" =>  { default => 0, description => "show shared functions between Win16 and Win32" },
  32     "shared-segmented" =>  { default => 0, description => "segmented shared functions between Win16 and Win32 checking" },
  33
  34     "config" => { default => 1, description => "check configuration include consistancy" },
  35     "config-unnessary" => { default => 0, parent => "config", description => "check for unnessary #include \"config.h\"" },
  36
  37     "spec-mismatch" => { default => 0, description => "spec file mismatch checking" },
  38
  39     "local" =>  { default => 1, description => "local checking" },
  40     "module" => {
  41         default => { active => 1, filter => 0, hash => {} },
  42         parent => "local",
  43         parser => \&parser_comma_list,
  44         description => "module filter"
  45     },
  46
  47     "argument" => { default => 1, parent => "local", description => "argument checking" },
  48     "argument-count" => { default => 1, parent => "argument", description => "argument count checking" },
  49     "argument-forbidden" => {
  50         default => { active => 1, filter => 0, hash => {} },
  51         parent => "argument",
  52         parser => \&parser_comma_list,
  53         description => "argument forbidden checking"
  54     },
  55     "argument-kind" => {
  56         default => { active => 0, filter => 0, hash => {} },
  57         parent => "argument",
  58         parser => \&parser_comma_list,
  59         description => "argument kind checking"
  60     },
  61     "calling-convention" => { default => 0, parent => "local", description => "calling convention checking" },
  62     "misplaced" => { default => 0, parent => "local", description => "check for misplaced functions" },
  63     "cross-call" => { default => 0, parent => "local", description => "check for cross calling functions" },
  64     "documentation" => { default => 1, parent => "local", description => "check for documentation inconsistances\n" },
  65     "documentation-width" => { default => 0, parent => "documentation", description => "check for documentation width inconsistances\n" },
  66
  67     "global" => { default => 1, description => "global checking" },
  68     "declared" => { default => 1, parent => "global", description => "declared checking" },
  69     "implemented" => { default => 1, parent => "global", description => "implemented checking" },
  70     "implemented-win32" => { default => 0, parent => "implemented", description => "implemented as win32 checking" },
  71     "include" => { default => 1, parent => "global", description => "include checking" },
  72     "headers" => { default => 0, parent => "global", description => "headers checking" },
  73     "stubs" => { default => 0, parent => "global", description => "stubs checking" }
  74 );
  75
  76 my %short_options = (
  77     "d" => "debug",
  78     "?" => "help",
  79     "v" => "verbose"
  80 );
  81
  82 sub new {
  83     my $proto = shift;
  84     my $class = ref($proto) || $proto;
  85     my $self  = {};
  86     bless ($self, $class);
  87
  88     my $refarguments = shift;
  89     my @ARGV = @$refarguments;
  90     my $wine_dir = shift;
  91
  92     for my $name (sort(keys(%options))) {
  93         my $option = $options{$name};
  94         my $key = uc($name);
  95         $key =~ tr/-/_/;
  96         $$option{key} = $key;
  97         my $refvalue = \${$self->{$key}};
  98         $$refvalue = $$option{default};
  99     }
 100
 101     my $c_files = \@{$self->{C_FILES}};
 102     my $h_files = \@{$self->{H_FILES}};
 103     my $module = \${$self->{MODULE}};
 104     my $global = \${$self->{GLOBAL}};
 105
 106     $$global = 0;
 107     while(defined($_ = shift @ARGV)) {
 108         if(/^-([^=]*)(=(.*))?$/) {
 109             my $name;
 110             my $value;
 111             if(defined($2)) {
 112                 $name = $1;
 113                 $value = $3;
 114             } else {
 115                 $name = $1;
 116             }
 117
 118             if($name =~ /^([^-].*)$/) {
 119                 $name = $short_options{$1};
 120             } else {
 121                 $name =~ s/^-(.*)$/$1/;
 122             }
 123
 124             my $prefix;
 125             if($name =~ /^no-(.*)$/) {
 126                 $name = $1;
 127                 $prefix = "no";
 128                 if(defined($value)) {
 129                     print STDERR "<internal>: options with prefix 'no' can't take parameters\n";
 130                     exit 1;
 131                 }
 132             }
 133
 134             my $option = $options{$name};
 135             if(defined($option)) {
 136                 my $key = $$option{key};
 137                 my $parser = $$option{parser};
 138                 my $refvalue = \${$self->{$key}};
 139
 140                 if(defined($parser)) {
 141                     $$refvalue = &$parser($prefix,$value);
 142                 } else {
 143                     if(defined($value)) {
 144                         $$refvalue = $value;
 145                     } elsif(!defined($prefix)) {
 146                         $$refvalue = 1;
 147                     } else {
 148                         $$refvalue = 0;
 149                     }
 150                 }
 151                 next;
 152             }
 153         }
 154
 155         if(/^--module-dlls$/) {
 156             my @dirs = `cd dlls && find ./ -type d ! -name CVS`;
 157             my %names;
 158             for my $dir (@dirs) {
 159                 chomp $dir;
 160                 $dir =~ s/^\.\/(.*)$/$1/;
 161                 next if $dir eq "";
 162                 $names{$dir} = 1;
 163             }
 164             $$module = { active => 1, filter => 1, hash => \%names };
 165         }
 166         elsif(/^-(.*)$/) {
 167             print STDERR "<internal>: unknown option: $&\n";
 168             print STDERR "<internal>: usage: winapi-check [--help] [<files>]\n";
 169             exit 1;
 170         } else {
 171             push @$c_files, $_;
 172         }
 173     }
 174
 175     my $c_paths;
 176     if($#$c_files == -1) {
 177         $c_paths = ".";
 178         $$global = 1;
 179     } else {
 180         $c_paths = join(" ", @$c_files);
 181     }
 182
 183     my $h_paths = "$wine_dir/include $wine_dir/include/wine";
 184
 185     @$c_files = sort(map {
 186         s/^.\/(.*)$/$1/;
 187         if(!/spec\.c$/) {
 188             $_;
 189         } else {
 190             ();
 191         }
 192     } split(/\n/, `find $c_paths -name \\*.c`));
 193
 194     @$h_files = sort(map {
 195         s/^.\/(.*)$/$1/;
 196         $_;
 197     } split(/\n/, `find $h_paths -name \\*.h`));
 198
 199     return $self;
 200 }
 201
 202 sub show_help {
 203     my $self = shift;
 204
 205     my $maxname = 0;
 206     for my $name (sort(keys(%options))) {
 207         if(length($name) > $maxname) {
 208             $maxname = length($name);
 209         }
 210     }
 211
 212     print "usage: winapi-check [--help] [<files>]\n";
 213     print "\n";
 214     for my $name (sort(keys(%options))) {
 215         my $option = $options{$name};
 216         my $description = $$option{description};
 217         my $default = $$option{default};
 218
 219         my $output;
 220         if(ref($default) ne "HASH") {
 221             if($default) {
 222                 $output = "--no-$name";
 223             } else {
 224                 $output = "--$name";
 225             }
 226         } else {
 227             if($default->{active}) {
 228                 $output = "--[no-]$name\[=<value>]";
 229             } else {
 230                 $output = "--$name\[=<value>]";
 231             }
 232         }
 233
 234         print "$output";
 235         for (0..(($maxname - length($name) + 14) - (length($output) - length($name) + 1))) { print " "; }
 236         if(ref($default) ne "HASH") {
 237             if($default) {
 238                 print "Disable $description\n";
 239             } else {
 240                 print "Enable $description\n";
 241             }
 242         } else {
 243             if($default->{active}) {
 244                 print "(Disable) $description\n";
 245             } else {
 246                 print "Enable $description\n";
 247             }
 248
 249
 250         }
 251     }
 252 }
 253
 254 sub AUTOLOAD {
 255     my $self = shift;
 256
 257     my $name = $winapi_options::AUTOLOAD;
 258     $name =~ s/^.*::(.[^:]*)$/\U$1/;
 259
 260     my $refvalue = $self->{$name};
 261     if(!defined($refvalue)) {
 262         die "<internal>: winapi_options.pm: member $name does not exists\n";
 263     }
 264     return $$refvalue;
 265 }
 266
 267 sub c_files { my $self = shift; return @{$self->{C_FILES}}; }
 268
 269 sub h_files { my $self = shift; return @{$self->{H_FILES}}; }
 270
 271 sub report_module {
 272     my $self = shift;
 273     my $module = $self->module;
 274
 275     my $name = shift;
 276
 277     if(defined($name)) {
 278         return $module->{active} && (!$module->{filter} || $module->{hash}->{$name});
 279     } else {
 280         return 0;
 281     }
 282 }
 283
 284 sub report_argument_forbidden {
 285     my $self = shift;
 286     my $argument_forbidden = $self->argument_forbidden;
 287
 288     my $type = shift;
 289
 290     return $argument_forbidden->{active} && (!$argument_forbidden->{filter} || $argument_forbidden->{hash}->{$type});
 291 }
 292
 293 sub report_argument_kind {
 294     my $self = shift;
 295     my $argument_kind = $self->argument_kind;
 296
 297     my $kind = shift;
 298
 299     return $argument_kind->{active} && (!$argument_kind->{filter} || $argument_kind->{hash}->{$kind});
 300
 301 }
 302
 303 1;
 304