| 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~ | |||||||||||||
| 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 |
|||||||||||||
| 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 |
|||||||||||||
| 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 |
|||||||||||||
| 2540 | 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; |