Fixed some issues found by winapi_check.
[wine] / tools / winapi / options.pm
1 package options;
2
3 use strict;
4
5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
6 require Exporter;
7
8 @ISA = qw(Exporter);
9 @EXPORT = qw(&parse_comma_list);
10 @EXPORT_OK = qw();
11
12 sub parse_comma_list {
13     my $prefix = shift;
14     my $value = shift;
15     if(defined($prefix) && $prefix eq "no") {
16         return { active => 0, filter => 0, hash => {} };
17     } elsif(defined($value)) {
18         my %names;
19         for my $name (split /,/, $value) {
20             $names{$name} = 1;
21         }
22         return { active => 1, filter => 1, hash => \%names };
23     } else {
24         return { active => 1, filter => 0, hash => {} };
25     }
26 }
27
28 my $_options;
29
30 sub new {
31     my $self = shift;
32     $_options = _options->new(@_);
33     return $_options;
34 }
35
36 sub AUTOLOAD {
37     my $self = shift;
38
39     my $name = $options::AUTOLOAD;
40     $name =~ s/^.*::(.[^:]*)$/$1/;
41
42     return $_options->$name(@_);
43 }
44
45 package _options;
46
47 use strict;
48
49 sub new {
50     my $proto = shift;
51     my $class = ref($proto) || $proto;
52     my $self  = {};
53     bless ($self, $class);
54
55     my $options_long = \%{$self->{OPTIONS_LONG}};
56     my $options_short = \%{$self->{OPTIONS_SHORT}};
57     my $options_usage = \${$self->{OPTIONS_USAGE}};
58
59     my $refoptions_long = shift;
60     my $refoptions_short = shift;
61     $$options_usage = shift;
62
63     %$options_long = %{$refoptions_long};
64     %$options_short = %{$refoptions_short};
65
66     $self->options_set("default");
67
68     my $c_files = \@{$self->{C_FILES}};
69     my $h_files = \@{$self->{H_FILES}};
70     my @files;
71
72     while(defined($_ = shift @ARGV)) {
73         if(/^--(all|none)$/) {
74             $self->options_set("$1");
75             next;
76         } elsif(/^-([^=]*)(=(.*))?$/) {
77             my $name;
78             my $value;
79             if(defined($2)) {
80                 $name = $1;
81                 $value = $3;
82             } else {
83                 $name = $1;
84             }
85             
86             if($name =~ /^([^-].*)$/) {
87                 $name = $$options_short{$1};
88             } else {
89                 $name =~ s/^-(.*)$/$1/;
90             }
91                    
92             my $prefix;
93             if(defined($name) && $name =~ /^no-(.*)$/) {
94                 $name = $1;
95                 $prefix = "no";
96                 if(defined($value)) {
97                     output->write("options with prefix 'no' can't take parameters\n");
98
99                     return undef;
100                 }
101             }
102
103             my $option;
104             if(defined($name)) {
105                 $option = $$options_long{$name};
106             }
107
108             if(defined($option)) {
109                 my $key = $$option{key};
110                 my $parser = $$option{parser};
111                 my $refvalue = \${$self->{$key}};
112                 my @parents = ();
113                 
114                 if(defined($$option{parent})) {
115                     if(ref($$option{parent}) eq "ARRAY") {
116                         @parents = @{$$option{parent}};
117                     } else {
118                         @parents = $$option{parent};
119                     }
120                 }
121
122                 if(defined($parser)) { 
123                     $$refvalue = &$parser($prefix,$value);
124                 } else {
125                     if(defined($value)) {
126                         $$refvalue = $value;
127                     } elsif(!defined($prefix)) {
128                         $$refvalue = 1;
129                     } else {
130                         $$refvalue = 0;
131                     }
132                 }
133
134                 if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
135                     while($#parents >= 0) {
136                         my @old_parents = @parents;
137                         @parents = ();
138                         foreach my $parent (@old_parents) {
139                             my $parentkey = $$options_long{$parent}{key};
140                             my $refparentvalue = \${$self->{$parentkey}};
141                             
142                             $$refparentvalue = 1;
143
144                             if(defined($$options_long{$parent}{parent})) {
145                                 if(ref($$options_long{$parent}{parent}) eq "ARRAY") {
146                                     push @parents, @{$$options_long{$parent}{parent}};
147                                 } else {
148                                     push @parents, $$options_long{$parent}{parent};
149                                 }
150                             }
151                         }
152                     }
153                 }
154                 next;
155             }
156         }
157         
158         if(/^-(.*)$/) {
159             output->write("unknown option: $_\n"); 
160             output->write($$options_usage);
161             exit 1;
162         } else {
163             if(!-e $_) {
164                 output->write("$_: no such file or directory\n");
165                 exit 1;
166             }
167
168             push @files, $_;
169         }
170     }
171
172     if($self->help) {
173         output->write($$options_usage);
174         $self->show_help;
175         exit 0;
176     }
177
178     my @paths = ();
179     my @c_files = ();
180     my @h_files = ();
181     foreach my $file (@files) {
182         if($file =~ /\.c$/) {
183             push @c_files, $file;
184         } elsif($file =~ /\.h$/) {
185             push @h_files, $file;
186         } else {
187             push @paths, $file;
188         }
189     }
190
191     if($#c_files == -1 && $#h_files == -1 && $#paths == -1)
192     {
193         @paths = ".";
194     }
195
196     if($#paths != -1 || $#c_files != -1) {
197         my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
198         my %found;
199         @$c_files = sort(map {
200             s/^\.\/(.*)$/$1/;
201             if(defined($found{$_}) || /glue\.c|spec\.c$/) {
202                 ();
203             } else {
204                 $found{$_}++;
205                 $_;
206             }
207         } split(/\n/, `$c_command`));
208     }
209
210     if($#h_files != -1) {
211         my $h_command = "find " . join(" ", @h_files) . " -name \\*.h";
212         my %found;
213
214         @$h_files = sort(map {
215             s/^\.\/(.*)$/$1/;
216             if(defined($found{$_})) {
217                 ();
218             } else {
219                 $found{$_}++;
220                 $_;
221             }
222         } split(/\n/, `$h_command`));
223     }
224
225     return $self;
226 }
227
228 sub DESTROY {
229 }
230
231 sub options_set {
232     my $self = shift;
233
234     my $options_long = \%{$self->{OPTIONS_LONG}};
235     my $options_short = \%{$self->{OPTIONS_SHORT}};
236
237     local $_ = shift;
238     for my $name (sort(keys(%$options_long))) {
239         my $option = $$options_long{$name};
240         my $key = uc($name);
241         $key =~ tr/-/_/;
242         $$option{key} = $key;
243         my $refvalue = \${$self->{$key}};
244
245         if(/^default$/) {
246             $$refvalue = $$option{default};
247         } elsif(/^all$/) {
248             if($name !~ /^help|debug|verbose|module$/) {
249                 if(ref($$refvalue) ne "HASH") {
250                     $$refvalue = 1;
251                 } else {
252                     $$refvalue = { active => 1, filter => 0, hash => {} };
253                 }
254             }
255         } elsif(/^none$/) {
256             if($name !~ /^help|debug|verbose|module$/) {
257                 if(ref($$refvalue) ne "HASH") {
258                     $$refvalue = 0;
259                 } else {
260                     $$refvalue = { active => 0, filter => 0, hash => {} };
261                 }
262             }
263         }
264     }
265 }
266
267 sub show_help {
268     my $self = shift;
269
270     my $options_long = \%{$self->{OPTIONS_LONG}};
271     my $options_short = \%{$self->{OPTIONS_SHORT}};
272
273     my $maxname = 0;
274     for my $name (sort(keys(%$options_long))) {
275         if(length($name) > $maxname) {
276             $maxname = length($name);
277         }
278     }
279
280     for my $name (sort(keys(%$options_long))) {
281         my $option = $$options_long{$name};
282         my $description = $$option{description};
283         my $default = $$option{default};
284         my $current = ${$self->{$$option{key}}};
285
286         my $value = $current;
287         
288         my $command;
289         if(ref($value) ne "HASH") {
290             if($value) {
291                 $command = "--no-$name";
292             } else {
293                 $command = "--$name";
294             }
295         } else {
296             if($value->{active}) {
297                 $command = "--[no-]$name\[=<value>]";
298             } else {
299                 $command = "--$name\[=<value>]";
300             }
301         }
302
303         output->write($command);
304         for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { output->write(" "); }
305         if(ref($value) ne "HASH") {
306             if($value) {
307                 output->write("Disable ");
308             } else {
309                 output->write("Enable ");
310             }    
311         } else {
312             if($value->{active}) {
313                 output->write("(Disable) ");
314             } else {
315                 output->write("Enable ");
316             }
317         }
318         if($default == $current) {
319             output->write("$description (default)\n");
320         } else {
321             output->write("$description\n");
322         }    
323     }
324 }
325
326 sub AUTOLOAD {
327     my $self = shift;
328
329     my $name = $_options::AUTOLOAD;
330     $name =~ s/^.*::(.[^:]*)$/\U$1/;
331
332     my $refvalue = $self->{$name};
333     if(!defined($refvalue)) {
334         die "<internal>: options.pm: member $name does not exists\n"; 
335     }
336
337     if(ref($$refvalue) ne "HASH") {
338         return $$refvalue;
339     } else {
340         return $$refvalue->{active};
341     }
342 }
343
344 sub c_files { my $self = shift; return @{$self->{C_FILES}}; }
345
346 sub h_files { my $self = shift; return @{$self->{H_FILES}}; }
347
348 1;