git.oblomov.eu Git - wine/blob - 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  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 new {
  65     my $proto = shift;
  66     my $class = ref($proto) || $proto;
  67     my $self  = {};
  68     bless ($self, $class);
  69
  70     my $options_long = \%{$self->{_OPTIONS_LONG}};
  71     my $options_short = \%{$self->{_OPTIONS_SHORT}};
  72     my $options_usage = \${$self->{_OPTIONS_USAGE}};
  73
  74     my $refoptions_long = shift;
  75     my $refoptions_short = shift;
  76     $$options_usage = shift;
  77
  78     %$options_long = %{$refoptions_long};
  79     %$options_short = %{$refoptions_short};
  80
  81     $self->options_set("default");
  82
  83     my $arguments = \@{$self->{_ARGUMENTS}};
  84     @$arguments = ();
  85
  86     my $end_of_options = 0;
  87     while(defined($_ = shift @ARGV)) {
  88         if(/^--$/) {
  89             $end_of_options = 1;
  90             next;
  91         } elsif($end_of_options) {
  92             # Nothing
  93         } elsif(/^--(all|none)$/) {
  94             $self->options_set("$1");
  95             next;
  96         } elsif(/^-([^=]*)(=(.*))?$/) {
  97             my $name;
  98             my $value;
  99             if(defined($2)) {
 100                 $name = $1;
 101                 $value = $3;
 102             } else {
 103                 $name = $1;
 104             }
 105
 106             if($name =~ /^([^-].*)$/) {
 107                 $name = $$options_short{$1};
 108             } else {
 109                 $name =~ s/^-(.*)$/$1/;
 110             }
 111
 112             my $prefix;
 113             if(defined($name) && $name =~ /^no-(.*)$/) {
 114                 $name = $1;
 115                 $prefix = "no";
 116                 if(defined($value)) {
 117                     $output->write("options with prefix 'no' can't take parameters\n");
 118
 119                     return undef;
 120                 }
 121             }
 122
 123             my $option;
 124             if(defined($name)) {
 125                 $option = $$options_long{$name};
 126             }
 127
 128             if(defined($option)) {
 129                 my $key = $$option{key};
 130                 my $parser = $$option{parser};
 131                 my $refvalue = \${$self->{$key}};
 132                 my @parents = ();
 133
 134                 if(defined($$option{parent})) {
 135                     if(ref($$option{parent}) eq "ARRAY") {
 136                         @parents = @{$$option{parent}};
 137                     } else {
 138                         @parents = $$option{parent};
 139                     }
 140                 }
 141
 142                 if(defined($parser)) {
 143                     if(!defined($value)) {
 144                         $value = shift @ARGV;
 145                     }
 146                     $$refvalue = &$parser($prefix,$value);
 147                 } else {
 148                     if(defined($value)) {
 149                         $$refvalue = $value;
 150                     } elsif(!defined($prefix)) {
 151                         $$refvalue = 1;
 152                     } else {
 153                         $$refvalue = 0;
 154                     }
 155                 }
 156
 157                 if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
 158                     while($#parents >= 0) {
 159                         my @old_parents = @parents;
 160                         @parents = ();
 161                         foreach my $parent (@old_parents) {
 162                             my $parentkey = $$options_long{$parent}{key};
 163                             my $refparentvalue = \${$self->{$parentkey}};
 164
 165                             $$refparentvalue = 1;
 166
 167                             if(defined($$options_long{$parent}{parent})) {
 168                                 if(ref($$options_long{$parent}{parent}) eq "ARRAY") {
 169                                     push @parents, @{$$options_long{$parent}{parent}};
 170                                 } else {
 171                                     push @parents, $$options_long{$parent}{parent};
 172                                 }
 173                             }
 174                         }
 175                     }
 176                 }
 177                 next;
 178             }
 179         }
 180
 181         if(!$end_of_options && /^-(.*)$/) {
 182             $output->write("unknown option: $_\n");
 183             $output->write($$options_usage);
 184             exit 1;
 185         } else {
 186             push @$arguments, $_;
 187         }
 188     }
 189
 190     if($self->help) {
 191         $output->write($$options_usage);
 192         $self->show_help;
 193         exit 0;
 194     }
 195
 196     return $self;
 197 }
 198
 199 sub DESTROY {
 200 }
 201
 202 sub parse_files {
 203     my $self = shift;
 204
 205     my $arguments = \@{$self->{_ARGUMENTS}};
 206     my $directories = \@{$self->{_DIRECTORIES}};
 207     my $c_files = \@{$self->{_C_FILES}};
 208     my $h_files = \@{$self->{_H_FILES}};
 209
 210     my $error = 0;
 211     my @files = ();
 212     foreach (@$arguments) {
 213         if(!-e $_) {
 214             $output->write("$_: no such file or directory\n");
 215             $error = 1;
 216         } else {
 217             push @files, $_;
 218         }
 219     }
 220     if($error) {
 221         exit 1;
 222     }
 223
 224     my @paths = ();
 225     my @c_files = ();
 226     my @h_files = ();
 227     foreach my $file (@files) {
 228         if($file =~ /\.c$/) {
 229             push @c_files, $file;
 230         } elsif($file =~ /\.h$/) {
 231             push @h_files, $file;
 232         } else {
 233             push @paths, $file;
 234         }
 235     }
 236
 237     if($#c_files == -1 && $#h_files == -1 && $#paths == -1)
 238     {
 239         @paths = ".";
 240     }
 241
 242     if($#paths != -1 || $#c_files != -1) {
 243         my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
 244         my %found;
 245         @$c_files = sort(map {
 246             s/^\.\/(.*)$/$1/;
 247             if(defined($found{$_})) {
 248                 ();
 249             } else {
 250                 $found{$_}++;
 251                 $_;
 252             }
 253         } split(/\n/, `$c_command`));
 254     }
 255
 256     if($#paths != -1 || $#h_files != -1) {
 257         my $h_command = "find " . join(" ", @paths, @h_files) . " -name \\*.h";
 258         my %found;
 259
 260         @$h_files = sort(map {
 261             s/^\.\/(.*)$/$1/;
 262             if(defined($found{$_})) {
 263                 ();
 264             } else {
 265                 $found{$_}++;
 266                 $_;
 267             }
 268         } split(/\n/, `$h_command`));
 269     }
 270
 271     my %dirs;
 272     foreach my $file (@$c_files, @$h_files) {
 273         my $dir = $file;
 274         $dir =~ s%/?[^/]+$%%;
 275         if(!$dir) { $dir = "."; }
 276         $dirs{$dir}++
 277     }
 278
 279     @$directories = sort(keys(%dirs));
 280 }
 281
 282 sub options_set {
 283     my $self = shift;
 284
 285     my $options_long = \%{$self->{_OPTIONS_LONG}};
 286     my $options_short = \%{$self->{_OPTIONS_SHORT}};
 287
 288     local $_ = shift;
 289     for my $name (sort(keys(%$options_long))) {
 290         my $option = $$options_long{$name};
 291         my $key = uc($name);
 292         $key =~ tr/-/_/;
 293         $$option{key} = $key;
 294         my $refvalue = \${$self->{$key}};
 295
 296         if(/^default$/) {
 297             $$refvalue = $$option{default};
 298         } elsif(/^all$/) {
 299             if($name !~ /^(?:help|debug|verbose|module)$/) {
 300                 if(ref($$refvalue) ne "HASH") {
 301                     $$refvalue = 1;
 302                 } else {
 303                     $$refvalue = { active => 1, filter => 0, hash => {} };
 304                 }
 305             }
 306         } elsif(/^none$/) {
 307             if($name !~ /^(?:help|debug|verbose|module)$/) {
 308                 if(ref($$refvalue) ne "HASH") {
 309                     $$refvalue = 0;
 310                 } else {
 311                     $$refvalue = { active => 0, filter => 0, hash => {} };
 312                 }
 313             }
 314         }
 315     }
 316 }
 317
 318 sub show_help {
 319     my $self = shift;
 320
 321     my $options_long = \%{$self->{_OPTIONS_LONG}};
 322     my $options_short = \%{$self->{_OPTIONS_SHORT}};
 323
 324     my $maxname = 0;
 325     for my $name (sort(keys(%$options_long))) {
 326         if(length($name) > $maxname) {
 327             $maxname = length($name);
 328         }
 329     }
 330
 331     for my $name (sort(keys(%$options_long))) {
 332         my $option = $$options_long{$name};
 333         my $description = $$option{description};
 334         my $default = $$option{default};
 335         my $current = ${$self->{$$option{key}}};
 336
 337         my $value = $current;
 338
 339         my $command;
 340         if(ref($value) ne "HASH") {
 341             if($value) {
 342                 $command = "--no-$name";
 343             } else {
 344                 $command = "--$name";
 345             }
 346         } else {
 347             if($value->{active}) {
 348                 $command = "--[no-]$name\[=<value>]";
 349             } else {
 350                 $command = "--$name\[=<value>]";
 351             }
 352         }
 353
 354         $output->write($command);
 355         for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { $output->write(" "); }
 356         if(ref($value) ne "HASH") {
 357             if($value) {
 358                 $output->write("Disable ");
 359             } else {
 360                 $output->write("Enable ");
 361             }
 362         } else {
 363             if($value->{active}) {
 364                 $output->write("(Disable) ");
 365             } else {
 366                 $output->write("Enable ");
 367             }
 368         }
 369         if($default == $current) {
 370             $output->write("$description\n");
 371         }
 372     }
 373 }
 374
 375 sub AUTOLOAD {
 376     my $self = shift;
 377
 378     my $name = $_options::AUTOLOAD;
 379     $name =~ s/^.*::(.[^:]*)$/\U$1/;
 380
 381     my $refvalue = $self->{$name};
 382     if(!defined($refvalue)) {
 383         die "<internal>: options.pm: member $name does not exists\n";
 384     }
 385
 386     if(ref($$refvalue) ne "HASH") {
 387         return $$refvalue;
 388     } else {
 389         return $$refvalue->{active};
 390     }
 391 }
 392
 393 sub arguments {
 394     my $self = shift;
 395
 396     my $arguments = \@{$self->{_ARGUMENTS}};
 397
 398     return @$arguments;
 399 }
 400
 401 sub c_files {
 402     my $self = shift;
 403
 404     my $c_files = \@{$self->{_C_FILES}};
 405
 406     if(!defined(@$c_files)) {
 407         $self->parse_files;
 408     }
 409
 410     return @$c_files;
 411 }
 412
 413 sub h_files {
 414     my $self = shift;
 415
 416     my $h_files = \@{$self->{_H_FILES}};
 417
 418     if(!defined(@$h_files)) {
 419         $self->parse_files;
 420     }
 421
 422     return @$h_files;
 423 }
 424
 425 sub directories {
 426     my $self = shift;
 427
 428     my $directories = \@{$self->{_DIRECTORIES}};
 429
 430     if(!defined(@$directories)) {
 431         $self->parse_files;
 432     }
 433
 434     return @$directories;
 435 }
 436
 437 1;