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         if(!/spec\.c$/) {
 179             $_;
 180         } else {
 181             ();
 182         }
 183     } split(/\n/, `find $paths -name \\*.c`);
 184
 185     return $self;
 186 }
 187
 188 sub show_help {
 189     my $self = shift;
 190
 191     my $maxname = 0;
 192     for my $name (sort(keys(%options))) {
 193         if(length($name) > $maxname) {
 194             $maxname = length($name);
 195         }
 196     }
 197
 198     print "usage: winapi-check [--help] [<files>]\n";
 199     print "\n";
 200     for my $name (sort(keys(%options))) {
 201         my $option = $options{$name};
 202         my $description = $$option{description};
 203         my $default = $$option{default};
 204
 205         my $output;
 206         if(ref($default) ne "HASH") {
 207             if($default) {
 208                 $output = "--no-$name";
 209             } else {
 210                 $output = "--$name";
 211             }
 212         } else {
 213             if($default->{active}) {
 214                 $output = "--[no-]$name\[=<value>]";
 215             } else {
 216                 $output = "--$name\[=<value>]";
 217             }
 218         }
 219
 220         print "$output";
 221         for (0..(($maxname - length($name) + 14) - (length($output) - length($name) + 1))) { print " "; }
 222         if(ref($default) ne "HASH") {
 223             if($default) {
 224                 print "Disable $description\n";
 225             } else {
 226                 print "Enable $description\n";
 227             }
 228         } else {
 229             if($default->{active}) {
 230                 print "(Disable) $description\n";
 231             } else {
 232                 print "Enable $description\n";
 233             }
 234
 235
 236         }
 237     }
 238 }
 239
 240 sub AUTOLOAD {
 241     my $self = shift;
 242
 243     my $name = $winapi_options::AUTOLOAD;
 244     $name =~ s/^.*::(.[^:]*)$/\U$1/;
 245
 246     my $refvalue = $self->{$name};
 247     if(!defined($refvalue)) {
 248         die "<internal>: winapi_options.pm: member $name does not exists\n";
 249     }
 250     return $$refvalue;
 251 }
 252
 253 sub files { my $self = shift; return @{$self->{FILES}}; }
 254
 255 sub report_module {
 256     my $self = shift;
 257     my $module = $self->module;
 258
 259     my $name = shift;
 260
 261     if(defined($name)) {
 262         return $module->{active} && (!$module->{filter} || $module->{hash}->{$name});
 263     } else {
 264         return 0;
 265     }
 266 }
 267
 268 sub report_argument_forbidden {
 269     my $self = shift;
 270     my $argument_forbidden = $self->argument_forbidden;
 271
 272     my $type = shift;
 273
 274     return $argument_forbidden->{active} && (!$argument_forbidden->{filter} || $argument_forbidden->{hash}->{$type});
 275 }
 276
 277 sub report_argument_kind {
 278     my $self = shift;
 279     my $argument_kind = $self->argument_kind;
 280
 281     my $kind = shift;
 282
 283     return $argument_kind->{active} && (!$argument_kind->{filter} || $argument_kind->{hash}->{$kind});
 284
 285 }
 286
 287 1;
 288