src/ActiveDoc/UserQuery.pm

#
#  UserQuery
#
#  Set up and record Queries requested from the user
#
# Interface
# ---------
# new(UserInterface)    : A new query object with a specific interface
# dump(fh,expr)         : dump out parameters that match expr to filehandle
# store(fh)             : dump every param to fh
# restore(fh)           : restore from filehandle
# params()              : return list of all params
# setparam(name,value)  : set a parameter 
# setifundef(name,value) : only set param to value if undefined
# getparam(name)        : return value of named parameter
# getexpandedparam(name) : return the value of the parameter with any
#                          variables expanded in the context of the UserQuery
#                          variables
# clearquery()          : remove all queries to be asked
# setquery($type,$parameter,$string,@args) : register a query of type for 
#                                               $parameter
# querycheck(name, checkobject) : Set a checksum to be made on each query 
# addquerymessage(name,string) : Add an extra message to the query for name
# askuser()             : Ask user registered queries
# formatquery(args)     : apply formatting information for display
#                                 of the query . args dependent on implemtation
#                                 query type etc.
# interface()           : Return the interface object for the query

package ActiveDoc::UserQuery;
require 5.001;

sub new {
        my $class=shift;
        my $interface=shift;
        $self={};
        bless $self, $class;
        $self->{params}={};
        $self->{UserInterface}=$interface;
        return $self;
}

sub dump {
        my $self=shift;
        my $fh=shift;
        my $string=shift;

        foreach $key ( keys %{$self->{params}} ) {
          if ( $key=~/$string/ ) {
                print $fh "k:".$key."\n";
                print $fh "v:".$self->{params}{$key}."\n";
          }
        }
        print $fh "#End\n";
}

sub store {
        my $self=shift;
        my $fh=shift;

        my $key;
        foreach $key ( keys %{$self->{params}} ) {
          print $fh "k:".$key."\n";
          print $fh "v:".$self->{params}{$key}."\n";
        }
        print $fh "#End\n";
}

sub restore {
        my $self=shift;
        my $fh=shift;

        my $check="k:";
        my $key="";
        while ( $line=<$fh> ) {
          chomp $line;
          last if ( $line eq "\#End" );
          if ( $line!~/^$check/ ) {
                die "Data Corruption Error when restoring $self\n"; 
          }
          if ( $check eq "k:" ) {
                $check="v:";
                ($key=$line)=~s/k://;
          }
          else {
                $check="k:";
                ($value=$line)=~s/v://;
                $self->setparam($key,$value);
          }
        } #end while
}

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

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

sub params {
        my $self=shift;
        return ( keys %{$self->{params}} );
}

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

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

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

sub getexpandedparam {
        my $self=shift;
        my $name=shift;
        
        my $string=$self->getparam($name);
        $string=~s/\$\((.*?)\)/$self->{paramhash}{$1}/g;
        $string=~s/\$(.*?)( |\/|\Z)/$self->{paramhash}{$1}$2/g;

        return $string;
}

sub clearquery {
        my $self=shift;
        undef %self->{querytype};
        undef %self->{queryvars};
        undef @{$self->{queries}}; 
        undef %{$self->{queryformat}};
}

sub setquery {
        my $self=shift;
        my $type=shift;
        my $name=shift;
        my $string=shift;
        my @vars=@_;

        push @{$self->{queries}},$name;
        $self->{querytype}{$name}=$type;
        $self->{querystring}{$name}=$string;
        for ( $i=0; $i<=$#vars; $i++ ) {
          $self->{queryvars}{$name}[$i]=$vars[$i];
        }
}

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

        $self->{querycheck}{$name}=$check;
}

sub addquerymessage {
        my $self=shift;
        my $name=shift;
        my $string=shift;
        $self->{querystring}{$name}=$self->{querystring}{$name}.$string;        
}

sub formatquery {
        my $self=shift;

        my $name=$self->{queries}[$#$self->{queries}];
        $self->{queryformat}{$name}= @_;
}

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

        $self->{UserInterface}->startform($string);
        foreach $query ( @{$self->{queries}} ) {
          my @rqargs=($self->{querytype}{$query}, $query, 
                $self->{querystring}{$query},
                $self->{queryvars}{$query}, $self->{queryformat}{$query});
          if ( exists $self->{querycheck}{$query} ) {
             $self->{UserInterface}->runcheckedquery(  
                                $self->{querycheck}{$query}, @rqargs);
          } 
          else {
             $self->{UserInterface}->runquery(@rqargs);
          }
        }
        $self->{UserInterface}->endform($self);
}

sub interface {
        my $self=shift;
        return $self->{UserInterface};
}
Revision:	1.6
Committed:	Fri Dec 17 08:36:23 1999 UTC (25 years, 5 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
CVS Tags:	ProtoEnd
Changes since 1.5:	+14 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	williamc	1.1	#
2			# UserQuery
3			#
4	williamc	1.4	# Set up and record Queries requested from the user
5	williamc	1.1	#
6			# Interface
7			# ---------
8			# new(UserInterface) : A new query object with a specific interface
9	williamc	1.4	# dump(fh,expr) : dump out parameters that match expr to filehandle
10			# store(fh) : dump every param to fh
11			# restore(fh) : restore from filehandle
12			# params() : return list of all params
13	williamc	1.1	# setparam(name,value) : set a parameter
14	williamc	1.2	# setifundef(name,value) : only set param to value if undefined
15	williamc	1.1	# getparam(name) : return value of named parameter
16	williamc	1.6	# getexpandedparam(name) : return the value of the parameter with any
17			# variables expanded in the context of the UserQuery
18			# variables
19	williamc	1.1	# clearquery() : remove all queries to be asked
20	williamc	1.3	# setquery($type,$parameter,$string,@args) : register a query of type for
21			# $parameter
22			# querycheck(name, checkobject) : Set a checksum to be made on each query
23			# addquerymessage(name,string) : Add an extra message to the query for name
24	williamc	1.1	# askuser() : Ask user registered queries
25			# formatquery(args) : apply formatting information for display
26			# of the query . args dependent on implemtation
27			# query type etc.
28			# interface() : Return the interface object for the query
29
30			package ActiveDoc::UserQuery;
31			require 5.001;
32
33			sub new {
34			my $class=shift;
35			my $interface=shift;
36			$self={};
37			bless $self, $class;
38			$self->{params}={};
39			$self->{UserInterface}=$interface;
40			return $self;
41			}
42
43	williamc	1.4	sub dump {
44			my $self=shift;
45			my $fh=shift;
46			my $string=shift;
47
48	williamc	1.5	foreach $key ( keys %{$self->{params}} ) {
49	williamc	1.4	if ( $key=~/$string/ ) {
50			print $fh "k:".$key."\n";
51	williamc	1.5	print $fh "v:".$self->{params}{$key}."\n";
52	williamc	1.4	}
53			}
54			print $fh "#End\n";
55			}
56
57			sub store {
58			my $self=shift;
59			my $fh=shift;
60
61			my $key;
62			foreach $key ( keys %{$self->{params}} ) {
63			print $fh "k:".$key."\n";
64			print $fh "v:".$self->{params}{$key}."\n";
65			}
66			print $fh "#End\n";
67			}
68
69			sub restore {
70			my $self=shift;
71			my $fh=shift;
72
73			my $check="k:";
74			my $key="";
75			while ( $line=<$fh> ) {
76			chomp $line;
77			last if ( $line eq "\#End" );
78			if ( $line!~/^$check/ ) {
79			die "Data Corruption Error when restoring $self\n";
80			}
81			if ( $check eq "k:" ) {
82			$check="v:";
83			($key=$line)=~s/k://;
84			}
85			else {
86			$check="k:";
87			($value=$line)=~s/v://;
88			$self->setparam($key,$value);
89			}
90			} #end while
91			}
92
93	williamc	1.1	sub setparam {
94			my $self=shift;
95			my $name=shift;
96			my $value=shift;
97
98	williamc	1.4	print "Setting $name = $value\n";
99	williamc	1.1	$self->{params}{$name}=$value;
100	williamc	1.4	}
101
102			sub params {
103			my $self=shift;
104			return ( keys %{$self->{params}} );
105	williamc	1.2	}
106
107			sub setifundef {
108			my $self=shift;
109			my $name=shift;
110			my $value=shift;
111
112			if ( ! defined $self->getparam($name) ) {
113			$self->setparam($name, $value);
114			}
115	williamc	1.1	}
116
117			sub getparam {
118			my $self=shift;
119			my $name=shift;
120			return $self->{params}{$name};
121			}
122	williamc	1.6
123			sub getexpandedparam {
124			my $self=shift;
125			my $name=shift;
126
127			my $string=$self->getparam($name);
128			$string=~s/\$\((.*?)\)/$self->{paramhash}{$1}/g;
129			$string=~s/\$(.*?)( \|\/\|\Z)/$self->{paramhash}{$1}$2/g;
130
131			return $string;
132			}
133	williamc	1.1
134			sub clearquery {
135			my $self=shift;
136			undef %self->{querytype};
137			undef %self->{queryvars};
138			undef @{$self->{queries}};
139			undef %{$self->{queryformat}};
140			}
141
142			sub setquery {
143			my $self=shift;
144			my $type=shift;
145			my $name=shift;
146			my $string=shift;
147			my @vars=@_;
148
149			push @{$self->{queries}},$name;
150			$self->{querytype}{$name}=$type;
151			$self->{querystring}{$name}=$string;
152			for ( $i=0; $i<=$#vars; $i++ ) {
153			$self->{queryvars}{$name}[$i]=$vars[$i];
154			}
155			}
156
157	williamc	1.3	sub querycheck {
158			my $self=shift;
159			my $name=shift;
160			my $check=shift;
161
162			$self->{querycheck}{$name}=$check;
163			}
164
165			sub addquerymessage {
166			my $self=shift;
167			my $name=shift;
168			my $string=shift;
169			$self->{querystring}{$name}=$self->{querystring}{$name}.$string;
170			}
171
172	williamc	1.1	sub formatquery {
173			my $self=shift;
174
175			my $name=$self->{queries}[$#$self->{queries}];
176			$self->{queryformat}{$name}= @_;
177			}
178
179			sub askuser {
180			my $self=shift;
181			my $string=shift;
182
183	williamc	1.3	$self->{UserInterface}->startform($string);
184	williamc	1.1	foreach $query ( @{$self->{queries}} ) {
185	williamc	1.3	my @rqargs=($self->{querytype}{$query}, $query,
186			$self->{querystring}{$query},
187			$self->{queryvars}{$query}, $self->{queryformat}{$query});
188			if ( exists $self->{querycheck}{$query} ) {
189			$self->{UserInterface}->runcheckedquery(
190			$self->{querycheck}{$query}, @rqargs);
191			}
192			else {
193			$self->{UserInterface}->runquery(@rqargs);
194			}
195	williamc	1.1	}
196			$self->{UserInterface}->endform($self);
197			}
198
199			sub interface {
200			my $self=shift;
201			return $self->{UserInterface};
202			}