tools/winapi/options.pm - wine - Git at Google

 #
 # Copyright 1999, 2000, 2001 Patrik Stridvall
 #
 # This library is free software; you can redistribute it and/or
 # modify it under the terms of the GNU Lesser General Public
 # License as published by the Free Software Foundation; either
 # version 2.1 of the License, or (at your option) any later version.
 #
 # This library is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # Lesser General Public License for more details.
 #
 # You should have received a copy of the GNU Lesser General Public
 # License along with this library; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #

 package options;

 use strict;

 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 require Exporter;

 @ISA = qw(Exporter);
 @EXPORT = qw();
 @EXPORT_OK = qw($options &parse_comma_list &parse_value);

 use vars qw($options);

 use output qw($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 => {} };
     }
 }

 sub parse_value {
     my $prefix = shift;
     my $value = shift;

     return $value;
 }

 package _options;

 use strict;

 use output qw($output);

 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 $arguments = \@{$self->{_ARGUMENTS}};
     @$arguments = ();

     my $end_of_options = 0;
     while(defined($_ = shift @ARGV)) {
 	if(/^--$/) {
 	    $end_of_options = 1;
 	    next;
 	} elsif($end_of_options) {
 	    # Nothing
 	} elsif(/^--(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)) {
 		    $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)) {
 		    if(!defined($value)) {
 			$value = shift @ARGV;
 		    }
 		    $$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(!$end_of_options && /^-(.*)$/) {
 	    $output->write("unknown option: $_\n");
 	    $output->write($$options_usage);
 	    exit 1;
 	} else {
 	    push @$arguments, $_;
 	}
     }

     if($self->help) {
 	$output->write($$options_usage);
 	$self->show_help;
 	exit 0;
     }

     return $self;
 }

 sub DESTROY {
 }

 sub parse_files {
     my $self = shift;

     my $arguments = \@{$self->{_ARGUMENTS}};
     my $directories = \@{$self->{_DIRECTORIES}};
     my $c_files = \@{$self->{_C_FILES}};
     my $h_files = \@{$self->{_H_FILES}};

     my $error = 0;
     my @files = ();
     foreach (@$arguments) {
 	if(!-e $_) {
 	    $output->write("$_: no such file or directory\n");
 	    $error = 1;
 	} else {
 	    push @files, $_;
 	}
     }
     if($error) {
 	exit 1;
     }

     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{$_})) {
 		();
 	    } else {
 		$found{$_}++;
 		$_;
 	    }
 	} split(/\n/, `$c_command`));
     }

     if($#paths != -1 || $#h_files != -1) {
 	my $h_command = "find " . join(" ", @paths, @h_files) . " -name \\*.h";
 	my %found;

 	@$h_files = sort(map {
 	    s/^\.\/(.*)$/$1/;
 	    if(defined($found{$_})) {
 		();
 	    } else {
 		$found{$_}++;
 		$_;
 	    }
 	} split(/\n/, `$h_command`));
     }

     my %dirs;
     foreach my $file (@$c_files, @$h_files) {
 	my $dir = $file;
 	$dir =~ s%/?[^/]+$%%;
 	if(!$dir) { $dir = "."; }
 	$dirs{$dir}++
     }

     @$directories = sort(keys(%dirs));
 }

 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>]";
 	    }
 	}

 	$output->write($command);
 	for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { $output->write(" "); }
 	if(ref($value) ne "HASH") {
 	    if($value) {
 		$output->write("Disable ");
 	    } else {
 		$output->write("Enable ");
 	    }
 	} else {
 	    if($value->{active}) {
 		$output->write("(Disable) ");
 	    } else {
 	        $output->write("Enable ");
 	    }
 	}
         if($default == $current) {
 	    $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 arguments {
     my $self = shift;

     my $arguments = \@{$self->{_ARGUMENTS}};

     return @$arguments;
 }

 sub c_files {
     my $self = shift;

     my $c_files = \@{$self->{_C_FILES}};

     if(!defined(@$c_files)) {
 	$self->parse_files;
     }

     return @$c_files;
 }

 sub h_files {
     my $self = shift;

     my $h_files = \@{$self->{_H_FILES}};

     if(!defined(@$h_files)) {
 	$self->parse_files;
     }

     return @$h_files;
 }

 sub directories {
     my $self = shift;

     my $directories = \@{$self->{_DIRECTORIES}};

     if(!defined(@$directories)) {
 	$self->parse_files;
     }

     return @$directories;
 }

 1;
	#
	# Copyright 1999, 2000, 2001 Patrik Stridvall
	#
	# This library is free software; you can redistribute it and/or
	# modify it under the terms of the GNU Lesser General Public
	# License as published by the Free Software Foundation; either
	# version 2.1 of the License, or (at your option) any later version.
	#
	# This library is distributed in the hope that it will be useful,
	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	# Lesser General Public License for more details.
	#
	# You should have received a copy of the GNU Lesser General Public
	# License along with this library; if not, write to the Free Software
	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	#

	package options;

	use strict;

	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
	require Exporter;

	@ISA = qw(Exporter);
	@EXPORT = qw();
	@EXPORT_OK = qw($options &parse_comma_list &parse_value);

	use vars qw($options);

	use output qw($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 => {} };
	}
	}

	sub parse_value {
	my $prefix = shift;
	my $value = shift;

	return $value;
	}

	package _options;

	use strict;

	use output qw($output);

	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 $arguments = \@{$self->{_ARGUMENTS}};
	@$arguments = ();

	my $end_of_options = 0;
	while(defined($_ = shift @ARGV)) {
	if(/^--$/) {
	$end_of_options = 1;
	next;
	} elsif($end_of_options) {
	# Nothing
	} elsif(/^--(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)) {
	$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)) {
	if(!defined($value)) {
	$value = shift @ARGV;
	}
	$$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(!$end_of_options && /^-(.*)$/) {
	$output->write("unknown option: $_\n");
	$output->write($$options_usage);
	exit 1;
	} else {
	push @$arguments, $_;
	}
	}

	if($self->help) {
	$output->write($$options_usage);
	$self->show_help;
	exit 0;
	}

	return $self;
	}

	sub DESTROY {
	}

	sub parse_files {
	my $self = shift;

	my $arguments = \@{$self->{_ARGUMENTS}};
	my $directories = \@{$self->{_DIRECTORIES}};
	my $c_files = \@{$self->{_C_FILES}};
	my $h_files = \@{$self->{_H_FILES}};

	my $error = 0;
	my @files = ();
	foreach (@$arguments) {
	if(!-e $_) {
	$output->write("$_: no such file or directory\n");
	$error = 1;
	} else {
	push @files, $_;
	}
	}
	if($error) {
	exit 1;
	}

	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{$_})) {
	();
	} else {
	$found{$_}++;
	$_;
	}
	} split(/\n/, `$c_command`));
	}

	if($#paths != -1 \|\| $#h_files != -1) {
	my $h_command = "find " . join(" ", @paths, @h_files) . " -name \\*.h";
	my %found;

	@$h_files = sort(map {
	s/^\.\/(.*)$/$1/;
	if(defined($found{$_})) {
	();
	} else {
	$found{$_}++;
	$_;
	}
	} split(/\n/, `$h_command`));
	}

	my %dirs;
	foreach my $file (@$c_files, @$h_files) {
	my $dir = $file;
	$dir =~ s%/?[^/]+$%%;
	if(!$dir) { $dir = "."; }
	$dirs{$dir}++
	}

	@$directories = sort(keys(%dirs));
	}

	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>]";
	}
	}

	$output->write($command);
	for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { $output->write(" "); }
	if(ref($value) ne "HASH") {
	if($value) {
	$output->write("Disable ");
	} else {
	$output->write("Enable ");
	}
	} else {
	if($value->{active}) {
	$output->write("(Disable) ");
	} else {
	$output->write("Enable ");
	}
	}
	if($default == $current) {
	$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 arguments {
	my $self = shift;

	my $arguments = \@{$self->{_ARGUMENTS}};

	return @$arguments;
	}

	sub c_files {
	my $self = shift;

	my $c_files = \@{$self->{_C_FILES}};

	if(!defined(@$c_files)) {
	$self->parse_files;
	}

	return @$c_files;
	}

	sub h_files {
	my $self = shift;

	my $h_files = \@{$self->{_H_FILES}};

	if(!defined(@$h_files)) {
	$self->parse_files;
	}

	return @$h_files;
	}

	sub directories {
	my $self = shift;

	my $directories = \@{$self->{_DIRECTORIES}};

	if(!defined(@$directories)) {
	$self->parse_files;
	}

	return @$directories;
	}

	1;