wine-wine/tools/winapi/options.pm

351 lines
7.2 KiB
Perl
Raw Normal View History

package options;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(&parse_comma_list);
@EXPORT_OK = qw();
2001-07-11 17:27:45 +00:00
my $output = "output";
sub parse_comma_list {
my $prefix = shift;
my $value = shift;
if(defined($prefix) && $prefix eq "no") {
return { active => 0, filter => 0, hash => {} };
} elsif(defined($value)) {
my %names;
for my $name (split /,/, $value) {
$names{$name} = 1;
}
return { active => 1, filter => 1, hash => \%names };
} else {
return { active => 1, filter => 0, hash => {} };
}
}
my $_options;
sub new {
my $self = shift;
$_options = _options->new(@_);
return $_options;
}
sub AUTOLOAD {
my $self = shift;
my $name = $options::AUTOLOAD;
$name =~ s/^.*::(.[^:]*)$/$1/;
return $_options->$name(@_);
}
package _options;
use strict;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
my $options_long = \%{$self->{OPTIONS_LONG}};
my $options_short = \%{$self->{OPTIONS_SHORT}};
my $options_usage = \${$self->{OPTIONS_USAGE}};
my $refoptions_long = shift;
my $refoptions_short = shift;
$$options_usage = shift;
%$options_long = %{$refoptions_long};
%$options_short = %{$refoptions_short};
$self->options_set("default");
my $c_files = \@{$self->{C_FILES}};
my $h_files = \@{$self->{H_FILES}};
my @files;
while(defined($_ = shift @ARGV)) {
if(/^--(all|none)$/) {
$self->options_set("$1");
next;
} elsif(/^-([^=]*)(=(.*))?$/) {
my $name;
my $value;
if(defined($2)) {
$name = $1;
$value = $3;
} else {
$name = $1;
}
if($name =~ /^([^-].*)$/) {
$name = $$options_short{$1};
} else {
$name =~ s/^-(.*)$/$1/;
}
my $prefix;
if(defined($name) && $name =~ /^no-(.*)$/) {
$name = $1;
$prefix = "no";
if(defined($value)) {
2001-07-11 17:27:45 +00:00
$output->write("options with prefix 'no' can't take parameters\n");
return undef;
}
}
my $option;
if(defined($name)) {
$option = $$options_long{$name};
}
if(defined($option)) {
my $key = $$option{key};
my $parser = $$option{parser};
my $refvalue = \${$self->{$key}};
my @parents = ();
if(defined($$option{parent})) {
if(ref($$option{parent}) eq "ARRAY") {
@parents = @{$$option{parent}};
} else {
@parents = $$option{parent};
}
}
if(defined($parser)) {
$$refvalue = &$parser($prefix,$value);
} else {
if(defined($value)) {
$$refvalue = $value;
} elsif(!defined($prefix)) {
$$refvalue = 1;
} else {
$$refvalue = 0;
}
}
if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
while($#parents >= 0) {
my @old_parents = @parents;
@parents = ();
foreach my $parent (@old_parents) {
my $parentkey = $$options_long{$parent}{key};
my $refparentvalue = \${$self->{$parentkey}};
$$refparentvalue = 1;
if(defined($$options_long{$parent}{parent})) {
if(ref($$options_long{$parent}{parent}) eq "ARRAY") {
push @parents, @{$$options_long{$parent}{parent}};
} else {
push @parents, $$options_long{$parent}{parent};
}
}
}
}
}
next;
}
}
if(/^-(.*)$/) {
2001-07-11 17:27:45 +00:00
$output->write("unknown option: $_\n");
$output->write($$options_usage);
exit 1;
} else {
if(!-e $_) {
2001-07-11 17:27:45 +00:00
$output->write("$_: no such file or directory\n");
exit 1;
}
push @files, $_;
}
}
if($self->help) {
2001-07-11 17:27:45 +00:00
$output->write($$options_usage);
$self->show_help;
exit 0;
}
my @paths = ();
my @c_files = ();
my @h_files = ();
foreach my $file (@files) {
if($file =~ /\.c$/) {
push @c_files, $file;
} elsif($file =~ /\.h$/) {
push @h_files, $file;
} else {
push @paths, $file;
}
}
if($#c_files == -1 && $#h_files == -1 && $#paths == -1)
{
@paths = ".";
}
if($#paths != -1 || $#c_files != -1) {
my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
my %found;
@$c_files = sort(map {
s/^\.\/(.*)$/$1/;
if(defined($found{$_}) || /glue\.c|spec\.c$/) {
();
} else {
$found{$_}++;
$_;
}
} split(/\n/, `$c_command`));
}
if($#h_files != -1) {
my $h_command = "find " . join(" ", @h_files) . " -name \\*.h";
my %found;
@$h_files = sort(map {
s/^\.\/(.*)$/$1/;
if(defined($found{$_})) {
();
} else {
$found{$_}++;
$_;
}
} split(/\n/, `$h_command`));
}
return $self;
}
sub DESTROY {
}
sub options_set {
my $self = shift;
my $options_long = \%{$self->{OPTIONS_LONG}};
my $options_short = \%{$self->{OPTIONS_SHORT}};
local $_ = shift;
for my $name (sort(keys(%$options_long))) {
my $option = $$options_long{$name};
my $key = uc($name);
$key =~ tr/-/_/;
$$option{key} = $key;
my $refvalue = \${$self->{$key}};
if(/^default$/) {
$$refvalue = $$option{default};
} elsif(/^all$/) {
if($name !~ /^help|debug|verbose|module$/) {
if(ref($$refvalue) ne "HASH") {
$$refvalue = 1;
} else {
$$refvalue = { active => 1, filter => 0, hash => {} };
}
}
} elsif(/^none$/) {
if($name !~ /^help|debug|verbose|module$/) {
if(ref($$refvalue) ne "HASH") {
$$refvalue = 0;
} else {
$$refvalue = { active => 0, filter => 0, hash => {} };
}
}
}
}
}
sub show_help {
my $self = shift;
my $options_long = \%{$self->{OPTIONS_LONG}};
my $options_short = \%{$self->{OPTIONS_SHORT}};
my $maxname = 0;
for my $name (sort(keys(%$options_long))) {
if(length($name) > $maxname) {
$maxname = length($name);
}
}
for my $name (sort(keys(%$options_long))) {
my $option = $$options_long{$name};
my $description = $$option{description};
my $default = $$option{default};
my $current = ${$self->{$$option{key}}};
my $value = $current;
my $command;
if(ref($value) ne "HASH") {
if($value) {
$command = "--no-$name";
} else {
$command = "--$name";
}
} else {
if($value->{active}) {
$command = "--[no-]$name\[=<value>]";
} else {
$command = "--$name\[=<value>]";
}
}
2001-07-11 17:27:45 +00:00
$output->write($command);
for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { $output->write(" "); }
if(ref($value) ne "HASH") {
if($value) {
2001-07-11 17:27:45 +00:00
$output->write("Disable ");
} else {
2001-07-11 17:27:45 +00:00
$output->write("Enable ");
}
} else {
if($value->{active}) {
2001-07-11 17:27:45 +00:00
$output->write("(Disable) ");
} else {
2001-07-11 17:27:45 +00:00
$output->write("Enable ");
}
}
if($default == $current) {
2001-07-11 17:27:45 +00:00
$output->write("$description (default)\n");
} else {
2001-07-11 17:27:45 +00:00
$output->write("$description\n");
}
}
}
sub AUTOLOAD {
my $self = shift;
my $name = $_options::AUTOLOAD;
$name =~ s/^.*::(.[^:]*)$/\U$1/;
my $refvalue = $self->{$name};
if(!defined($refvalue)) {
die "<internal>: options.pm: member $name does not exists\n";
}
if(ref($$refvalue) ne "HASH") {
return $$refvalue;
} else {
return $$refvalue->{active};
}
}
sub c_files { my $self = shift; return @{$self->{C_FILES}}; }
sub h_files { my $self = shift; return @{$self->{H_FILES}}; }
1;