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