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
# clearinclude()     : clear all entries from the include list
# clearexclude()     : clear all entries from the exclude list
# ----------------------------------------------
# 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 clearinclude {
        my $self=shift;
        undef %{$self->{include}};
}
sub clearexclude {
        my $self=shift;
        undef %{$self->{exclude}};
}

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;
        my $set;

        if ( $gp=~/(.*)::/ ) {
          $set=$1;
        }
        else {
         $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}) && ($gp eq "") );
        $self->closecontext($gp);
}

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

        if ( $gp=~/(.*)::/ ) {
          $set=$1;
        }
        else {
         $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}=1; 
        foreach $i ( keys %{$self->{context}} ) {
            if ( ( exists $self->{include}{$i} )
                 || ( exists $self->{include}{all} ) ) {
                $self->{status}=( $self->{status} && 1);
            }
            if ( exists $self->{exclude}{$i} ) {
                $self->{status}=0;
            }
        }
}
Revision:	1.3
Committed:	Wed Jun 23 09:53:30 1999 UTC (25 years, 10 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_3-p4, forV1_1_0, v103_xml_071106, V1_0_3-p3, V1_0_3-p2, before110xmlBRmerge, V110p2, V110p1, V1_0_4p1, V1_0_3-p1, V1_0_3, V1_0_2, V1_0_2_p1, v102p1, V1_0_1, V1_0_0, V1_pre0, SCRAM_V1, SCRAMV1_IMPORT, V0_19_7, V0_19_6, V0_19_6p1, V0_19_5, SFATEST, V0_19_4, V0_19_4_pre3, V0_19_4_pre2, V0_19_4_pre1, V0_19_3, V0_19_2, V0_19_1, V0_19_0, V0_18_5, V0_18_4, V_18_3_TEST, VO_18_3, V0_18_2, V0_18_1, ProtoEnd
Branch point for:	v103_with_xml, v103_branch, V1_pre1, SCRAM_V1_BRANCH, V0_19_4_B, V0_9branch
Changes since 1.2:	+27 -5 lines
Log Message:	Make sure we and status with previous results
#	Content
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	# 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	package GroupChecker;
27	require 5.001;
28	require Exporter;
29	@ISA=qw(Exporter);
30
31	sub new {
32	my $class=shift;
33	$self={};
34	bless $self, $class;
35	$self->{context}{none}=1;
36	return $self;
37	}
38
39	sub clearinclude {
40	my $self=shift;
41	undef %{$self->{include}};
42	}
43	sub clearexclude {
44	my $self=shift;
45	undef %{$self->{exclude}};
46	}
47
48	sub exclude {
49	my $self=shift;
50	my $gp=shift;
51
52	${$self->{exclude}}{$gp}=1;
53	$self->_setstatus;
54	}
55
56	sub unexclude {
57	my $self=shift;
58	my $gp=shift;
59
60	delete ${$self->{exclude}}{$gp};
61	$self->_setstatus;
62	}
63
64	sub include {
65	my $self=shift;
66	my $gp=shift;
67
68	${$self->{include}}{$gp}=1;
69	$self->_setstatus;
70	}
71
72	sub uninclude {
73	my $self=shift;
74	my $gp=shift;
75
76	delete ${$self->{include}}{$gp};
77	$self->_setstatus;
78	}
79
80	sub getexcluded {
81	my $self=shift;
82	return keys %{$self->{exclude}}
83	}
84
85	sub getincluded {
86	my $self=shift;
87	return keys %{$self->{include}}
88	}
89
90	sub opencontext {
91	my $self=shift;
92	my $gp=shift;
93	my $set;
94
95	if ( $gp=~/(.*)::/ ) {
96	$set=$1;
97	}
98	else {
99	$set='none';
100	}
101
102	push @{$self->{contextstack}{$set}}, $gp;
103	$self->{context}{$gp}=1;
104	$self->_setstatus();
105	}
106
107	sub closelastcontext {
108	my $self=shift;
109	my $set=shift;
110	my $gp;
111
112	if ( $set eq "" ) { $set='none' }
113	do {
114	$gp=pop @{$self->{contextstack}{$set}};
115	} while ( (! exists $self->{context}{$gp}) && ($gp eq "") );
116	$self->closecontext($gp);
117	}
118
119	sub closecontext {
120	my $self=shift;
121	my $gp=shift;
122
123	if ( $gp=~/(.*)::/ ) {
124	$set=$1;
125	}
126	else {
127	$set='none';
128	}
129	delete $self->{context}{$gp};
130	$self->_setstatus();
131	}
132
133	sub status {
134	my $self=shift;
135	return $self->{status};
136	}
137
138	# -------------- Support Routines -----------------------------------
139
140	sub _setstatus {
141	my $self=shift;
142	my $i;
143
144	$self->{status}=1;
145	foreach $i ( keys %{$self->{context}} ) {
146	if ( ( exists $self->{include}{$i} )
147	\|\| ( exists $self->{include}{all} ) ) {
148	$self->{status}=( $self->{status} && 1);
149	}
150	if ( exists $self->{exclude}{$i} ) {
151	$self->{status}=0;
152	}
153	}
154	}