ACE/bin/PerlACE/ConfigList.pm

   1 #!/usr/bin/env perl
   2
   3 package PerlACE::ConfigList;
   4 use strict;
   5 use FileHandle;
   6
   7 @PerlACE::ConfigList::Configs = ();
   8 @PerlACE::ConfigList::Excludes = ();
   9
  10 my @new_argv = ();
  11
  12 for(my $i = 0; $i <= $#ARGV; ++$i) {
  13     if ($ARGV[$i] eq '-Config') {
  14         if (defined $ARGV[$i + 1]) {
  15             push @PerlACE::ConfigList::Configs, $ARGV[++$i];
  16         }
  17         else {
  18             print STDERR "You must pass a configuration with -Config\n";
  19             exit(1);
  20         }
  21     }
  22     elsif ($ARGV[$i] eq '-Exclude') {
  23         if (defined $ARGV[$i + 1]) {
  24             push @PerlACE::ConfigList::Excludes, $ARGV[++$i];
  25         }
  26         else {
  27             print STDERR "You must pass an exclude pattern with -Exclude\n";
  28             exit(1);
  29         }
  30     }
  31     else {
  32         push @new_argv, $ARGV[$i];
  33     }
  34 }
  35 @ARGV = @new_argv;
  36
  37
  38 sub new ()
  39 {
  40     my $self = {};
  41     @{$self->{MY_CONFIGS}} = @PerlACE::ConfigList::Configs;
  42     bless $self;
  43     return $self;
  44 }
  45
  46 sub my_config_list
  47 {
  48     my $self = shift;
  49     if (@_) { @{$self->{MY_CONFIGS}} = @_; }
  50     return @{$self->{MY_CONFIGS}};
  51 }
  52
  53 sub add_one_config ($)
  54 {
  55     my $self = shift;
  56     my $newconfig = shift;
  57     push @{$self->{MY_CONFIGS}}, $newconfig;
  58 }
  59
  60 sub check_config (@)
  61 {
  62     my $self = shift;
  63     my @testconfigs = @_;
  64     my $the_config_allows_this = 1; # default case is true
  65
  66     # Go though each ID on the line in turn...
  67     foreach my $config (@testconfigs) {
  68         my $required_found = !($config =~ /^\w/);
  69         foreach my $myconfig (@{$self->{MY_CONFIGS}}) {
  70             if ($config eq "!$myconfig") { $the_config_allows_this = 0; }
  71             if ($config eq $myconfig) { $required_found = 1; }
  72         }
  73         if (!$required_found) { $the_config_allows_this = 0; }
  74     }
  75     return $the_config_allows_this;
  76 }
  77
  78 sub load ($)
  79 {
  80     my $self = shift;
  81     my $filename = shift;
  82
  83     my $fh = new FileHandle;
  84     if (!$fh->open ("< $filename")) {
  85         print STDERR "Could not open $filename: $!\n";
  86         exit (1);
  87     }
  88
  89     while (<$fh>) {
  90         chomp;
  91         if (/^\s*$/ || /^#/) {
  92             next;
  93         }
  94         # compress white space
  95         s/\s+/ /g;
  96
  97         my $entry = '';
  98         my $configs = '';
  99
 100         ($entry, $configs) = split /:/;
 101
 102         # remove trailing white spaces
 103         $entry =~ s/\s+$//;
 104
 105         push @{$self->{ENTRIES}}, $entry;
 106         if (defined $configs) {
 107             @{$self->{CONFIGS}->{$entry}} =  split (" ", $configs);
 108         }
 109     }
 110
 111     $fh->close ();
 112 }
 113
 114 sub valid_entries ()
 115 {
 116     my $self = shift;
 117     my @entries = ();
 118     my $exclude = 0;
 119
 120     foreach my $entry (@{$self->{ENTRIES}}) {
 121         $exclude = 0;
 122         foreach my $expat (@PerlACE::ConfigList::Excludes) {
 123           if ($entry =~ /$expat/) {
 124             $exclude = 1;
 125             last;
 126           }
 127         }
 128         if (!$exclude && $self->check_config (@{$self->{CONFIGS}->{$entry}})) {
 129             push @entries, $entry;
 130         }
 131     }
 132     return @entries;
 133 }
 134
 135 sub list_configs ()
 136 {
 137     my $self = shift;
 138     my %allconfigs = {};
 139     my $list = '';
 140
 141     foreach my $entry (@{$self->{ENTRIES}}) {
 142
 143         foreach my $config (@{$self->{CONFIGS}->{$entry}}) {
 144             $config =~ s/!//g;
 145             if ($allconfigs{$config} != 1) {
 146                 $list .= $config.' ';
 147                 $allconfigs{$config} = 1;
 148             }
 149         }
 150     }
 151
 152     return $list;
 153 }
 154
 155 sub dump ()
 156 {
 157     my $self = shift;
 158
 159     print "============================================================\n";
 160     print "Config\n";
 161     foreach my $config (@{$self->{MY_CONFIGS}}) {
 162         print $config, "\n";
 163     }
 164     print "\n";
 165     print "Entries\n";
 166     foreach my $entry (@{$self->{ENTRIES}}) {
 167         print "- ", $entry, ": ";
 168         foreach my $config (@{$self->{CONFIGS}->{$entry}}) {
 169             print $config, " ";
 170         }
 171         print "\n";
 172     }
 173     print "============================================================\n";
 174 }
 175
 176 1;