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