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.2.1
Committed:	Fri Apr 7 08:08:04 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	BuildSystemProto1, V0_18_0, V0_18_0model, V0_17_1, V0_18_0alpha, V0_17_0, V0_16_4, V0_16_3, V0_16_2, V0_16_1, V0_16_0, V0_15_1, V0_15_0, V0_15_0beta, V0_14_0, V0_12_12_4, V0_12_12_3, V0_13_3, V0_13_2, V0_12_12_2, V0_12_12_1, V0_12_12_0, PlayGround_0, V0_13_1, V0_13_0, V0_12_12, V0_12_11, V0_12_9b, V0_12_10, V0_12_9, V0_12_8, V0_12_7, V0_12_6, V0_12_5, V0_12_4, V0_12_3, V0_12_2, V0_12_1, V0_12_0, V0_11_4, V0_11_3, V0_11_2, V0_11_1, V0_11_0
Branch point for:	V0_17branch, V0_16branch, V0_15branch, HPWbranch
Changes since 1.3:	+0 -0 lines
Log Message:	copy from dev
#	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	williamc	1.3	# clearinclude() : clear all entries from the include list
19			# clearexclude() : clear all entries from the exclude list
20	williamc	1.1	# ----------------------------------------------
21	williamc	1.2	# 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	williamc	1.1
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	williamc	1.2	$self->{context}{none}=1;
36	williamc	1.1	return $self;
37			}
38
39	williamc	1.3	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	williamc	1.1	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	williamc	1.3	my $set;
94	williamc	1.1
95	williamc	1.3	if ( $gp=~/(.*)::/ ) {
96			$set=$1;
97			}
98			else {
99			$set='none';
100			}
101	williamc	1.2
102			push @{$self->{contextstack}{$set}}, $gp;
103			$self->{context}{$gp}=1;
104			$self->_setstatus();
105	williamc	1.1	}
106
107			sub closelastcontext {
108			my $self=shift;
109	williamc	1.2	my $set=shift;
110			my $gp;
111
112			if ( $set eq "" ) { $set='none' }
113			do {
114			$gp=pop @{$self->{contextstack}{$set}};
115	williamc	1.3	} while ( (! exists $self->{context}{$gp}) && ($gp eq "") );
116	williamc	1.2	$self->closecontext($gp);
117			}
118	williamc	1.1
119	williamc	1.2	sub closecontext {
120			my $self=shift;
121			my $gp=shift;
122
123	williamc	1.3	if ( $gp=~/(.*)::/ ) {
124			$set=$1;
125			}
126			else {
127			$set='none';
128			}
129	williamc	1.2	delete $self->{context}{$gp};
130			$self->_setstatus();
131	williamc	1.1	}
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	williamc	1.3	$self->{status}=1;
145	williamc	1.2	foreach $i ( keys %{$self->{context}} ) {
146	williamc	1.1	if ( ( exists $self->{include}{$i} )
147			\|\| ( exists $self->{include}{all} ) ) {
148	williamc	1.3	$self->{status}=( $self->{status} && 1);
149	williamc	1.1	}
150			if ( exists $self->{exclude}{$i} ) {
151			$self->{status}=0;
152			}
153			}
154			}