src/ActiveDoc/Query.pm

#
# Query.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# Hold information request data
#
# Interface
# ---------
# new()         : A new Query object
# querylist()   : return ordered list of query names
# title()       : return/set the title text
# intro()       : return/set the intro text
# querytype(name) : return/set the input type of the named query
# querymessage(name) : return/set the message text associated with the named
#                       query
# queryprompt(name)  : return/set the prompt string for the query
# queryoptions(name) : return/set the query option list for the named query
# querycheck(name)   : return/set the query checker object
# currentvalue(name) : return the current value of the query list exapnded
#                       in the context of the other query values - affected
#                        by lodgevalue.
# getparam(name) : return the absolute value of the param (non expanded) - not
#                  affected by lodgevalue until OK called.
# setparam(name,value) : set the value of a given query to list
# setifundef(name,value) : set the value of a given query to list
# expand(string)         : expand given string
# lodgevalue(name,val)   : set a value of a given query variable to the list
#                          current value will be expanded in terms of these
#                          return (pass/fail,messageobject,new_vals_in_options)
# OK()                   : set all query values to the values of the lodged 
#                          variables
# cancel()               : clear the values of any lodged variables
# setparam(name,value)   : hard set
# params                 : return list of all parameters
# runchecker(name,value) : run a query checker to analyse a value, any
#                          return values are added to the option list

package ActiveDoc::Query;
require 5.004;

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        return $self;
}

sub title {
        my $self=shift;
        @_?$self->{title}=shift
          :((defined $self->{title})?$self->{title}:"");
}

sub intro {
        my $self=shift;
        @_?$self->{intro}=shift
          :((defined $self->{intro})?$self->{intro}:"");
}

sub querytype {
        my $self=shift;
        my $name=shift;
        my $rv;

        if ( @_) {
             $rv=shift; 
             if ( ! exists $self->{querytype}{$name} ) {
                # store the order in which definitions are made
                push @{$self->{queryorder}}, $name;
             }
             $self->{querytype}{$name}=$rv;
        }
        else {
          $rv=$self->{querytype}{$name};
        }
        return $rv;
        
}

sub querycheck {
        my $self=shift;
        my $name=shift;

        @_?$self->{querycheck}{$name}=shift
          :$self->{querycheck}{$name};
}

sub querymessage {
        my $self=shift;
        my $name=shift;

        if ( @_ ) {
          $self->{querymessage}{$name}=shift;
        }
        return  $self->expand($self->{querymessage}{$name});
}

sub queryprompt {
        my $self=shift;
        my $name=shift;

        my $rv=undef;
        if ( @_ ) {
          $self->{queryprompt}{$name}=shift;
        } elsif ( ! defined $self->{queryprompt}{$name} ) {
          $self->{queryprompt}{$name}="";
        }
        $rv=$self->expand($self->{queryprompt}{$name});
        return $rv;             
}

sub queryoptions {
        my $self=shift;
        my $name=shift;
        my @out=();

        if ( @_ ) {
          push @{$self->{queryoptions}{$name}},@_;
        }
        foreach $option ( @{$self->{queryoptions}{$name}} ) {
          push @out, $self->expand($option);
        }
        
        return @out;
}

sub expand {
        my $self=shift;
        my $string=shift;

        return "" , if ( ! defined $string );
        $string=~s{
                \$\((\w+)\)
        }{
          if (defined $self->{lodgehash}{$1}) {
                $self->expand($self->{lodgehash}{$1});
          } else {
                "\$$1";
          }
        }egx;
        $string=~s{
                \$(\w+)
        }{
          if (defined $self->{lodgehash}{$1}) {
                $self->expand($self->{lodgehash}{$1});
          } else {
                "\$$1";
          }
        }egx;
        return $string;
}

sub currentvalue {
        my $self=shift;
        my $name=shift;

        $self->expand(
          ((defined $self->{lodgehash}{$name})?$self->{lodgehash}{$name}:""));
}

sub getparam {
        my $self=shift;
        my $name=shift;
        return $self->{params}{$name};
}

sub lodgevalue {
        my $self=shift;
        my $name=shift;
        my $value=shift;

        # pass this parameter to the checker
        my ($ret,$message,@vals)=$self->runchecker($name,$value);
        # only lodge the value if its valid
        if ( $ret eq 0 ) { 
          $self->_lodgevalue($name,$value);
        }
        return ($ret,$message,@vals);
}

sub _lodgevalue {
        my $self=shift;
        my $name=shift;
        my $value=shift;

        $self->{lodgehash}{$name}=$value;
}

sub runchecker {
        my $self=shift;
        my $name=shift;
        my $value=shift;
        my $ret=0;
        my $message;
        my @vals=();

        if (defined $self->querycheck($name)) {
          ($ret,$message,@vals)=$self->querycheck($name)->consider($value);
          # add any analysis options to the option list
          if ( $#vals >= 0 ) {
           $self->queryoptions($name,@vals);
          }
        }
        return ($ret,$message,@vals);
}

sub OK {
        my $self=shift;
        
        foreach $name ( $self->querylist() ) {
          $self->setparam($name, $self->{lodgehash}{$name});
        }
}

sub querylist {
        my $self=shift;
        return @{$self->{queryorder}};
}

sub cancel {
        my $self=shift;
        
        foreach $name ( keys %{$self->{lodgehash}} ) {
          $self->{lodgehash}{$name}=$self->{params}{$name};
        }
}

sub setifundef {
        my $self=shift;
        my $name=shift;
        my $value=shift;

        if ( ! defined $self->{params}{$name} ) {
          $self->setparam($name,$value);
        }
}

sub setparam {
        my $self=shift;
        my $name=shift;
        my $value=shift;

        $self->{params}{$name}=$value;
        $self->_lodgevalue($name,$value);
}

sub params {
        my $self=shift;

        return ( keys %{$self->{params}} );
}
Revision:	1.8
Committed:	Tue Dec 4 19:24:04 2001 UTC (23 years, 5 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	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
Branch point for:	V1_pre1, SCRAM_V1_BRANCH, V0_19_4_B
Changes since 1.7:	+0 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	williamc	1.1	#
2			# Query.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			# -----------
8			# Hold information request data
9			#
10			# Interface
11			# ---------
12			# new() : A new Query object
13			# querylist() : return ordered list of query names
14			# title() : return/set the title text
15			# intro() : return/set the intro text
16			# querytype(name) : return/set the input type of the named query
17			# querymessage(name) : return/set the message text associated with the named
18			# query
19			# queryprompt(name) : return/set the prompt string for the query
20			# queryoptions(name) : return/set the query option list for the named query
21	williamc	1.3	# querycheck(name) : return/set the query checker object
22	williamc	1.1	# currentvalue(name) : return the current value of the query list exapnded
23			# in the context of the other query values - affected
24			# by lodgevalue.
25			# getparam(name) : return the absolute value of the param (non expanded) - not
26			# affected by lodgevalue until OK called.
27			# setparam(name,value) : set the value of a given query to list
28	williamc	1.2	# setifundef(name,value) : set the value of a given query to list
29	williamc	1.4	# expand(string) : expand given string
30	williamc	1.1	# lodgevalue(name,val) : set a value of a given query variable to the list
31			# current value will be expanded in terms of these
32	williamc	1.4	# return (pass/fail,messageobject,new_vals_in_options)
33	williamc	1.1	# OK() : set all query values to the values of the lodged
34			# variables
35			# cancel() : clear the values of any lodged variables
36			# setparam(name,value) : hard set
37			# params : return list of all parameters
38	williamc	1.4	# runchecker(name,value) : run a query checker to analyse a value, any
39			# return values are added to the option list
40	williamc	1.1
41			package ActiveDoc::Query;
42			require 5.004;
43
44			sub new {
45			my $class=shift;
46			$self={};
47			bless $self, $class;
48			return $self;
49			}
50
51			sub title {
52			my $self=shift;
53			@_?$self->{title}=shift
54			:((defined $self->{title})?$self->{title}:"");
55			}
56
57			sub intro {
58			my $self=shift;
59			@_?$self->{intro}=shift
60			:((defined $self->{intro})?$self->{intro}:"");
61			}
62
63			sub querytype {
64			my $self=shift;
65			my $name=shift;
66	williamc	1.4	my $rv;
67	williamc	1.1
68	williamc	1.4	if ( @_) {
69			$rv=shift;
70			if ( ! exists $self->{querytype}{$name} ) {
71			# store the order in which definitions are made
72			push @{$self->{queryorder}}, $name;
73			}
74			$self->{querytype}{$name}=$rv;
75			}
76			else {
77			$rv=$self->{querytype}{$name};
78			}
79			return $rv;
80
81	williamc	1.3	}
82
83			sub querycheck {
84			my $self=shift;
85			my $name=shift;
86
87			@_?$self->{querycheck}{$name}=shift
88			:$self->{querycheck}{$name};
89	williamc	1.1	}
90
91			sub querymessage {
92			my $self=shift;
93			my $name=shift;
94
95	williamc	1.6	if ( @_ ) {
96			$self->{querymessage}{$name}=shift;
97			}
98			return $self->expand($self->{querymessage}{$name});
99	williamc	1.1	}
100
101			sub queryprompt {
102			my $self=shift;
103			my $name=shift;
104
105			my $rv=undef;
106			if ( @_ ) {
107			$self->{queryprompt}{$name}=shift;
108	williamc	1.4	} elsif ( ! defined $self->{queryprompt}{$name} ) {
109			$self->{queryprompt}{$name}="";
110	williamc	1.1	}
111	williamc	1.4	$rv=$self->expand($self->{queryprompt}{$name});
112	williamc	1.1	return $rv;
113			}
114
115			sub queryoptions {
116			my $self=shift;
117			my $name=shift;
118			my @out=();
119
120			if ( @_ ) {
121			push @{$self->{queryoptions}{$name}},@_;
122			}
123			foreach $option ( @{$self->{queryoptions}{$name}} ) {
124			push @out, $self->expand($option);
125			}
126
127			return @out;
128			}
129
130			sub expand {
131			my $self=shift;
132			my $string=shift;
133
134	williamc	1.5	return "" , if ( ! defined $string );
135	williamc	1.1	$string=~s{
136			\$\((\w+)\)
137			}{
138			if (defined $self->{lodgehash}{$1}) {
139			$self->expand($self->{lodgehash}{$1});
140			} else {
141			"\$$1";
142			}
143			}egx;
144			$string=~s{
145			\$(\w+)
146			}{
147			if (defined $self->{lodgehash}{$1}) {
148			$self->expand($self->{lodgehash}{$1});
149			} else {
150			"\$$1";
151			}
152			}egx;
153			return $string;
154			}
155
156			sub currentvalue {
157			my $self=shift;
158			my $name=shift;
159
160			$self->expand(
161			((defined $self->{lodgehash}{$name})?$self->{lodgehash}{$name}:""));
162			}
163
164			sub getparam {
165			my $self=shift;
166			my $name=shift;
167			return $self->{params}{$name};
168			}
169
170			sub lodgevalue {
171			my $self=shift;
172			my $name=shift;
173	williamc	1.4	my $value=shift;
174
175			# pass this parameter to the checker
176			my ($ret,$message,@vals)=$self->runchecker($name,$value);
177			# only lodge the value if its valid
178			if ( $ret eq 0 ) {
179	williamc	1.7	$self->_lodgevalue($name,$value);
180	williamc	1.4	}
181			return ($ret,$message,@vals);
182			}
183	williamc	1.1
184	williamc	1.7	sub _lodgevalue {
185			my $self=shift;
186			my $name=shift;
187			my $value=shift;
188
189			$self->{lodgehash}{$name}=$value;
190			}
191
192	williamc	1.4	sub runchecker {
193			my $self=shift;
194			my $name=shift;
195			my $value=shift;
196			my $ret=0;
197			my $message;
198			my @vals=();
199
200			if (defined $self->querycheck($name)) {
201			($ret,$message,@vals)=$self->querycheck($name)->consider($value);
202			# add any analysis options to the option list
203			if ( $#vals >= 0 ) {
204			$self->queryoptions($name,@vals);
205			}
206			}
207			return ($ret,$message,@vals);
208	williamc	1.1	}
209
210			sub OK {
211			my $self=shift;
212
213			foreach $name ( $self->querylist() ) {
214			$self->setparam($name, $self->{lodgehash}{$name});
215			}
216			}
217
218			sub querylist {
219			my $self=shift;
220	williamc	1.4	return @{$self->{queryorder}};
221	williamc	1.1	}
222
223			sub cancel {
224			my $self=shift;
225
226			foreach $name ( keys %{$self->{lodgehash}} ) {
227			$self->{lodgehash}{$name}=$self->{params}{$name};
228	williamc	1.2	}
229			}
230
231			sub setifundef {
232			my $self=shift;
233			my $name=shift;
234			my $value=shift;
235
236			if ( ! defined $self->{params}{$name} ) {
237			$self->setparam($name,$value);
238	williamc	1.1	}
239			}
240
241			sub setparam {
242			my $self=shift;
243			my $name=shift;
244			my $value=shift;
245
246			$self->{params}{$name}=$value;
247	williamc	1.7	$self->_lodgevalue($name,$value);
248	williamc	1.1	}
249
250			sub params {
251			my $self=shift;
252
253			return ( keys %{$self->{params}} );
254			}