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