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\[=]"; } else { $command = "--$name\[=]"; } } $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 (default)\n"); } else { $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 ": 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;