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