| 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 |
|
# ---------------------------------------------- |
| 19 |
+ |
# group names are characters. Anything before a :: will indicate the |
| 20 |
+ |
# group set upon which the closecontext etc will operate. The group set is |
| 21 |
+ |
# still part of the group name. |
| 22 |
+ |
# |
| 23 |
|
|
| 24 |
|
package GroupChecker; |
| 25 |
|
require 5.001; |
| 30 |
|
my $class=shift; |
| 31 |
|
$self={}; |
| 32 |
|
bless $self, $class; |
| 33 |
< |
push @{$self->{context}},'none'; |
| 33 |
> |
$self->{context}{none}=1; |
| 34 |
|
return $self; |
| 35 |
|
} |
| 36 |
|
|
| 80 |
|
my $self=shift; |
| 81 |
|
my $gp=shift; |
| 82 |
|
|
| 83 |
< |
push @{$self->{context}}, $gp; |
| 84 |
< |
$self->_setstatus; |
| 83 |
> |
( $gp=~/(.*)::/ ? $set=$1 : $set='none' ); |
| 84 |
> |
|
| 85 |
> |
push @{$self->{contextstack}{$set}}, $gp; |
| 86 |
> |
$self->{context}{$gp}=1; |
| 87 |
> |
$self->_setstatus(); |
| 88 |
|
} |
| 89 |
|
|
| 90 |
|
sub closelastcontext { |
| 91 |
|
my $self=shift; |
| 92 |
+ |
my $set=shift; |
| 93 |
+ |
my $gp; |
| 94 |
|
|
| 95 |
< |
pop @{$self->{context}}; |
| 96 |
< |
$self->_setstatus; |
| 95 |
> |
if ( $set eq "" ) { $set='none' } |
| 96 |
> |
do { |
| 97 |
> |
$gp=pop @{$self->{contextstack}{$set}}; |
| 98 |
> |
} while ( ! exists $self->{context}{$gp} ); |
| 99 |
> |
$self->closecontext($gp); |
| 100 |
> |
} |
| 101 |
> |
|
| 102 |
> |
sub closecontext { |
| 103 |
> |
my $self=shift; |
| 104 |
> |
my $gp=shift; |
| 105 |
> |
|
| 106 |
> |
( $gp=~/(.*)::/ ? $set=$1 : $set='none' ); |
| 107 |
> |
delete $self->{context}{$gp}; |
| 108 |
> |
$self->_setstatus(); |
| 109 |
|
} |
| 110 |
|
|
| 111 |
|
sub status { |
| 120 |
|
my $i; |
| 121 |
|
|
| 122 |
|
$self->{status}=0; # If not on exclude or include then always false |
| 123 |
< |
foreach $i ( @{$self->{context}} ) { |
| 123 |
> |
foreach $i ( keys %{$self->{context}} ) { |
| 124 |
|
if ( ( exists $self->{include}{$i} ) |
| 125 |
|
|| ( exists $self->{include}{all} ) ) { |
| 126 |
|
$self->{status}=1; |
