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     $self->options_set("default");
  93
  94     my $c_files = \@{$self->{C_FILES}};
  95     my $h_files = \@{$self->{H_FILES}};
  96     my $module = \${$self->{MODULE}};
  97     my $global = \${$self->{GLOBAL}};
  98
  99     while(defined($_ = shift @ARGV)) {
 100         if(/^--(all|none)$/) {
 101             $self->options_set("$1");
 102             next;
 103         } elsif(/^-([^=]*)(=(.*))?$/) {
 104             my $name;
 105             my $value;
 106             if(defined($2)) {
 107                 $name = $1;
 108                 $value = $3;
 109             } else {
 110                 $name = $1;
 111             }
 112
 113             if($name =~ /^([^-].*)$/) {
 114                 $name = $short_options{$1};
 115             } else {
 116                 $name =~ s/^-(.*)$/$1/;
 117             }
 118
 119             my $prefix;
 120             if(defined($name) && $name =~ /^no-(.*)$/) {
 121                 $name = $1;
 122                 $prefix = "no";
 123                 if(defined($value)) {
 124                     print STDERR "<internal>: options with prefix 'no' can't take parameters\n";
 125                     exit 1;
 126                 }
 127             }
 128
 129             my $option;
 130             if(defined($name)) {
 131                 $option = $options{$name};
 132             }
 133
 134             if(defined($option)) {
 135                 my $key = $$option{key};
 136                 my $parser = $$option{parser};
 137                 my $parent = $$option{parent};
 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
 152                 if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
 153                     while(defined($parent)) {
 154                         my $parentkey = $options{$parent}{key};
 155                         my $refparentvalue = \${$self->{$parentkey}};
 156
 157                         $$refparentvalue = 1;
 158                         $parent = $options{$parent}{parent};
 159                     }
 160                 }
 161                 next;
 162             }
 163         }
 164
 165         if(/^--module-dlls$/) {
 166             my @dirs = `cd dlls && find . -type d ! -name CVS`;
 167             my %names;
 168             for my $dir (@dirs) {
 169                 chomp $dir;
 170                 $dir =~ s/^\.\/(.*)$/$1/;
 171                 next if $dir eq "";
 172                 $names{$dir} = 1;
 173             }
 174             $$module = { active => 1, filter => 1, hash => \%names };
 175         }
 176         elsif(/^-(.*)$/) {
 177             print STDERR "<internal>: unknown option: $&\n";
 178             print STDERR "<internal>: usage: winapi-check [--help] [<files>]\n";
 179             exit 1;
 180         } else {
 181             push @$c_files, $_;
 182         }
 183     }
 184
 185     my $c_paths;
 186     if($#$c_files == -1 || ($#$c_files == 0 && $$c_files[0] eq $wine_dir)) {
 187         $c_paths = ".";
 188     } else {
 189         $c_paths = join(" ", @$c_files);
 190         $$global = 0;
 191     }
 192
 193     my $h_paths = "$wine_dir/include $wine_dir/include/wine";
 194
 195     @$c_files = sort(map {
 196         s/^.\/(.*)$/$1/;
 197         if(!/spec\.c$/) {
 198             $_;
 199         } else {
 200             ();
 201         }
 202     } split(/\n/, `find $c_paths -name \\*.c`));
 203
 204     @$h_files = sort(map {
 205         s/^.\/(.*)$/$1/;
 206         $_;
 207     } split(/\n/, `find $h_paths -name \\*.h`));
 208
 209     return $self;
 210 }
 211
 212 sub options_set {
 213     my $self = shift;
 214
 215     local $_ = shift;
 216     for my $name (sort(keys(%options))) {
 217         my $option = $options{$name};
 218         my $key = uc($name);
 219         $key =~ tr/-/_/;
 220         $$option{key} = $key;
 221         my $refvalue = \${$self->{$key}};
 222
 223         if(/^default$/) {
 224             $$refvalue = $$option{default};
 225         } elsif(/^all$/) {
 226             if($name !~ /^help|debug|verbose|module$/) {
 227                 if(ref($$refvalue) ne "HASH") {
 228                     $$refvalue = 1;
 229                 } else {
 230                     $$refvalue = { active => 1, filter => 0, hash => {} };
 231                 }
 232             }
 233         } elsif(/^none$/) {
 234             if($name !~ /^help|debug|verbose|module$/) {
 235                 if(ref($$refvalue) ne "HASH") {
 236                     $$refvalue = 0;
 237                 } else {
 238                     $$refvalue = { active => 0, filter => 0, hash => {} };
 239                 }
 240             }
 241         }
 242     }
 243 }
 244
 245 sub show_help {
 246     my $self = shift;
 247
 248     my $maxname = 0;
 249     for my $name (sort(keys(%options))) {
 250         if(length($name) > $maxname) {
 251             $maxname = length($name);
 252         }
 253     }
 254
 255     print "usage: winapi-check [--help] [<files>]\n";
 256     print "\n";
 257     for my $name (sort(keys(%options))) {
 258         my $option = $options{$name};
 259         my $description = $$option{description};
 260         my $default = $$option{default};
 261         my $current = ${$self->{$$option{key}}};
 262
 263         my $value = $current;
 264
 265         my $output;
 266         if(ref($value) ne "HASH") {
 267             if($value) {
 268                 $output = "--no-$name";
 269             } else {
 270                 $output = "--$name";
 271             }
 272         } else {
 273             if($value->{active}) {
 274                 $output = "--[no-]$name\[=<value>]";
 275             } else {
 276                 $output = "--$name\[=<value>]";
 277             }
 278         }
 279
 280         print "$output";
 281         for (0..(($maxname - length($name) + 17) - (length($output) - length($name) + 1))) { print " "; }
 282         if(ref($value) ne "HASH") {
 283             if($value) {
 284                 print "Disable ";
 285             } else {
 286                 print "Enable ";
 287             }
 288         } else {
 289             if($value->{active}) {
 290                 print "(Disable) ";
 291             } else {
 292                 print "Enable ";
 293             }
 294         }
 295         if($default == $current) {
 296             print "$description (default)\n";
 297         } else {
 298             print "$description\n";
 299         }
 300     }
 301 }
 302
 303 sub AUTOLOAD {
 304     my $self = shift;
 305
 306     my $name = $winapi_options::AUTOLOAD;
 307     $name =~ s/^.*::(.[^:]*)$/\U$1/;
 308
 309     my $refvalue = $self->{$name};
 310     if(!defined($refvalue)) {
 311         die "<internal>: winapi_options.pm: member $name does not exists\n";
 312     }
 313
 314     if(ref($$refvalue) ne "HASH") {
 315         return $$refvalue;
 316     } else {
 317         return $$refvalue->{active};
 318     }
 319 }
 320
 321 sub c_files { my $self = shift; return @{$self->{C_FILES}}; }
 322
 323 sub h_files { my $self = shift; return @{$self->{H_FILES}}; }
 324
 325 sub report_module {
 326     my $self = shift;
 327     my $refvalue = $self->{MODULE};
 328
 329     my $name = shift;
 330
 331     if(defined($name)) {
 332         return $$refvalue->{active} && (!$$refvalue->{filter} || $$refvalue->{hash}->{$name});
 333     } else {
 334         return 0;
 335     }
 336 }
 337
 338 sub report_argument_forbidden {
 339     my $self = shift;
 340     my $refargument_forbidden = $self->{ARGUMENT_FORBIDDEN};
 341
 342     my $type = shift;
 343
 344     return $$refargument_forbidden->{active} && (!$$refargument_forbidden->{filter} || $$refargument_forbidden->{hash}->{$type});
 345 }
 346
 347 sub report_argument_kind {
 348     my $self = shift;
 349     my $refargument_kind = $self->{ARGUMENT_KIND};
 350
 351     my $kind = shift;
 352
 353     return $$refargument_kind->{active} && (!$$refargument_kind->{filter} || $$refargument_kind->{hash}->{$kind});
 354
 355 }
 356
 357 1;
 358