File Coverage

blib/lib/HTML/DBForm/Search/DropDown.pm

Criterion	Covered	Total	%
statement	12	92	13.0
branch	0	34	0.0
condition	0	2	0.0
subroutine	4	13	30.7
pod	2	10	20.0
total	18	151	11.9

line	stmt	bran	cond	sub	pod	time	code
1							package HTML::DBForm::Search::DropDown;
2
3	1			1		1030	use strict;
	1					3
	1					45
4	1			1		6	use warnings;
	1					3
	1					51
5	1			1		5	no warnings 'uninitialized';
	1					2
	1					1403
6
7							our $VERSION = '1.05';
8
9							=head1 NAME
10
11							HTML::DBForm::Search::DropDown - Creates a web interface for searching database tables
12
13							=head1 SYNOPSIS
14
15							$search = HTML::DBForm::Search->new('dropdown', { column => 'name' });
16
17							$editor->run(search => $search);
18
19
20							=head1 INTRODUCTION
21
22							HTML::DBForm::Search::DropDown provides a web interface to search for rows
23							in a database to be updated by HTML::DBForm.
24
25							=cut
26
27							=head1 METHODS
28
29							=over 4
30
31							=cut
32
33
34							=head2 new
35
36							Constructor inherited from HTML::DBForm::Search
37
38							takes a scalar indicating the type of search module
39							to create (in this case 'dropdown'), and a list of
40							hash refs designating which columns to display as HTML
41							select form elements, and in which order.
42
43							Each hash should have one of the following keys:
44							'column', 'columns', or 'sql'. 'column' should be the db
45							column to search, 'columns' should be two db columns, the
46							first of which will be the column to search, and the second of
47							which will be the values to display as option labels. 'sql'
48							can be used to populate the select options with an arbitrary SQL
49							statement. If one column is returned from the SQL statement, then
50							it will be used as choice values and lables. If two columns are
51							returned, then the first will be the specified column value, while
52							the second will be used as option labels.
53
54
55							B
56
57							$search = HTML::DBForm::Search->new('dropdown',
58							{ column => 'category' },
59							{ columns => ['id', ' CONCAT(fname, ' ', lname) '] }
60							);
61
62
63
64							This would create a two step search, the first screen would be a
65							selection of existing categories, and the next screen would be a
66							selection of names within the chosen categories. When picking
67							columns to display in the search, be aware that the final choice
68							should result in the primary key being chosen.
69
70
71							B
72
73							$search = HTML::DBForm::Search->new('dropdown',
74							{ sql => ['id','SELECT id, label FROM table ORDER BY label'] }
75							);
76
77							This would create a simple one step search.
78
79							You can use as many hashrefs as needed, each one will generate
80							a new search step, (e.g three hash references will create a three
81							step search). Just keep in mind that the last column chosen must be
82							the column given to DBForm->new() as a primary key.
83
84
85
86							=cut
87
88
89							# implementation of this method is required
90							# constructor inherited from Class::Factory
91							# via HTML::DBForm::Search
92
93							sub init {
94
95	1			1	0	25	my $self = shift;
96	1					10	$self->{params} = \@_;
97
98	1					5	return $self;
99							}
100
101
102
103
104							# implementation of this method is required
105							# main subroutine called by HTML::DBForm
106
107							sub run {
108
109	0			0	0		my ($self, $editor) = @_;
110
111							my $tmpl_ref = $self->{'tmpl_file'}
112	0	0					? do { open(FH, "< $self->{'tmpl_file'}"); local $/; }
	0
	0
	0
113							: &TEMPLATE;
114
115
116	0						$self->{template} = HTML::Template->new(
117							scalarref => \$tmpl_ref,
118							die_on_bad_params => 0,
119							loop_context_vars => 1,
120							);
121
122
123	0						$self->{editor} = $editor;
124
125							# find out what step we are on
126	0		0				$self->{step} = $self->{editor}->{query}->param('step') \|\| 0;
127
128	0						$self->{template}->param(STEP => $self->{step} + 1);
129
130	0						$self->get_choices;
131
132	0	0					return ($self->{editor}->{error}) ?
133							$self->{editor}->{template}->output :
134							$self->{template}->output ;
135
136							}
137
138
139
140							=head2 set_stylesheet
141
142							Sets an optional css file
143
144							Takes a scalar holding the path to a stylesheet.
145
146
147							B
148
149							$search->set_stylesheet('/styles/site_styles.css');
150
151							=cut
152
153							sub set_stylesheet {
154
155	0			0	1		my $self = shift;
156	0						$self->{css} = shift ;
157							}
158
159
160
161							=head2 set_template
162
163							Sets an optional template file
164
165							Takes a scalar holding the path to an HTML::Template template.
166
167							To get a template file to start with, you can do this:
168							perl -MHTML::DBForm::Search::DropDown -e 'print
169							HTML::DBForm::Search::DropDown::TEMPLATE()' > sample.tmpl
170
171							B
172
173							$search->set_template('/www/templates/my.tmpl');
174
175							=cut
176
177							sub set_template {
178
179	0			0	1		my $self = shift;
180	0						$self->{tmpl_file} = shift ;
181							}
182
183
184
185
186							# get choices to display
187
188							sub get_choices {
189
190	0			0	0		my $self = shift;
191
192	0	0					if ($self->{params}->[$self->{step}]->{sql}){
193
194							# use sql parameter
195	0						$self->populate_search(
196							$self->{params}->[$self->{step}]->{sql}->[1]
197							);
198
199							} else {
200
201							# generate our own sql
202	0						$self->populate_search(
203							$self->get_select($self->parse_params($self->{step}))
204							);
205							}
206							}
207
208
209
210							# parse search parameters
211
212							sub parse_params {
213
214	0			0	0		my $self = shift;
215	0						my $i = shift;
216
217	0						my $c_param = $self->{params}->[$i];
218
219	0	0					if ($c_param->{column}){
220	0						return ($c_param->{column}, $c_param->{column});
221							}
222
223	0	0					if ($c_param->{columns}) {
224	0						return ($c_param->{columns}->[0], $c_param->{columns}->[1]);
225							}
226
227	0	0					if ($c_param->{sql}) {
228	0						return ($c_param->{sql}->[0], $c_param->{sql}->[1]);
229							}
230							}
231
232
233
234							# build a select statement
235
236							sub get_select {
237
238	0			0	0		my $self = shift;
239	0						my ($col1, $col2) = @_;
240
241
242	0						my $sql = qq( SELECT DISTINCT $col1, $col2
243							FROM $self->{editor}->{table}
244							);
245
246	0	0					return $sql.' ORDER BY '.$col2 unless $self->{step};
247
248	0						my (@values, $i);
249
250	0						for my $step(0 .. $self->{step}-1){
251
252	0	0					$sql .= ' WHERE ' unless $i++;
253	0						$sql .= ($self->parse_params($step))[0] ." = ?";
254	0	0					$sql .= ' AND ' unless $step >= $self->{step}-1;
255
256	0						push @values,
257							$self->{editor}->{query}->param(($self->parse_params($step))[0]);
258							}
259
260	0						$sql .= ' ORDER BY '. $col2;
261
262
263							# the sql is the first element
264							# the rest of the array is
265							# filled with placeholder vals
266
267	0						unshift @values, $sql;
268	0						return @values;
269
270							}
271
272
273
274							# populate search choices
275
276							sub populate_search {
277
278	0			0	0		my $self = shift;
279	0						my ($sql, @params) = @_;
280	0						my (@tmpl_loop, $db_return);
281
282	0	0					eval{
283	0						$db_return = $self->{editor}->{dbh}->selectall_arrayref($sql, undef, @params);
284	0						1 } or $self->{editor}->_err_msg($@, $sql);
285
286							# workaround for servers that lack
287							# subqueries ( e.g mysql < 4.1 )
288
289	0	0					if ($self->{params}->[$self->{step}]->{sql}){
290	0						$db_return = $self->constrain_results($db_return);
291							};
292
293
294	0						for my $row_ref(@$db_return){
295	0						my %row = (
296							VALUE => $row_ref->[0],
297							LABEL => $row_ref->[1],
298							);
299	0						push(@tmpl_loop, \%row);
300							}
301
302
303							# keep track of old choices
304	0						my @prev_vals;
305	0						for my $step(0 .. $self->{step}-1){
306	0						my %row;
307	0						$row{LABEL} = ($self->parse_params($step))[0];
308	0						$row{VALUE} = $self->{editor}->{query}->param(($self->parse_params($step))[0]);
309	0						push @prev_vals, \%row;
310							}
311
312
313							# is this the last step?
314	0	0					my $rm = (($self->{step} +1 ) >= scalar(@{$self->{params}})) ? 'display' :'';
	0
315
316
317							# is it the first?
318	0	0					my $cancel = ($self->{step} > 0) ? 1 : 0;
319
320
321	0						$self->{template}->param( SEARCH_LOOP => \@tmpl_loop,
322							FORM => 1,
323							SELECT_NAME => ($self->parse_params($self->{step}))[0],
324							RUN_MODE => $rm,
325							CANCEL => $cancel,
326							PREV_VALS => \@prev_vals,
327							CUSTOM_CSS => $self->{css},
328							);
329							}
330
331
332
333							# discard extra sql returns
334
335							sub constrain_results {
336
337							# this would be much cleaner
338							# but less portable using subqueries
339							# instead of two seperate queries
340
341	0			0	0		my ($self, $list) = @_;
342
343							# get a list of all results
344							# based on previous selections
345	0						my $editor = $self->{editor};
346
347	0						my $sql = qq( SELECT DISTINCT
348							$self->{params}->[$self->{step}]->{sql}->[0]
349							FROM $editor->{table}
350							);
351
352	0						my (@values, $i, @results);
353
354	0						for my $step(0 .. $self->{step}-2){
355
356	0	0					$sql .= ' WHERE ' unless $i++;
357	0						$sql .= ($self->parse_params($step))[0] ." = ?";
358	0	0					$sql .= ' AND ' unless $step >= $self->{step}-2;
359
360	0						push @values,
361							$editor->{query}->param(($self->parse_params($step))[0]);
362							}
363
364	0						my $selections;
365
366
367	0	0					eval{
368	0						$selections =
369	0						$editor->{dbh}->selectcol_arrayref($sql, undef, @values); 1
370							} or $editor->_err_msg($@, $sql);
371
372	0						for my $lr(@$list){
373	0	0					push (@results, $lr) if grep{/^$lr->[0]$/} @$selections;
	0
374							}
375
376	0						return \@results;
377							}
378
379
380
381
382							sub TEMPLATE {
383
384	0			0	0		qq(
385
386
387
388
389
390
428
429
430
431
432
433
434
435
436
437
438							Edit or Create a Record:
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465							onclick='document.location="javascript:history.go(-1)"'
466							style="width:80;">
467
468
469
470							onclick='document.location="?rm=display"'
471							style="width:80;">
472
473
474
475
476
477							);
478							}
479
480
481							1;