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