File Coverage

blib/lib/Class/DBI/Plugin/FilterOnClick.pm
Criterion Covered Total %
statement 22 24 91.6
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 30 32 93.7


line stmt bran cond sub pod time code
1             package Class::DBI::Plugin::FilterOnClick;
2              
3 1     1   26783 use base qw( Class::DBI::Plugin );
  1         3  
  1         955  
4              
5             our $VERSION = 1.2;
6              
7 1     1   3697 use strict;
  1         2  
  1         31  
8 1     1   7 use warnings;
  1         8  
  1         34  
9 1     1   1899 use HTML::Table;
  1         30670  
  1         84  
10 1     1   1141 use HTML::Strip;
  1         11162  
  1         97  
11 1     1   10001 use HTML::FillInForm;
  1         5544  
  1         42  
12 1     1   1528 use CGI::FormBuilder;
  1         31983  
  1         60  
13 1     1   494 use Tie::Hash::Indexed;
  0            
  0            
14             use CGI qw/:form/;
15             use Class::DBI::AsForm;
16             use Data::Dumper;
17             use URI::Escape;
18             use Config::Magic;
19              
20             our $cgi = CGI->new();
21             our $config_hash = {};
22              
23             our @allowed_methods = qw(
24             rows
25             exclude_from_url
26             display_columns
27             cdbi_class
28             page_name
29             descending_string
30             ascending_string
31             mouseover_bgcolor
32             mouseover_class
33             no_form_tag
34             no_mouseover
35             no_reset
36             no_submit
37             debug
38             searchable
39             rowclass
40             rowclass_odd
41             rowcolor_even
42             rowcolor_odd
43             filtered_class
44             navigation_list
45             navigation_column
46             navigation_style
47             navigation_alignment
48             page_navigation_separator
49             navigation_separator
50             hide_zero_match
51             query_string
52             data_table
53             form_table
54             order_by
55             hidden_fields
56             auto_hidden_fields
57             config_file
58             use_formbuilder
59             search_exclude
60             );
61              
62             # field_to_column
63              
64             sub output_debug_info : Plugged {
65             my ($self,$message,$level) = @_;
66             $level ||= $self->debug();
67             return undef if $level == 0;
68             if ($level == 2) {
69             print "$message\n";
70             }
71            
72             if ($level == 1) {
73             warn "$message\n";
74             }
75             }
76              
77             sub allowed_methods : Plugged {
78             return @allowed_methods;
79             }
80              
81             sub read_config : Plugged {
82             my ($self,$config_file) = @_;
83             # my $config = Config::Auto::parse($config_file);
84             my $config_reader = Config::Magic->new($config_file);
85             my $config = $config_reader->parse();
86              
87            
88             $config->{config_file} = $config_file;
89             foreach my $config_key (keys %{$config}) {
90             next if !grep /$config_key/ , @allowed_methods;
91             next if !defined $config->{$config_key};
92             # change ~ to space
93             $config->{$config_key} =~ s/~/ /g;
94             $config->{$config_key} =~ s/[\r\n]+$//;
95             $self->output_debug_info( "assigning: $config_key" );
96             if ($config->{$config_key} =~ /\|/) {
97             my @values = split(/\|/,$config->{$config_key});
98             $config->{$config_key} = \@values;
99             }
100             #if ($config_key eq 'debug') {
101             # $debug = $config->{$config_key};
102             #} else {
103             $self->$config_key($config->{$config_key});
104             #}
105             }
106            
107            
108            
109             $self->output_debug_info( Dumper($config) );
110             }
111              
112             sub html : Plugged {
113             my ($class,%args) = @_;
114             $class->filteronclick(%args);
115             }
116              
117             sub filteronclick : Plugged {
118             my %args;
119             tie %args, 'Tie::Hash::Indexed';
120             my ( $class ) = shift;
121             %args = @_;
122              
123             my $self = bless {
124             }, $class;
125              
126             # default to 0 for the debug level
127             $self->debug(0);
128            
129             if (ref $args{-field_to_column} eq 'HASH') {
130             tie %{$self->{'field_to_column'}}, 'Tie::Hash::Indexed';
131             %{$self->{'field_to_column'}} = %{$args{-field_to_column}};
132             }
133              
134             if (defined $args{-config_file}) {
135             # add code for configuration file based settings
136             $self->output_debug_info( "conf = $args{-config_file}" );
137             $self->read_config( $args{-config_file} );
138             }
139            
140             if (defined $args{-params}) {
141             if (ref $self->exclude_from_url() ne 'ARRAY' &&
142             defined $args{-exclude_from_url}) {
143             $self->exclude_from_url( $args{-exclude_from_url} );
144             }
145             $self->params($args{-params});
146             $self->search_ref();
147             $self->url_query();
148             unless (defined $args{-no_hidden_fields}) {
149             $self->hidden_fields( $self->params() );
150             }
151             }
152             # $config_hash = $config;
153             my $rows = $args{-rows} || $self->rows() || 15;
154             if ($rows) {
155             $self->on_page($args{-on_page});
156             $self->pager_object($self->pager($rows,$args{-on_page}));
157             }
158            
159             # end code for configuration based settings
160            
161             # create some common items for later use
162             my $find_columns = $args{-display_columns} ||
163             $self->config('display_columns') ||
164             $self->field_to_column();
165             $self->display_columns($self->determine_columns($find_columns));
166             $self->query_string_intelligence();
167             $self->create_order_by_links();
168            
169             $self;
170             }
171              
172             =head1 NAME
173              
174             Class::DBI::Plugin::FilterOnClick - Generate browsable and searchable HTML Tables using FilterOnClick in conjunction with Class::DBI
175              
176             =head1 SYNOPSIS
177              
178             # Inside of your sub-class ("package ClassDBIBaseClass;" for example)
179             # of Class::DBI for use with your database and
180             # tables add these lines:
181            
182             use Class::DBI::Plugin::FilterOnClick;
183             use Class::DBI::Plugin::Pager;
184             use Class::DBI::AbstractSearch;
185             use Class::DBI::Plugin::AbstractCount;
186             use Class::DBI::Plugin::RetrieveAll;
187            
188             # the rest of your CDBI setup to follow
189             .....
190            
191             # Inside your script (separate from your Class::DBI setup file) you will be
192             # able to use this module's methods on your table class or object as needed.
193              
194             # use the package/module created above
195             use ClassDBIBaseClass;
196            
197             # include URI::Escape for some parameters clean up
198             use URI::Escape;
199            
200             # we are using CGI in this example, but you can use Apache::ASP, Embperl, etc.
201             use CGI;
202            
203             my $cgi = CGI->new();
204            
205             my %params;
206              
207             # clean up and create our parameters to be passed to FilterOnClick
208             map { $params{$_} =
209             uri_unescape($cgi->param("$_"))
210             } $cgi->param();
211              
212             # create our FilterOnClick object
213             my $filteronclick = Baseball::Master->filteronclick(
214             -config_file => '/srv/www/cgi-bin/baseball.ini',
215             -rows => $cgi->param('rows') || 15 ,
216             -on_page => $cgi->param('page') || 1,
217             -params => \%params );
218              
219             $filteronclick->field_to_column(
220             lastname => 'Last Name' . $html->order_by_link('lastname'),
221             firstname => 'First Name' . $html->order_by_link('firstname'),
222             bats => 'Bats',
223             throws => 'Throws',
224             ht_ft => 'Height Ft',
225             ht_in => 'In',
226             wt => 'Weight',
227             birthyear => 'Birthyear',
228             birthstate => 'Birthstate',
229             _FilterOnClickCustom1_ => 'Other Data',
230             _FilterOnClickCustom2_ => 'More Data'
231             );
232            
233            
234             $filteronclick->data_table->addRow(
235             'Last Name',
236             'First Name',
237             'Bats' ,
238             'Throws' ,
239             'Height (ft)',
240             '(inches)',
241             'Weight',
242             'Birth Year' );
243              
244             $filteronclick->params( $cgi->Vars; );
245             $filteronclick->exclude_from_url([ 'page' ]);
246              
247             # indicate which columns to exclude, inverse of display above
248             # can be set in config file as well
249             $filteronclick->exclude_columns();
250            
251             # indicate the base class to work with, this is optional,
252             # if you should create you object via a call to
253             # Class::DBI::Plugin::FilterOnClick vs. a Class::DBI sub class
254             # this assures the correct sub class is used for data collection
255            
256             $filteronclick->cdbi_class( 'Baseball::Master' );
257            
258             # indicate the style of navigation to provide
259             $filteronclick->navigation_style( 'both' );
260            
261             print qq~
Filter by First Letter of Last Name~;
262              
263             print $filteronclick->string_filter_navigation(
264             -column => 'lastname',
265             -position => 'begins',
266             );
267              
268             print qq~~;
269              
270             $filteronclick->only('firstname');
271            
272              
273             print $filteronclick->build_table(
274            
275             _FilterOnClickCustom1_ => sub {
276             my $pid = shift; # pid = Primary ID of the record in the base table
277             my @status_objects = Baseball::Allstars->search(lahmanid => $pid);
278             if (@status_objects) {
279             my $years;
280             foreach my $st (@status_objects) {
281             $years .= $st->year() . " ";
282             }
283             return $years;
284             }
285             return 'NA';
286             },
287            
288             _FilterOnClickCustom2_ => sub {
289             my $pid = shift; # pid = Primary ID of the record in the base table
290             my @status_objects = Baseball::Allstars->search(lahmanid => $pid);
291             if (@status_objects) {
292             my $teams;
293             foreach my $st (@status_objects) {
294             $teams .= $st->team() . " ";
295             }
296             return $teams;
297             }
298             return 'NA';
299             },
300             );
301              
302             my $nav = $filteronclick->html_table_navigation();
303              
304             print qq!
$nav
\n!;
305              
306             $filteronclick->add_bottom_span($nav);
307            
308             print $filteronclick->data_table;
309              
310             =head1 UPGRADE WARNING
311              
312             If you are using Class::DBI::Plugin::HTML or a pre version 1
313             Class::DBI::Plugin::FilterOnClick you will need to alter your code to support
314             the new style used in version 1 and greater releases.
315              
316             Version 1.1 uses Class::DBI::Plugin::Pager, you will need to alter your base
317             class to reflect this change. In other words the use of Class::DBI::Pager is
318             no longer allowed. This was done for an improvement in performance.
319              
320             =head1 DESCRIPTION
321              
322             The intention of this module is to simplify the creation of browsable and
323             searchable HTML tables without having to write the HTML or SQL, either in your
324             script or in templates.
325              
326             It is intended for use inside of other frameworks such as Embperl,
327             Apache::ASP or even CGI. It does not aspire to be its own framework.
328             If you are looking for a frameworks which allow using Class::DBI I suggest you
329             look into the Maypole or the Catalyst module.
330              
331             See FilterOnClick below for more on the purpose of this module.
332              
333             Tables are created using HTML::Table. The use of HTML::Table was selected
334             because it allows for several advanced sorting techniques that can provide for
335             easy manipulation of the data outside of the SQL statement. This is very useful
336             in scenarios where you want to provide/test a sort routine and not write
337             SQL for it. The more I use this utility the less likely it seems that one would
338             need to leverage this, but it is an option if you want to explore it.
339              
340             Feedback on this module, its interface, usage, documentation etc. is
341             welcome.
342              
343             =head1 FilterOnClick
344              
345             FilterOnClick is a process for allowing database filtering via an HTML table.
346             Within a script, filters are predefined based on the type of data and the users
347             desired interaction with the data. When users click on an item in the table it
348             filters (or unfilters if the value had used to filter previously) the records
349             displayed to match the associated filter. Filters can be applied and unapplied
350             in almost any order. In addition to filtering FilterOnClick also allows for
351             ordering the data.
352              
353             The concept at its core is relatively simple in nature. You filter the results
354             in the table by clicking on values that are of interest to you. Each click turns
355             on or off a filter, which narrows or expands the total number of matching records.
356             This allows for identifying abnormal entries, trends, or errors, simply by paging,
357             searching or filtering through your data. If you configure the table appropriately
358             you can even link to applications or web pages to allow editing the records.
359              
360             An example FilterOnClick session would consist of something like this:
361             You get a table of records, for our example lets assume we
362             have four columns: "First Name" aka FN, "Last Name" aka LN , "Address" ,
363             and "Email". These columns are pulled from the database and placed
364             into an HTML table on a web page. The values in the FN , LN and Email
365             address columns are links back to the script that generated the original
366             table, but contain filter information within the query string.
367             In other words the link holds information that will modify the SQL query
368             for the next representation of data.
369              
370             Presently there are six (6) built in filter types for within tables and
371             three (3) more that are specific to string based matches outside of the table
372             itself. (see string_filter_navigation method below for info on the second three)
373              
374             The six html table level filters are 'only','contains','beginswith','endswith'
375             'variancepercent','variancenumerical'. The where clause is
376             created within FilterOnClick automatically through the
377             Class::DBI::AbstractSearch module. You are not required to create any SQL
378             statements or add any code to your Class::DBI base class for simple database
379             structures.
380              
381             Back to the example at hand. Lets say the database has 20K records and
382             the sort order was set to LN by default. The FN column has been configured with
383             an 'only' filter. In the FN list you see the FN you are looking for so you click
384             on it, when the script runs and auto-generates a new filter (query) that now
385             only shows records that match the FN you clicked on.
386             Clicking on the FN column a second time removes the filter.
387              
388             Filters are cascading, allowing you to filter on multiple columns.
389             So if you want to find all the 'Smith's' with email
390             addresses like 'aol.com' you could click first on an email address
391             containing 'aol.com' and then a last name of 'Smith', provided you
392             configured a proper filter code for the table.
393              
394             If the searchable option has been enabled you can also perform text based
395             searched on any column.
396              
397             You can see FilterOnClick in action at:
398             http://cdbi.gina.net/cdbitest.pl (user: cdbi password: demo)
399              
400             Example code to create a FilterOnClick column value ( see the build_table method ):
401              
402             Match Exactly
403              
404             $filteronclick->only('column_name');
405            
406             # within the build_table method you can do this
407             column_name => 'only'
408              
409             Match Beginning of column value with string provided
410              
411             $filteronclick->beginswith('column_name' , 'string');
412              
413             Match ending of column value with string provided
414              
415             $filteronclick->endswith('column_name , 'string');
416              
417             Filter to columns that contain a particular string (no anchor point)
418              
419             $filteronclick->contains('column_name' , 'string');
420              
421             Show records with a numerical variance of a column value
422              
423             $filteronclick->variancenumerical('column_name' , number);
424              
425             Show records with a percentage variance of a column value
426              
427             $filteronclick->variancepercent('column_name' , number);
428              
429              
430             =head1 CONFIGURATION FILE
431              
432             As of version .9 you can assign many of the attributes via a configuration file
433             See the t/examples directory for a sample ini file
434              
435             =head1 METHOD NOTES
436              
437             The parameters are passed in via a hash, arrayref or scalar for the methods.
438             The Class::DBI::Plugin::FilterOnClick specific keys in the hash are preceeded
439             by a hypen (-). The build_table method allows for column names to be passed
440             in with their own anonymous subroutine (callback) if you need to produce any
441             special formating or linkage. Column name anonymous subroutines should NOT
442             begin with a hypen.
443              
444             =head1 METHODS
445              
446             =head2 filteronclick
447              
448             Creates a new Class::DBI::Plugin::FilterOnClick object
449              
450             $filteronclick = ClassDBIBase::Class->filteronclick();
451              
452             =head2 debug
453              
454             Wants: 0, 1 or 2
455              
456             Defaults to: 0
457              
458             Valid in Conifguration File: Yes
459              
460             Set to one to turn on debugging output. This will result in a considerable amount
461             of information being sent to the browser output so be sure to disable in production.
462             Can be set via method or configuration file. If set to 1 it will print debug
463             data via 'warn' if set to 2 it will print debug data via 'print'
464              
465             $filteronclick->debug(1);
466              
467             =head2 params
468              
469             Wants: Hash reference of page paramters
470              
471             Defaults to: {} (empty hash ref)
472              
473             This should be passed in via the filteronclick method as -params to allow
474             auto generation of various attributes, this documentation is provided for those
475             that want to handle various stages of the build process manually.
476              
477             Set the params that have been passed on the current request to the page/script
478              
479             $filteronclick->params( {
480             param1 => 'twenty'
481             } );
482            
483             Using CGI
484              
485             use URI::Escape;
486             my %params;
487              
488             map { $params{$_} =
489             uri_unescape($cgi->param("$_"))
490             } $cgi->param();
491              
492             $filteronclick->params( \%params );
493            
494             Using Apache::ASP
495              
496             $filteronclick->params( $Request->Form() );
497            
498             Using Embperl
499              
500             $filteronclick->params( \%fdat );
501              
502             =head2 config
503              
504             Wants: configuration key, value is optional
505              
506             Defatuls to: na
507              
508             Configuration values can be accessed directly or via the config method. This is
509             allowed so you know where the value you are calling is being assigned from.
510              
511             To get get a value:
512              
513             $filteronclick->config("searchable");
514              
515             To set a value do this:
516              
517             $filteronclick->config('searchable',1);
518              
519              
520             =head2 exclude_from_url
521              
522             Wants: Array reference
523              
524             Defaults to: [] (emptry array ref)
525              
526             Key/value pair to be removed from auto generated URL query strings. The key for
527             the page should be one of the items here to avoid navigation issues
528              
529             $filteronclick->exclude_from_url( [ 'page' ] );
530              
531             =head2 form_table
532              
533             Wants: HTML::Table object
534              
535             Defaults to: HTML::Table object
536              
537             Returns: HTML::Table object
538              
539             $filteronclick->form_table(); # get current form table object
540             $filteronclick->form_table($html_table_object); # set form table object
541              
542             There is no need to set this manually for simple forms. This method is a lingering
543             item and may be removed in future releases. If you use it please inform the author.
544              
545             =head2 field_to_column
546              
547             Wants: Hash
548              
549             Defaults to: empty
550              
551             $filteronclick->field_to_column(
552             'firstname' => 'First Name',
553             'lastname' => 'Last Name'
554             );
555              
556             =head2 cdbi_class
557              
558             Wants: string
559              
560             Defaults: n/a
561              
562             Returns: current value
563              
564             Sets or returns the table class the HTML is being generated for
565            
566             $filteronclick->cdbi_class();
567              
568             =head2 config_file
569              
570             Returns the name of the config_file currently in use
571              
572             =head2 rows
573              
574             Wants: Number
575              
576             Defaults to: 15
577              
578             Sets the number of rows the table output by build_table will contain per page
579              
580             $filteronclick->rows(20);
581              
582             =head2 html_table
583              
584             Wants: HTML::Table object
585              
586             Defaults to: HTML::Table object
587              
588             This is useful if you want to either create your own HTML::Table object and
589             pass it in or you want to heavily modify the resulting table from build_table.
590             See the L module for more information.
591              
592             =cut
593              
594             sub html_table : Plugged {
595             my ( $self, %args ) = @_;
596             my $new_table = HTML::Table->new(%args);
597             $self->data_table( $new_table );
598             $self->form_table( $new_table );
599             }
600              
601             =head2 build_table
602              
603             Wants: Hash
604              
605             Defatuls to: na
606              
607             Returns: HTML::Table object
608              
609             Accepts a hash of options to define the table parameters and content. This method
610             returns an HTML::Table object. It also sets the data_table method to the HTML::Table
611             object generated so you can ignore the return value and make further modifications
612             to the table via the built in methods.
613            
614             See Synopsis above for an example usage.
615              
616             The build_table method has a wide range of paramters that are mostly optional.
617              
618             =head2 exclude_columns
619              
620             Wants: Arrary reference
621              
622             Defaults to: na
623              
624             Valid in configuration File: Yes
625              
626             Returns: When called with no argument, returns current value; an array ref
627              
628             Removes fields even if included in the display_columns list.
629             Useful if you are not setting the columns or the columns are dynamic and you
630             want to insure a particular column (field) is not revealed even if someone adds
631             it somewhere else.
632              
633             =head2 extend_query_string
634              
635             Wants: hash of key and values to add
636              
637             Defaults to: na
638              
639             Valid in configuration File: No
640              
641             Returns: Current query string + the arguments passed in
642              
643             Adds elements to the query string to allow for creating custom predefined
644             links with the current filter options applied.
645              
646             =head2 data_table
647              
648             Wants: HTML::Table object
649              
650             Defaults to: na
651              
652             Returns: HTML::Table object is assigned
653              
654             Allows for you to pass in an HTML::Table object, this is handy
655             if you have setup the column headers or have done some special formating prior to
656             retrieving the results.
657              
658             =head2 pager_object
659              
660             Wants: Class::DBI::Pager object
661              
662             Defaults to: Class::DBI::Pager object
663              
664             Returns: Current pager_object
665              
666             Allows you to pass in a Class::DBI::Pager based object. This is useful in
667             conjunction with the html_table_navigation method. If not passed in
668             and no -records have been based it will use the calling class to perform the
669             lookup of records.
670              
671             As of version .9 you do not need to assign this manually, it will be auto
672             populated when call to 'filteronclick' is made.
673              
674             =head2 records
675              
676             Wants: Array reference
677              
678             Defaults to: na
679              
680             Returns: present value
681              
682             Expects an anonymous array of record objects. This allows for your own creation
683             of record retrieval methods without relying on the underlying techniques of the
684             build_table attempts to automate it. In other words you can send in records from
685             none Class::DBI sources, but you lose some functionality.
686              
687             =head2 where
688              
689             Wants: Hash reference
690              
691             Defaults to: Dynamically created hash ref based on query string values, part of
692             the FilterOnClick process.
693              
694             Expects an anonymous hash that is compatiable with Class::DBI::AbstractSearch
695              
696             =head2 order_by
697              
698             Wants: scalar
699              
700             Returns: current value if set
701              
702             Passed along with the -where OR it is sent to the retrieve_all_sort_by method
703             if present. The retrieve_all_sort_by method is part of the
704             L module.
705              
706             =head2 page_name
707              
708             Wants: scalar
709              
710             Returns: current value if set
711              
712             Valid in Configuration file: Yes
713              
714             Used within form and querystring creation. This is the name of the script that
715             is being called.
716              
717             =head2 query_string
718              
719             Wants: scalar
720              
721             Returns: current value if set
722              
723             It is not required to set this, it is auto generated through the FilterOnClick
724             process. This method is generally used for debugging.
725              
726             =head2 rowcolor_even
727              
728             Wants: Valid HTML code attribute
729              
730             Defaults to: '#ffffff'
731              
732             Returns: Current value if set
733              
734             Valid in Configuration file: Yes
735              
736             Define the even count row backgroud color
737              
738             =head2 rowcolor_odd
739              
740             Wants: Valid HTML code attributes
741              
742             Defaults to: '#c0c0c0'
743              
744             Valid in Configuration file: Yes
745              
746             Define the odd count row backgroud color
747              
748             =head2 rowclass
749              
750              
751             Valid in Configuration file: Yes
752              
753             (optional) - overrides the -rowcolor above and assigns a class (css) to table rows
754              
755             =head2 no_mouseover
756              
757             Valid in Configuration file: Yes
758              
759             Turns off the mouseover feature on the table output by build_table
760              
761             =head2 mouseover_class
762              
763              
764             Valid in Configuration file: Yes
765              
766             The CSS class to use when mousing over a table row
767              
768             =head2 searchable
769              
770              
771             Valid in Configuration file: Yes
772              
773             Enables free form searching within a column
774              
775             =head2 search_exclude
776              
777             Wants: arrayref of column names to not allow searching on
778              
779             Defaults to: []
780              
781             Returns: current columns to not allow searching for when called without parameters,
782             returns nothing when new values are passed in.
783              
784             list of columns that should allow for searching if searchable is set to 1
785              
786             =head2 mouseover_bgcolor
787              
788              
789             Valid in Configuration file: Yes
790              
791             Color for mouseover if not using a CSS definition. Defaults to red if not set
792              
793             =head2 filtered_class
794              
795             Valid in Configuration file: Yes
796              
797             Defines the CSS class to use for columns that currently have an active Filter
798              
799             =head2 ascending_string
800              
801             Wants: string (can be image name)
802              
803             Default to: '^'
804              
805             Valid in Configuration file: Yes
806              
807             The string used to represent the ascending sort filter option. If value ends
808             with a file extension assumes it is an image and adds approriate img tag.
809              
810             =head2 descending_string
811              
812             Wants: string (can be an image name)
813              
814             Defaults to: 'v'
815              
816             Valid in Configuration file: Yes
817              
818             The string used to represent the descending sort filter option. If value ends
819             with a file extension assumes it is an image and adds approriate img tag.
820              
821             =head2 rowclass_odd
822              
823             Valid in Configuration file: Yes
824              
825             The CSS class to use for odd rows within the table
826              
827             =head2 navigation_separator
828              
829             Valid in Configuration file: Yes
830              
831             The seperator character(s) for page navigation
832              
833             =head2 page_navigation_separator
834              
835             Valid in Configuration file: Yes
836              
837             The seperator for page navigation
838              
839             =head2 table field name (dynamic method)
840              
841             (code ref || (like,only) , optional) - You can pass in anonymous subroutines for
842             a particular field by using the table field name (column). Three items are
843             passed back to the sub; value of the column in the database, current url, and
844             the entire database record as a Class::DBI result object.
845              
846             Example:
847            
848             first_name => sub {
849             my ($name,$turl,$record) = @_;
850              
851             my $extra = $record->other_column();
852              
853             return qq!$name - $extra!;
854             },
855              
856             =cut
857              
858             sub determine_columns : Plugged {
859             my ($self,$columns) = @_;
860             my $class;
861            
862             if ( !$self->isa('Class::DBI::Plugin') ) {
863             $class = $self;
864             } else {
865             $class = $self->cdbi_class();
866             }
867            
868             my @columns;
869             if (ref $columns eq 'ARRAY') {
870             @columns = @{ $columns };
871             return @columns;
872             }
873            
874             if ( !@columns && ref $self->display_columns() eq 'ARRAY' ) {
875             @columns = @{ $self->display_columns() };
876             return @columns;
877             }
878            
879             if ( !@columns && ref $self->field_to_column() eq 'HASH' ) {
880             @columns = keys %{$self->field_to_column()};
881             return @columns;
882             }
883            
884             if ( !@columns ) {
885             @columns = $class->columns();
886             return @columns;
887             }
888            
889             return undef;
890            
891             }
892              
893             sub create_auto_hidden_fields : Plugged {
894             my ($self) = @_;
895             my $hidden = $self->params() || {};
896             my $hidden_options;
897             foreach my $hidden_field ( keys %{ $hidden } ) {
898             next if $hidden_field !~ /\w/;
899             $hidden_options .=
900             qq!!;
901             }
902             $self->auto_hidden_fields($hidden_options);
903             }
904              
905             sub filter_lookup : Plugged {
906             # determines the level of match on a particular filter
907             my ($self,$args) = @_;
908             my %args = %{ $args };
909             foreach ('-type','-value','-column','-base') {
910             $args{$_} ||= '';
911             }
912             if (defined $args{-type}) {
913             my %in = ();
914             if ( ref $self->current_filters() eq 'HASH') {
915             %in = %{ $self->current_filters() };
916             } else {
917             return 0;
918             }
919              
920             $self->output_debug_info("
" . Dumper(\%in) . "
");
921             $self->output_debug_info("
" . Dumper(\%args) . "
");
922             if (scalar(keys %in) > 0) {
923             foreach (keys %in) {
924             if (
925             lc($in{$_}{column}) eq lc($args{-column})
926             && $in{$_}{type} eq $args{-type}
927             && $in{$_}{base} eq $args{-base}
928             && $in{$_}{value} eq $args{-value}
929             ) {
930             return 3;
931             } elsif (
932             lc($in{$_}{column}) eq lc($args{-column})
933             && $in{$_}{type} eq $args{-type}
934             && $in{$_}{base} eq $args{-base}
935             ) {
936             return 2;
937             } elsif (lc($in{$_}{column}) eq lc($args{-column})
938             && $in{$_}{type} eq $args{-type}) {
939             return 1;
940             }
941             }
942             }
943            
944             }
945            
946             return 0;
947             }
948              
949             sub build_query_string : Plugged {
950            
951             # there are five conditions that need to be meet
952             # Condition 1 - Link with existing items from last query
953             # Condition 2 - Existing items minus current column if already filtered
954             # Condition 3 - Existing items plus ORDERBYCOL (minus existing ORDERBY if applicable)
955             # Condition 4 - Existing items plus additional item if sent in, but only if
956             # not currently in query_string
957             # Condition 5 - Existing items plus string navigation, but also exclude
958             # correctly if it was already in the list of links
959            
960             my ($self,%args) = @_;
961             foreach ('-type','-value','-column','-base') {
962             $args{$_} ||= '';
963             }
964             $args{-string_navigation} ||= 0;
965             $self->output_debug_info("
Building a QUERY_STRING
");
966             my $query_string = $self->query_string() || '';
967              
968             my $single = $args{-single} || 0;
969              
970             my %in = ();
971            
972              
973             # create a variable to track if we have active filters, possibly simpler
974             # then a hash check
975              
976             my $active_filters = 0;
977              
978             # check to see if the current filters exist, assign to %in if they do
979             if ( ref $self->current_filters() eq 'HASH') {
980             %in = %{ $self->current_filters() };
981             }
982              
983             my @existing_strings = ();
984             if (scalar(keys %in) > 0) {
985             foreach my $key (reverse sort keys %in) {
986             push @existing_strings, $in{$key}{type} . $in{$key}{value} . '-' .
987             $in{$key}{column} . "=" .
988             $in{$key}{base};
989             }
990             }
991             # set our active filters to true if we have keys in our %in hash
992             my $query_string_match = 0;
993              
994             if ($args{-type} =~ /(WITH|CONTAINS)$/i && !defined $args{-value} ) {
995             %args = ();
996             }
997              
998             if (scalar(keys %in) > 0) {
999             $active_filters = 1;
1000             if ( defined $args{-type} ) {
1001             $query_string_match = $self->filter_lookup(\%args);
1002             }
1003             }
1004            
1005             # rewrite of logic started on 5-20-2007
1006             # rethink everything
1007              
1008             # create a link based on the arguments passed in, this most likely
1009             # will most likely not be used, or that is the assumption anyway
1010             my $args_string = $args{-type} .
1011             $args{-value} .
1012             '-' .
1013             $args{-column} .
1014             "=" .
1015             $args{-base};
1016            
1017             # create an empty array to house our link strings
1018             my @string = ();
1019            
1020             my $skip;
1021            
1022             # determine our current column being worked on
1023             my $column = $args{-column} || $self->current_column();
1024            
1025             # lower case the column for "safety"
1026             $column = lc($column);
1027            
1028             # here is how the method is called
1029             # my $link = $self->build_query_string(-column => $column,
1030             # -value => $args{-value},
1031             # -type => $type,
1032             # -base => $link_val,
1033             # -single => $args{-single} || 0
1034             # );
1035            
1036             my %strings = ();
1037             my %short_strings = ();
1038             # number 1 lets create the args based extension if applicable
1039             if ( defined $args{-type} ) {
1040            
1041             my $alt_string;
1042              
1043             if ($single == 1 && $query_string_match < 3) {
1044             # single means we only want one link in the URL
1045             return $args_string;
1046             }
1047              
1048             if ( $query_string_match == 0 || $query_string_match == 1 || $args{-string_navigation} == 1) {
1049             $strings{$args_string}++;
1050             $in{'9999'}{column} = $args{-column} || '';
1051             $in{'9999'}{type} = $args{-type} || '';
1052             $in{'9999'}{value} = $args{-value} || '';
1053             $in{'9999'}{base} = $args{-base} || '';
1054            
1055             }
1056              
1057             }
1058              
1059             if ($active_filters) {
1060            
1061             foreach my $key (reverse sort keys %in) {
1062              
1063             my $type_and_value = $in{$key}{type} . $in{$key}{value};
1064              
1065             if ($self->url_query() =~ /$column/ && $in{$key}{column} eq $column) {
1066             next;
1067             }
1068              
1069             my $string = $in{$key}{type} . $in{$key}{value} . '-' .
1070             $in{$key}{column} . "=" .
1071             $in{$key}{base};
1072             next if defined $strings{$string} && exists $strings{$string};
1073             my $short_string = $in{$key}{type} . $in{$key}{column};
1074              
1075            
1076             $strings{$string}++;
1077             $short_strings{$short_string}++;
1078             next if ($strings{$string} > 1 || $short_strings{$short_string} > 1)
1079             && $in{$key}{type} !~ /begins|ends/i;
1080              
1081             }
1082             }
1083              
1084             my $out = join('&',keys %strings);
1085             $self->output_debug_info("
     In lower section - $column - $out
");
1086             #if (!$single) {
1087             my @count = $out =~ /ORDERBYCOL-(\w+)\=(ASC|DESC)/g;
1088             if (scalar(@count) > 2) {
1089             $out =~ s/ORDERBYCOL-(\w+)\=(ASC|DESC)//;
1090             }
1091             #}
1092             return $out;
1093              
1094              
1095             }
1096              
1097             sub query_string_intelligence : Plugged {
1098             # method will help deduce what should be done with
1099             # an incoming query string
1100              
1101             my ($self,%args) = @_;
1102             my $query_info;
1103             my $order_by;
1104             my $query_string = $args{-query_string} || $self->query_string();
1105             my %out = ();
1106            
1107             # break it into parts
1108             my %working = %{$self->params};
1109            
1110             my $base;
1111             my $count;
1112             foreach my $key (keys %working) {
1113             $count++;
1114             $self->output_debug_info( "Looking at: $key" );
1115             my $front = $key;
1116             $front =~ s/-(\w+)$//;
1117             my $column = $1;
1118             # look for =1 commands
1119             # if ($working{$key} == 1 || $key =~ /VARIANCE/) {
1120             if ($key =~ /CONTAINS|BEGINSWITH|ENDSWITH|VARIANCE/) {
1121             # CONTAINS00-price
1122             # $self->output_debug_info( "Silly Test!" );
1123             my $base = $working{$key};
1124             my ($type,$null,$value) =
1125             $front =~ /(CONTAINS|BEGINSWITH|ENDSWITH|VARIANCE(NUMERICAL|PERCENT))(\w+)/;
1126             $self->output_debug_info( "$type,$value,$column,$base" );
1127             if ($type) {
1128             $out{$count} = {
1129             type => $type || '',
1130             value => $value || '',
1131             base => $base || '',
1132             column => $column || '',
1133             };
1134             }
1135             next;
1136             }
1137            
1138             if ($front =~ /(only|orderbycol)/i) {
1139             my $type = uc($front);
1140             $out{$count} = {
1141             type => $type || '',
1142             base => $working{$key} || '',
1143             column => $column || '',
1144             value => '',
1145             # value => $value,
1146             };
1147             $self->output_debug_info( "$type,$column" );
1148             }
1149            
1150             }
1151            
1152             $self->current_filters(\%out);
1153             }
1154              
1155             sub colorize_value : Plugged {
1156             my ($self,$col,$text) = @_;
1157             #print "working on $col with $text\n";
1158             #sleep 2;
1159             if (defined $self->{column_value_colors}{$col} &&
1160             $text =~ /$self->{column_value_colors}{$col}[0]/ ) {
1161            
1162             $text = $cgi->span({
1163             -class => $self->{column_value_colors}{$col}[1]},
1164             $text
1165             );
1166             }
1167             return $text;
1168             }
1169              
1170             sub build_table : Plugged {
1171            
1172             my ( $self, %args ) = @_;
1173            
1174             my $table = $args{-data_table} || $self->data_table();
1175             if (!$table || !$table->isa( 'HTML::Table' ) ) {
1176             $table = HTML::Table->new();
1177             $self->data_table($table);
1178             }
1179             my $table_obj = $args{-pager_object} || $self->pager_object();
1180             my $page_name = $args{-page_name} || $self->page_name();
1181             my $query_string = $args{-query_string} || $self->query_string();
1182             my $exclude = $args{-exclude_columns} || $self->exclude_columns() || 0;
1183             my $where = $args{-where} || $self->where();
1184             my $order_by = $args{-order_by} || $self->order_by();
1185             my $filtered_class = $args{-filtered_class} || 'filtered';
1186             my $search = $args{-searchable} || $self->searchable || 0;
1187             my $find_columns = $args{-display_columns} || $self->field_to_column();
1188             my @search_exclude = @{$self->search_exclude()} || ();
1189             my $primary = $self->columns('Primary');
1190            
1191             my $class;
1192            
1193             # order by via query string adjustment
1194             if ($query_string && $query_string =~ /ORDERBYCOL/) {
1195             my ($order_col,$direction) = $query_string =~ m/BYCOL\-([\w\_]+)=(\w+)/;
1196             $order_by = "$order_col $direction";
1197             }
1198            
1199             my @columns = $self->determine_columns($find_columns);
1200            
1201             if ( !@columns ) {
1202             warn
1203             "Array 'columns' was not defined and could not be auto identified\n";
1204             }
1205            
1206             if ( ref($exclude) eq 'ARRAY' ) {
1207             @columns = $self->_process_excludes( $exclude, @columns );
1208             }
1209            
1210             # create text search row if requested
1211             if ($search) {
1212             my @text_fields;
1213             $self->create_auto_hidden_fields();
1214             foreach my $col (@columns) {
1215             # exclude any in the search exclude array
1216             if (@search_exclude) {
1217             if ( grep /$col/i , @{$self->search_exclude()} ) {
1218             push @text_fields , '';
1219             next;
1220             }
1221             }
1222             if ( grep /$col/i , $self->columns() ) {
1223              
1224             if ( ( !$self->search_primary() )
1225             && ( lc($col) eq lc($self->columns('Primary') ) ) ) {
1226             push @text_fields , '';
1227             next;
1228             }
1229             push @text_fields ,
1230             $cgi->start_form( -action => $page_name , -method => "get" ) .
1231             $cgi->textfield( -name => "SEARCH-$col",
1232             -size => 4 ) . $self->auto_hidden_fields() .
1233             $cgi->submit( -name => '', -value => "GO" ) .
1234             $cgi->end_form();
1235            
1236             #
1237             #! .
1238             #$self->auto_hidden_fields() .
1239             #qq!
1240             #!;
1241             } else {
1242             push @text_fields , '';
1243             }
1244             }
1245              
1246             $table->addRow(@text_fields);
1247             $table->setRowVAlign(-1,'top');
1248             my $corner = $table->getCell( 1, 1 );
1249             }
1250            
1251             my @records;
1252              
1253             if ( ref $args{-records} eq 'ARRAY' ) {
1254             @records = @{ $args{-records} };
1255             }
1256             else {
1257            
1258             # testing based on suggestion from user
1259            
1260             if ( ref $where eq 'ARRAY' ) {
1261             $self->output_debug_info( "Where was an ARRAY" );
1262             @records = $table_obj->search_where( @{ $where } );
1263             }
1264            
1265             elsif ( ref $where ne 'HASH' ) {
1266             if ( defined $order_by ) {
1267             $self->output_debug_info( "Where was NOT a HASH and we had an ORDER BY" );
1268             # @records = $table_obj->retrieve_all_sorted_by( $order_by );
1269             $table_obj->where($where);
1270             $table_obj->order_by($order_by);
1271             @records = $table_obj->search_where();
1272            
1273             }
1274             else {
1275            
1276             $self->output_debug_info( "Where was NOT a HASH" );
1277             @records = $table_obj->retrieve_all();
1278            
1279             }
1280              
1281             }
1282             else {
1283             $self->output_debug_info( "Last attempt to get records ($where,$order_by)" );
1284             $table_obj->where($where);
1285             $table_obj->order_by($order_by);
1286             @records =
1287             $table_obj->search_where();
1288             }
1289              
1290             }
1291             my $count;
1292              
1293             # define our background colors (even and odd rows)
1294             my $bgcolor = $args{-rowcolor_odd} || $self->rowcolor_odd() || '#c0c0c0';
1295             my $bgcolor2 = $args{-rowcolor_even} || $self->rowcolor_even() || '#ffffff';
1296            
1297             # define our colors or classes
1298             my $mouseover_bgcolor = $args{-mouseover_bgcolor} ||
1299             $self->mouseover_bgcolor() ||
1300             'red';
1301            
1302             my $mouseover_class = $args{-mouseover_class} ||
1303             $self->mouseover_class() ||
1304             '';
1305            
1306             # define if we use bgcolor or class to assign color
1307             my $js_this_object = 'this.bgColor';
1308             my $bg_over = $mouseover_bgcolor;
1309             my $bg_out_odd = $bgcolor;
1310             my $bg_out_even = $bgcolor2;
1311            
1312             if ($mouseover_class) {
1313             $js_this_object = 'this.className';
1314             $bg_over = $mouseover_class;
1315             $args{-rowclass} ||= $self->rowclass() || 'defaultRowClass';
1316             $args{-rowclass_odd} ||= $self->rowclass_odd() || 'defaultRowClassOdd';
1317             $bg_out_even = $args{-rowclass};
1318             $bg_out_odd = $args{-rowclass_odd};
1319             }
1320            
1321             foreach my $rec (@records) {
1322             $count++;
1323             my $pid = $rec->$primary();
1324             my @row;
1325             foreach my $working_column (@columns) {
1326             next if $working_column !~ /\w/;
1327             $self->current_column($working_column);
1328             $self->current_record($rec);
1329             if ($working_column =~ /_FilterOnClickCustom\d+?_/) {
1330             # do your thing
1331             if ( ref $args{$working_column} eq 'CODE' ) {
1332            
1333             push @row, $self->colorize_value($working_column,$args{$working_column}->(
1334             $pid,
1335             $working_column,
1336             $query_string,
1337             $rec
1338             )
1339             );
1340             }
1341             next;
1342             }
1343             if (!defined $args{$working_column} && defined $self->{column_filters}{$working_column}) {
1344             # print "$working_column : " . $self->{column_filters}{$working_column} . "\n";
1345             $args{$working_column} = $self->{column_filters}{$working_column};
1346             }
1347             $self->output_debug_info( "col = $working_column" );
1348             if ( ref $args{$working_column} eq 'CODE' ) {
1349             $self->output_debug_info("
Doing the match where the column on has CODE ref ($working_column)
");
1350             # test to add link to CODE columns as well
1351             if ($query_string && (
1352             $query_string =~ /CONTAINS[\w+]\-$working_column=/
1353             # SEARCH-price=00&=GO
1354             || $query_string =~ /SEARCH-$working_column/
1355             )
1356             ) {
1357             push @row,
1358             $self->add_link(
1359             -link_text => $self->colorize_value($working_column,$args{$working_column}->(
1360             $rec->$working_column,
1361             $query_string,
1362             $rec
1363             )
1364             ),
1365             -type => 'CONTAINS'
1366            
1367             );
1368             } else {
1369             push @row, $self->colorize_value($working_column,$args{$working_column}->(
1370             $rec->$working_column,
1371             $query_string,
1372             $rec
1373             )
1374             )
1375             }
1376             }
1377             elsif ( $args{$working_column} =~ /only|like|beginswith|endswith|contains|variance/i ) {
1378             $self->output_debug_info("Doing the match where the column on has one value and is not an ARRAY ref ($working_column)
");
1379             push @row,
1380             $self->add_link(
1381             -type => $args{$working_column},
1382             -link_text => $self->colorize_value($working_column,$rec->$working_column),
1383             );
1384              
1385             } elsif ( ref($args{$working_column}) eq 'ARRAY' ) {
1386             $self->output_debug_info("
Doing the match where the column on has one value and IS an ARRAY ref ($working_column)
");
1387             my ($type,$value) = @{ $args{$working_column} };
1388             my $display_value = $rec->$working_column;
1389            
1390             push @row,
1391             $self->add_link(
1392             -type => "$type",
1393             -value => "$value",
1394             -link_text => $self->colorize_value($working_column,$rec->$working_column),
1395             -hardcoded => 1
1396             );
1397            
1398             }
1399             else {
1400             $self->output_debug_info("
Doing the match where the column us in the url_query ($working_column)
");
1401             if (grep /$working_column/ , $self->cdbi_class->columns() ) {
1402             # is the match too agressive? it includes the character to match, should it?
1403             # I content not if the column value is already in the URL
1404             if ($self->url_query =~ /(VARIANCE|BEGINSWITH|ENDSWITH|CONTAINS)\w+\-$working_column/) {
1405             # my $type = $1;
1406             $self->output_debug_info("Trimmed down the regex capture $1
");
1407             push @row, $self->add_link(
1408             -type => $1,
1409             -link_text => $self->colorize_value($working_column,$rec->$working_column),
1410             -hardcoded => 1
1411             );
1412             } else {
1413             push @row, $self->colorize_value($working_column,$rec->$working_column);
1414             }
1415             }
1416             }
1417            
1418             if ($query_string && $query_string =~ /(ONL|VAR|BEGIN|ENDS|CONTAINS)\w+\-$working_column/) {
1419             $row[-1] = qq~
$row[-1]
~;
1420             } else {
1421             if (defined $self->{column_css_class}{$working_column}) {
1422            
1423             $row[-1] = qq~             qq~">$row[-1]~;
1425             }
1426             }
1427             }
1428             $table->addRow(@row);
1429            
1430             if ( ($count % 2 == 0) && $args{-rowclass} ne '' ) {
1431             $table->setRowClass( -1, $args{-rowclass} );
1432             } elsif ( ($count % 2 != 0) && $args{-rowclass} ne '' ) {
1433             $table->setRowClass( -1, $args{-rowclass_odd} );
1434             } elsif ( ($count %2 == 0) && $args{-rowclass} eq '') {
1435            
1436             $table->setRowBGColor( -1, $bgcolor2 );
1437              
1438             } elsif ( ($count %2 != 0) && $args{-rowclass} eq '') {
1439            
1440             $table->setRowBGColor( -1, $bgcolor );
1441             }
1442            
1443             $args{-no_mouseover} ||= $self->no_mouseover();
1444            
1445             if (!$args{-no_mouseover}) {
1446            
1447             my $out = $bg_out_odd;
1448             if ($count % 2 == 0) {
1449             $out = $bg_out_even;
1450             }
1451             $table->setRowAttr( -1 ,
1452             qq!onmouseover="$js_this_object='$bg_over'"
1453             onmouseout="$js_this_object='$out'"!);
1454             }
1455            
1456            
1457             # if defined $args{-rowclass};
1458             }
1459             $self->data_table($table);
1460             return $table;
1461             }
1462              
1463             sub add_link : Plugged {
1464              
1465             my ($self,%args) = @_;
1466              
1467             my $type = $args{-type};
1468             my $hardcoded = $args{-hardcoded};
1469             my $name = $args{-name} || $args{-link_text};
1470             my $value = $args{-value} || '';
1471              
1472             my $column = $args{-column} || $self->current_column();
1473             my $ourl = $self->url_query();
1474             my $page_name = $self->page_name();
1475             my $turl = $ourl;
1476              
1477             # my $link_text = $name;
1478             my $hs = HTML::Strip->new();
1479             my $link_text = $hs->parse( $name );
1480             $hs->eof;
1481              
1482             my $link_val = $link_text;
1483            
1484             $link_val = 1 if $type =~ /like|begin|end|contain/i;
1485              
1486             # add the string to the type if we are doing
1487             # a begin,end or contain link
1488            
1489             if ( $type =~ /begin|end|contain/i && !$hardcoded ) {
1490             # $type .= $name;
1491             # $self->output_debug_info("matched begin/end/contain");
1492             }
1493            
1494             # $self->output_debug_info(Dumper(\%args));
1495             my $link = $self->build_query_string(-column => $column,
1496             -value => $args{-value},
1497             -type => $type,
1498             -base => $link_val,
1499             -single => $args{-single} || 0,
1500             -string_navigation => $args{-string_navigation} || 0,
1501             );
1502             # $self->output_debug_info( " * * * THE LINK: $link" );
1503             return qq!$name!;
1504            
1505             }
1506              
1507             sub order_by_link : Plugged {
1508             my ($self,$column_name) = @_;
1509             return $self->{order_by_links}{$column_name};
1510             }
1511              
1512             sub create_order_by_links : Plugged {
1513             my ($self,%args) = @_;
1514            
1515             my $asc_string = $args{-ascending_string} || 'v';
1516             my $desc_string = $args{-descending_string} || '^';
1517             my $page_name = $args{-page_name} || $self->page_name() || '';
1518             #
1519              
1520             my $order_by_links_hashref;
1521            
1522             my @order_by_html;
1523             foreach my $col ( @{$self->display_columns} ) {
1524             #my $asc_qstring = "ORDERBYCOL-$col=ASC";
1525             #my $desc_qstring = "ORDERBYCOL-$col=DESC";
1526             my $query_string = $args{-query_string} ||
1527             $self->build_query_string() ||
1528             '';
1529             my $q_string_copy = $query_string;
1530             if ($query_string && $query_string =~ /ORDERBYCOL-(\w+)\=(ASC|DESC)/) {
1531             $query_string =~ s/ORDERBYCOL-(\w+)\=(ASC|DESC)//;
1532             }
1533             my $link_base = "$page_name?";
1534             my @qdesc = ( $query_string);
1535             my @qasc = @qdesc;
1536            
1537             #if ($query_string) {
1538            
1539             # $link_base .= "$query_string&";
1540             #}
1541              
1542              
1543             my $desc_qstring = $self->build_query_string(
1544             -type => 'ORDERBYCOL',
1545             -column => "$col",
1546             -base => 'DESC',
1547             -single => 1
1548             );
1549             $self->output_debug_info( $desc_qstring . "***
" );
1550             my $asc_qstring = $self->build_query_string(
1551             -type => 'ORDERBYCOL',
1552             -column => "$col",
1553             -base => 'ASC',
1554             -single => 1
1555             );
1556            
1557             my $asc_class_open = '';
1558             my $desc_class_open = '';
1559             my $asc_class_close = '';
1560             my $desc_class_close = '';
1561             $self->output_debug_info($q_string_copy . " this is the string");
1562             if ($q_string_copy && $q_string_copy =~ /$asc_qstring/i) {
1563             $asc_qstring = $query_string; # ~ s/\Q$asc_qstring//i;
1564             $asc_class_open = qq!!;
1565             $asc_class_close = qq!!;
1566             } else {
1567             push @qasc , $asc_qstring;
1568             #$asc_qstring .= '&' . $query_string;
1569             }
1570            
1571             if ($q_string_copy && $q_string_copy =~ /$desc_qstring/i) {
1572             $desc_qstring = $query_string;
1573             # ~ s/\Q$desc_qstring//i;
1574             $desc_class_open = qq!!;
1575             $desc_class_close = qq!!;
1576             } else {
1577             push @qdesc , $desc_qstring;
1578             #$desc_qstring .= '&' . $query_string;
1579             }
1580            
1581             if ($asc_string && $asc_string =~ /\.\w{3,}/i) {
1582             $asc_string = qq!!;
1583             }
1584            
1585             if ($desc_string && $desc_string =~ /\.\w{3,}/i) {
1586             $desc_string = qq!!;
1587             }
1588            
1589             my $asc_out = join('&',@qasc);
1590             my $desc_out = join('&',@qdesc);
1591             if ($asc_out) {
1592             $asc_out =~ s/^\&//;
1593             }
1594            
1595             if ($desc_out) {
1596             $desc_out =~ s/^\&//;
1597             }
1598            
1599             my $tstring = qq!
1600             $asc_class_open$asc_string$asc_class_close
1601             $desc_class_open$desc_string$desc_class_close
1602             !;
1603             push @order_by_html, $tstring;
1604             $order_by_links_hashref->{$col} = $tstring;
1605             }
1606             $self->order_by_links($order_by_links_hashref);
1607             return @order_by_html;
1608             }
1609              
1610             # this is a work in progress
1611             # intended to provide hidden field support
1612             # for both forms and table
1613              
1614             sub add_hidden : Plugged {
1615            
1616             my ($self,$args) = @_;
1617             my $hidden;
1618             my $html_table;
1619             if ( $hidden ) {
1620             my $corner = $html_table->getCell( 1, 1 );
1621             foreach my $hidden_field ( keys %{ $hidden } ) {
1622             next if $hidden_field !~ /\w/;
1623             $corner .=
1624             qq!!;
1625             }
1626              
1627             $html_table->setCell( 1, 1, $corner );
1628             }
1629              
1630             }
1631              
1632             sub build_form : Plugged {
1633              
1634             my ( $self, %args ) = @_;
1635              
1636             if ($self->use_formbuilder() ) {
1637             my $find_columns = $args{-display_columns} || $self->field_to_column();
1638             $self->display_columns($self->determine_columns($find_columns));
1639             $args{'fields'} ||= $self->display_columns();
1640             my $form = CGI::FormBuilder->new(
1641             %args,
1642             );
1643            
1644             return $form;
1645             }
1646              
1647             my $html_table = $args{-form_table} || $self->form_table() || HTML::Table->new();
1648             #if (!$html_table->isa( 'HTML::Table' ) ) {
1649             # $html_table = HTML::Table->new();
1650             #}
1651             my $labels = $args{-field_to_column} || $self->field_to_column();
1652             my @columns = $self->determine_columns($args{-display_columns} || $labels);
1653            
1654             my $hidden = $args{-hidden_fields} || $self->hidden_fields();
1655             my $exclude = $args{-exclude_columns} || $self->exclude_columns() || 0;
1656            
1657             if ( !@columns ) {
1658             warn
1659             "Array 'display_columns' was not defined and could not be auto identified\n";
1660             }
1661             if ( ref $exclude eq 'ARRAY' ) {
1662             @columns = $self->_process_excludes( $exclude , @columns );
1663             }
1664              
1665             my %cgi_field = $self->to_cgi;
1666              
1667             foreach my $col (@columns) {
1668             my $cell_content;
1669             if ( ref $args{$col} eq 'CODE' ) {
1670             $cell_content = $args{$col}->( $cgi_field{$col}->as_HTML() );
1671             }
1672             else {
1673              
1674             $cell_content = $cgi_field{$col}->as_HTML();
1675             }
1676              
1677             $html_table->addRow( $labels->{$col} || $col, $cell_content );
1678             $html_table->setRowClass( -1, $args{-rowclass} )
1679             if defined $args{-rowclass};
1680             }
1681              
1682             $args{-no_submit} ||= $self->no_submit();
1683              
1684             if ( !$args{-no_submit} ) {
1685             $html_table =
1686             $self->_process_attributes( $args{-attributes}, $html_table );
1687             $html_table->addRow();
1688             $html_table->setCellColSpan( $html_table->getTableRows, 1,
1689             $html_table->getTableCols );
1690             $html_table->setCell( $html_table->getTableRows, 1,
1691             CGI::submit( '.submit', 'Continue' ) );
1692             }
1693              
1694             if ( $hidden ) {
1695             my $corner = $html_table->getCell( 1, 1 );
1696             foreach my $hidden_field ( keys %{ $hidden } ) {
1697             next if $hidden_field !~ /\w/;
1698             $corner .=
1699             qq!!;
1700             }
1701              
1702             $html_table->setCell( 1, 1, $corner );
1703             }
1704              
1705             $args{-no_form_tag} ||= $self->no_form_tag();
1706              
1707             if ( !$args{-no_form_tag} ) {
1708             $html_table =
1709             start_form( $args{-form_tag_attributes} ) . $html_table . end_form;
1710             }
1711              
1712             return $html_table;
1713              
1714             }
1715              
1716             sub _process_attributes : Plugged {
1717             my ( $self, $attributes, $html_table ) = @_;
1718             foreach ( keys %{$attributes} ) {
1719             if ( ref $attributes->{$_} eq 'ARRAY' ) {
1720             $self->output_debug_info( "_process_attributes is doing a $_" );
1721             $html_table->$_( @{ $attributes->{$_} } );
1722             }
1723             else {
1724             $html_table->$_( $attributes->{$_} );
1725             }
1726             }
1727             return $html_table;
1728             }
1729              
1730             sub _process_excludes : Plugged {
1731              
1732             my ( $self, $exclude_list, @columns ) = @_;
1733             my %exclude;
1734             map { $exclude{$_} = 1 } @{$exclude_list};
1735             $self->output_debug_info( "excluding" . Dumper(\%exclude) );
1736             map { undef $_ if exists $exclude{$_} } @columns;
1737             return grep /\w/, @columns;
1738             }
1739              
1740              
1741              
1742             =head2 html_table_navigation
1743              
1744             Creates HTML anchor tag (link) based navigation for datasets. Requires Class::DBI::Pager.
1745             Navigation can be in google style (1 2 3 4) or block (previous,next).
1746              
1747             my $nav = $cdbi_plugin_html->html_table_navigation(
1748             -pager_object => $pager,
1749             # pass in -navigation with block as the value for
1750             # next/previous style
1751             # "google" style is the default
1752             -navigation_style => 'block',
1753             -page_name => 'test2.pl',
1754             );
1755              
1756             print "'$nav'\n";
1757              
1758             =cut
1759              
1760             sub html_table_navigation : Plugged {
1761             my ( $self, %args ) = @_;
1762             my $pager = $args{-pager_object} || $self->pager_object();
1763              
1764             my $nav_block;
1765             my $nav_number;
1766             my $page_name = $args{-page_name} || $self->page_name();
1767             my $query_string = $args{-query_string} || $self->query_string() || '';
1768             my $navigation_style = $args{-navigation_style} || $self->navigation_style()
1769             || 'both';
1770             my $page_navigation_separator = $args{-page_navigation_separator} ||
1771             $self->page_navigation_separator() ||
1772             ' | ';
1773            
1774             my $first_page_link = CGI::a(
1775             {
1776             href => "$page_name?page="
1777             . $pager->first_page . '&'
1778             . $query_string
1779             },'first'
1780             );
1781            
1782             my $last_page_link = CGI::a(
1783             {
1784             href => "$page_name?page="
1785             . $pager->last_page . '&'
1786             . $query_string
1787             },'last'
1788             );
1789             if ($pager->total_entries() <= $self->rows()) {
1790             $last_page_link = '';
1791             $first_page_link = '';
1792             }
1793             if ( defined $navigation_style
1794             && defined $page_name )
1795             {
1796              
1797             if ( $pager->previous_page ) {
1798             $nav_block .= CGI::a(
1799             {
1800             href => "$page_name?page="
1801             . $pager->previous_page . '&'
1802             . $query_string
1803             },
1804             'prev'
1805             );
1806              
1807             }
1808              
1809             if ( $pager->previous_page && $pager->next_page ) {
1810             $nav_block .= $page_navigation_separator;
1811             }
1812              
1813             if ( $pager->next_page ) {
1814             $nav_block .= CGI::a(
1815             {
1816             href => "$page_name?page="
1817             . $pager->next_page . '&'
1818             . $query_string
1819             },
1820             'next'
1821             );
1822             }
1823              
1824            
1825             #} else {
1826            
1827             # determine paging system
1828             # need to allow for "to first" and "to last" record list
1829             # need to allow for "next" and "previous"
1830             # need to show which record group we are on
1831             # need to limit the list of records via an argument and/or
1832             # a reasonable default.
1833            
1834             if ( ($pager->total_entries / $pager->entries_per_page) > 10 ) {
1835            
1836             my $left = $pager->last_page - $pager->current_page;
1837             my $offset = $left;
1838             if ($left > 9) {
1839             $offset = 9;
1840             }
1841             foreach my $num ( $pager->current_page .. $offset + $pager->current_page ) {
1842             $nav_number .= add_number($pager->current_page,$num,$page_name,$query_string);
1843             }
1844            
1845             } else {
1846            
1847             foreach my $num ( $pager->first_page .. $pager->last_page ) {
1848             # $current,$number,$page_name,$query_string
1849             $nav_number .= add_number($pager->current_page,$num,$page_name,$query_string);
1850             }
1851            
1852             }
1853             #}
1854             }
1855             if ($nav_number) {
1856             $nav_number = '' if $nav_number =~ /\[ 1 \]\s$/;
1857             }
1858              
1859             my $nav = $nav_number;
1860              
1861             # warn "'$nav_number'\n";
1862              
1863             if ( lc( $navigation_style ) eq 'both' ) {
1864             if ( $nav_block =~ /\|/ ) {
1865             $nav_block =~ s/ \| / $nav_number/;
1866             $nav = $nav_block;
1867             }
1868             elsif ( $nav_block =~ m#prev$# ) {
1869             $nav = $nav_block . ' ' . $nav_number;
1870             }
1871             else {
1872             $nav = $nav_number . ' ' . $nav_block;
1873             }
1874              
1875             }
1876              
1877             if ( $navigation_style eq 'block' ) {
1878             $nav = $nav_block;
1879             }
1880            
1881             return $first_page_link . " " . $nav . " $last_page_link";
1882             }
1883              
1884             sub add_number {
1885             my ($current,$num,$page_name,$query_string) = @_;
1886             my $nav_num;
1887             if ( $num == $current ) {
1888             $nav_num .= "[ $num ]";
1889             }
1890             else {
1891             $nav_num .= '[ ';
1892             $nav_num .= CGI::a(
1893             {
1894             href =>
1895             "$page_name?page=$num&$query_string"
1896             },
1897             $num
1898             );
1899             $nav_num .= ' ]';
1900             }
1901             $nav_num .= ' ';
1902             return $nav_num;
1903             }
1904              
1905             sub fill_in_form : Plugged {
1906             my ( $self, %args ) = @_;
1907             my $fif = new HTML::FillInForm;
1908             return $fif->fill(%args);
1909              
1910             }
1911              
1912             =head2 add_bottom_span
1913              
1914             Places the content you pass in at the bottom of the HTML::Table
1915             object passed in. Used for adding "submit" buttons or navigation to
1916             the bottom of a table.
1917              
1918             =cut
1919              
1920             sub add_bottom_span : Plugged {
1921             my ( $self, $add ) = @_;
1922             $self->data_table->addRow();
1923             $self->data_table->setCellColSpan( $self->data_table->getTableRows,
1924             1,
1925             $self->data_table->getTableCols );
1926             $self->data_table->setCell( $self->data_table->getTableRows, 1, $add );
1927             # return $table;
1928             }
1929              
1930             =head2 search_ref
1931              
1932             Creates the URL and where statement based on the parameters based
1933             into the script. This method sets the query_string accessor value
1934             and returns the where hash ref.
1935              
1936             $cdbi_plugin_html->search_ref(
1937             # hash ref of incoming parameters (form data or query string)
1938             # can also be set via the params method instead of passed in
1939             -params => \%params,
1940            
1941             # the like parameters by column (field) name that the
1942             # SQL statement should include in the where statement
1943             -like_column_map => { 'first_name' => 'A%' },
1944            
1945             );
1946              
1947             =head2 url_query
1948              
1949             Creates the query portion of the URL based on the incoming parameters, this
1950             method sets the query_string accessor value and returns the query string
1951              
1952             $cdbi_plugin_html->url_query(
1953            
1954             # pass in the parameters coming into the script as a hashref
1955             -params => \%params,
1956            
1957             # items to remove from the url, extra data that
1958             # doesn't apply to the database fields
1959             -exclude_from_url => [ 'page' ],
1960             );
1961              
1962             =head2 navigation_style
1963              
1964             Wants: string, either 'block' or 'both'
1965              
1966             Defaults to: block
1967              
1968             Valid in Configuration File: Yes
1969              
1970             Returns: Current setting
1971              
1972             $filteronclick->navigation_style('both');
1973              
1974             The navigation style applies to the string_filer_navigation method.
1975              
1976             =head2 string_filter_navigation
1977              
1978             my ($filter_navigation) = $cdbi_plugin_html->string_filter_navigation(
1979             -position => 'ends'
1980             );
1981              
1982             This method creates navigation in a series of elements, each element indicating a item that
1983             should appear in a particular column value. This filter uses anchor points to determine how
1984             to qualify the search. The anchor points are:
1985             BEGINSWITH
1986             ENDSWITH
1987             CONTAINS
1988              
1989             The items in the 'strings' list will only be hrefs if the items in the database
1990             match the search. If you prefer them not to be displayed at all pass in the
1991             -hide_zero_match
1992              
1993             The allowed parameters to pass into the method are:
1994              
1995             =head2 hide_zero_match
1996              
1997             Removes items that have no matches in the database from the strings allowed in the final navigation.
1998              
1999             -position (optional - default is 'begin') - Tells the method how to do the match, allowed options are any case
2000             of 'begin' , 'end' or 'contains'. These options can be the entire anchor points as outlined above,
2001             but for ease of use only the aforemention is enforced at a code level.
2002              
2003             =head2 query_string
2004              
2005             (optional) - See methods above for documentation
2006              
2007             =head2 navigation_list
2008              
2009             (optional, array_ref - default is A-Z) - Array ref containing the strings to filter on.
2010              
2011             =head2 navigation_column
2012              
2013             Indicates which column the string filter will occur on.
2014             If you want to provide a filter on multiple columns it is recommended that
2015             you create multiple string_filter_navigation.
2016             Can be set via method, string_filter_navigation argument or configuration file
2017              
2018             -page_name - The name of page that the navigation should link to
2019              
2020             =head2 navigation_alignment
2021              
2022             Set HTML attribute alignment for the page navigation.
2023              
2024             =head2 navigation_seperator
2025              
2026             $filteronclick->navigation_seperator('::');
2027             -or-
2028             -navigation_seperator => '::' # argument passed into string_filter_navigation
2029             -or-
2030             navigation_sperator=:: in the configuration file
2031            
2032             (optional, default two non-breaking spaces) - The characters to place between each item in the list.
2033              
2034             =head2 align
2035              
2036             (optional, defaults to center) - defines the alignment of the navigation
2037              
2038             =head2 no_reset
2039              
2040             don't include the filter reset link in the output
2041              
2042             =head2 form_select
2043              
2044             This method is used in conjunction with build_form and is slated for removal in
2045             the next release. Please contact the author if you use this method or are
2046             interested in seeing it improved rather then removed.
2047              
2048             this methods expects the following:
2049              
2050             -value_column # column containing the value for the option in the select
2051             -text_column # column containing the text for the optoin in the select (optional)
2052             -selected_value # the value to be selected (optional)
2053             -no_select_tag # returns option list only (optional)
2054              
2055              
2056             =head1 FILTERS
2057              
2058             Filters are generated with the build_table method. Filters allow for cascading
2059             drill down of data based on individual cell values. See Example page for
2060             a demo.
2061              
2062             =head2 beginswith
2063              
2064             Declare a begins with match on a column
2065              
2066             $filteronclick->beginswith('column_name','A');
2067             # where 'A' is the value to match at the beginning
2068              
2069             =head2 endswith
2070              
2071             $filteronclick->endswith('column_name','A');
2072             # where 'A' is the value to match at the end of the column contents
2073              
2074             =head2 contains
2075              
2076             $filteronclick->contains('column_name','A');
2077             # where 'A' is the value to match anywhere in the column contents
2078              
2079             =head2 variancepercent
2080              
2081             $filteronclick->variancepercent('column_name',2);
2082             # where '2' is the allowed percentage of variance to filter on
2083              
2084             =head2 variancenumerical
2085              
2086             $filteronclick->variancenumerical('column_name',2);
2087             # where '2' is the allowed variance to filter on based
2088             # if value for 'column_name' is clicked
2089              
2090             =head2 only
2091              
2092             $filteronclick->only('column_name');
2093             # creates a filter on 'column_name' cells to match the value in the cell
2094             # clicked
2095              
2096             =head1 Additional Column Value Methods
2097              
2098             =head2 colorize
2099              
2100             Wants: list with column name, regular expression and CSS class name
2101              
2102             Defaults to: na
2103              
2104             Returns: na
2105              
2106             $filteronclick->colorize('column_name','regex','className');
2107             # will colorize a cell value based on a css entry when the value
2108             # matches the regex passed in
2109              
2110             This method will colorize a cell with matching content based on a CSS class
2111             passed into it. The appropriate html markup for the css is added to the output.
2112              
2113             =cut
2114              
2115             sub string_filter_navigation : Plugged {
2116              
2117             # intent of sub is to provide a consistent way to navigate to find
2118             # records that contain a particular string.
2119             my ( $self, %args ) = @_;
2120             $self->output_debug_info("STARTING STRING NAV!");
2121             # set up or variables and defaults
2122              
2123             my @links;
2124              
2125             my @alphabet;
2126              
2127             $args{-strings} = $args{-navigation_list} || $self->navigation_list();
2128              
2129             if (ref($args{-strings}) eq 'ARRAY') {
2130             @alphabet = @{ $args{-strings} }
2131             } else {
2132             @alphabet = ( 'A' .. 'Z' )
2133             }
2134              
2135             my $navigation_separator = $args{-navigation_separator} ||
2136             $self->navigation_separator() ||
2137             '  ';
2138            
2139             my $navigation_alignment = $args{-navigation_alignment}
2140             || $self->navigation_alignment()
2141             || 'center';
2142            
2143             my $page_name = $args{-page_name} || $self->page_name();
2144             my $query_string = $args{-query_string} || $self->query_string();
2145             my $filtered_class = $args{-filtered_class}
2146             || $self->filtered_class()
2147             || 'filtered';
2148            
2149             $args{-no_reset} ||= $self->no_reset();
2150            
2151             if ( $args{-no_reset} == 0 ) {
2152             push @links, qq!Reset$args{-separator}!;
2153             }
2154             my $filter;
2155             my $link_type;
2156            
2157             foreach my $string (@alphabet) {
2158            
2159             if ( $args{-position} =~ /ends/i ) {
2160             $filter = "\%$string";
2161             $link_type = 'ENDSWITH';
2162             }
2163             elsif ( $args{-position} =~ /contain/i ) {
2164             $filter = "\%$string\%";
2165             $link_type = 'CONTAINS';
2166             }
2167             else {
2168             $filter = "$string\%";
2169             $link_type = 'BEGINSWITH';
2170             }
2171              
2172             my $count = $self->cdbi_class()->count_search_where(
2173             $args{-column} => { like => "$filter" }
2174             );
2175             if ($count) {
2176             $self->output_debug_info("sending some info");
2177             push @links,
2178            
2179             $self->add_link(
2180             -type => $link_type,
2181             -link_text => $string,
2182             -value => $string,
2183             -column => $args{-column},
2184             -string_navigation => 1,
2185             );
2186            
2187             }
2188             elsif ( $args{-hide_zero_match} > 1 ) {
2189              
2190             # do nothing
2191             }
2192             else {
2193             push @links, qq!$string!;
2194             }
2195              
2196             if ($query_string =~ /(WITH|CONTAINS)$string\-$args{-column}/) {
2197             $links[-1] = qq~$links[-1]~;
2198             }
2199            
2200             if (scalar(@links) % 30 == 0) {
2201             $links[-1] .= "
";
2202             }
2203             }
2204             $self->output_debug_info("ENDING STRING NAV!");
2205             return qq!
!
2206             . join( $navigation_separator, @links )
2207             . "";
2208             }
2209              
2210             sub search_ref : Plugged {
2211             my ( $self, %args ) = @_;
2212             $args{-exclude_from_url} ||= $self->exclude_from_url();
2213             $args{-params} ||= $self->params();
2214             my %where;
2215             if ( exists $args{-exclude_from_url} ) {
2216              
2217             # print_arrayref("Exclude from URL",$args{-exclude_from_url});
2218             map { delete $args{-params}->{$_} } @{ $args{-exclude_from_url} };
2219             }
2220              
2221             if ( exists $args{-params} ) {
2222              
2223             # print_hashref("Incoming parameters",$args{-params});
2224             my @only = grep /ONLY\-/, keys %{ $args{-params} };
2225             my @like = grep /LIKE\-/, keys %{ $args{-params} };
2226             my @beginswith = grep /BEGINSWITH\w+/, keys %{ $args{-params} };
2227             my @endswith = grep /ENDSWITH\w+/, keys %{ $args{-params} };
2228             my @contains = grep /CONTAINS[\@\w+]/, keys %{ $args{-params} };
2229             my @percentage = grep /VARIANCEPERCENT\d+/, keys %{ $args{-params} };
2230             my @numerical = grep /VARIANCENUMERICAL\d+/, keys %{ $args{-params} };
2231            
2232             if (@only) {
2233             $self->output_debug_info( "\tOnly show matches of: " );
2234             foreach my $only (@only) {
2235             $self->output_debug_info( $only );
2236             $only =~ s/ONLY-//;
2237              
2238             # print qq~\t\t$only becomes $only = '$args{-params}->{"ONLY-" . $only}'\n~;
2239             $where{$only} = $args{-params}->{ "ONLY-" . $only };
2240             }
2241              
2242             }
2243              
2244             if (@like) {
2245              
2246             # print "\tLike clauses to be added\n";
2247             foreach my $like (@like) {
2248             $like =~ s/LIKE-//;
2249              
2250             # print "\t\t$like becomes \"first_name LIKE '$args{-like_column_map}->{$like}'\"\n";
2251             if ( exists $args{-like_column_map}->{$like} ) {
2252              
2253             $where{$like} =
2254             { 'LIKE', $args{-like_column_map}->{$like} };
2255             }
2256             }
2257             }
2258              
2259             if (@beginswith) {
2260             $self->output_debug_info( "\tShow only begining with" );
2261             foreach my $beginswith (@beginswith) {
2262             my ( $value, $column ) =
2263             $beginswith =~ m/beginswith(\w+)-([\w\_]+)/i;
2264             $self->output_debug_info(
2265             qq~ '$beginswith' - looking $column that begins with $value~);
2266             $where{$column} = { 'LIKE', "$value\%" };
2267             }
2268             }
2269              
2270             if (@endswith) {
2271             $self->output_debug_info("\tShow only endswith with");
2272            
2273             foreach my $endswith (@endswith) {
2274             my ( $value, $column ) =
2275             $endswith =~ m/endswith(\w+)-([\w\_]+)/i;
2276             $self->output_debug_info(
2277             qq~\t\t'$endswith' - looking $column that ends with $value~);
2278             $where{$column} = { 'LIKE', "\%$value" };
2279             }
2280             }
2281              
2282             if (@contains) {
2283             $self->output_debug_info("\tShow only entries that contain");
2284             my $null = 'IS NULL';
2285             my $notnull = 'IS NOT NULL';
2286             foreach my $contains (@contains) {
2287             my ( $value, $column ) =
2288             $contains =~ m/contains(.+)-([\w\_]+)/i;
2289             $self->output_debug_info(
2290             qq~\t\t'$contains' - looking $column that contain $value~);
2291             if ($value eq 'NOTNULL') {
2292             $where{$column} = \$notnull;
2293             } elsif ($value eq 'NULL') {
2294             $where{$column} = \$null;
2295             } elsif ($value eq 'NOSTRING') {
2296             $where{$column} = '';
2297             } else {
2298             $where{$column} = { 'LIKE', "\%$value\%" };
2299             }
2300             }
2301             }
2302              
2303             if (@percentage) {
2304             $self->output_debug_info(
2305             "\tShow only entries that are within a percentage variance");
2306             foreach my $per (@percentage) {
2307             my ( $percent , $column ) =
2308             # VARIANCEPERCENT5-wt=170
2309             $per =~ m/VARIANCEPERCENT(\d+)-([\w\_]+)/i;
2310             # $per =~ m/VARIANCEPERCENT(\d+)-([\w\_]+)/i;
2311             my $value = $args{-params}->{$per};
2312             $self->output_debug_info(
2313             qq~ $per - looking for $percent variance
2314             on $column where value for variance is $value~);
2315             $percent = $percent / 100;
2316             my $diff = $value * $percent;
2317            
2318             my $high = $value + $diff;
2319             my $low = $value - $diff;
2320            
2321             $where{$column} = { 'BETWEEN' , [ $low , $high ] };
2322             }
2323             }
2324            
2325             if (@numerical) {
2326             $self->output_debug_info("\tShow only entries that are within a percentage variance");
2327             foreach my $string (@numerical) {
2328             my ( $number , $column ) =
2329             # VARIANCEPERCENT5-wt=170
2330             $string =~ m/VARIANCENUMERICAL(\d+)-([\w\_]+)/i;
2331             # $per =~ m/VARIANCEPERCENT(\d+)-([\w\_]+)/i;
2332             my $value = $args{-params}->{$string};
2333             $self->output_debug_info(
2334             qq~ $string - looking for $number variance
2335             on $column where value for variance is $value~);
2336            
2337            
2338             my $high = $value + $number;
2339             my $low = $value - $number;
2340            
2341             $where{$column} = { 'BETWEEN' , [ $low , $high ] };
2342             }
2343             }
2344            
2345             }
2346              
2347             if (exists $args{-override}) {
2348             %where = ( %where , %{ $args{-override} } );
2349             }
2350              
2351             if ( scalar( keys %where ) > 0 ) {
2352             $self->where( \%where );
2353             return \%where;
2354             }
2355             else {
2356             $self->where( undef );
2357             return undef;
2358             }
2359              
2360             }
2361              
2362             sub url_query : Plugged {
2363             my ( $self, %args ) = @_;
2364             $args{-params} ||= $self->params();
2365             $args{-exclude_from_url} ||= $self->exclude_from_url();
2366             if ( exists $args{-exclude_from_url} ) {
2367             map { delete $args{-params}->{$_} } @{ $args{-exclude_from_url} };
2368             }
2369             my %Param = %{ $args{-params} };
2370             my @url;
2371             foreach my $key ( keys %Param ) {
2372              
2373             if ( $key =~ m/\w/ && defined $Param{"$key"} ) {
2374             $self->output_debug_info("url_query $key
");
2375             push @url, qq~$key=~ . uri_escape( $Param{"$key"} )
2376             if defined $Param{"$key"}; # ne '';
2377             }
2378             }
2379              
2380             if ( $url[0] ) {
2381             $self->query_string( join( '&', @url ) );
2382             return join( '&', @url );
2383             }
2384             else {
2385             $self->query_string( undef );
2386             return undef;
2387             }
2388             }
2389              
2390             sub form_select : Plugged {
2391             my ( $self, %args ) = @_;
2392              
2393             my $html;
2394             my @objs = $self->get_records(%args);
2395             my $value_column = $args{'-value_column'};
2396             my $text_column = $args{'-text_column'};
2397             my $divider = $args{'-text_divider'};
2398             $divider ||= ', ';
2399             foreach my $obj (@objs) {
2400             my $text;
2401             my $value = $obj->$value_column();
2402             if ( ref($text_column) eq 'ARRAY' ) {
2403             my @text_multiple;
2404             foreach my $tc ( @{$text_column} ) {
2405             push @text_multiple, $obj->$tc();
2406             }
2407             $text = join( $divider, @text_multiple );
2408             }
2409             elsif ($text_column) {
2410             $text = $obj->$text_column();
2411             }
2412             else {
2413             $text = $value;
2414             }
2415             my $selected;
2416             $selected = ' SELECTED' if $value eq $args{'-selected_value'};
2417             $html .= qq!\n!;
2418              
2419             }
2420             if ( $args{no_select_tag} == 0 ) {
2421             $html = qq!
2422             $html
2423             !;
2424             }
2425             return $html;
2426             }
2427              
2428             sub get_records : Plugged {
2429              
2430             # this code was taken from the build_table method
2431             # due to a limitation of the Class::DBI::Pager module and/or the way
2432             # in which this module identifies itself this code is currently replicated
2433             # here since Class::DBI::Pager throws and error when used.
2434             # behavior was retested with Class::DBI::Plugin and problem persisted
2435              
2436             my ( $table_obj, %args ) = @_;
2437             my $order_by = $args{-order_by} || $table_obj->order_by();
2438             if ( $table_obj->isa('Class::DBI::Plugin::FilterOnClick') ) {
2439             $table_obj = $table_obj->cdbi_class() ||
2440             $table_obj->pager_object()
2441            
2442             }
2443             $table_obj->output_debug_info( Dumper($table_obj) );
2444             my @records;
2445             if ( ref $args{-where} ne 'HASH' ) {
2446             if ( defined $order_by ) {
2447             @records = $table_obj->retrieve_all_sorted_by( $order_by );
2448             }
2449             else {
2450             @records = $table_obj->retrieve_all;
2451             }
2452              
2453             # @records = $table_obj->search( user_id => '>0' , { order_by => $args{-order} } );
2454             }
2455             else {
2456              
2457             # my %attr = $args{-order};
2458             @records =
2459             $table_obj->search_where( $args{-where}, { order => $order_by } );
2460             }
2461             return @records;
2462             }
2463              
2464             =head1 INTERNAL METHODS/SUBS
2465              
2466             If you want to change behaviors or hack the source these methods and subs should
2467             be reviewed as well.
2468              
2469             =head2 get_records
2470              
2471             Finds all matching records in the database
2472              
2473             =head2 create_order_by_links
2474              
2475             =head2 add_number
2476              
2477             =head2 determine_columns
2478              
2479             Finds the columns that are to be displayed
2480              
2481             =head2 auto_hidden_fields
2482              
2483             =head2 add_hidden
2484              
2485             =head2 create_auto_hidden_fields
2486              
2487             =head2 add_link
2488              
2489             =head2 allowed_methods
2490              
2491             =head2 build_form
2492              
2493             =head2 build_query_string
2494              
2495             =head2 colorize_value
2496              
2497             =head2 column_css_class
2498              
2499             =head2 current_column
2500              
2501             =head2 current_filters
2502              
2503             =head2 current_record
2504              
2505             =head2 fill_in_form
2506              
2507             =head2 filter_lookup
2508              
2509             =head2 hidden_fields
2510              
2511             =head2 html
2512              
2513             =head2 no_form_tag
2514              
2515             =head2 no_submit
2516              
2517             =head2 on_page
2518              
2519             =head2 order_by_link
2520              
2521             =head2 order_by_links
2522              
2523             =head2 output_debug_info
2524              
2525             =head2 query_string_intelligence
2526              
2527             =head2 read_config
2528              
2529             =head2 search_primary
2530              
2531             =head2 use_formbuilder
2532              
2533             =head1 BUGS
2534              
2535             Unknown at this time.
2536              
2537             =head1 SEE ALSO
2538              
2539             L, L, L,
2540             L, L
2541              
2542             =head1 AUTHOR
2543              
2544             Aaron Johnson
2545             aaronjjohnson@gmail.com
2546              
2547             =head1 THANKS
2548              
2549             Thanks to my Dad for buying that TRS-80 in 1981 and getting
2550             me addicted to computers.
2551              
2552             Thanks to my wife for leaving me alone while I write my code
2553             :^)
2554              
2555             The CDBI community for all the feedback on the list and
2556             contributors that make these utilities possible.
2557              
2558             Roy Johnson (no relation) for reviewing the documentation prior to the 1.1
2559             release.
2560              
2561             =head1 CHANGES
2562              
2563             Changes file included in distro
2564              
2565             =head1 COPYRIGHT
2566              
2567             Copyright (c) 2004-2007 Aaron Johnson.
2568             All rights Reserved. This module is free software.
2569             It may be used, redistributed and/or modified under
2570             the same terms as Perl itself.
2571              
2572             =cut
2573              
2574              
2575             sub params : Plugged {
2576             my $self = shift;
2577              
2578             if(@_ == 1) {
2579             my $params = shift;
2580             foreach my $key ( keys %{ $params } ) {
2581             next if $key !~ /SEARCH/;
2582             if (!defined $params->{$key}) {
2583             delete $params->{$key};
2584             next;
2585             }
2586             my ($column) = $key =~ /SEARCH-(.+)/;
2587             $params->{"CONTAINS$params->{$key}-$column"} = 1;
2588             delete $params->{$key};
2589             }
2590             $self->{params} = $params;
2591             }
2592             elsif(@_ > 1) {
2593             $self->{params} = [@_];
2594             }
2595              
2596             return $self->{params};
2597             }
2598              
2599              
2600             sub field_to_column : Plugged {
2601             my ($self) = shift;
2602             if(@_ > 1) {
2603             my %args;
2604             tie %args , 'Tie::Hash::Indexed';
2605             %args = @_;
2606             $self->{field_to_column} = \%args;
2607             $self->display_columns(keys %args);
2608             } else {
2609             return $self->{field_to_column};
2610             }
2611             }
2612              
2613             sub query_string : Plugged {
2614             my $self = shift;
2615              
2616             if(@_ == 1) {
2617             $self->{query_string} = shift;
2618             }
2619             elsif(@_ > 1) {
2620             $self->{query_string} = [@_];
2621             }
2622              
2623             return $self->{query_string};
2624             }
2625              
2626             sub pager_object : Plugged {
2627             my $self = shift;
2628              
2629             if(@_ == 1) {
2630             $self->{pager_object} = shift;
2631             }
2632             elsif(@_ > 1) {
2633             $self->{pager_object} = [@_];
2634             }
2635              
2636             return $self->{pager_object};
2637             }
2638              
2639             sub where : Plugged {
2640             my $self = shift;
2641              
2642             if(@_ == 1) {
2643             $self->{where} = shift;
2644             }
2645             elsif(@_ > 1) {
2646             $self->{where} = [@_];
2647             }
2648              
2649             return $self->{where};
2650             }
2651              
2652             ## Testing this section for .9 release
2653              
2654             sub config : Plugged {
2655             my ($self,$key) = @_;
2656             return $config_hash->{$key};
2657             }
2658              
2659             ## colorize matching values
2660              
2661             sub colorize : Plugged {
2662             my $self = shift;
2663             $self->{column_value_colors}{$_[0]} = [ $_[1] , $_[2] ];
2664             }
2665              
2666             ## assign class (css) to a column
2667              
2668             sub column_css_class : Plugged {
2669             my $self = shift;
2670             $self->{column_css_class}{$_[0]} = $_[1];
2671             }
2672              
2673             ## the following are called with:
2674             ## $html->beginswith('lastname','A');
2675              
2676             sub beginswith : Plugged {
2677             my $self = shift;
2678             $self->{column_filters}{$_[0]} = [ 'BEGINSWITH' , $_[1] ];
2679             }
2680              
2681             sub endswith : Plugged {
2682             my $self = shift;
2683             $self->{column_filters}{$_[0]} = [ 'ENDSWITH' , $_[1] ];
2684             }
2685              
2686             sub contains : Plugged {
2687             my $self = shift;
2688             $self->{column_filters}{$_[0]} = [ 'CONTAINS' , $_[1] ];
2689             }
2690              
2691             sub variancepercent : Plugged {
2692             my $self = shift;
2693             $self->{column_filters}{$_[0]} = [ 'VARIANCEPERCENT' , $_[1] ];
2694             }
2695              
2696             sub variancenumerical : Plugged {
2697             my $self = shift;
2698             $self->{column_filters}{$_[0]} = [ 'VARIANCENUMERICAL' , $_[1] ];
2699             }
2700              
2701             sub only : Plugged {
2702             my $self = shift;
2703             $self->{column_filters}{$_[0]} = 'ONLY';
2704             }
2705              
2706              
2707             sub current_column : Plugged {
2708             my $self = shift;
2709              
2710             if(@_ == 1) {
2711             $self->{current_column} = shift;
2712             }
2713             elsif(@_ > 1) {
2714             $self->{current_column} = [@_];
2715             }
2716             return $self->{current_column};
2717             }
2718              
2719             sub current_record : Plugged {
2720             my $self = shift;
2721              
2722             if(@_ == 1) {
2723             $self->{current_record} = shift;
2724             }
2725             elsif(@_ > 1) {
2726             $self->{current_record} = [@_];
2727             }
2728             return $self->{current_record};
2729             }
2730              
2731             ## from config
2732              
2733             sub rows : Plugged {
2734             my $self = shift;
2735              
2736             if(@_ == 1) {
2737             $self->{rows} = shift;
2738             }
2739             elsif(@_ > 1) {
2740             $self->{rows} = [@_];
2741             }
2742             return $self->{rows};
2743             }
2744              
2745             sub exclude_from_url : Plugged {
2746             my $self = shift;
2747              
2748             if(@_ == 1) {
2749             $self->{exclude_from_url} = shift;
2750             }
2751             elsif(@_ > 1) {
2752             $self->{exclude_from_url} = [@_];
2753             }
2754             return $self->{exclude_from_url};
2755             }
2756              
2757             sub order_by_links : Plugged {
2758             my $self = shift;
2759              
2760             if(@_ == 1) {
2761             $self->{order_by_links} = shift;
2762             }
2763             elsif(@_ > 1) {
2764             $self->{order_by_links} = [@_];
2765             }
2766             return $self->{order_by_links};
2767             }
2768              
2769             sub extend_query_string : Plugged {
2770             my ($self,%args) = @_;
2771             my @new;
2772             foreach ( keys %args ) {
2773             push @new , $_ . "=" . uri_escape($args{$_});
2774             }
2775             return $self->query_string() . '&' . join('&',@new);
2776             }
2777              
2778             sub display_columns : Plugged {
2779             my $self = shift;
2780              
2781             if(@_ == 1) {
2782             $self->{display_columns} = shift;
2783             }
2784             elsif(@_ > 1) {
2785             $self->{display_columns} = [@_];
2786             }
2787             return $self->{display_columns};
2788             }
2789              
2790             sub search_exclude : Plugged {
2791             my $self = shift;
2792              
2793             if(@_ == 1) {
2794             $self->{search_exclude} = shift;
2795             }
2796             elsif(@_ > 1) {
2797             $self->{search_exclude} = [@_];
2798             }
2799             return $self->{search_exclude} || [];
2800             }
2801              
2802             sub cdbi_class : Plugged {
2803             my $self = shift;
2804              
2805             if(@_ == 1) {
2806             $self->{cdbi_class} = shift;
2807             }
2808             elsif(@_ > 1) {
2809             $self->{cdbi_class} = [@_];
2810             }
2811             return $self->{cdbi_class};
2812             }
2813              
2814             sub page_name : Plugged {
2815             my $self = shift;
2816              
2817             if(@_ == 1) {
2818             $self->{page_name} = shift;
2819             }
2820             elsif(@_ > 1) {
2821             $self->{page_name} = [@_];
2822             }
2823             return $self->{page_name};
2824             }
2825              
2826              
2827             sub descending_string : Plugged {
2828             my $self = shift;
2829              
2830             if(@_ == 1) {
2831             $self->{descending_string} = shift;
2832             }
2833             elsif(@_ > 1) {
2834             $self->{descending_string} = [@_];
2835             }
2836             return $self->{descending_string};
2837             }
2838              
2839             sub ascending_string : Plugged {
2840             my $self = shift;
2841              
2842             if(@_ == 1) {
2843             $self->{ascending_string} = shift;
2844             }
2845             elsif(@_ > 1) {
2846             $self->{ascending_string} = [@_];
2847             }
2848             return $self->{ascending_string};
2849             }
2850              
2851             sub mouseover_bgcolor : Plugged {
2852             my $self = shift;
2853              
2854             if(@_ == 1) {
2855             $self->{mouseover_bgcolor} = shift;
2856             }
2857             elsif(@_ > 1) {
2858             $self->{mouseover_bgcolor} = [@_];
2859             }
2860             return $self->{mouseover_bgcolor};
2861             }
2862              
2863             sub mouseover_class : Plugged {
2864             my $self = shift;
2865              
2866             if(@_ == 1) {
2867             $self->{mouseover_class} = shift;
2868             }
2869             elsif(@_ > 1) {
2870             $self->{mouseover_class} = [@_];
2871             }
2872             return $self->{mouseover_class};
2873             }
2874              
2875             sub no_form_tag : Plugged {
2876             my $self = shift;
2877              
2878             if(@_ == 1) {
2879             $self->{no_form_tag} = shift;
2880             }
2881             elsif(@_ > 1) {
2882             $self->{no_form_tag} = [@_];
2883             }
2884             return $self->{no_form_tag};
2885             }
2886              
2887             sub no_mouseover : Plugged {
2888             my $self = shift;
2889              
2890             if(@_ == 1) {
2891             $self->{no_mouseover} = shift;
2892             }
2893             elsif(@_ > 1) {
2894             $self->{no_mouseover} = [@_];
2895             }
2896             return $self->{no_mouseover};
2897             }
2898              
2899             sub no_reset : Plugged {
2900             my $self = shift;
2901              
2902             if(@_ == 1) {
2903             $self->{no_reset} = shift;
2904             }
2905             elsif(@_ > 1) {
2906             $self->{no_reset} = [@_];
2907             }
2908             return $self->{no_reset};
2909             }
2910              
2911             sub no_submit : Plugged {
2912             my $self = shift;
2913              
2914             if(@_ == 1) {
2915             $self->{no_submit} = shift;
2916             }
2917             elsif(@_ > 1) {
2918             $self->{no_submit} = [@_];
2919             }
2920             return $self->{no_submit};
2921             }
2922              
2923             sub debug : Plugged {
2924             my $self = shift;
2925              
2926             if(@_ == 1) {
2927             $self->{debug} = shift;
2928             }
2929             elsif(@_ > 1) {
2930             $self->{debug} = [@_];
2931             }
2932             return $self->{debug};
2933             }
2934              
2935             sub searchable : Plugged {
2936             my $self = shift;
2937              
2938             if(@_ == 1) {
2939             $self->{searchable} = shift;
2940             }
2941             elsif(@_ > 1) {
2942             $self->{searchable} = [@_];
2943             }
2944             return $self->{searchable};
2945             }
2946              
2947             sub rowclass : Plugged {
2948             my $self = shift;
2949              
2950             if(@_ == 1) {
2951             $self->{rowclass} = shift;
2952             }
2953             elsif(@_ > 1) {
2954             $self->{rowclass} = [@_];
2955             }
2956             return $self->{rowclass};
2957             }
2958              
2959             sub rowclass_odd : Plugged {
2960             my $self = shift;
2961              
2962             if(@_ == 1) {
2963             $self->{rowclass_odd} = shift;
2964             }
2965             elsif(@_ > 1) {
2966             $self->{rowclass_odd} = [@_];
2967             }
2968             return $self->{rowclass_odd};
2969             }
2970              
2971             sub rowcolor_even : Plugged {
2972             my $self = shift;
2973              
2974             if(@_ == 1) {
2975             $self->{rowcolor_even} = shift;
2976             }
2977             elsif(@_ > 1) {
2978             $self->{rowcolor} = [@_];
2979             }
2980             return $self->{rowcolor_even};
2981             }
2982              
2983             sub rowcolor_odd : Plugged {
2984             my $self = shift;
2985              
2986             if(@_ == 1) {
2987             $self->{rowcolor_odd} = shift;
2988             }
2989             elsif(@_ > 1) {
2990             $self->{rowcolor_odd} = [@_];
2991             }
2992             return $self->{rowcolor_odd};
2993             }
2994              
2995             sub search_primary : Plugged {
2996             my $self = shift;
2997              
2998             if(@_ == 1) {
2999             $self->{search_primary} = shift;
3000             }
3001             elsif(@_ > 1) {
3002             $self->{search_primary} = [@_];
3003             }
3004             return $self->{search_primary};
3005             }
3006              
3007             sub filtered_class : Plugged {
3008             my $self = shift;
3009              
3010             if(@_ == 1) {
3011             $self->{filtered_class} = shift;
3012             }
3013             elsif(@_ > 1) {
3014             $self->{filtered_class} = [@_];
3015             }
3016             return $self->{filtered_class};
3017             }
3018              
3019             sub navigation_list : Plugged {
3020             my $self = shift;
3021              
3022             if(@_ == 1) {
3023             $self->{navigation_list} = shift;
3024             }
3025             elsif(@_ > 1) {
3026             $self->{navigation_list} = [@_];
3027             }
3028             return $self->{navigation_list};
3029             }
3030              
3031             sub navigation_column : Plugged {
3032             my $self = shift;
3033              
3034             if(@_ == 1) {
3035             $self->{navigation_column} = shift;
3036             }
3037             elsif(@_ > 1) {
3038             $self->{navigation_column} = [@_];
3039             }
3040             return $self->{navigation_column};
3041             }
3042              
3043             sub navigation_style : Plugged {
3044             my $self = shift;
3045              
3046             if(@_ == 1) {
3047             $self->{navigation_style} = shift;
3048             }
3049             elsif(@_ > 1) {
3050             $self->{navigation_style} = [@_];
3051             }
3052             return $self->{navigation_style};
3053             }
3054              
3055             sub navigation_alignment : Plugged {
3056             my $self = shift;
3057              
3058             if(@_ == 1) {
3059             $self->{navigation_alignment} = shift;
3060             }
3061             elsif(@_ > 1) {
3062             $self->{navigation_alignment} = [@_];
3063             }
3064             return $self->{navigation_alignment};
3065             }
3066              
3067             #sub separator : Plugged {
3068             # my $self = shift;
3069             #
3070             # if(@_ == 1) {
3071             # $self->{separator} = shift;
3072             # }
3073             # elsif(@_ > 1) {
3074             # $self->{separator} = [@_];
3075             # }
3076             # return $self->{separator};
3077             #}
3078              
3079             sub hide_zero_match : Plugged {
3080             my $self = shift;
3081              
3082             if(@_ == 1) {
3083             $self->{hide_zero_match} = shift;
3084             }
3085             elsif(@_ > 1) {
3086             $self->{hide_zero_match} = [@_];
3087             }
3088             return $self->{hide_zero_match};
3089             }
3090              
3091             sub data_table : Plugged {
3092             my $self = shift;
3093              
3094             if(@_ == 1) {
3095             $self->{data_table} = shift;
3096             }
3097             elsif(@_ > 1) {
3098             $self->{data_table} = [@_];
3099             }
3100             return $self->{data_table};
3101             }
3102              
3103             sub form_table : Plugged {
3104             my $self = shift;
3105              
3106             if(@_ == 1) {
3107             $self->{form_table} = shift;
3108             }
3109             elsif(@_ > 1) {
3110             $self->{form_table} = [@_];
3111             }
3112             return $self->{form_table};
3113             }
3114              
3115             sub order_by : Plugged {
3116             my $self = shift;
3117              
3118             if(@_ == 1) {
3119             $self->{order_by} = shift;
3120             }
3121             elsif(@_ > 1) {
3122             $self->{order_by} = [@_];
3123             }
3124             return $self->{order_by};
3125             }
3126              
3127             sub hidden_fields : Plugged {
3128             my $self = shift;
3129              
3130             if(@_ == 1) {
3131             $self->{hidden_fields} = shift;
3132             }
3133             elsif(@_ > 1) {
3134             $self->{hidden_fields} = [@_];
3135             }
3136             return $self->{hidden_fields};
3137             }
3138              
3139             sub auto_hidden_fields : Plugged {
3140             my $self = shift;
3141              
3142             if(@_ == 1) {
3143             $self->{auto_hidden_fields} = shift;
3144             }
3145             elsif(@_ > 1) {
3146             $self->{auto_hidden_fields} = [@_];
3147             }
3148             return $self->{auto_hidden_fields};
3149             }
3150              
3151             sub config_file : Plugged {
3152             my $self = shift;
3153              
3154             if(@_ == 1) {
3155             $self->{config_file} = shift;
3156             }
3157             elsif(@_ > 1) {
3158             $self->{config_file} = [@_];
3159             }
3160             return $self->{config_file};
3161             }
3162              
3163             sub exclude_columns : Plugged {
3164             my $self = shift;
3165              
3166             if(@_ == 1) {
3167             $self->{exclude_columns} = shift;
3168             }
3169             elsif(@_ > 1) {
3170             $self->{exclude_columns} = [@_];
3171             }
3172              
3173             return $self->{exclude_columns};
3174             }
3175              
3176              
3177             sub page_navigation_separator : Plugged {
3178             my $self = shift;
3179              
3180             if(@_ == 1) {
3181             $self->{page_navigation_separator} = shift;
3182             }
3183             elsif(@_ > 1) {
3184             $self->{page_navigation_separator} = [@_];
3185             }
3186             return $self->{page_navigation_separator};
3187             }
3188              
3189             sub navigation_separator : Plugged {
3190             my $self = shift;
3191              
3192             if(@_ == 1) {
3193             $self->{navigation_separator} = shift;
3194             }
3195             elsif(@_ > 1) {
3196             $self->{navigation_separator} = [@_];
3197             }
3198             return $self->{navigation_separator};
3199             }
3200              
3201             sub use_formbuilder : Plugged {
3202             my $self = shift;
3203              
3204             if(@_ == 1) {
3205             $self->{use_formbuilder} = shift;
3206             }
3207             elsif(@_ > 1) {
3208             $self->{use_formbuilder} = [@_];
3209             }
3210             return $self->{use_formbuilder};
3211             }
3212              
3213             # added to set/get current page outside of pager object
3214             # added in 1.1
3215              
3216             sub on_page : Plugged {
3217             my $self = shift;
3218              
3219             if(@_ == 1) {
3220             $self->{on_page} = shift;
3221             }
3222             elsif(@_ > 1) {
3223             $self->{on_page} = [@_];
3224             }
3225             return $self->{on_page};
3226             }
3227              
3228             ## end from config
3229              
3230             # added in 1.1 to allow for better query parsing
3231              
3232             sub current_filters : Plugged {
3233             my $self = shift;
3234              
3235             if(@_ == 1) {
3236             $self->{current_filters} = shift;
3237             }
3238             elsif(@_ > 1) {
3239             $self->{current_filters} = [@_];
3240             }
3241             return $self->{current_filters};
3242             }
3243              
3244             1;