Several bug fixes and additions.
[wine] / 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, parent => "local", 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 => 1, filter => 1, hash => { double => 1 } },
57         parent => "argument",
58         parser => \&parser_comma_list,
59         description => "argument kind checking"
60     },
61     "calling-convention" => { default => 1, parent => "local", description => "calling convention checking" },
62     "calling-convention-win16" => { default => 0, parent => "calling-convention", description => "calling convention checking (Win16)" },
63     "calling-convention-win32" => { default => 1, parent => "calling-convention", description => "calling convention checking (Win32)" },
64     "misplaced" => { default => 1, parent => "local", description => "check for misplaced functions" },
65     "statements"  => { default => 0, parent => "local", description => "check for statements inconsistances" },
66     "cross-call" => { default => 0, parent => "statements",  description => "check for cross calling functions" },
67     "cross-call-win32-win16" => { 
68         default => 0, parent => "cross-call", description => "check for cross calls between win32 and win16"
69      },
70     "cross-call-unicode-ascii" => { 
71         default => 0, parent => "cross-call", description => "check for cross calls between Unicode and ASCII" 
72     },
73     "debug-messages" => { default => 0, parent => "statements", description => "check for debug messages inconsistances" },
74
75     "documentation" => {
76         default => 1,
77         parent => "local", 
78         description => "check for documentation inconsistances"
79         },
80     "documentation-pedantic" => { 
81         default => 0, 
82         parent => "documentation", 
83         description => "be pendantic when checking for documentation inconsistances"
84         },
85
86     "documentation-arguments" => {
87         default => 1,
88         parent => "documentation",
89         description => "check for arguments documentation inconsistances\n"
90         },
91     "documentation-comment-indent" => {
92         default => 0, 
93         parent => "documentation", description => "check for documentation comment indent inconsistances"
94         },
95     "documentation-comment-width" => {
96         default => 0, 
97         parent => "documentation", description => "check for documentation comment width inconsistances"
98         },
99     "documentation-name" => {
100         default => 1,
101         parent => "documentation",
102         description => "check for documentation name inconsistances\n"
103         },
104     "documentation-ordinal" => {
105         default => 1,
106         parent => "documentation",
107         description => "check for documentation ordinal inconsistances\n"
108         },
109     "documentation-wrong" => {
110         default => 1,
111         parent => "documentation",
112         description => "check for wrong documentation\n"
113         },
114
115     "prototype" => {default => 0, parent => ["local", "headers"], description => "prototype checking" },
116     "global" => { default => 1, description => "global checking" },
117     "declared" => { default => 1, parent => "global", description => "declared checking" },
118     "implemented" => { default => 0, parent => "local", description => "implemented checking" },
119     "implemented-win32" => { default => 0, parent => "implemented", description => "implemented as win32 checking" },
120     "include" => { default => 1, parent => "global", description => "include checking" },
121     "headers" => { default => 0, parent => "global", description => "headers checking" },
122     "headers-duplicated" => { default => 0, parent => "headers", description => "duplicated function declarations checking" },
123     "headers-misplaced" => { default => 0, parent => "headers", description => "misplaced function declarations checking" },
124     "stubs" => { default => 0, parent => "global", description => "stubs checking" }
125 );
126
127 my %short_options = (
128     "d" => "debug",
129     "?" => "help",
130     "v" => "verbose"
131 );
132
133 sub new {
134     my $proto = shift;
135     my $class = ref($proto) || $proto;
136     my $self  = {};
137     bless ($self, $class);
138
139     my $output = \${$self->{OUTPUT}};
140
141     $$output = shift;
142     my $refarguments = shift;
143     my $wine_dir = shift;
144
145     $self->options_set("default");
146
147     my $c_files = \@{$self->{C_FILES}};
148     my $h_files = \@{$self->{H_FILES}};
149     my $module = \${$self->{MODULE}};
150     my $global = \${$self->{GLOBAL}};
151
152     my @files;
153
154     if($wine_dir eq ".") {
155         $$global = 1;
156     } else {
157         $$global = 0;
158     }
159
160     while(defined($_ = shift @$refarguments)) {
161         if(/^--(all|none)$/) {
162             $self->options_set("$1");
163             next;
164         } elsif(/^-([^=]*)(=(.*))?$/) {
165             my $name;
166             my $value;
167             if(defined($2)) {
168                 $name = $1;
169                 $value = $3;
170             } else {
171                 $name = $1;
172             }
173             
174             if($name =~ /^([^-].*)$/) {
175                 $name = $short_options{$1};
176             } else {
177                 $name =~ s/^-(.*)$/$1/;
178             }
179                    
180             my $prefix;
181             if(defined($name) && $name =~ /^no-(.*)$/) {
182                 $name = $1;
183                 $prefix = "no";
184                 if(defined($value)) {
185                     $$output->write("options with prefix 'no' can't take parameters\n");
186
187                     return undef;
188                 }
189             }
190
191             my $option;
192             if(defined($name)) {
193                 $option = $options{$name};
194             }
195
196             if(defined($option)) {
197                 my $key = $$option{key};
198                 my $parser = $$option{parser};
199                 my $refvalue = \${$self->{$key}};
200                 my @parents = ();
201                 
202                 if(defined($$option{parent})) {
203                     if(ref($$option{parent}) eq "ARRAY") {
204                         @parents = @{$$option{parent}};
205                     } else {
206                         @parents = $$option{parent};
207                     }
208                 }
209
210                 if(defined($parser)) { 
211                     $$refvalue = &$parser($prefix,$value);
212                 } else {
213                     if(defined($value)) {
214                         $$refvalue = $value;
215                     } elsif(!defined($prefix)) {
216                         $$refvalue = 1;
217                     } else {
218                         $$refvalue = 0;
219                     }
220                 }
221
222                 if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
223                     while($#parents >= 0) {
224                         my @old_parents = @parents;
225                         @parents = ();
226                         foreach my $parent (@old_parents) {
227                             my $parentkey = $options{$parent}{key};
228                             my $refparentvalue = \${$self->{$parentkey}};
229                             
230                             $$refparentvalue = 1;
231
232                             if(defined($options{$parent}{parent})) {
233                                 if(ref($options{$parent}{parent}) eq "ARRAY") {
234                                     push @parents, @{$options{$parent}{parent}};
235                                 } else {
236                                     push @parents, $options{$parent}{parent};
237                                 }
238                             }
239                         }
240                     }
241                 }
242                 next;
243             }    
244         }
245         
246         if(/^--module-dlls$/) {
247             my @dirs = `cd dlls && find . -type d ! -name CVS`;
248             my %names;
249             for my $dir (@dirs) {
250                 chomp $dir;
251                 $dir =~ s/^\.\/(.*)$/$1/;
252                 next if $dir eq "";
253                 $names{$dir} = 1;
254             }
255             $$module = { active => 1, filter => 1, hash => \%names };
256         }       
257         elsif(/^-(.*)$/) {
258             $$output->write("unknown option: $_\n"); 
259
260             return undef;
261         } else {
262             if(!-e $_) {
263                 $$output->write("$_: no such file or directory\n");
264
265                 return undef;
266             }
267
268             push @files, $_;
269         }
270     }
271
272     if($self->help) {
273         return $self;
274     }
275
276     my @paths = ();
277     my @c_files = ();
278     my @h_files = ();
279     foreach my $file (@files) {
280         if($file =~ /\.c$/) {
281             push @c_files, $file;
282         } elsif($file =~ /\.h$/) {
283             push @h_files, $file;
284         } else {
285             push @paths, $file;
286         }
287     }
288
289     if($#c_files == -1 && $#h_files == -1 &&
290        ($#paths == -1 || ($#paths == 0 && $paths[0] eq $wine_dir)))
291     {
292         @paths = ".";
293         push @h_files, "$wine_dir/include";
294     } else {
295         $$global = 0;
296     }
297
298     if($#paths != -1 || $#c_files != -1) {
299         my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
300         my %found;
301         @$c_files = sort(map {
302             s/^\.\/(.*)$/$1/;
303             if(defined($found{$_}) || /glue\.c|spec\.c$/) {
304                 ();
305             } else {
306                 $found{$_}++;
307                 $_;
308             }
309         } split(/\n/, `$c_command`));
310     }
311
312     if($#h_files != -1) {
313         my $h_command = "find " . join(" ", @h_files) . " -name \\*.h";
314         my %found;
315
316         @$h_files = sort(map {
317             s/^\.\/(.*)$/$1/;
318             if(defined($found{$_})) {
319                 ();
320             } else {
321                 $found{$_}++;
322                 $_;
323             }
324         } split(/\n/, `$h_command`));
325     }
326     return $self;
327 }
328
329 sub DESTROY {
330 }
331
332 sub options_set {
333     my $self = shift;
334
335     local $_ = shift;
336     for my $name (sort(keys(%options))) {
337         my $option = $options{$name};
338         my $key = uc($name);
339         $key =~ tr/-/_/;
340         $$option{key} = $key;
341         my $refvalue = \${$self->{$key}};
342
343         if(/^default$/) {
344             $$refvalue = $$option{default};
345         } elsif(/^all$/) {
346             if($name !~ /^help|debug|verbose|module$/) {
347                 if(ref($$refvalue) ne "HASH") {
348                     $$refvalue = 1;
349                 } else {
350                     $$refvalue = { active => 1, filter => 0, hash => {} };
351                 }
352             }
353         } elsif(/^none$/) {
354             if($name !~ /^help|debug|verbose|module$/) {
355                 if(ref($$refvalue) ne "HASH") {
356                     $$refvalue = 0;
357                 } else {
358                     $$refvalue = { active => 0, filter => 0, hash => {} };
359                 }
360             }
361         }
362     }
363 }
364
365 sub show_help {
366     my $self = shift;
367
368     my $maxname = 0;
369     for my $name (sort(keys(%options))) {
370         if(length($name) > $maxname) {
371             $maxname = length($name);
372         }
373     }
374
375     print "usage: winapi-check [--help] [<files>]\n";
376     print "\n";
377     for my $name (sort(keys(%options))) {
378         my $option = $options{$name};
379         my $description = $$option{description};
380         my $default = $$option{default};
381         my $current = ${$self->{$$option{key}}};
382
383         my $value = $current;
384         
385         my $output;
386         if(ref($value) ne "HASH") {
387             if($value) {
388                 $output = "--no-$name";
389             } else {
390                 $output = "--$name";
391             }
392         } else {
393             if($value->{active}) {
394                 $output = "--[no-]$name\[=<value>]";
395             } else {
396                 $output = "--$name\[=<value>]";
397             }
398         }
399
400         print "$output";
401         for (0..(($maxname - length($name) + 17) - (length($output) - length($name) + 1))) { print " "; }
402         if(ref($value) ne "HASH") {
403             if($value) {
404                 print "Disable ";
405             } else {
406                 print "Enable ";
407             }    
408         } else {
409             if($value->{active}) {
410                 print "(Disable) ";
411             } else {
412                 print "Enable ";
413             }
414         }
415         if($default == $current) {
416             print "$description (default)\n";
417         } else {
418             print "$description\n";
419         }    
420     }
421 }
422
423 sub AUTOLOAD {
424     my $self = shift;
425
426     my $name = $winapi_options::AUTOLOAD;
427     $name =~ s/^.*::(.[^:]*)$/\U$1/;
428
429     my $refvalue = $self->{$name};
430     if(!defined($refvalue)) {
431         die "<internal>: winapi_options.pm: member $name does not exists\n"; 
432     }
433
434     if(ref($$refvalue) ne "HASH") {
435         return $$refvalue;
436     } else {
437         return $$refvalue->{active};
438     }
439 }
440
441 sub c_files { my $self = shift; return @{$self->{C_FILES}}; }
442
443 sub h_files { my $self = shift; return @{$self->{H_FILES}}; }
444
445 sub report_module {
446     my $self = shift;
447     my $refvalue = $self->{MODULE};
448     
449     my $name = shift;
450
451     if(defined($name)) {
452         return $$refvalue->{active} && (!$$refvalue->{filter} || $$refvalue->{hash}->{$name}); 
453     } else {
454         return 0;
455     } 
456 }
457
458 sub report_argument_forbidden {
459     my $self = shift;   
460     my $refargument_forbidden = $self->{ARGUMENT_FORBIDDEN};
461
462     my $type = shift;
463
464     return $$refargument_forbidden->{active} && (!$$refargument_forbidden->{filter} || $$refargument_forbidden->{hash}->{$type}); 
465 }
466
467 sub report_argument_kind {
468     my $self = shift;
469     my $refargument_kind = $self->{ARGUMENT_KIND};
470
471     my $kind = shift;
472
473     return $$refargument_kind->{active} && (!$$refargument_kind->{filter} || $$refargument_kind->{hash}->{$kind}); 
474
475 }
476
477 1;
478