winedump: Added support for dumping long long constants.
[wine] / tools / winapi / options.pm
1 #
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
3 #
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
8 #
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12 # Lesser General Public License for more details.
13 #
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17 #
18
19 package options;
20
21 use strict;
22
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
24 require Exporter;
25
26 @ISA = qw(Exporter);
27 @EXPORT = qw();
28 @EXPORT_OK = qw($options parse_comma_list parse_value);
29
30 use vars qw($options);
31
32 use output qw($output);
33
34 sub parse_comma_list($$) {
35     my $prefix = shift;
36     my $value = shift;
37
38     if(defined($prefix) && $prefix eq "no") {
39         return { active => 0, filter => 0, hash => {} };
40     } elsif(defined($value)) {
41         my %names;
42         for my $name (split /,/, $value) {
43             $names{$name} = 1;
44         }
45         return { active => 1, filter => 1, hash => \%names };
46     } else {
47         return { active => 1, filter => 0, hash => {} };
48     }
49 }
50
51 sub parse_value($$) {
52     my $prefix = shift;
53     my $value = shift;
54
55     return $value;
56 }
57
58 package _options;
59
60 use strict;
61
62 use output qw($output);
63
64 sub options_set($$);
65
66 sub new($$$$) {
67     my $proto = shift;
68     my $class = ref($proto) || $proto;
69     my $self  = {};
70     bless ($self, $class);
71
72     my $options_long = \%{$self->{_OPTIONS_LONG}};
73     my $options_short = \%{$self->{_OPTIONS_SHORT}};
74     my $options_usage = \${$self->{_OPTIONS_USAGE}};
75
76     my $refoptions_long = shift;
77     my $refoptions_short = shift;
78     $$options_usage = shift;
79
80     %$options_long = %{$refoptions_long};
81     %$options_short = %{$refoptions_short};
82
83     $self->options_set("default");
84
85     my $arguments = \@{$self->{_ARGUMENTS}};
86     @$arguments = ();
87
88     my $end_of_options = 0;
89     while(defined($_ = shift @ARGV)) {
90         if(/^--$/) {
91             $end_of_options = 1;
92             next;
93         } elsif($end_of_options) {
94             # Nothing
95         } elsif(/^--(all|none)$/) {
96             $self->options_set("$1");
97             next;
98         } elsif(/^-([^=]*)(=(.*))?$/) {
99             my $name;
100             my $value;
101             if(defined($2)) {
102                 $name = $1;
103                 $value = $3;
104             } else {
105                 $name = $1;
106             }
107
108             if($name =~ /^([^-].*)$/) {
109                 $name = $$options_short{$1};
110             } else {
111                 $name =~ s/^-(.*)$/$1/;
112             }
113
114             my $prefix;
115             if(defined($name) && $name =~ /^no-(.*)$/) {
116                 $name = $1;
117                 $prefix = "no";
118                 if(defined($value)) {
119                     $output->write("options with prefix 'no' can't take parameters\n");
120
121                     return undef;
122                 }
123             }
124
125             my $option;
126             if(defined($name)) {
127                 $option = $$options_long{$name};
128             }
129
130             if(defined($option)) {
131                 my $key = $$option{key};
132                 my $parser = $$option{parser};
133                 my $refvalue = \${$self->{$key}};
134                 my @parents = ();
135
136                 if(defined($$option{parent})) {
137                     if(ref($$option{parent}) eq "ARRAY") {
138                         @parents = @{$$option{parent}};
139                     } else {
140                         @parents = $$option{parent};
141                     }
142                 }
143
144                 if(defined($parser)) {
145                     if(!defined($value)) {
146                         $value = shift @ARGV;
147                     }
148                     $$refvalue = &$parser($prefix,$value);
149                 } else {
150                     if(defined($value)) {
151                         $$refvalue = $value;
152                     } elsif(!defined($prefix)) {
153                         $$refvalue = 1;
154                     } else {
155                         $$refvalue = 0;
156                     }
157                 }
158
159                 if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
160                     while($#parents >= 0) {
161                         my @old_parents = @parents;
162                         @parents = ();
163                         foreach my $parent (@old_parents) {
164                             my $parentkey = $$options_long{$parent}{key};
165                             my $refparentvalue = \${$self->{$parentkey}};
166
167                             $$refparentvalue = 1;
168
169                             if(defined($$options_long{$parent}{parent})) {
170                                 if(ref($$options_long{$parent}{parent}) eq "ARRAY") {
171                                     push @parents, @{$$options_long{$parent}{parent}};
172                                 } else {
173                                     push @parents, $$options_long{$parent}{parent};
174                                 }
175                             }
176                         }
177                     }
178                 }
179                 next;
180             }
181         }
182
183         if(!$end_of_options && /^-(.*)$/) {
184             $output->write("unknown option: $_\n");
185             $output->write($$options_usage);
186             exit 1;
187         } else {
188             push @$arguments, $_;
189         }
190     }
191
192     if($self->help) {
193         $output->write($$options_usage);
194         $self->show_help;
195         exit 0;
196     }
197
198     return $self;
199 }
200
201 sub DESTROY {
202 }
203
204 sub parse_files($) {
205     my $self = shift;
206
207     my $arguments = \@{$self->{_ARGUMENTS}};
208     my $directories = \@{$self->{_DIRECTORIES}};
209     my $c_files = \@{$self->{_C_FILES}};
210     my $h_files = \@{$self->{_H_FILES}};
211
212     my $error = 0;
213     my @files = ();
214     foreach (@$arguments) {
215         if(!-e $_) {
216             $output->write("$_: no such file or directory\n");
217             $error = 1;
218         } else {
219             push @files, $_;
220         }
221     }
222     if($error) {
223         exit 1;
224     }
225
226     my @paths = ();
227     my @c_files = ();
228     my @h_files = ();
229     foreach my $file (@files) {
230         if($file =~ /\.c$/) {
231             push @c_files, $file;
232         } elsif($file =~ /\.h$/) {
233             push @h_files, $file;
234         } else {
235             push @paths, $file;
236         }
237     }
238
239     if($#c_files == -1 && $#h_files == -1 && $#paths == -1)
240     {
241         @paths = ".";
242     }
243
244     if($#paths != -1 || $#c_files != -1) {
245         my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
246         my %found;
247         @$c_files = sort(map {
248             s/^\.\/(.*)$/$1/;
249             if(defined($found{$_})) {
250                 ();
251             } else {
252                 $found{$_}++;
253                 $_;
254             }
255         } split(/\n/, `$c_command`));
256     }
257
258     if($#paths != -1 || $#h_files != -1) {
259         my $h_command = "find " . join(" ", @paths, @h_files) . " -name \\*.h";
260         my %found;
261
262         @$h_files = sort(map {
263             s/^\.\/(.*)$/$1/;
264             if(defined($found{$_})) {
265                 ();
266             } else {
267                 $found{$_}++;
268                 $_;
269             }
270         } split(/\n/, `$h_command`));
271     }
272
273     my %dirs;
274     foreach my $file (@$c_files, @$h_files) {
275         my $dir = $file;
276         $dir =~ s%/?[^/]+$%%;
277         if(!$dir) { $dir = "."; }
278         $dirs{$dir}++
279     }
280
281     @$directories = sort(keys(%dirs));
282 }
283
284 sub options_set($$) {
285     my $self = shift;
286
287     my $options_long = \%{$self->{_OPTIONS_LONG}};
288     my $options_short = \%{$self->{_OPTIONS_SHORT}};
289
290     local $_ = shift;
291     for my $name (sort(keys(%$options_long))) {
292         my $option = $$options_long{$name};
293         my $key = uc($name);
294         $key =~ tr/-/_/;
295         $$option{key} = $key;
296         my $refvalue = \${$self->{$key}};
297
298         if(/^default$/) {
299             $$refvalue = $$option{default};
300         } elsif(/^all$/) {
301             if($name !~ /^(?:help|debug|verbose|module)$/) {
302                 if(ref($$refvalue) ne "HASH") {
303                     $$refvalue = 1;
304                 } else {
305                     $$refvalue = { active => 1, filter => 0, hash => {} };
306                 }
307             }
308         } elsif(/^none$/) {
309             if($name !~ /^(?:help|debug|verbose|module)$/) {
310                 if(ref($$refvalue) ne "HASH") {
311                     $$refvalue = 0;
312                 } else {
313                     $$refvalue = { active => 0, filter => 0, hash => {} };
314                 }
315             }
316         }
317     }
318 }
319
320 sub show_help($) {
321     my $self = shift;
322
323     my $options_long = \%{$self->{_OPTIONS_LONG}};
324     my $options_short = \%{$self->{_OPTIONS_SHORT}};
325
326     my $maxname = 0;
327     for my $name (sort(keys(%$options_long))) {
328         if(length($name) > $maxname) {
329             $maxname = length($name);
330         }
331     }
332
333     for my $name (sort(keys(%$options_long))) {
334         my $option = $$options_long{$name};
335         my $description = $$option{description};
336         my $parser = $$option{parser};
337         my $current = ${$self->{$$option{key}}};
338
339         my $value = $current;
340
341         my $command;
342         if(!defined $parser) {
343             if($value) {
344                 $command = "--no-$name";
345             } else {
346                 $command = "--$name";
347             }
348         } else {
349             if(ref($value) eq "HASH" && $value->{active}) {
350                 $command = "--[no-]$name\[=<value>]";
351             } else {
352                 $command = "--$name\[=<value>]";
353             }
354         }
355
356         $output->write($command);
357         $output->write(" " x (($maxname - length($name) + 17) - (length($command) - length($name) + 1)));
358         if(!defined $parser) {
359             if($value) {
360                 $output->write("Disable ");
361             } else {
362                 $output->write("Enable ");
363             }
364         } else {
365             if(ref($value) eq "HASH")
366             {
367                 if ($value->{active}) {
368                     $output->write("(Disable) ");
369                 } else {
370                     $output->write("Enable ");
371                 }
372             }
373         }
374         $output->write("$description\n");
375     }
376 }
377
378 sub AUTOLOAD {
379     my $self = shift;
380
381     my $name = $_options::AUTOLOAD;
382     $name =~ s/^.*::(.[^:]*)$/\U$1/;
383
384     my $refvalue = $self->{$name};
385     if(!defined($refvalue)) {
386         die "<internal>: options.pm: member $name does not exist\n";
387     }
388
389     if(ref($$refvalue) ne "HASH") {
390         return $$refvalue;
391     } else {
392         return $$refvalue->{active};
393     }
394 }
395
396 sub arguments($) {
397     my $self = shift;
398
399     my $arguments = \@{$self->{_ARGUMENTS}};
400
401     return @$arguments;
402 }
403
404 sub c_files($) {
405     my $self = shift;
406
407     my $c_files = \@{$self->{_C_FILES}};
408
409     if(!defined(@$c_files)) {
410         $self->parse_files;
411     }
412
413     return @$c_files;
414 }
415
416 sub h_files($) {
417     my $self = shift;
418
419     my $h_files = \@{$self->{_H_FILES}};
420
421     if(!defined(@$h_files)) {
422         $self->parse_files;
423     }
424
425     return @$h_files;
426 }
427
428 sub directories($) {
429     my $self = shift;
430
431     my $directories = \@{$self->{_DIRECTORIES}};
432
433     if(!defined(@$directories)) {
434         $self->parse_files;
435     }
436
437     return @$directories;
438 }
439
440 1;