src/ActiveDoc/GroupChecker.pm

#
# Maintain a variable to indicate status of a number of requirements
#
# --------------
# Interface
#
# exclude(gp)        : exclude a group
# unexclude(gp)      : unexclude a group
# include(gp)        : include a group
# uninclude(gp)      : uninclude a group
# opencontext(gp)    : Annonce group context
# closelastcontext() : Close group context
# status()           : If include/excluded groups match the current gp context
#                      return 1 else 0
# getincluded()      : return an array of included groups
# getexcluded()      : return array of excluded groups
# ----------------------------------------------

package GroupChecker;
require 5.001;
require Exporter;
@ISA=qw(Exporter);

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        push @{$self->{context}},'none';
        return $self;
}

sub exclude {
        my $self=shift;
        my $gp=shift;

        ${$self->{exclude}}{$gp}=1;
        $self->_setstatus;
}

sub unexclude {
        my $self=shift;
        my $gp=shift;

        delete ${$self->{exclude}}{$gp};
        $self->_setstatus;
}

sub include {
        my $self=shift;
        my $gp=shift;

        ${$self->{include}}{$gp}=1;
        $self->_setstatus;
}

sub uninclude {
        my $self=shift;
        my $gp=shift;

        delete ${$self->{include}}{$gp};
        $self->_setstatus;
}

sub getexcluded {
        my $self=shift;
        return keys %{$self->{exclude}}
}

sub getincluded {
        my $self=shift;
        return keys %{$self->{include}}
}

sub opencontext {
        my $self=shift;
        my $gp=shift;

        push @{$self->{context}}, $gp;
        $self->_setstatus;
}

sub closelastcontext {
        my $self=shift;

        pop @{$self->{context}};
        $self->_setstatus;
}

sub status {
        my $self=shift;
        return $self->{status};
}

# -------------- Support Routines -----------------------------------

sub _setstatus {
        my $self=shift;
        my $i;
        
        $self->{status}=0; # If not on exclude or include then always false
        foreach $i ( @{$self->{context}} ) {
            if ( ( exists $self->{include}{$i} )
                 || ( exists $self->{include}{all} ) ) {
                $self->{status}=1;
            }
            if ( exists $self->{exclude}{$i} ) {
                $self->{status}=0;
            }
        }
}
Revision:	1.1
Committed:	Thu Jun 10 13:09:58 1999 UTC (25 years, 11 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Log Message:	First tested gruopchecker
#	User	Rev	Content
1	williamc	1.1	#
2			# Maintain a variable to indicate status of a number of requirements
3			#
4			# --------------
5			# Interface
6			#
7			# exclude(gp) : exclude a group
8			# unexclude(gp) : unexclude a group
9			# include(gp) : include a group
10			# uninclude(gp) : uninclude a group
11			# opencontext(gp) : Annonce group context
12			# closelastcontext() : Close group context
13			# status() : If include/excluded groups match the current gp context
14			# return 1 else 0
15			# getincluded() : return an array of included groups
16			# getexcluded() : return array of excluded groups
17			# ----------------------------------------------
18
19			package GroupChecker;
20			require 5.001;
21			require Exporter;
22			@ISA=qw(Exporter);
23
24			sub new {
25			my $class=shift;
26			$self={};
27			bless $self, $class;
28			push @{$self->{context}},'none';
29			return $self;
30			}
31
32			sub exclude {
33			my $self=shift;
34			my $gp=shift;
35
36			${$self->{exclude}}{$gp}=1;
37			$self->_setstatus;
38			}
39
40			sub unexclude {
41			my $self=shift;
42			my $gp=shift;
43
44			delete ${$self->{exclude}}{$gp};
45			$self->_setstatus;
46			}
47
48			sub include {
49			my $self=shift;
50			my $gp=shift;
51
52			${$self->{include}}{$gp}=1;
53			$self->_setstatus;
54			}
55
56			sub uninclude {
57			my $self=shift;
58			my $gp=shift;
59
60			delete ${$self->{include}}{$gp};
61			$self->_setstatus;
62			}
63
64			sub getexcluded {
65			my $self=shift;
66			return keys %{$self->{exclude}}
67			}
68
69			sub getincluded {
70			my $self=shift;
71			return keys %{$self->{include}}
72			}
73
74			sub opencontext {
75			my $self=shift;
76			my $gp=shift;
77
78			push @{$self->{context}}, $gp;
79			$self->_setstatus;
80			}
81
82			sub closelastcontext {
83			my $self=shift;
84
85			pop @{$self->{context}};
86			$self->_setstatus;
87			}
88
89			sub status {
90			my $self=shift;
91			return $self->{status};
92			}
93
94			# -------------- Support Routines -----------------------------------
95
96			sub _setstatus {
97			my $self=shift;
98			my $i;
99
100			$self->{status}=0; # If not on exclude or include then always false
101			foreach $i ( @{$self->{context}} ) {
102			if ( ( exists $self->{include}{$i} )
103			\|\| ( exists $self->{include}{all} ) ) {
104			$self->{status}=1;
105			}
106			if ( exists $self->{exclude}{$i} ) {
107			$self->{status}=0;
108			}
109			}
110			}