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 ( %{$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 $key\n";
          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.4
Committed:	Mon Oct 25 15:09:21 1999 UTC (25 years, 6 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.3:	+63 -1 lines
Log Message:	Add restore and store persistency methods
#	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			foreach $key ( %{$self->{params}} ) {
46			if ( $key=~/$string/ ) {
47			print $fh "k:".$key."\n";
48			print $fh "v:".$$self->{params}{$key}."\n";
49			}
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 $key\n";
61			print $fh "k:".$key."\n";
62			print $fh "v:".$self->{params}{$key}."\n";
63			}
64			print $fh "#End\n";
65			}
66
67			sub restore {
68			my $self=shift;
69			my $fh=shift;
70
71			my $check="k:";
72			my $key="";
73			while ( $line=<$fh> ) {
74			chomp $line;
75			last if ( $line eq "\#End" );
76			if ( $line!~/^$check/ ) {
77			die "Data Corruption Error when restoring $self\n";
78			}
79			if ( $check eq "k:" ) {
80			$check="v:";
81			($key=$line)=~s/k://;
82			}
83			else {
84			$check="k:";
85			($value=$line)=~s/v://;
86			$self->setparam($key,$value);
87			}
88			} #end while
89			}
90
91	williamc	1.1	sub setparam {
92			my $self=shift;
93			my $name=shift;
94			my $value=shift;
95
96	williamc	1.4	print "Setting $name = $value\n";
97	williamc	1.1	$self->{params}{$name}=$value;
98	williamc	1.4	}
99
100			sub params {
101			my $self=shift;
102
103			return ( keys %{$self->{params}} );
104	williamc	1.2	}
105
106			sub setifundef {
107			my $self=shift;
108			my $name=shift;
109			my $value=shift;
110
111			if ( ! defined $self->getparam($name) ) {
112			$self->setparam($name, $value);
113			}
114	williamc	1.1	}
115
116			sub getparam {
117			my $self=shift;
118			my $name=shift;
119			return $self->{params}{$name};
120			}
121
122			sub clearquery {
123			my $self=shift;
124			undef %self->{querytype};
125			undef %self->{queryvars};
126			undef @{$self->{queries}};
127			undef %{$self->{queryformat}};
128			}
129
130			sub setquery {
131			my $self=shift;
132			my $type=shift;
133			my $name=shift;
134			my $string=shift;
135			my @vars=@_;
136
137			push @{$self->{queries}},$name;
138			$self->{querytype}{$name}=$type;
139			$self->{querystring}{$name}=$string;
140			for ( $i=0; $i<=$#vars; $i++ ) {
141			$self->{queryvars}{$name}[$i]=$vars[$i];
142			}
143			}
144
145	williamc	1.3	sub querycheck {
146			my $self=shift;
147			my $name=shift;
148			my $check=shift;
149
150			$self->{querycheck}{$name}=$check;
151			}
152
153			sub addquerymessage {
154			my $self=shift;
155			my $name=shift;
156			my $string=shift;
157			$self->{querystring}{$name}=$self->{querystring}{$name}.$string;
158			}
159
160	williamc	1.1	sub formatquery {
161			my $self=shift;
162
163			my $name=$self->{queries}[$#$self->{queries}];
164			$self->{queryformat}{$name}= @_;
165			}
166
167			sub askuser {
168			my $self=shift;
169			my $string=shift;
170
171	williamc	1.3	$self->{UserInterface}->startform($string);
172	williamc	1.1	foreach $query ( @{$self->{queries}} ) {
173	williamc	1.3	my @rqargs=($self->{querytype}{$query}, $query,
174			$self->{querystring}{$query},
175			$self->{queryvars}{$query}, $self->{queryformat}{$query});
176			if ( exists $self->{querycheck}{$query} ) {
177			$self->{UserInterface}->runcheckedquery(
178			$self->{querycheck}{$query}, @rqargs);
179			}
180			else {
181			$self->{UserInterface}->runquery(@rqargs);
182			}
183	williamc	1.1	}
184			$self->{UserInterface}->endform($self);
185			}
186
187			sub interface {
188			my $self=shift;
189			return $self->{UserInterface};
190			}