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