diff options
Diffstat (limited to 'bin/PerlACE/ConfigList.pm')
-rw-r--r-- | bin/PerlACE/ConfigList.pm | 155 |
1 files changed, 0 insertions, 155 deletions
diff --git a/bin/PerlACE/ConfigList.pm b/bin/PerlACE/ConfigList.pm deleted file mode 100644 index f2546d844d9..00000000000 --- a/bin/PerlACE/ConfigList.pm +++ /dev/null @@ -1,155 +0,0 @@ -# $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 /:/; - - 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;
\ No newline at end of file |