diff options
Diffstat (limited to 'ACE/bin/PerlACE/ConfigList.pm')
-rw-r--r-- | ACE/bin/PerlACE/ConfigList.pm | 158 |
1 files changed, 158 insertions, 0 deletions
diff --git a/ACE/bin/PerlACE/ConfigList.pm b/ACE/bin/PerlACE/ConfigList.pm new file mode 100644 index 00000000000..74e530b1c94 --- /dev/null +++ b/ACE/bin/PerlACE/ConfigList.pm @@ -0,0 +1,158 @@ +# $Id$ + +package PerlACE::ConfigList; +use strict; +use FileHandle; + +@PerlACE::ConfigList::Configs = (); + +my @new_argv = (); + +for(my $i = 0; $i <= $#ARGV; ++$i) { + if ($ARGV[$i] eq '-Config') { + if (defined $ARGV[$i + 1]) { + push @PerlACE::ConfigList::Configs, $ARGV[++$i]; + } + else { + print STDERR "You must pass a configuration with Config\n"; + exit(1); + } + } + else { + push @new_argv, $ARGV[$i]; + } +} +@ARGV = @new_argv; + + +sub new () +{ + my $self = {}; + @{$self->{MY_CONFIGS}} = @PerlACE::ConfigList::Configs; + bless $self; + return $self; +} + +sub my_config_list +{ + my $self = shift; + if (@_) { @{$self->{MY_CONFIGS}} = @_; } + return @{$self->{MY_CONFIGS}}; +} + +sub add_one_config ($) +{ + my $self = shift; + my $newconfig = shift; + push @{$self->{MY_CONFIGS}}, $newconfig; +} + +sub check_config (@) +{ + my $self = shift; + my @testconfigs = @_; + my $included = 0; + my $excluded = 0; + my $noincludes = 1; + + foreach my $config (@testconfigs) { + if ($config =~ /^\w/) { $noincludes = 0; } + foreach my $myconfig (@{$self->{MY_CONFIGS}}) { + if ($config eq "!$myconfig") { $excluded = 1; } + if ($config eq $myconfig) { $included = 1; } + } + } + return ($included || $noincludes) && !$excluded; +} + +sub load ($) +{ + my $self = shift; + my $filename = shift; + + my $fh = new FileHandle; + if (!$fh->open ("< $filename")) { + print STDERR "Could not open $filename: $!\n"; + exit (1); + } + + while (<$fh>) { + chomp; + if (/^\s*$/ || /^#/) { + next; + } + # compress white space + s/\s+/ /g; + + my $entry = ''; + my $configs = ''; + + ($entry, $configs) = split /:/; + + # remove trailing white spaces + $entry =~ s/\s+$//; + + push @{$self->{ENTRIES}}, $entry; + if (defined $configs) { + @{$self->{CONFIGS}->{$entry}} = split (" ", $configs); + } + } + + $fh->close (); +} + +sub valid_entries () +{ + my $self = shift; + my @entries = (); + + foreach my $entry (@{$self->{ENTRIES}}) { + if ($self->check_config (@{$self->{CONFIGS}->{$entry}})) { + push @entries, $entry; + } + } + return @entries; +} + +sub list_configs () +{ + my $self = shift; + my %allconfigs = {}; + my $list = ''; + + foreach my $entry (@{$self->{ENTRIES}}) { + + foreach my $config (@{$self->{CONFIGS}->{$entry}}) { + $config =~ s/!//g; + if ($allconfigs{$config} != 1) { + $list .= $config.' '; + $allconfigs{$config} = 1; + } + } + } + + return $list; +} + +sub dump () +{ + my $self = shift; + + print "============================================================\n"; + print "Config\n"; + foreach my $config (@{$self->{MY_CONFIGS}}) { + print $config, "\n"; + } + print "\n"; + print "Entries\n"; + foreach my $entry (@{$self->{ENTRIES}}) { + print "- ", $entry, ": "; + foreach my $config (@{$self->{CONFIGS}->{$entry}}) { + print $config, " "; + } + print "\n"; + } + print "============================================================\n"; +} + +1; |