File Coverage

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


line stmt bran cond sub pod time code
1             package CGI::OptimalQuery::InteractiveFilter;
2              
3 1     1   647 use strict;
  1         2  
  1         23  
4 1     1   3 use warnings;
  1         1  
  1         20  
5 1     1   3 no warnings qw( uninitialized );
  1         0  
  1         23  
6 1     1   2 use base 'CGI::OptimalQuery::Base';
  1         1  
  1         55  
7 1     1   8 use Data::Dumper;
  1         1  
  1         39  
8 1     1   4 use DBIx::OptimalQuery();
  1         0  
  1         19  
9 1     1   2 use CGI();
  1         1  
  1         3928  
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}->(CGI::header());
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 = @{ $_[4] } if ref($_[4]) eq 'ARRAY';
207             foreach my $key (keys %args) { $$rv{'ARG_'.$key} = $args{$key}; }
208             return $rv;
209             },
210              
211             # just return the first token for all other rules not specified
212             '*default*' => sub { $_[2] }
213             );
214              
215              
216              
217             # ------------------------- process actions -------------------------
218             sub process_actions {
219 0     0 0   my $o = shift;
220 0           my $q = $$o{q};
221 0           $$o{view} = 'html_filter_form';
222              
223             # should we load a fresh filter into the appropriate params
224             # representing the filter?
225 0 0         if ($q->param('filter') ne '') {
226 0           my $expression_array = $$o{oq}->parse($DBIx::OptimalQuery::filterGrammar,
227             $q->param('filter'), \%translations);
228 0 0         die "bad filter!\nfilter= ".$q->param('filter').
229             "\nexp=".Dumper( $expression_array )."\n" unless ref($expression_array) eq 'ARRAY';
230              
231             # fill in the params representing the filter state
232 0           my $i = 0;
233 0           foreach my $exp (@$expression_array) {
234 0           $i++;
235 0           while (my ($k,$v) = each %$exp) { $q->param('F'.$i.'_'.$k,$v); }
  0            
236             }
237 0           $q->param('FINDX', $i);
238 0           $q->param('hideParen', ($i < 3));
239 0           $$o{view} = 'html_filter_form';
240             }
241              
242            
243             # did the user request a new expression?
244 0 0 0       if ( defined $q->param('NEXT_EXPR')
    0          
    0          
245             && scalar $q->param('NEXT_EXPR') ne '-- add new filter element --') {
246 0           my $val = scalar $q->param('NEXT_EXPR');
247 0           my $findx = $q->param('FINDX');
248 0 0         $findx = 0 unless $findx > 0;
249 0           $findx++;
250 0           my $pn = 'F' . $findx . '_';
251 0 0         if( $val =~ /\(\)\Z/ ) { # ends with a ()
252 0           $q->param($pn.'FUNCT', $val);
253             } else {
254 0           $q->param($pn.'L_COLMN', $val);
255 0           $q->param($pn.'L_VALUE', '');
256 0 0 0       if ($o->typ4clm($val) eq 'char' ||
257             $o->typ4clm($val) eq 'clob') {
258 0           $q->param($pn.'CMPOP', 'contains');
259             } else {
260 0           $q->param($pn.'CMPOP', '=');
261             }
262             }
263 0           $q->param('FINDX', $findx);
264 0           $q->param('hideParen', ( $findx < 3 ) );
265 0           $q->param('NEXT_EXPR', '--- Choose Next Filter ---');
266 0           $$o{view} = 'html_filter_form';
267              
268             }
269              
270             # did user submit the filter?
271             elsif ($q->param('act') eq 'submit_filter') {
272 0           my $ftxt = $o->recreateFilterString();
273 0           $q->param('filter', $ftxt);
274 0           $$o{view} = 'html_parent_update';
275 0 0         if ($$o{error}) {
276 0           $$o{view} = 'html_filter_form';
277             }
278             }
279              
280             # did user request to delete filter
281             elsif ($q->param('act') eq 'submit_del') {
282 0           delselForm( $q );
283 0           $$o{view} = 'html_filter_form';
284             }
285              
286 0           return undef;
287             }
288              
289              
290             # ------------------------- cmp_val -------------------------
291             sub cmp_val ( $$$$ ) {
292 0     0 0   my( $q, $pnam, $vals, $lbls ) = @_;
293              
294              
295 0   0       my $isUserVal = ( $q->param($pnam.'COLMN') eq ''
296             || $q->param($pnam.'ISVAL') );
297              
298             return
299 0 0         $q->button( -name=>$pnam.'BTN',
    0          
    0          
300             -label=>$isUserVal?'value:':'column:',
301             -onClick=>"toggle_value('$pnam');",
302             -class=>'colvalbtn')
303             . $q->hidden( -name=>$pnam.'ISVAL', -default=>$isUserVal )
304             . $q->textfield( -name=>$pnam.'VALUE',
305             -class=> ( $isUserVal ? 'val' : 'hide' ) )
306             . $q->popup_menu( -name=>$pnam.'COLMN',
307             -values=> $vals, -labels=> $lbls,
308             -onChange=>"submit_act('refresh');",
309             -class=> $isUserVal ? 'hide' : 'col');
310              
311             }
312              
313             # ------------------------- recreateFilterString -------------------------
314             sub recreateFilterString {
315 0     0 0   my $o = shift;
316 0           my $q = $$o{q};
317              
318             # pull out the fuctions arguments from the form
319 0           my %funct_args = ();
320 0           foreach my $fak ( $q->param() ){
321 0           my @ary = split 'ARG_', $fak;
322 0 0         $funct_args{$ary[0]}{$ary[1]} = $q->param($fak)
323             if defined $ary[1];
324             }
325              
326 0           my $ftext = '';
327 0           my $ei = scalar $q->param('FINDX');
328 0           for( my $i = 1; $i <= $ei; $i++ ) {
329 0           my $p = 'F' . $i . '_';
330              
331 0           my $parcnt = $q->param($p.'L_PAREN');
332 0 0         $ftext .= ($parcnt < 1 ? '' : '('x$parcnt . ' ' );
333              
334 0 0 0       if( defined $q->param($p.'FUNCT')
335             && $q->param($p.'FUNCT') ne '' ) {
336              
337             # TODO: Grab the $p.'ARG_' and Dump it.
338 0           my $f = $q->param($p.'FUNCT');
339 0           $f =~ s/\(\)\Z//;
340 0           my $args = '';
341 0           while (my ($k,$v) = each %{ $funct_args{$p} }) {
  0            
342 0 0         $args .= ',' if $args;
343 0 0         $v = "'".$v."'" if $v =~ /\W/;
344 0           $args .= "$k,$v";
345             }
346 0           $ftext .= " $f($args) ";
347             } else {
348 0 0         if( $q->param($p.'L_ISVAL') ) {
349 0           $ftext .= '\'' . $q->param($p.'L_VALUE') . '\'';
350             } else {
351 0           $ftext .= '[' . $q->param($p.'L_COLMN') . ']';
352              
353             # force operator to be "like/not like" if a numeric operator
354 0 0 0       if ($o->typ4clm(uc($q->param($p.'L_COLMN'))) eq 'clob' &&
355             $q->param($p.'CMPOP') !~ /\w/) {
356 0 0         if ($q->param($p.'CMPOP') =~ /\!/) {
357 0           $q->param($p.'CMPOP', "not like");
358             } else {
359 0           $q->param($p.'CMPOP', "like");
360             }
361             }
362             }
363              
364 0           $ftext .= ' ' . $q->param($p.'CMPOP') . ' ';
365              
366 0 0         if( $q->param($p.'R_ISVAL') ) {
367 0           my $val = $q->param($p.'R_VALUE');
368 0 0 0       if ($val =~ /\'/ || $val =~ /\"/) {
369 0 0         if ($val !~ /\"/) { $val = '"'.$val.'"'; }
  0 0          
370 0           elsif ($val !~ /\'/) { $val = "'".$val."'"; }
371 0           else { $val =~ s/\'|\"//g; }
372             } else {
373 0           $val = "'$val'";
374             }
375 0           $ftext .= $val;
376              
377             # if date comparison and right side is value and numeric operator
378             # ensure the right side valud fits date_format string
379 0 0 0       if ($q->param($p.'L_COLMN') &&
      0        
      0        
380             $q->param($p.'CMPOP') !~ /\w/ &&
381             exists $$o{schema}{select}{$q->param($p.'L_COLMN')} &&
382             exists $$o{schema}{select}{$q->param($p.'L_COLMN')}[3]{date_format}) {
383 0           my $date_format = $$o{schema}{select}{$q->param($p.'L_COLMN')}[3]{date_format};
384 0           local $$o{dbh}->{RaiseError} = 0;
385 0           local $$o{dbh}->{PrintError} = 0;
386 0 0         if ($$o{dbh}{Driver}{Name} eq 'Oracle') {
387 0           my $dt = $q->param($p.'R_VALUE');
388 0 0         if ($dt ne '') {
389 0           my ($rv) = $$o{dbh}->selectrow_array("SELECT 1 FROM dual WHERE to_date(?,'$date_format') IS NOT NULL", undef, $dt);
390 0 0         if (! $rv) {
391 0           $$o{error} = "invalid date: \"$dt\", must be in format: \"$date_format\"";
392 0           return undef;
393             }
394             }
395             }
396             }
397             } else {
398 0           $ftext .= '[' . $q->param($p.'R_COLMN') . ']';
399             }
400             }
401              
402 0           $parcnt = $q->param($p.'R_PAREN');
403 0 0         $ftext .= ( $parcnt<1 ? '' : ')'x$parcnt .' ' ) . "\n";
404              
405 0 0         $ftext .= $q->param($p.'ANDOR') . "\n" unless( $i == $ei );
406              
407             }
408              
409 0           $ftext =~ s/\n//g;
410 0           return $ftext;
411             }
412              
413             # ------------------------- delselForm -------------------------
414             sub delselForm( $ ) {
415 0     0 0   my( $q ) = @_;
416              
417 0           my $oei = scalar $q->param('FINDX');
418 0           my $ni=1;
419 0           for( my $oi = 1; $oi <= $oei; $oi++ ) {
420 0           my $op = 'F' . $oi . '_';
421 0 0         unless( $q->param($op.'DELME') ) {
422 0 0         if( $oi != $ni ){
423 0           my $np = 'F' . $ni . '_';
424 0           $q->delete($np.'FUNCT'); # clear so NOT assumed a func
425            
426              
427 0           foreach my $par ( $q->param() ) {
428 0 0         if( $par =~ s/\A$op// ){
429 0           $q->param( $np.$par, $q->param($op.$par) );
430             }
431             }
432             }
433 0           $ni++;
434             }
435             }
436 0           $ni--;
437 0           $q->param('FINDX', $ni);
438 0           return $oei - $ni;
439             }
440              
441              
442             # ------------------------- typ4clm -------------------------
443             sub typ4clm ($$) {
444 0     0 0   my( $o, $clm ) = @_;
445 0           $clm =~ s/\A\[//;
446 0           $clm =~ s/\]\Z//;
447 0           return $o->{oq}->get_col_types('filter')->{uc($clm)};
448             }
449              
450             # ------------------------- cmpopLOV -------------------------
451 0     0 0   sub cmpopLOV { ['=','!=','<','<=','>','>=','like','not like','contains','not contains'] }
452              
453              
454             # ------------------------- html_parent_update -------------------------
455             sub html_parent_update( $ ) {
456              
457 0     0 0   my ($o) = @_;
458              
459 0           my $q = $o->{q};
460              
461 0           my $filter = $q->param('filter');
462 0           $filter =~ s/\n/\ /g;
463              
464 0           my $js = "
465             if( window.opener
466             && !window.opener.closed
467             && window.opener.OQval ) {
468             var w = window.opener;
469             w.OQval('filter', '".$o->escape_js($filter)."');
470             if (w.OQval('rows_page') == 'All') w.OQval('rows_page', 10);
471             w.OQrefresh();
472             window.close();
473             }
474              
475             function show_defaultOQ() {
476             window.document.failedFilterForm.submit();
477             return true;
478             }
479             ";
480              
481             my $doc = $q->start_html( -title=>'OQFilter', -script=> $js )
482             . '

Unable to contact this filters parent.

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

'
791             . $q->checkbox ( -name=>'CHECKALL', -label=>'ALL', -value=>'1',
792             -checked=>0, -override=>1,
793             -onClick=>'checkall_delme();',
794             -class=>'delbox' )
795             . '
796             . $q->button ( -name=>'SUBMIT_DEL', -label=>'REMOVE',
797             -onClick=>"submit_act('submit_del');",
798             -class=> 'hide' )
799             . '
800             if( $q->param('FINDX') > 0 ); # we printed something above here
801              
802 0           my @sel_opts = ('-- add new filter element --', $q->optgroup ( -name=>'Column to compare:',
803             -values=> \ @columnLOV ,
804             -labels=> \ %columnLBL ) );
805 0 0         if (@functionLOV) {
806 0           push @sel_opts, $q->optgroup ( -name=>'Named Filters:',
807             -values=> \ @functionLOV ,
808             -labels=> \ %functionLBL );
809             }
810              
811 0           $html .= "
\n"
812             . '
( Parenthesis must be matching pairs )
'
813             . ''
814             . $q->popup_menu ( -name=>'NEXT_EXPR',
815             -default=>'--- Choose Next Filter ---',
816             -override=>1,
817             -values=>\@sel_opts,
818             -onChange=>"submit();" )
819             . ' or '
820             . $q->submit( -name=>'SUBMIT', -class=>'submit_ok' )
821             . " "
822             . $q->end_form()
823             . "\n
824            
829             ".$q->end_html();
830              
831 0           return $html;
832              
833             }
834              
835              
836             1;
837              
838