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
# closecontext(gp)   : Close group context
# closelastcontext(set) : Close the last context added to group the group set
# 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
# ----------------------------------------------
# group names are characters. Anything before a :: will indicate the 
# group set upon which the closecontext etc will operate. The group set is
# still part of the group name.
#

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

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        $self->{context}{none}=1;
        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;

        ( $gp=~/(.*)::/ ? $set=$1 : $set='none' );
        
        push @{$self->{contextstack}{$set}}, $gp;
        $self->{context}{$gp}=1;
        $self->_setstatus();
}

sub closelastcontext {
        my $self=shift;
        my $set=shift;
        my $gp;

        if ( $set eq "" ) { $set='none' } 
        do {
           $gp=pop @{$self->{contextstack}{$set}};
        } while ( ! exists $self->{context}{$gp} );
        $self->closecontext($gp);
}

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

        ( $gp=~/(.*)::/ ? $set=$1 : $set='none' );
        delete $self->{context}{$gp};
        $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 ( keys %{$self->{context}} ) {
            if ( ( exists $self->{include}{$i} )
                 || ( exists $self->{include}{all} ) ) {
                $self->{status}=1;
            }
            if ( exists $self->{exclude}{$i} ) {
                $self->{status}=0;
            }
        }
}
Revision:	1.2
Committed:	Thu Jun 10 15:41:31 1999 UTC (25 years, 11 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.1:	+29 -7 lines
Log Message:	Add a closegroupcontext method and group sets concept
#	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	williamc	1.2	# closecontext(gp) : Close group context
13			# closelastcontext(set) : Close the last context added to group the group set
14	williamc	1.1	# 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	williamc	1.2	# 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	williamc	1.1
24			package GroupChecker;
25			require 5.001;
26			require Exporter;
27			@ISA=qw(Exporter);
28
29			sub new {
30			my $class=shift;
31			$self={};
32			bless $self, $class;
33	williamc	1.2	$self->{context}{none}=1;
34	williamc	1.1	return $self;
35			}
36
37			sub exclude {
38			my $self=shift;
39			my $gp=shift;
40
41			${$self->{exclude}}{$gp}=1;
42			$self->_setstatus;
43			}
44
45			sub unexclude {
46			my $self=shift;
47			my $gp=shift;
48
49			delete ${$self->{exclude}}{$gp};
50			$self->_setstatus;
51			}
52
53			sub include {
54			my $self=shift;
55			my $gp=shift;
56
57			${$self->{include}}{$gp}=1;
58			$self->_setstatus;
59			}
60
61			sub uninclude {
62			my $self=shift;
63			my $gp=shift;
64
65			delete ${$self->{include}}{$gp};
66			$self->_setstatus;
67			}
68
69			sub getexcluded {
70			my $self=shift;
71			return keys %{$self->{exclude}}
72			}
73
74			sub getincluded {
75			my $self=shift;
76			return keys %{$self->{include}}
77			}
78
79			sub opencontext {
80			my $self=shift;
81			my $gp=shift;
82
83	williamc	1.2	( $gp=~/(.*)::/ ? $set=$1 : $set='none' );
84
85			push @{$self->{contextstack}{$set}}, $gp;
86			$self->{context}{$gp}=1;
87			$self->_setstatus();
88	williamc	1.1	}
89
90			sub closelastcontext {
91			my $self=shift;
92	williamc	1.2	my $set=shift;
93			my $gp;
94
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	williamc	1.1
102	williamc	1.2	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	williamc	1.1	}
110
111			sub status {
112			my $self=shift;
113			return $self->{status};
114			}
115
116			# -------------- Support Routines -----------------------------------
117
118			sub _setstatus {
119			my $self=shift;
120			my $i;
121
122			$self->{status}=0; # If not on exclude or include then always false
123	williamc	1.2	foreach $i ( keys %{$self->{context}} ) {
124	williamc	1.1	if ( ( exists $self->{include}{$i} )
125			\|\| ( exists $self->{include}{all} ) ) {
126			$self->{status}=1;
127			}
128			if ( exists $self->{exclude}{$i} ) {
129			$self->{status}=0;
130			}
131			}
132			}