| 1 |
+ |
BEGIN |
| 2 |
+ |
{ |
| 3 |
+ |
print " ActiveDoc::Query: I AM used!!","\n"; |
| 4 |
+ |
}; |
| 5 |
+ |
|
| 6 |
+ |
|
| 7 |
|
# |
| 8 |
|
# Query.pm |
| 9 |
|
# |
| 32 |
|
# affected by lodgevalue until OK called. |
| 33 |
|
# setparam(name,value) : set the value of a given query to list |
| 34 |
|
# setifundef(name,value) : set the value of a given query to list |
| 35 |
< |
# expand(@string) : expand given strings |
| 35 |
> |
# expand(string) : expand given string |
| 36 |
|
# lodgevalue(name,val) : set a value of a given query variable to the list |
| 37 |
|
# current value will be expanded in terms of these |
| 38 |
+ |
# return (pass/fail,messageobject,new_vals_in_options) |
| 39 |
|
# OK() : set all query values to the values of the lodged |
| 40 |
|
# variables |
| 41 |
|
# cancel() : clear the values of any lodged variables |
| 42 |
|
# setparam(name,value) : hard set |
| 43 |
|
# params : return list of all parameters |
| 44 |
+ |
# runchecker(name,value) : run a query checker to analyse a value, any |
| 45 |
+ |
# return values are added to the option list |
| 46 |
|
|
| 47 |
|
package ActiveDoc::Query; |
| 48 |
|
require 5.004; |
| 69 |
|
sub querytype { |
| 70 |
|
my $self=shift; |
| 71 |
|
my $name=shift; |
| 72 |
+ |
my $rv; |
| 73 |
|
|
| 74 |
< |
@_?$self->{querytype}{$name}=shift |
| 75 |
< |
:$self->{querytype}{$name}; |
| 74 |
> |
if ( @_) { |
| 75 |
> |
$rv=shift; |
| 76 |
> |
if ( ! exists $self->{querytype}{$name} ) { |
| 77 |
> |
# store the order in which definitions are made |
| 78 |
> |
push @{$self->{queryorder}}, $name; |
| 79 |
> |
} |
| 80 |
> |
$self->{querytype}{$name}=$rv; |
| 81 |
> |
} |
| 82 |
> |
else { |
| 83 |
> |
$rv=$self->{querytype}{$name}; |
| 84 |
> |
} |
| 85 |
> |
return $rv; |
| 86 |
> |
|
| 87 |
|
} |
| 88 |
|
|
| 89 |
|
sub querycheck { |
| 98 |
|
my $self=shift; |
| 99 |
|
my $name=shift; |
| 100 |
|
|
| 101 |
< |
@_?($self->{querymessage}{$name}=shift) |
| 102 |
< |
:($self->expand($self->{querymessage}{$name})); |
| 101 |
> |
if ( @_ ) { |
| 102 |
> |
$self->{querymessage}{$name}=shift; |
| 103 |
> |
} |
| 104 |
> |
return $self->expand($self->{querymessage}{$name}); |
| 105 |
|
} |
| 106 |
|
|
| 107 |
|
sub queryprompt { |
| 111 |
|
my $rv=undef; |
| 112 |
|
if ( @_ ) { |
| 113 |
|
$self->{queryprompt}{$name}=shift; |
| 114 |
< |
$rv=$self->{queryprompt}{$name}; |
| 115 |
< |
} elsif ( defined $self->{queryprompt}{$name} ) { |
| 93 |
< |
$rv=$self->expand($self->{queryprompt}{$name}); |
| 114 |
> |
} elsif ( ! defined $self->{queryprompt}{$name} ) { |
| 115 |
> |
$self->{queryprompt}{$name}=""; |
| 116 |
|
} |
| 117 |
+ |
$rv=$self->expand($self->{queryprompt}{$name}); |
| 118 |
|
return $rv; |
| 119 |
|
} |
| 120 |
|
|
| 137 |
|
my $self=shift; |
| 138 |
|
my $string=shift; |
| 139 |
|
|
| 140 |
+ |
return "" , if ( ! defined $string ); |
| 141 |
|
$string=~s{ |
| 142 |
|
\$\((\w+)\) |
| 143 |
|
}{ |
| 176 |
|
sub lodgevalue { |
| 177 |
|
my $self=shift; |
| 178 |
|
my $name=shift; |
| 179 |
+ |
my $value=shift; |
| 180 |
+ |
|
| 181 |
+ |
# pass this parameter to the checker |
| 182 |
+ |
my ($ret,$message,@vals)=$self->runchecker($name,$value); |
| 183 |
+ |
# only lodge the value if its valid |
| 184 |
+ |
if ( $ret eq 0 ) { |
| 185 |
+ |
$self->_lodgevalue($name,$value); |
| 186 |
+ |
} |
| 187 |
+ |
return ($ret,$message,@vals); |
| 188 |
+ |
} |
| 189 |
+ |
|
| 190 |
+ |
sub _lodgevalue { |
| 191 |
+ |
my $self=shift; |
| 192 |
+ |
my $name=shift; |
| 193 |
+ |
my $value=shift; |
| 194 |
+ |
|
| 195 |
+ |
$self->{lodgehash}{$name}=$value; |
| 196 |
+ |
} |
| 197 |
|
|
| 198 |
< |
$self->{lodgehash}{$name}=shift; |
| 198 |
> |
sub runchecker { |
| 199 |
> |
my $self=shift; |
| 200 |
> |
my $name=shift; |
| 201 |
> |
my $value=shift; |
| 202 |
> |
my $ret=0; |
| 203 |
> |
my $message; |
| 204 |
> |
my @vals=(); |
| 205 |
> |
|
| 206 |
> |
if (defined $self->querycheck($name)) { |
| 207 |
> |
($ret,$message,@vals)=$self->querycheck($name)->consider($value); |
| 208 |
> |
# add any analysis options to the option list |
| 209 |
> |
if ( $#vals >= 0 ) { |
| 210 |
> |
$self->queryoptions($name,@vals); |
| 211 |
> |
} |
| 212 |
> |
} |
| 213 |
> |
return ($ret,$message,@vals); |
| 214 |
|
} |
| 215 |
|
|
| 216 |
|
sub OK { |
| 223 |
|
|
| 224 |
|
sub querylist { |
| 225 |
|
my $self=shift; |
| 226 |
< |
return ( keys %{$self->{querytype}}); |
| 226 |
> |
return @{$self->{queryorder}}; |
| 227 |
|
} |
| 228 |
|
|
| 229 |
|
sub cancel { |
| 249 |
|
my $name=shift; |
| 250 |
|
my $value=shift; |
| 251 |
|
|
| 195 |
– |
print "Setting $name = $value\n"; |
| 252 |
|
$self->{params}{$name}=$value; |
| 253 |
< |
$self->lodgevalue($name,$value); |
| 253 |
> |
$self->_lodgevalue($name,$value); |
| 254 |
|
} |
| 255 |
|
|
| 256 |
|
sub params { |
