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., 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 && -d ".git")
 240     {
 241         @$c_files = sort split /\0/, `git ls-files -z \\*.c`;
 242         @$h_files = sort split /\0/, `git ls-files -z \\*.h`;
 243     }
 244     else
 245     {
 246         if($#c_files == -1 && $#h_files == -1 && $#paths == -1)
 247         {
 248             @paths = ".";
 249         }
 250
 251         if($#paths != -1 || $#c_files != -1) {
 252             my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
 253             my %found;
 254             @$c_files = sort(map {
 255                 s/^\.\/(.*)$/$1/;
 256                 if(defined($found{$_})) {
 257                     ();
 258                 } else {
 259                     $found{$_}++;
 260                     $_;
 261                 }
 262                              } split(/\n/, `$c_command`));
 263         }
 264
 265         if($#paths != -1 || $#h_files != -1) {
 266             my $h_command = "find " . join(" ", @paths, @h_files) . " -name \\*.h";
 267             my %found;
 268
 269             @$h_files = sort(map {
 270                 s/^\.\/(.*)$/$1/;
 271                 if(defined($found{$_})) {
 272                     ();
 273                 } else {
 274                     $found{$_}++;
 275                     $_;
 276                 }
 277                              } split(/\n/, `$h_command`));
 278         }
 279     }
 280
 281     my %dirs;
 282     foreach my $file (@$c_files, @$h_files) {
 283         my $dir = $file;
 284         $dir =~ s%/?[^/]+$%%;
 285         if(!$dir) { $dir = "."; }
 286         $dirs{$dir}++
 287     }
 288
 289     @$directories = sort(keys(%dirs));
 290 }
 291
 292 sub options_set($$) {
 293     my $self = shift;
 294
 295     my $options_long = \%{$self->{_OPTIONS_LONG}};
 296     my $options_short = \%{$self->{_OPTIONS_SHORT}};
 297
 298     local $_ = shift;
 299     for my $name (sort(keys(%$options_long))) {
 300         my $option = $$options_long{$name};
 301         my $key = uc($name);
 302         $key =~ tr/-/_/;
 303         $$option{key} = $key;
 304         my $refvalue = \${$self->{$key}};
 305
 306         if(/^default$/) {
 307             $$refvalue = $$option{default};
 308         } elsif(/^all$/) {
 309             if($name !~ /^(?:help|debug|verbose|module)$/) {
 310                 if(ref($$refvalue) ne "HASH") {
 311                     $$refvalue = 1;
 312                 } else {
 313                     $$refvalue = { active => 1, filter => 0, hash => {} };
 314                 }
 315             }
 316         } elsif(/^none$/) {
 317             if($name !~ /^(?:help|debug|verbose|module)$/) {
 318                 if(ref($$refvalue) ne "HASH") {
 319                     $$refvalue = 0;
 320                 } else {
 321                     $$refvalue = { active => 0, filter => 0, hash => {} };
 322                 }
 323             }
 324         }
 325     }
 326 }
 327
 328 sub show_help($) {
 329     my $self = shift;
 330
 331     my $options_long = \%{$self->{_OPTIONS_LONG}};
 332     my $options_short = \%{$self->{_OPTIONS_SHORT}};
 333
 334     my $maxname = 0;
 335     for my $name (sort(keys(%$options_long))) {
 336         if(length($name) > $maxname) {
 337             $maxname = length($name);
 338         }
 339     }
 340
 341     for my $name (sort(keys(%$options_long))) {
 342         my $option = $$options_long{$name};
 343         my $description = $$option{description};
 344         my $parser = $$option{parser};
 345         my $current = ${$self->{$$option{key}}};
 346
 347         my $value = $current;
 348
 349         my $command;
 350         if(!defined $parser) {
 351             if($value) {
 352                 $command = "--no-$name";
 353             } else {
 354                 $command = "--$name";
 355             }
 356         } else {
 357             if(ref($value) eq "HASH" && $value->{active}) {
 358                 $command = "--[no-]$name\[=<value>]";
 359             } else {
 360                 $command = "--$name\[=<value>]";
 361             }
 362         }
 363
 364         $output->write($command);
 365         $output->write(" " x (($maxname - length($name) + 17) - (length($command) - length($name) + 1)));
 366         if(!defined $parser) {
 367             if($value) {
 368                 $output->write("Disable ");
 369             } else {
 370                 $output->write("Enable ");
 371             }
 372         } else {
 373             if(ref($value) eq "HASH")
 374             {
 375                 if ($value->{active}) {
 376                     $output->write("(Disable) ");
 377                 } else {
 378                     $output->write("Enable ");
 379                 }
 380             }
 381         }
 382         $output->write("$description\n");
 383     }
 384 }
 385
 386 sub AUTOLOAD {
 387     my $self = shift;
 388
 389     my $name = $_options::AUTOLOAD;
 390     $name =~ s/^.*::(.[^:]*)$/\U$1/;
 391
 392     my $refvalue = $self->{$name};
 393     if(!defined($refvalue)) {
 394         die "<internal>: options.pm: member $name does not exist\n";
 395     }
 396
 397     if(ref($$refvalue) ne "HASH") {
 398         return $$refvalue;
 399     } else {
 400         return $$refvalue->{active};
 401     }
 402 }
 403
 404 sub arguments($) {
 405     my $self = shift;
 406
 407     my $arguments = \@{$self->{_ARGUMENTS}};
 408
 409     return @$arguments;
 410 }
 411
 412 sub c_files($) {
 413     my $self = shift;
 414
 415     my $c_files = \@{$self->{_C_FILES}};
 416
 417     if(!defined(@$c_files)) {
 418         $self->parse_files;
 419     }
 420
 421     return @$c_files;
 422 }
 423
 424 sub h_files($) {
 425     my $self = shift;
 426
 427     my $h_files = \@{$self->{_H_FILES}};
 428
 429     if(!defined(@$h_files)) {
 430         $self->parse_files;
 431     }
 432
 433     return @$h_files;
 434 }
 435
 436 sub directories($) {
 437     my $self = shift;
 438
 439     my $directories = \@{$self->{_DIRECTORIES}};
 440
 441     if(!defined(@$directories)) {
 442         $self->parse_files;
 443     }
 444
 445     return @$directories;
 446 }
 447
 448 1;