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;

        $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.4
Committed:	Thu Jan 6 13:21:55 2000 UTC (25 years, 4 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.3:	+48 -8 lines
Log Message:	Keep Query order Info
#	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			$string=~s{
133			\$\((\w+)\)
134			}{
135			if (defined $self->{lodgehash}{$1}) {
136			$self->expand($self->{lodgehash}{$1});
137			} else {
138			"\$$1";
139			}
140			}egx;
141			$string=~s{
142			\$(\w+)
143			}{
144			if (defined $self->{lodgehash}{$1}) {
145			$self->expand($self->{lodgehash}{$1});
146			} else {
147			"\$$1";
148			}
149			}egx;
150			return $string;
151			}
152
153			sub currentvalue {
154			my $self=shift;
155			my $name=shift;
156
157			$self->expand(
158			((defined $self->{lodgehash}{$name})?$self->{lodgehash}{$name}:""));
159			}
160
161			sub getparam {
162			my $self=shift;
163			my $name=shift;
164			return $self->{params}{$name};
165			}
166
167			sub lodgevalue {
168			my $self=shift;
169			my $name=shift;
170	williamc	1.4	my $value=shift;
171
172			# pass this parameter to the checker
173			my ($ret,$message,@vals)=$self->runchecker($name,$value);
174			# only lodge the value if its valid
175			if ( $ret eq 0 ) {
176			$self->{lodgehash}{$name}=$value;
177			}
178			return ($ret,$message,@vals);
179			}
180	williamc	1.1
181	williamc	1.4	sub runchecker {
182			my $self=shift;
183			my $name=shift;
184			my $value=shift;
185			my $ret=0;
186			my $message;
187			my @vals=();
188
189			if (defined $self->querycheck($name)) {
190			($ret,$message,@vals)=$self->querycheck($name)->consider($value);
191			# add any analysis options to the option list
192			if ( $#vals >= 0 ) {
193			$self->queryoptions($name,@vals);
194			}
195			}
196			return ($ret,$message,@vals);
197	williamc	1.1	}
198
199			sub OK {
200			my $self=shift;
201
202			foreach $name ( $self->querylist() ) {
203			$self->setparam($name, $self->{lodgehash}{$name});
204			}
205			}
206
207			sub querylist {
208			my $self=shift;
209	williamc	1.4	return @{$self->{queryorder}};
210	williamc	1.1	}
211
212			sub cancel {
213			my $self=shift;
214
215			foreach $name ( keys %{$self->{lodgehash}} ) {
216			$self->{lodgehash}{$name}=$self->{params}{$name};
217	williamc	1.2	}
218			}
219
220			sub setifundef {
221			my $self=shift;
222			my $name=shift;
223			my $value=shift;
224
225			if ( ! defined $self->{params}{$name} ) {
226			$self->setparam($name,$value);
227	williamc	1.1	}
228			}
229
230			sub setparam {
231			my $self=shift;
232			my $name=shift;
233			my $value=shift;
234
235			print "Setting $name = $value\n";
236			$self->{params}{$name}=$value;
237			$self->lodgevalue($name,$value);
238			}
239
240			sub params {
241			my $self=shift;
242
243			return ( keys %{$self->{params}} );
244			}