git.oblomov.eu Git - wine/blob - 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, parent => "local", 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 => 1, filter => 1, hash => { double => 1 } },
  57         parent => "argument",
  58         parser => \&parser_comma_list,
  59         description => "argument kind checking"
  60     },
  61     "calling-convention" => { default => 1, parent => "local", description => "calling convention checking" },
  62     "calling-convention-win16" => { default => 0, parent => "calling-convention", description => "calling convention checking (Win16)" },
  63     "calling-convention-win32" => { default => 1, parent => "calling-convention", description => "calling convention checking (Win32)" },
  64     "misplaced" => { default => 1, parent => "local", description => "check for misplaced functions" },
  65     "statements"  => { default => 0, parent => "local", description => "check for statements inconsistances" },
  66     "cross-call" => { default => 0, parent => "statements",  description => "check for cross calling functions" },
  67     "cross-call-win32-win16" => {
  68         default => 0, parent => "cross-call", description => "check for cross calls between win32 and win16"
  69      },
  70     "cross-call-unicode-ascii" => {
  71         default => 0, parent => "cross-call", description => "check for cross calls between Unicode and ASCII"
  72      },
  73     "debug-messages" => { default => 0, parent => "statements", description => "check for debug messages inconsistances" },
  74     "documentation" => { default => 1, parent => "local", description => "check for documentation inconsistances\n" },
  75     "documentation-pedantic" => { default => 0, parent => "documentation", description => "be pendantic when checking for documentation inconsistances\n" },
  76     "documentation-width" => { default => 0, parent => "documentation", description => "check for documentation width inconsistances\n" },
  77     "documentation-arguments" => { default => 1, parent => "documentation", description => "check for arguments documentation inconsistances\n" },
  78     "documentation-ordinal" => { default => 0, parent => "documentation", description => "check for ordinal documentation inconsistances\n" },
  79     "prototype" => { default => 0, parent => ["local", "headers"], description => "prototype checking" },
  80
  81     "global" => { default => 1, description => "global checking" },
  82     "declared" => { default => 1, parent => "global", description => "declared checking" },
  83     "implemented" => { default => 0, parent => "local", description => "implemented checking" },
  84     "implemented-win32" => { default => 0, parent => "implemented", description => "implemented as win32 checking" },
  85     "include" => { default => 1, parent => "global", description => "include checking" },
  86     "headers" => { default => 0, parent => "global", description => "headers checking" },
  87     "headers-duplicated" => { default => 0, parent => "headers", description => "duplicated function declarations checking" },
  88     "headers-misplaced" => { default => 0, parent => "headers", description => "misplaced function declarations checking" },
  89     "stubs" => { default => 0, parent => "global", description => "stubs checking" }
  90 );
  91
  92 my %short_options = (
  93     "d" => "debug",
  94     "?" => "help",
  95     "v" => "verbose"
  96 );
  97
  98 sub new {
  99     my $proto = shift;
 100     my $class = ref($proto) || $proto;
 101     my $self  = {};
 102     bless ($self, $class);
 103
 104     my $output = \${$self->{OUTPUT}};
 105
 106     $$output = shift;
 107     my $refarguments = shift;
 108     my $wine_dir = shift;
 109
 110     $self->options_set("default");
 111
 112     my $c_files = \@{$self->{C_FILES}};
 113     my $h_files = \@{$self->{H_FILES}};
 114     my $module = \${$self->{MODULE}};
 115     my $global = \${$self->{GLOBAL}};
 116
 117     my @files;
 118
 119     if($wine_dir eq ".") {
 120         $$global = 1;
 121     } else {
 122         $$global = 0;
 123     }
 124
 125     while(defined($_ = shift @$refarguments)) {
 126         if(/^--(all|none)$/) {
 127             $self->options_set("$1");
 128             next;
 129         } elsif(/^-([^=]*)(=(.*))?$/) {
 130             my $name;
 131             my $value;
 132             if(defined($2)) {
 133                 $name = $1;
 134                 $value = $3;
 135             } else {
 136                 $name = $1;
 137             }
 138
 139             if($name =~ /^([^-].*)$/) {
 140                 $name = $short_options{$1};
 141             } else {
 142                 $name =~ s/^-(.*)$/$1/;
 143             }
 144
 145             my $prefix;
 146             if(defined($name) && $name =~ /^no-(.*)$/) {
 147                 $name = $1;
 148                 $prefix = "no";
 149                 if(defined($value)) {
 150                     $$output->write("options with prefix 'no' can't take parameters\n");
 151
 152                     return undef;
 153                 }
 154             }
 155
 156             my $option;
 157             if(defined($name)) {
 158                 $option = $options{$name};
 159             }
 160
 161             if(defined($option)) {
 162                 my $key = $$option{key};
 163                 my $parser = $$option{parser};
 164                 my $refvalue = \${$self->{$key}};
 165                 my @parents = ();
 166
 167                 if(defined($$option{parent})) {
 168                     if(ref($$option{parent}) eq "ARRAY") {
 169                         @parents = @{$$option{parent}};
 170                     } else {
 171                         @parents = $$option{parent};
 172                     }
 173                 }
 174
 175                 if(defined($parser)) {
 176                     $$refvalue = &$parser($prefix,$value);
 177                 } else {
 178                     if(defined($value)) {
 179                         $$refvalue = $value;
 180                     } elsif(!defined($prefix)) {
 181                         $$refvalue = 1;
 182                     } else {
 183                         $$refvalue = 0;
 184                     }
 185                 }
 186
 187                 if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
 188                     while($#parents >= 0) {
 189                         my @old_parents = @parents;
 190                         @parents = ();
 191                         foreach my $parent (@old_parents) {
 192                             my $parentkey = $options{$parent}{key};
 193                             my $refparentvalue = \${$self->{$parentkey}};
 194
 195                             $$refparentvalue = 1;
 196
 197                             if(defined($options{$parent}{parent})) {
 198                                 if(ref($options{$parent}{parent}) eq "ARRAY") {
 199                                     push @parents, @{$options{$parent}{parent}};
 200                                 } else {
 201                                     push @parents, $options{$parent}{parent};
 202                                 }
 203                             }
 204                         }
 205                     }
 206                 }
 207                 next;
 208             }
 209         }
 210
 211         if(/^--module-dlls$/) {
 212             my @dirs = `cd dlls && find . -type d ! -name CVS`;
 213             my %names;
 214             for my $dir (@dirs) {
 215                 chomp $dir;
 216                 $dir =~ s/^\.\/(.*)$/$1/;
 217                 next if $dir eq "";
 218                 $names{$dir} = 1;
 219             }
 220             $$module = { active => 1, filter => 1, hash => \%names };
 221         }
 222         elsif(/^-(.*)$/) {
 223             $$output->write("unknown option: $_\n");
 224
 225             return undef;
 226         } else {
 227             if(!-e $_) {
 228                 $$output->write("$_: no such file or directory\n");
 229
 230                 return undef;
 231             }
 232
 233             push @files, $_;
 234         }
 235     }
 236
 237     if($self->help) {
 238         return $self;
 239     }
 240
 241     my @paths = ();
 242     my @c_files = ();
 243     my @h_files = ();
 244     foreach my $file (@files) {
 245         if($file =~ /\.c$/) {
 246             push @c_files, $file;
 247         } elsif($file =~ /\.h$/) {
 248             push @h_files, $file;
 249         } else {
 250             push @paths, $file;
 251         }
 252     }
 253
 254     if($#c_files == -1 && $#h_files == -1 &&
 255        ($#paths == -1 || ($#paths == 0 && $paths[0] eq $wine_dir)))
 256     {
 257         @paths = ".";
 258         push @h_files, "$wine_dir/include";
 259     } else {
 260         $$global = 0;
 261     }
 262
 263     if($#paths != -1 || $#c_files != -1) {
 264         my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
 265         my %found;
 266         @$c_files = sort(map {
 267             s/^\.\/(.*)$/$1/;
 268             if(defined($found{$_}) || /glue\.c|spec\.c$/) {
 269                 ();
 270             } else {
 271                 $found{$_}++;
 272                 $_;
 273             }
 274         } split(/\n/, `$c_command`));
 275     }
 276
 277     if($#h_files != -1) {
 278         my $h_command = "find " . join(" ", @h_files) . " -name \\*.h";
 279         my %found;
 280
 281         @$h_files = sort(map {
 282             s/^\.\/(.*)$/$1/;
 283             if(defined($found{$_})) {
 284                 ();
 285             } else {
 286                 $found{$_}++;
 287                 $_;
 288             }
 289         } split(/\n/, `$h_command`));
 290     }
 291     return $self;
 292 }
 293
 294 sub DESTROY {
 295 }
 296
 297 sub options_set {
 298     my $self = shift;
 299
 300     local $_ = shift;
 301     for my $name (sort(keys(%options))) {
 302         my $option = $options{$name};
 303         my $key = uc($name);
 304         $key =~ tr/-/_/;
 305         $$option{key} = $key;
 306         my $refvalue = \${$self->{$key}};
 307
 308         if(/^default$/) {
 309             $$refvalue = $$option{default};
 310         } elsif(/^all$/) {
 311             if($name !~ /^help|debug|verbose|module$/) {
 312                 if(ref($$refvalue) ne "HASH") {
 313                     $$refvalue = 1;
 314                 } else {
 315                     $$refvalue = { active => 1, filter => 0, hash => {} };
 316                 }
 317             }
 318         } elsif(/^none$/) {
 319             if($name !~ /^help|debug|verbose|module$/) {
 320                 if(ref($$refvalue) ne "HASH") {
 321                     $$refvalue = 0;
 322                 } else {
 323                     $$refvalue = { active => 0, filter => 0, hash => {} };
 324                 }
 325             }
 326         }
 327     }
 328 }
 329
 330 sub show_help {
 331     my $self = shift;
 332
 333     my $maxname = 0;
 334     for my $name (sort(keys(%options))) {
 335         if(length($name) > $maxname) {
 336             $maxname = length($name);
 337         }
 338     }
 339
 340     print "usage: winapi-check [--help] [<files>]\n";
 341     print "\n";
 342     for my $name (sort(keys(%options))) {
 343         my $option = $options{$name};
 344         my $description = $$option{description};
 345         my $default = $$option{default};
 346         my $current = ${$self->{$$option{key}}};
 347
 348         my $value = $current;
 349
 350         my $output;
 351         if(ref($value) ne "HASH") {
 352             if($value) {
 353                 $output = "--no-$name";
 354             } else {
 355                 $output = "--$name";
 356             }
 357         } else {
 358             if($value->{active}) {
 359                 $output = "--[no-]$name\[=<value>]";
 360             } else {
 361                 $output = "--$name\[=<value>]";
 362             }
 363         }
 364
 365         print "$output";
 366         for (0..(($maxname - length($name) + 17) - (length($output) - length($name) + 1))) { print " "; }
 367         if(ref($value) ne "HASH") {
 368             if($value) {
 369                 print "Disable ";
 370             } else {
 371                 print "Enable ";
 372             }
 373         } else {
 374             if($value->{active}) {
 375                 print "(Disable) ";
 376             } else {
 377                 print "Enable ";
 378             }
 379         }
 380         if($default == $current) {
 381             print "$description (default)\n";
 382         } else {
 383             print "$description\n";
 384         }
 385     }
 386 }
 387
 388 sub AUTOLOAD {
 389     my $self = shift;
 390
 391     my $name = $winapi_options::AUTOLOAD;
 392     $name =~ s/^.*::(.[^:]*)$/\U$1/;
 393
 394     my $refvalue = $self->{$name};
 395     if(!defined($refvalue)) {
 396         die "<internal>: winapi_options.pm: member $name does not exists\n";
 397     }
 398
 399     if(ref($$refvalue) ne "HASH") {
 400         return $$refvalue;
 401     } else {
 402         return $$refvalue->{active};
 403     }
 404 }
 405
 406 sub c_files { my $self = shift; return @{$self->{C_FILES}}; }
 407
 408 sub h_files { my $self = shift; return @{$self->{H_FILES}}; }
 409
 410 sub report_module {
 411     my $self = shift;
 412     my $refvalue = $self->{MODULE};
 413
 414     my $name = shift;
 415
 416     if(defined($name)) {
 417         return $$refvalue->{active} && (!$$refvalue->{filter} || $$refvalue->{hash}->{$name});
 418     } else {
 419         return 0;
 420     }
 421 }
 422
 423 sub report_argument_forbidden {
 424     my $self = shift;
 425     my $refargument_forbidden = $self->{ARGUMENT_FORBIDDEN};
 426
 427     my $type = shift;
 428
 429     return $$refargument_forbidden->{active} && (!$$refargument_forbidden->{filter} || $$refargument_forbidden->{hash}->{$type});
 430 }
 431
 432 sub report_argument_kind {
 433     my $self = shift;
 434     my $refargument_kind = $self->{ARGUMENT_KIND};
 435
 436     my $kind = shift;
 437
 438     return $$refargument_kind->{active} && (!$$refargument_kind->{filter} || $$refargument_kind->{hash}->{$kind});
 439
 440 }
 441
 442 1;
 443