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;

        @_?($self->{querymessage}{$name}=shift)
          :($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->{lodgehash}{$name}=$value;
        }
        return ($ret,$message,@vals);
}

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;

        print "Setting $name = $value\n";
        $self->{params}{$name}=$value;
        $self->lodgevalue($name,$value);
}

sub params {
        my $self=shift;

        return ( keys %{$self->{params}} );
}
Revision:	1.5
Committed:	Fri Jan 14 18:54:09 2000 UTC (25 years, 3 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.4:	+1 -0 lines
Log Message:	Add empty return val if undefined
#	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			@_?($self->{querymessage}{$name}=shift)
96			:($self->expand($self->{querymessage}{$name}));
97			}
98
99			sub queryprompt {
100			my $self=shift;
101			my $name=shift;
102
103			my $rv=undef;
104			if ( @_ ) {
105			$self->{queryprompt}{$name}=shift;
106	williamc	1.4	} elsif ( ! defined $self->{queryprompt}{$name} ) {
107			$self->{queryprompt}{$name}="";
108	williamc	1.1	}
109	williamc	1.4	$rv=$self->expand($self->{queryprompt}{$name});
110	williamc	1.1	return $rv;
111			}
112
113			sub queryoptions {
114			my $self=shift;
115			my $name=shift;
116			my @out=();
117
118			if ( @_ ) {
119			push @{$self->{queryoptions}{$name}},@_;
120			}
121			foreach $option ( @{$self->{queryoptions}{$name}} ) {
122			push @out, $self->expand($option);
123			}
124
125			return @out;
126			}
127
128			sub expand {
129			my $self=shift;
130			my $string=shift;
131
132	williamc	1.5	return "" , if ( ! defined $string );
133	williamc	1.1	$string=~s{
134			\$\((\w+)\)
135			}{
136			if (defined $self->{lodgehash}{$1}) {
137			$self->expand($self->{lodgehash}{$1});
138			} else {
139			"\$$1";
140			}
141			}egx;
142			$string=~s{
143			\$(\w+)
144			}{
145			if (defined $self->{lodgehash}{$1}) {
146			$self->expand($self->{lodgehash}{$1});
147			} else {
148			"\$$1";
149			}
150			}egx;
151			return $string;
152			}
153
154			sub currentvalue {
155			my $self=shift;
156			my $name=shift;
157
158			$self->expand(
159			((defined $self->{lodgehash}{$name})?$self->{lodgehash}{$name}:""));
160			}
161
162			sub getparam {
163			my $self=shift;
164			my $name=shift;
165			return $self->{params}{$name};
166			}
167
168			sub lodgevalue {
169			my $self=shift;
170			my $name=shift;
171	williamc	1.4	my $value=shift;
172
173			# pass this parameter to the checker
174			my ($ret,$message,@vals)=$self->runchecker($name,$value);
175			# only lodge the value if its valid
176			if ( $ret eq 0 ) {
177			$self->{lodgehash}{$name}=$value;
178			}
179			return ($ret,$message,@vals);
180			}
181	williamc	1.1
182	williamc	1.4	sub runchecker {
183			my $self=shift;
184			my $name=shift;
185			my $value=shift;
186			my $ret=0;
187			my $message;
188			my @vals=();
189
190			if (defined $self->querycheck($name)) {
191			($ret,$message,@vals)=$self->querycheck($name)->consider($value);
192			# add any analysis options to the option list
193			if ( $#vals >= 0 ) {
194			$self->queryoptions($name,@vals);
195			}
196			}
197			return ($ret,$message,@vals);
198	williamc	1.1	}
199
200			sub OK {
201			my $self=shift;
202
203			foreach $name ( $self->querylist() ) {
204			$self->setparam($name, $self->{lodgehash}{$name});
205			}
206			}
207
208			sub querylist {
209			my $self=shift;
210	williamc	1.4	return @{$self->{queryorder}};
211	williamc	1.1	}
212
213			sub cancel {
214			my $self=shift;
215
216			foreach $name ( keys %{$self->{lodgehash}} ) {
217			$self->{lodgehash}{$name}=$self->{params}{$name};
218	williamc	1.2	}
219			}
220
221			sub setifundef {
222			my $self=shift;
223			my $name=shift;
224			my $value=shift;
225
226			if ( ! defined $self->{params}{$name} ) {
227			$self->setparam($name,$value);
228	williamc	1.1	}
229			}
230
231			sub setparam {
232			my $self=shift;
233			my $name=shift;
234			my $value=shift;
235
236			print "Setting $name = $value\n";
237			$self->{params}{$name}=$value;
238			$self->lodgevalue($name,$value);
239			}
240
241			sub params {
242			my $self=shift;
243
244			return ( keys %{$self->{params}} );
245			}