File Coverage

lib/CGI/OptimalQuery/InteractiveFilter.pm
Criterion Covered Total %
statement 21 236 8.9
branch 0 108 0.0
condition 0 33 0.0
subroutine 7 19 36.8
pod 0 12 0.0
total 28 408 6.8


line stmt bran cond sub pod time code
1             package CGI::OptimalQuery::InteractiveFilter;
2              
3 1     1   908 use strict;
  1         12  
  1         25  
4 1     1   4 use warnings;
  1         2  
  1         23  
5 1     1   4 no warnings qw( uninitialized );
  1         2  
  1         24  
6 1     1   4 use base 'CGI::OptimalQuery::Base';
  1         1  
  1         94  
7 1     1   6 use Data::Dumper;
  1         1  
  1         49  
8 1     1   5 use DBIx::OptimalQuery();
  1         2  
  1         21  
9 1     1   4 use CGI();
  1         2  
  1         4228  
10              
11              
12             my $DEFAULT_CSS = <<'TILEND';
13            
67             TILEND
68              
69             =comment CSS MORE POSSIBILITIES
70             # Simplest mode
71             form.filterForm .colvalbtn { display:none; }
72             form.filterForm .noparen { display:none; }
73             form.filterForm #paren_warn { display:none; }
74              
75             # Disable deleting controls
76             form.filterForm .d_col { display:none; }
77              
78             # other possibilities ...
79             form.filterForm label:after { content: " mark"; }
80            
81            
82            
83            
84             =cut
85              
86              
87              
88              
89             # ------------------------- new -------------------------
90             sub new {
91 0     0 0   my $pack = shift;
92 0           my $o = $pack->SUPER::new(@_);
93 0           $$o{view} = '';
94 0   0       $$o{schema}{options}{'CGI::OptimalQuery::InteractiveFilter'}{css} ||= $DEFAULT_CSS;
95 0           $o->process_actions();
96 0           return $o;
97             }
98              
99              
100             # ------------------------- print -------------------------
101             sub output {
102 0     0 0   my $o = shift;
103 0           $$o{output_handler}->($$o{httpHeader}->());
104 0           my $view = $$o{view};
105 0 0         $$o{output_handler}->($o->$view()) if $o->can($view);
106 0           return undef;
107             }
108              
109              
110              
111              
112             =comment
113             Grammar Translations: basically this describes how to convert rules
114             into elements of an expression array. Each element in this array
115             is a hash ref with keys: L_PAREN, R_PAREN, ANDOR, CMPOP, R_VALUE,
116             L_COLMN, R_COLMN, FUNCT, ARG_XYZ. Later this array can be translated
117             to CGI params that represent the filter for an HTML form.
118             Notice: The hash key is the rule name, the value is a sub ref where
119             the following args are defined:
120             $_[0] is $oq
121             $_[1] is rule name
122             $_[2] is token 1, $_[3] is token 2, etc ...
123             =cut
124             my %translations = (
125              
126             # *** RULE ***
127             # exp:
128             # '(' exp ')' logicOp exp
129             # | '(' exp ')'
130             # | comparisonExp logicOp exp
131             # | comparisonExp
132             'exp' => sub {
133             # expression array is just an array of exp
134             # each element is a hashref containing keys
135             # L_PAREN, R_PAREN, ANDOR, CMPOP, R_VALUE,
136             # L_COLMN, R_COLMN, FUNCT, ARG_XYZ
137             my $expression_array;
138              
139             # handle tokens:
140             # '(' exp ')' logicOp exp
141             # | '(' exp ')'
142             if ($_[2] eq '(') {
143             $expression_array = $_[3];
144             $$expression_array[0]{L_PAREN}++;
145             $$expression_array[-1]{R_PAREN}++;
146              
147             # handle tokens: logicOp exp
148             if (exists $_[5]{ANDOR} && ref($_[6]) eq 'ARRAY') {
149             $$expression_array[-1]{ANDOR} = $_[5]{ANDOR};
150             push @$expression_array, @{ $_[6] }; # append exp
151             }
152             }
153              
154             # handle tokens:
155             # comparisonExp logicOp exp
156             # | comparisonExp
157             else {
158             $expression_array = [ $_[2] ];
159              
160             # add: logicOp exp
161             if (exists $_[3]{ANDOR} && ref($_[4]) eq 'ARRAY') {
162             $$expression_array[-1]{ANDOR} = $_[3]{ANDOR};
163             push @$expression_array, @{ $_[4] }; # append exp
164             }
165             }
166             return $expression_array;
167             },
168              
169             # *** RULE ***
170             # namedFilter
171             # | colAlias compOp colAlias
172             # | colAlias compOp bindVal
173             'comparisonExp' => sub {
174              
175             # if not a named filter
176             # combine CMPOP and R_VALUE | R_COLMN in
177             if (exists $_[2]{COLMN}) {
178             $_[2]{L_COLMN} = delete $_[2]{COLMN};
179             $_[2]{CMPOP} = $_[3]{CMPOP};
180             if (! ref $_[4]) { $_[2]{R_VALUE} = $_[4]; }
181             else { $_[2]{R_COLMN} = $_[4]{COLMN}; }
182             }
183             return $_[2];
184             },
185              
186             # remove quotes from string
187             'quotedString' => sub { $_ = $_[2]; s/^\'// || s/^\"//; s/\'$// || s/\"$//; $_; },
188              
189             # *** RULE ***
190             # colAlias: '[' /\w+/ ']'
191             'colAlias' => sub {
192             die "could not find colAlias '$_[3]'" unless exists $_[0]{select}{$_[3]};
193             return { 'COLMN' => $_[3] };
194             },
195              
196             # *** RULE *** logicOp: /and/i | /or/i
197             'logicOp' => sub { { ANDOR => uc($_[2]) } },
198              
199             # *** RULE *** compOp: '=' | '!=' | '<' |, ....
200             'compOp' => sub { { CMPOP => lc($_[2]) } },
201              
202             # *** RULE *** nullComp: /is\ null/i | /is\ not\ null/i
203             'namedFilter' => sub {
204             die "could not find named filter '$_[2]'" unless exists $_[0]{named_filters}{$_[2]};
205             my $rv = { 'FUNCT' => $_[2].'()' };
206             my %args;
207             %args = @{ $_[4] } if ref($_[4]) eq 'ARRAY';
208             foreach my $key (keys %args) { $$rv{'ARG_'.$key} = $args{$key}; }
209             return $rv;
210             },
211              
212             # just return the first token for all other rules not specified
213             '*default*' => sub { $_[2] }
214             );
215              
216              
217              
218             # ------------------------- process actions -------------------------
219             sub process_actions {
220 0     0 0   my $o = shift;
221 0           my $q = $$o{q};
222 0           $$o{view} = 'html_filter_form';
223              
224             # should we load a fresh filter into the appropriate params
225             # representing the filter?
226 0 0         if ($q->param('filter') ne '') {
227 0           my $expression_array = $$o{oq}->parse($DBIx::OptimalQuery::filterGrammar,
228             $q->param('filter'), \%translations);
229 0 0         die "bad filter!\nfilter= ".$q->param('filter').
230             "\nexp=".Dumper( $expression_array )."\n" unless ref($expression_array) eq 'ARRAY';
231              
232             # fill in the params representing the filter state
233 0           my $i = 0;
234 0           foreach my $exp (@$expression_array) {
235 0           $i++;
236 0           while (my ($k,$v) = each %$exp) { $q->param('F'.$i.'_'.$k,$v); }
  0            
237             }
238 0           $q->param('FINDX', $i);
239 0           $q->param('hideParen', ($i < 3));
240 0           $$o{view} = 'html_filter_form';
241             }
242              
243            
244             # did the user request a new expression?
245 0 0 0       if ( defined $q->param('NEXT_EXPR')
    0          
    0          
246             && scalar $q->param('NEXT_EXPR') ne '-- add new filter element --') {
247 0           my $val = scalar $q->param('NEXT_EXPR');
248 0           my $findx = $q->param('FINDX');
249 0 0         $findx = 0 unless $findx > 0;
250 0           $findx++;
251 0           my $pn = 'F' . $findx . '_';
252 0 0         if( $val =~ /\(\)\Z/ ) { # ends with a ()
253 0           $q->param($pn.'FUNCT', $val);
254             } else {
255 0           $q->param($pn.'L_COLMN', $val);
256 0           $q->param($pn.'L_VALUE', '');
257 0 0 0       if ($o->typ4clm($val) eq 'char' ||
258             $o->typ4clm($val) eq 'clob') {
259 0           $q->param($pn.'CMPOP', 'contains');
260             } else {
261 0           $q->param($pn.'CMPOP', '=');
262             }
263             }
264 0           $q->param('FINDX', $findx);
265 0           $q->param('hideParen', ( $findx < 3 ) );
266 0           $q->param('NEXT_EXPR', '--- Choose Next Filter ---');
267 0           $$o{view} = 'html_filter_form';
268              
269             }
270              
271             # did user submit the filter?
272             elsif ($q->param('act') eq 'submit_filter') {
273 0           my $ftxt = $o->recreateFilterString();
274 0           $q->param('filter', $ftxt);
275 0           $$o{view} = 'html_parent_update';
276 0 0         if ($$o{error}) {
277 0           $$o{view} = 'html_filter_form';
278             }
279             }
280              
281             # did user request to delete filter
282             elsif ($q->param('act') eq 'submit_del') {
283 0           delselForm( $q );
284 0           $$o{view} = 'html_filter_form';
285             }
286              
287 0           return undef;
288             }
289              
290              
291             # ------------------------- cmp_val -------------------------
292             sub cmp_val ( $$$$ ) {
293 0     0 0   my( $q, $pnam, $vals, $lbls ) = @_;
294              
295              
296 0   0       my $isUserVal = ( $q->param($pnam.'COLMN') eq ''
297             || $q->param($pnam.'ISVAL') );
298              
299             return
300 0 0         $q->button( -name=>$pnam.'BTN',
    0          
    0          
301             -label=>$isUserVal?'value:':'column:',
302             -onClick=>"toggle_value('$pnam');",
303             -class=>'colvalbtn')
304             . $q->hidden( -name=>$pnam.'ISVAL', -default=>$isUserVal )
305             . $q->textfield( -name=>$pnam.'VALUE',
306             -class=> ( $isUserVal ? 'val' : 'hide' ) )
307             . $q->popup_menu( -name=>$pnam.'COLMN',
308             -values=> $vals, -labels=> $lbls,
309             -onChange=>"submit_act('refresh');",
310             -class=> $isUserVal ? 'hide' : 'col');
311              
312             }
313              
314             # ------------------------- recreateFilterString -------------------------
315             sub recreateFilterString {
316 0     0 0   my $o = shift;
317 0           my $q = $$o{q};
318              
319             # pull out the fuctions arguments from the form
320 0           my %funct_args = ();
321 0           foreach my $fak ( $q->param() ){
322 0           my @ary = split 'ARG_', $fak;
323 0 0         $funct_args{$ary[0]}{$ary[1]} = $q->param($fak)
324             if defined $ary[1];
325             }
326              
327 0           my $ftext = '';
328 0           my $ei = scalar $q->param('FINDX');
329 0           for( my $i = 1; $i <= $ei; $i++ ) {
330 0           my $p = 'F' . $i . '_';
331              
332 0           my $parcnt = $q->param($p.'L_PAREN');
333 0 0         $ftext .= ($parcnt < 1 ? '' : '('x$parcnt . ' ' );
334              
335 0 0 0       if( defined $q->param($p.'FUNCT')
336             && $q->param($p.'FUNCT') ne '' ) {
337              
338             # TODO: Grab the $p.'ARG_' and Dump it.
339 0           my $f = $q->param($p.'FUNCT');
340 0           $f =~ s/\(\)\Z//;
341 0           my $args = '';
342 0           while (my ($k,$v) = each %{ $funct_args{$p} }) {
  0            
343 0 0         $args .= ',' if $args;
344 0 0         $v = "'".$v."'" if $v =~ /\W/;
345 0           $args .= "$k,$v";
346             }
347 0           $ftext .= " $f($args) ";
348             } else {
349 0 0         if( $q->param($p.'L_ISVAL') ) {
350 0           $ftext .= '\'' . $q->param($p.'L_VALUE') . '\'';
351             } else {
352 0           $ftext .= '[' . $q->param($p.'L_COLMN') . ']';
353              
354             # force operator to be "like/not like" if a numeric operator
355 0 0 0       if ($o->typ4clm(uc($q->param($p.'L_COLMN'))) eq 'clob' &&
356             $q->param($p.'CMPOP') !~ /\w/) {
357 0 0         if ($q->param($p.'CMPOP') =~ /\!/) {
358 0           $q->param($p.'CMPOP', "not like");
359             } else {
360 0           $q->param($p.'CMPOP', "like");
361             }
362             }
363             }
364              
365 0           $ftext .= ' ' . $q->param($p.'CMPOP') . ' ';
366              
367 0 0         if( $q->param($p.'R_ISVAL') ) {
368 0           my $val = $q->param($p.'R_VALUE');
369 0 0 0       if ($val =~ /\'/ || $val =~ /\"/) {
370 0 0         if ($val !~ /\"/) { $val = '"'.$val.'"'; }
  0 0          
371 0           elsif ($val !~ /\'/) { $val = "'".$val."'"; }
372 0           else { $val =~ s/\'|\"//g; }
373             } else {
374 0           $val = "'$val'";
375             }
376 0           $ftext .= $val;
377              
378             # if date comparison and right side is value and numeric operator
379             # ensure the right side valud fits date_format string
380 0 0 0       if ($q->param($p.'L_COLMN') &&
      0        
      0        
381             $q->param($p.'CMPOP') !~ /\w/ &&
382             exists $$o{schema}{select}{$q->param($p.'L_COLMN')} &&
383             exists $$o{schema}{select}{$q->param($p.'L_COLMN')}[3]{date_format}) {
384 0           my $date_format = $$o{schema}{select}{$q->param($p.'L_COLMN')}[3]{date_format};
385 0           local $$o{dbh}->{RaiseError} = 0;
386 0           local $$o{dbh}->{PrintError} = 0;
387 0 0         if ($$o{dbh}{Driver}{Name} eq 'Oracle') {
388 0           my $dt = $q->param($p.'R_VALUE');
389 0 0         if ($dt ne '') {
390 0           my ($rv) = $$o{dbh}->selectrow_array("SELECT 1 FROM dual WHERE to_date(?,'$date_format') IS NOT NULL", undef, $dt);
391 0 0         if (! $rv) {
392 0           $$o{error} = "invalid date: \"$dt\", must be in format: \"$date_format\"";
393 0           return undef;
394             }
395             }
396             }
397             }
398             } else {
399 0           $ftext .= '[' . $q->param($p.'R_COLMN') . ']';
400             }
401             }
402              
403 0           $parcnt = $q->param($p.'R_PAREN');
404 0 0         $ftext .= ( $parcnt<1 ? '' : ')'x$parcnt .' ' ) . "\n";
405              
406 0 0         $ftext .= $q->param($p.'ANDOR') . "\n" unless( $i == $ei );
407              
408             }
409              
410 0           $ftext =~ s/\n//g;
411 0           return $ftext;
412             }
413              
414             # ------------------------- delselForm -------------------------
415             sub delselForm( $ ) {
416 0     0 0   my( $q ) = @_;
417              
418 0           my $oei = scalar $q->param('FINDX');
419 0           my $ni=1;
420 0           for( my $oi = 1; $oi <= $oei; $oi++ ) {
421 0           my $op = 'F' . $oi . '_';
422 0 0         unless( $q->param($op.'DELME') ) {
423 0 0         if( $oi != $ni ){
424 0           my $np = 'F' . $ni . '_';
425 0           $q->delete($np.'FUNCT'); # clear so NOT assumed a func
426            
427              
428 0           foreach my $par ( $q->param() ) {
429 0 0         if( $par =~ s/\A$op// ){
430 0           $q->param( $np.$par, $q->param($op.$par) );
431             }
432             }
433             }
434 0           $ni++;
435             }
436             }
437 0           $ni--;
438 0           $q->param('FINDX', $ni);
439 0           return $oei - $ni;
440             }
441              
442              
443             # ------------------------- typ4clm -------------------------
444             sub typ4clm ($$) {
445 0     0 0   my( $o, $clm ) = @_;
446 0           $clm =~ s/\A\[//;
447 0           $clm =~ s/\]\Z//;
448 0           return $o->{oq}->get_col_types('filter')->{uc($clm)};
449             }
450              
451             # ------------------------- cmpopLOV -------------------------
452 0     0 0   sub cmpopLOV { ['=','!=','<','<=','>','>=','like','not like','contains','not contains'] }
453              
454              
455             # ------------------------- html_parent_update -------------------------
456             sub html_parent_update( $ ) {
457              
458 0     0 0   my ($o) = @_;
459              
460 0           my $q = $o->{q};
461              
462 0           my $filter = $q->param('filter');
463 0           $filter =~ s/\n/\ /g;
464              
465 0           my $js;
466 0           $js = "
467             if( window.opener
468             && !window.opener.closed
469             && window.opener.OQval ) {
470             var w = window.opener;
471             w.OQval('filter', '".$o->escape_js($filter)."');
472             if (w.OQval('rows_page') == 'All') w.OQval('rows_page', 10);
473             w.OQrefresh();
474             window.close();
475             }
476              
477             function show_defaultOQ() {
478             window.document.failedFilterForm.submit();
479             return true;
480             }
481             ";
482              
483             my $doc = $q->start_html( -title=>'OQFilter', -script=> $js )
484             . '

Unable to contact this filters parent.

'
485 0           . $q->start_form( -name=>'failedFilterForm', -class=>'filterForm', -action => $$o{schema}{URI_standalone}, -enctype=>'application/x-www-form-urlencoded');
486              
487              
488 0 0         if (ref($$o{schema}{state_params}) eq 'ARRAY') {
489 0           foreach my $p (@{ $$o{schema}{state_params} }) {
  0            
490 0           $doc .= "";
491             }
492             }
493              
494 0           $doc .= $q->hidden( -name=>'filter', -value=>'')
495             . ''
496             . 'Click here for a default view of the following RAW filter.'
497             . '
'
498             . $o->escape_html( $q->param('filter') )
499             . '
'
500             . $q->end_html() ;
501              
502 0           return $doc;
503             }
504              
505             # ------------------------- getFunctionNames -------------------------
506             sub getFunctionNames( $ ) {
507 0     0 0   my( $o ) = @_;
508 0           my %functs = (); # ( t1=>'Test One', t2=>"Test Two" );
509 0           foreach my $k ( keys %{$o->{schema}->{'named_filters'}} ) {
  0            
510 0           my $fref = $o->{schema}->{'named_filters'}{$k};
511 0 0 0       if (ref $fref eq 'ARRAY') { $functs{"$k".'()'} = $fref->[2]; }
  0 0          
512             elsif (ref $fref eq 'HASH' && $fref->{'title'} ne '') {
513 0           $functs{"$k".'()'} = $fref->{'title'};
514             }
515             }
516 0           return %functs;
517             }
518              
519             # ------------------------- getColumnNames -------------------------
520             sub getColumnNames( $ ) {
521 0     0 0   my( $o ) = @_;
522 0           my %cols = (); # ( t1=>'Test One', t2=>"Test Two" );
523 0           foreach my $k ( keys %{$o->{schema}->{'select'}} ) {
  0            
524 0 0         next if $$o{schema}{select}{$k}[3]{is_hidden};
525 0           my $cref = $o->{schema}->{'select'}{$k};
526 0 0         $cols{"$k"} =
527             ( ref $cref eq 'ARRAY' ) ? $cref->[2] : 'bad:'.(ref $cref) ;
528             }
529 0           return %cols;
530             }
531              
532             # ------------------------- html_filter_form -------------------------
533             sub html_filter_form( $ ) {
534 0     0 0   my( $o ) = @_;
535            
536 0           my %columnLBL = $o->getColumnNames();
537 0           my @columnLOV = sort { $columnLBL{$a} cmp $columnLBL{$b} } keys %columnLBL;
  0            
538             # TODO: create named_functions from pre-exising filters and use them
539             # my @functionLOV = map {"$_".'()'} keys %{$o->{schema}->{'named_filters'}};
540             # my @functionLOV = keys %{$o->{schema}->{'named_filters'}};
541 0           my %functionLBL = $o->getFunctionNames();
542 0           my @functionLOV = sort { $functionLBL{$a} cmp $functionLBL{$b} } keys %functionLBL;
  0            
543             # (t1=>'Test One', t2=>"Test Two");
544 0           my @andorLOV = ('AND', 'OR');
545              
546              
547 0           my $js="
548              
549             function toggle_value(basenam) {
550             var f = window.document.filterForm;
551             if( f.elements[basenam+'ISVAL'].value ) {
552             f.elements[basenam+'ISVAL'].value = '';
553             f.elements[basenam+'BTN'].value = 'column:';
554             f.elements[basenam+'VALUE'].className = 'hide';
555             f.elements[basenam+'COLMN'].className = 'col';
556             } else {
557             f.elements[basenam+'ISVAL'].value = 1;
558             f.elements[basenam+'BTN'].value = 'value:';
559             f.elements[basenam+'VALUE'].className = 'val';
560             f.elements[basenam+'COLMN'].className = 'hide';
561             }
562             return true;
563             }
564              
565             function update_paren_vis(basenam) {
566             var f = window.document.filterForm;
567             if( f.elements[basenam+'PAREN'].options[0].selected ) {
568             f.elements[basenam+'PARBTN'].className = 'noparen';
569             f.elements[basenam+'PAREN'].className = 'hide';
570             } else {
571             f.elements[basenam+'PARBTN'].className = 'hide';
572             f.elements[basenam+'PAREN'].className = 'paren';
573             }
574             window.check_paren();
575             return true;
576             }
577              
578             function toggle_paren(basenam) {
579             var f = window.document.filterForm;
580             if( f.elements[basenam+'PAREN'].options[0].selected ) {
581             f.elements[basenam+'PAREN'].options[1].selected = true;
582             } else {
583             f.elements[basenam+'PAREN'].options[0].selected = true;
584             }
585             window.update_paren_vis(basenam);
586             return true;
587             }
588              
589             function show_submit_del() {
590             var f = window.document.filterForm;
591             var i = f.elements['FINDX'].value;
592             for(; i>0; i--){
593             if( f.elements['F'+i+'_DELME'].checked ) {
594             f.elements['SUBMIT_DEL'].className = 'delbtn';
595             window.document.getElementById('submit_text').className = 'submit_off';
596             window.document.getElementById('submit_add').className = 'add_off';
597             return true;
598             }
599             }
600             f.elements['SUBMIT_DEL'].className = 'hide';
601             f.elements['CHECKALL'].checked = false;
602             window.document.getElementById('submit_add').className = 'add_ok';
603             window.check_paren();
604             return true;
605             }
606              
607             function submit_act(actval) {
608             var f = window.document.filterForm;
609             f.elements.act.value = actval;
610             f.submit();
611             return true;
612             }
613              
614             function checkall_delme() {
615             var f = window.document.filterForm;
616             var newval = f.elements['CHECKALL'].checked;
617             var i = f.elements['FINDX'].value;
618             for(; i>0; i--){
619             f.elements['F'+i+'_DELME'].checked = newval;
620             }
621             window.show_submit_del();
622             return true;
623             }
624              
625             function check_paren() {
626             var f = window.document.filterForm;
627             var i = f.elements['FINDX'].value;
628             var ocnt = 0;
629             for(; i>0; i--){
630             ocnt += f.elements['F'+i+'_R_PAREN'].value - f.elements['F'+i+'_L_PAREN'].value;
631             if( ocnt < 0 ) {
632             i = -3;
633             }
634             }
635             if( ocnt == 0 ) {
636             window.document.getElementById('submit_text').className = 'submit_ok';
637             window.document.getElementById('paren_warn').className = 'paren_match';
638             } else {
639             window.document.getElementById('submit_text').className = 'submit_off';
640             window.document.getElementById('paren_warn').className = 'paren_warn';
641             }
642             return true;
643             }
644              
645             ";
646              
647              
648              
649 0           my $q = $o->{q};
650              
651             # pull out the fuctions arguments from the form
652 0           my %funct_args = ();
653 0           foreach my $fak ( $q->param() ){
654 0           my @ary = split 'ARG_', $fak;
655 0 0         $funct_args{$ary[0]}{$ary[1]} = $q->param($fak)
656             if defined $ary[1];
657             }
658              
659              
660             my $html =
661             $q->start_html ( -title=>"Interactive Filter - $$o{schema}{title}",
662             -script=> $js,
663             -head=>
664             $$o{schema}{options}{'CGI::OptimalQuery::InteractiveFilter'}{css} ).
665             "
".
666             (($$o{error}) ? "".$q->escapeHTML($$o{error})."" : "").
667 0 0         $q->start_form( -action=> $$o{schema}{URI_standalone}, -name=>'filterForm',
668             -class=>'filterForm', -enctype=>'application/x-www-form-urlencoded');
669              
670              
671 0 0         if (ref($$o{schema}{state_params}) eq 'ARRAY') {
672 0           foreach my $p (@{ $$o{schema}{state_params} }) {
  0            
673 0           $html .= "";
674             }
675             }
676              
677             $html .=
678 0           $q->hidden ( -name=>'module', -value=>'InteractiveFilter',
679             -override=>1 )
680             . $q->hidden ( -name=>'act', -value=>'submit_filter',
681             -override=>1 )
682             . $q->hidden ( -name=>'hideParen', -value=>1 )
683             . $q->hidden ( -name=>'FINDX', -value=>'0') ;
684            
685              
686 0           $html .= "\n"; '; '; '; "; '; \n\n" ; '
687              
688              
689 0           my $hideParen = $q->param('hideParen');
690 0           my $pnp; # parameter name prefix
691              
692             my $thing_to_focus_on;
693              
694 0           for( my $findx = 1; $findx <= $q->param('FINDX'); $findx++ ) {
695 0           $pnp = 'F' . $findx . '_';
696 0 0         $html .= '
'
    0          
    0          
697             . $q->button ( -name=>$pnp.'L_PARBTN', -label=>'(',
698             -onClick=>"toggle_paren('$pnp"."L_');",
699             -class=> $hideParen
700             ? 'hide' : ( $q->param($pnp.'L_PAREN') > 0
701             ? 'hide' : 'noparen' ) )
702             . $q->popup_menu
703             ( -name=>$pnp.'L_PAREN', -values=>[0 .. 3], -default=>'0',
704             -labels=>{'0'=>'','1'=>'(','2'=>'((','3'=>'((('},
705             -onChange=>"update_paren_vis('$pnp"."L_');",
706             -class=>$q->param($pnp.'L_PAREN')<1 ?'hide':'paren' )
707             . '
708              
709 0 0         if( defined $q->param($pnp.'FUNCT') ) {
710 0           my $func_nam = $q->param($pnp.'FUNCT');
711 0           $func_nam =~ s/\(\)//;
712              
713             # if a predefined named filter
714 0 0         if (ref($o->{schema}->{'named_filters'}{$func_nam}) eq 'ARRAY') {
    0          
715 0           $html .= ''
716             . $q->popup_menu( -name=>$pnp.'FUNCT',
717             -values=> \ @functionLOV,
718             -labels=> \ %functionLBL,
719             -default=> $q->param($pnp.'FUNCT'),
720             -onChange=>"submit_act('refresh');" ) ;
721 0           $html .= '
722             }
723            
724             # if named filter has an html generator
725             elsif (exists $o->{schema}->{'named_filters'}{$func_nam}{html_generator}) {
726 0           $html .= ''
727             . $q->popup_menu( -name=>$pnp.'FUNCT',
728             -values=> \ @functionLOV,
729             -labels=> \ %functionLBL,
730             -default=> $q->param($pnp.'FUNCT'),
731             -onChange=>"submit_act('refresh');" ) ;
732             $html .=
733 0           $o->{schema}->{'named_filters'}{$func_nam}{'html_generator'}->($q, $pnp.'ARG_');
734 0           $html .= '
735             }
736              
737             # else if named filter does not have a html_generator
738             else {
739 0           $html .= "";
740 0           my %args;
741 0           my $arg_prefix = quotemeta($pnp.'ARG_');
742 0           foreach my $param (grep { /^$arg_prefix/ } $q->param) {
  0            
743 0           my $k = $param; $k =~ s/$arg_prefix//;
  0            
744 0           my $v = $q->param($param);
745 0           $args{$k} = $v;
746 0           $html .= "";
747             }
748              
749 0           my $rv = $o->{schema}->{'named_filters'}{$func_nam}{'sql_generator'}->(%args);
750 0           $html .= "
".$o->escape_html($$rv[2])."
751             }
752             }
753              
754             else {
755 0           $html .= ''
756             . &cmp_val($q, $pnp.'L_', \ @columnLOV, \ %columnLBL)
757             . ''
758             . $q->popup_menu (
759             -name=>$pnp.'CMPOP', -values=> cmpopLOV(), -class=>'cmpop')
760             . ''
761             . &cmp_val($q, $pnp.'R_', \ @columnLOV, \ %columnLBL )
762             . '
763             }
764              
765 0 0         $html .= ''
    0          
    0          
    0          
766             . $q->popup_menu ( -name=>$pnp.'R_PAREN',
767             -values=>[0 .. 3], -default=>'0',
768             -labels=>
769             {'0'=>'', '1'=>')', '2'=>'))', '3'=>')))'},
770             -onChange=>"update_paren_vis('$pnp"."R_');",
771             -class=> ( $q->param($pnp.'R_PAREN')<1
772             ? 'hide' : 'paren' ) )
773             . $q->button ( -name=>$pnp.'R_PARBTN', -label=>')',
774             -onClick=>"toggle_paren('$pnp"."R_');",
775             -class=> $hideParen
776             ? 'hide'
777             : ( $q->param($pnp.'R_PAREN')>0
778             ? 'hide' : 'noparen') )
779             . ''
780             . $q->checkbox ( -name=>$pnp.'DELME', -label=>'remove',
781             -value=>'1', -checked=>0, -override=>1,
782             -onClick=>'show_submit_del();',
783             -class=>'delbox' )
784             . "
"
785             . $q->popup_menu ( -name=>$pnp.'ANDOR', -values=> \ @andorLOV,
786             -class=>$findx == $q->param('FINDX')?'hide':'')
787             . "
788              
789             }
790              
791            
792 0 0         $html .= '
'
793             . $q->checkbox ( -name=>'CHECKALL', -label=>'ALL', -value=>'1',
794             -checked=>0, -override=>1,
795             -onClick=>'checkall_delme();',
796             -class=>'delbox' )
797             . '
'
798             . $q->button ( -name=>'SUBMIT_DEL', -label=>'REMOVE',
799             -onClick=>"submit_act('submit_del');",
800             -class=> 'hide' )
801             . '
802             if( $q->param('FINDX') > 0 ); # we printed something above here
803              
804 0           my @sel_opts = ('-- add new filter element --', $q->optgroup ( -name=>'Column to compare:',
805             -values=> \ @columnLOV ,
806             -labels=> \ %columnLBL ) );
807 0 0         if (@functionLOV) {
808 0           push @sel_opts, $q->optgroup ( -name=>'Named Filters:',
809             -values=> \ @functionLOV ,
810             -labels=> \ %functionLBL );
811             }
812              
813 0           $html .= "
\n"
814             . '
( Parenthesis must be matching pairs )
'
815             . ''
816             . $q->popup_menu ( -name=>'NEXT_EXPR',
817             -default=>'--- Choose Next Filter ---',
818             -override=>1,
819             -values=>\@sel_opts,
820             -onChange=>"submit();" )
821             . ' or '
822             . $q->submit( -name=>'SUBMIT', -class=>'submit_ok' )
823             . " "
824             . $q->end_form()
825             . "\n
826            
831             ".$q->end_html();
832              
833 0           return $html;
834              
835             }
836              
837              
838             1;