| 9 |
|
# include(gp) : include a group |
| 10 |
|
# uninclude(gp) : uninclude a group |
| 11 |
|
# opencontext(gp) : Annonce group context |
| 12 |
< |
# closelastcontext() : Close group context |
| 12 |
> |
# closecontext(gp) : Close group context |
| 13 |
> |
# closelastcontext(set) : Close the last context added to group the group set |
| 14 |
|
# status() : If include/excluded groups match the current gp context |
| 15 |
|
# return 1 else 0 |
| 16 |
|
# getincluded() : return an array of included groups |
| 17 |
|
# getexcluded() : return array of excluded groups |
| 18 |
+ |
# clearinclude() : clear all entries from the include list |
| 19 |
+ |
# clearexclude() : clear all entries from the exclude list |
| 20 |
|
# ---------------------------------------------- |
| 21 |
+ |
# group names are characters. Anything before a :: will indicate the |
| 22 |
+ |
# group set upon which the closecontext etc will operate. The group set is |
| 23 |
+ |
# still part of the group name. |
| 24 |
+ |
# |
| 25 |
+ |
|
| 26 |
|
|
| 27 |
|
package GroupChecker; |
| 28 |
+ |
BEGIN { print __PACKAGE__." still used.\n"; exit(1) } |
| 29 |
+ |
|
| 30 |
+ |
|
| 31 |
|
require 5.001; |
| 32 |
|
require Exporter; |
| 33 |
|
@ISA=qw(Exporter); |
| 36 |
|
my $class=shift; |
| 37 |
|
$self={}; |
| 38 |
|
bless $self, $class; |
| 39 |
< |
push @{$self->{context}},'none'; |
| 39 |
> |
$self->{context}{none}=1; |
| 40 |
|
return $self; |
| 41 |
|
} |
| 42 |
|
|
| 43 |
+ |
sub clearinclude { |
| 44 |
+ |
my $self=shift; |
| 45 |
+ |
undef %{$self->{include}}; |
| 46 |
+ |
} |
| 47 |
+ |
sub clearexclude { |
| 48 |
+ |
my $self=shift; |
| 49 |
+ |
undef %{$self->{exclude}}; |
| 50 |
+ |
} |
| 51 |
+ |
|
| 52 |
|
sub exclude { |
| 53 |
|
my $self=shift; |
| 54 |
|
my $gp=shift; |
| 94 |
|
sub opencontext { |
| 95 |
|
my $self=shift; |
| 96 |
|
my $gp=shift; |
| 97 |
+ |
my $set; |
| 98 |
|
|
| 99 |
< |
push @{$self->{context}}, $gp; |
| 100 |
< |
$self->_setstatus; |
| 99 |
> |
if ( $gp=~/(.*)::/ ) { |
| 100 |
> |
$set=$1; |
| 101 |
> |
} |
| 102 |
> |
else { |
| 103 |
> |
$set='none'; |
| 104 |
> |
} |
| 105 |
> |
|
| 106 |
> |
push @{$self->{contextstack}{$set}}, $gp; |
| 107 |
> |
$self->{context}{$gp}=1; |
| 108 |
> |
$self->_setstatus(); |
| 109 |
|
} |
| 110 |
|
|
| 111 |
|
sub closelastcontext { |
| 112 |
|
my $self=shift; |
| 113 |
+ |
my $set=shift; |
| 114 |
+ |
my $gp; |
| 115 |
|
|
| 116 |
< |
pop @{$self->{context}}; |
| 117 |
< |
$self->_setstatus; |
| 116 |
> |
if ( $set eq "" ) { $set='none' } |
| 117 |
> |
do { |
| 118 |
> |
$gp=pop @{$self->{contextstack}{$set}}; |
| 119 |
> |
} while ( (! exists $self->{context}{$gp}) && ($gp eq "") ); |
| 120 |
> |
$self->closecontext($gp); |
| 121 |
> |
} |
| 122 |
> |
|
| 123 |
> |
sub closecontext { |
| 124 |
> |
my $self=shift; |
| 125 |
> |
my $gp=shift; |
| 126 |
> |
|
| 127 |
> |
if ( $gp=~/(.*)::/ ) { |
| 128 |
> |
$set=$1; |
| 129 |
> |
} |
| 130 |
> |
else { |
| 131 |
> |
$set='none'; |
| 132 |
> |
} |
| 133 |
> |
delete $self->{context}{$gp}; |
| 134 |
> |
$self->_setstatus(); |
| 135 |
|
} |
| 136 |
|
|
| 137 |
|
sub status { |
| 145 |
|
my $self=shift; |
| 146 |
|
my $i; |
| 147 |
|
|
| 148 |
< |
$self->{status}=0; # If not on exclude or include then always false |
| 149 |
< |
foreach $i ( @{$self->{context}} ) { |
| 148 |
> |
$self->{status}=1; |
| 149 |
> |
foreach $i ( keys %{$self->{context}} ) { |
| 150 |
|
if ( ( exists $self->{include}{$i} ) |
| 151 |
|
|| ( exists $self->{include}{all} ) ) { |
| 152 |
< |
$self->{status}=1; |
| 152 |
> |
$self->{status}=( $self->{status} && 1); |
| 153 |
|
} |
| 154 |
|
if ( exists $self->{exclude}{$i} ) { |
| 155 |
|
$self->{status}=0; |
