line
stmt
bran
cond
sub
pod
time
code
1
package HTML::Pager;
2
3
=head1 NAME
4
5
HTML::Pager - Perl module to handle CGI HTML paging of arbitary data
6
7
=head1 SYNOPSIS
8
9
use HTML::Pager;
10
use CGI;
11
12
# get CGI query object
13
my $query = CGI->new();
14
15
# create a callback subroutine to generate the data to be paged
16
my $get_data_sub = sub {
17
my ($offset, $rows) = @_;
18
my @return_array;
19
20
for (my $x = 0; $x < $rows; $x++) {
21
push(@return_array, [ time() ]);
22
}
23
return \@return_array;
24
}
25
26
# create a Pager object
27
my $pager = HTML::Pager->new(
28
# required parameters
29
query => $query,
30
get_data_callback => $get_data_sub,
31
rows => 100,
32
page_size => 10,
33
34
# some optional parameters
35
persist_vars => ['myformvar1',
36
'myformvar2',
37
'myformvar3'],
38
cell_space_color => '#000000',
39
cell_background_color => '#ffffff',
40
nav_background_color => '#dddddd',
41
javascript_presubmit => 'last_minute_javascript()',
42
debug => 1,
43
);
44
45
46
47
48
# make it go - send the results to the browser.
49
print $pager->output;
50
51
52
=head1 DESCRIPTION
53
54
This module handles the paging of data coming from an arbitrary source
55
and being displayed using HTML::Template and CGI.pm. It provides
56
an interface to pages of data similar to many well-known sites, like
57
altavista.digital.com or www.google.com.
58
59
This module uses HTML::Template to do all its HTML generation. While
60
it is possible to use this module without directly using
61
HTML::Template, it's not very useful. Modification of the
62
look-and-feel as well as the functionality of the resulting HTML
63
should all be done through HTML::Template objects. Take a look at
64
L for more info.
65
66
=cut
67
68
1
1
611
use strict;
1
2
1
28
69
1
1
848
use integer;
1
11
1
38
70
1
1
1546
use HTML::Template;
1
13888
1
1962
71
72
$HTML::Pager::VERSION = '0.03';
73
74
=head1 METHODS
75
76
=head2 C
77
78
The new() method creates a new Pager object and prepares the data for
79
C.
80
81
C requires several options, see above for syntax:
82
83
=over 4
84
85
=item *
86
87
query - this is the CGI.pm query object for this run. Pager will
88
remove it's state-maintaining parameters from the query. They all
89
begin with PAGER_, so just be careful not to use that prefix.
90
91
=item *
92
93
rows - this is the total number of rows in your dataset. This is
94
needed to provide the next-button, prev-button and page-jump
95
functionality.
96
97
=item *
98
99
page_size - the number of rows to display at one time.
100
101
=item *
102
103
get_data_callback - this is a callback that you provide to get the
104
pages of data. It is passed two arguements - the offset and the
105
number of rows in the page. You return an array ref containing array
106
refs of row data. For you DBI-heads, this is very similar to
107
selectall_arrayref() - so similar that for very simple cases you can
108
just pass the result through. Example - this is a sub that returns
109
data from an in-memory array of hash refs.
110
111
my @data = (
112
{ name => sam, age => 10 },
113
{ name => saa, age => 11 },
114
{ name => sad, age => 12 },
115
{ name => sac, age => 13 },
116
{ name => sab, age => 14 },
117
# ...
118
);
119
120
my $get_data_sub = sub {
121
my ($offset, $rows) = @_;
122
my @return_array;
123
124
for (my $x = 0; $x < $rows; $x++) {
125
push(@return_array, [ $data[$offset + $x]{name},
126
$data[$offset + $x]{age}
127
]
128
);
129
}
130
return \@return_array;
131
}
132
133
my $pager = HTML::Pager->new(query => $query,
134
get_data_callback => $get_data_sub,
135
rows => 100,
136
page_size => 10
137
);
138
139
You can also specify arguements to be passed to your callback function. To do this, call new like:
140
141
HTML::Pager->new(query => $query,
142
get_data_callback => [$get_data_sub, $arg, $arg],
143
rows => 100,
144
page_size => 10
145
);
146
147
If you want to use named, rather than numeric TMPL_VARs in your Pager
148
template you can return a ref to an array of hashes rather than
149
arrays. This array of hashes will be passed directly to
150
HTML::Template to fill in the loop data for your paging area.
151
152
=back 4
153
154
155
C supports several optional arguements:
156
157
=over 4
158
159
=item *
160
161
debug - if set to 1, debugging information is warn()'d during the
162
program run. Defaults to 0.
163
164
=item *
165
166
template - this is an HTML::Template object to use instead of the
167
auto-generated HTML::Template used in Pager output. It must define
168
the following TMPL_LOOPs and TMPL_VARs. Here's what the default
169
template looks like, to give you an idea of how to change it to suite
170
your purposes:
171
172
173
174
191
192
193
194
Make sure you include all the TMPL_LOOPs and TMPL_VARs included above.
195
If you get HTML::Template errors about trying to set bad param
196
'PAGER_BLAH', that probably means you didn't put the 'PAGER_BLAH'
197
variable in your template. You can put extra state-maintaining
198
199
probably required for most real-world uses.
200
201
Optionally you can use named parameters inside PAGER_DATA_LIST, and
202
return an array of hashes to fill them in from get_data_callback. If
203
you did that your template might look like:
204
205
...
206
207
208
209
210
211
212
213
...
214
215
=item *
216
217
persist_vars - Pass a ref to an array of the names of the CGI form
218
parameters you want to store into this fuction, and they will be
219
included in the hidden form data of the pager form.
220
221
This method allows you to have hidden form variables which persist
222
from page to page. This is useful when connecting your pager to some
223
other function (such as a search form) which needs to keep some data
224
around for later use.
225
226
The old $pager->persist_vars() syntax still works but is deprecated.
227
228
=item *
229
230
column_names - should be set to an array ref containing the names of
231
the columns - this will be used to create column headers. Without
232
this arguement, the columns will have no headers. This option is only
233
useful in very simple cases where all the data is actually in use as
234
columns. Example:
235
236
my $pager = HTML::Pager->new( column_names => [ 'one', 'two' ]);
237
238
239
=item *
240
241
cell_space_color - this specifies the color of the lines separating
242
the cells. If the default template is mostly OK, except for the color
243
scheme, this will provide a middle ground between the necessity of
244
creating your own Pager template and suffering with bad colors.
245
Example:
246
247
my $pager = HTML::Pager->new( cell_space_color => '#222244' );
248
249
250
=item *
251
252
cell_background_color - this specifies the background color of each
253
data cell. If the default template is mostly OK, except for the color
254
scheme, this will provide a middle ground between the necessity of
255
creating your own Pager template and suffering with bad colors.
256
Example:
257
258
my $pager = HTML::Pager->new( cell_background_color => '#000000' );
259
260
261
262
=item *
263
264
nav_background_color - this specifies the background color of the
265
bottom navigation bar. If the default template is mostly OK, except
266
for the color scheme, this will provide a middle ground between the
267
necessity of creating your own Pager template and suffering with bad
268
colors. Example:
269
270
my $pager = HTML::Pager->new( nav_background_color => '#222244' );
271
272
273
=item *
274
275
javascript_presubmit - this optional parameter allows you to specify a
276
Javascript function which will be called when a user clicks on one of
277
the Pager navigation buttons, prior to submitting the form. Only if
278
this function returns 'true' will the form be submitted.
279
280
The Pager navigation calls its 'PAGER_set_offset_and_submit()'
281
javascript function when a user clicks the "Next", "Previous" or other
282
page buttons. This normally precludes calling your own javascript
283
submit functions to perform some task.
284
285
Through this hook, you can perform client-side functions, such as form
286
validation, which can modify the form or actually prevent the user
287
from going to the next page. This is particularly useful for enabling
288
some kind of work-flow involving form validation.
289
290
Constructor Example:
291
292
my $pager = HTML::Pager->new(
293
javascript_presubmit => 'last_minute_javascript()'
294
);
295
296
297
HTML Example:
298
299
304
305
=back 4
306
307
=cut
308
309
310
sub new {
311
0
0
1
my $pkg = shift;
312
0
my %hash;
313
0
for (my $x = 0; $x <= $#_; $x += 2) {
314
0
$hash{lc($_[$x])} = $_[($x + 1)];
315
}
316
0
my $self = bless(\%hash, $pkg);
317
318
# check required parameters
319
0
0
die("Called $pkg->new() called without a query parameter.")
320
unless exists($self->{query});
321
0
0
die ("Called $pkg->new() called with a query parameter that does not appear to be a valid CGI object.")
322
unless (ref($self->{query}) eq 'CGI');
323
324
0
0
0
die ("Called $pkg->new() called with a persist_vars parameter that does not appear to be an array ref.")
325
if (exists($self->{persist_vars})
326
and ref($self->{persist_vars}) ne 'ARRAY');
327
328
0
0
die("Called $pkg->new() called without a rows parameter.")
329
unless exists($self->{rows});
330
0
0
die("Called $pkg->new() called with and invalid rows parameter.")
331
if ($self->{rows} < 0);
332
333
0
0
die("Called $pkg->new() called without a page_size parameter.")
334
unless exists($self->{page_size});
335
0
0
die("Called $pkg->new() called with and invalid page_size parameter.")
336
if ($self->{page_size} <= 0);
337
338
0
0
die("Called $pkg->new() called without a get_data_callback parameter.")
339
unless exists($self->{get_data_callback});
340
0
0
0
die ("Called $pkg->new() with a get_data_callback parameter that does not appear to be a valid subroutine reference.")
0
341
if (!ref($self->{get_data_callback}) || !((ref($self->{get_data_callback}) ne 'CODE') || (ref($self->{get_data_callback}) ne 'ARRAY')));
342
343
# set default parameters
344
0
0
$self->{debug} = 0 unless exists($self->{debug});
345
0
0
$self->{column_names} = undef unless exists($self->{column_names});
346
0
0
$self->{persist_vars} = [] unless exists($self->{persist_vars});
347
0
0
$self->{javascript_presubmit} = '' unless exists($self->{javascript_presubmit});
348
349
# Default colors
350
0
0
$self->{cell_space_color} = '#000000' unless(exists($self->{cell_space_color}));
351
0
0
$self->{cell_background_color} = '#ffffff' unless(exists($self->{cell_background_color}));
352
0
0
$self->{nav_background_color} = '#DDDDDD' unless(exists($self->{nav_background_color}));
353
354
355
# pull out the query data
356
0
$self->_parse_query;
357
358
# fills in the paging template, generating one if necessary.
359
0
$self->_fill_template;
360
361
0
return $self;
362
}
363
364
365
# parses out the query data needed to maintain state - just
366
# PAGER_offset for now.
367
sub _parse_query {
368
0
0
my $self = shift;
369
0
my $query = $self->{query};
370
371
0
0
if (defined($query->param('PAGER_offset'))) {
372
0
$self->{offset} = $query->param('PAGER_offset');
373
} else {
374
0
$self->{offset} = 0;
375
}
376
377
0
0
($self->{debug}) && (warn("offset set to $self->{offset}"));
378
}
379
380
381
# fills in the template, generating the default one if necessary.
382
sub _fill_template {
383
0
0
my $self = shift;
384
385
# get the data
386
0
0
if (ref($self->{get_data_callback}) eq 'CODE') {
0
387
0
my $get_data_callback = $self->{get_data_callback};
388
0
$self->{data} = &$get_data_callback ($self->{offset}, $self->{page_size});
389
0
0
defined($self->{data}) ||
390
(die("Pager: get_data_callback returned undef!"));
391
} elsif (ref($self->{get_data_callback}) eq 'ARRAY') {
392
0
my $get_data_callback = $self->{get_data_callback}[0];
393
0
my @args;
394
0
for (my $x = 1; $x <= $#{$self->{get_data_callback}}; $x++) {
0
395
0
push(@args, $self->{get_data_callback}[$x]);
396
}
397
0
$self->{data} = &$get_data_callback ($self->{offset}, $self->{page_size}, @args);
398
0
0
defined($self->{data}) ||
399
(die("Pager: get_data_callback returned undef!"));
400
} else {
401
0
die "Bad format for get_data_callback - must be a code reference or an array reference (for use with extra arguements). See the documentation for details.";
402
}
403
404
0
0
($self->{debug}) && (warn("Got data."));
405
406
# check the data for the correct format, determine if we're doing
407
# named or positional args
408
0
0
if (ref($self->{data}) ne 'ARRAY') {
409
0
die "get_data_callback returned something that isn't an array ref! You must return from get_data_callback in the format [ [ \$col1, \$col2], [ \$col1, \$col2] ] or [ { NAME => value ... }, { NAME => value ...} ].";
410
}
411
412
0
my $args_type;
413
0
0
0
if (defined($self->{data}[0])
414
and (ref($self->{data}[0]) eq 'ARRAY')) {
415
0
$args_type = 'ARRAY';
416
} else {
417
0
$args_type = 'HASH';
418
}
419
420
0
foreach my $rowRef (@{$self->{data}}) {
0
421
0
0
die "get_data_callback returned something that isn't an array ref! You must return from get_data_callback in the format [ [ \$col1, \$col2], [ \$col1, \$col2] ] or [ { NAME => value ... }, { NAME => value ...} ]."
422
unless (ref($rowRef) eq $args_type);
423
}
424
425
# create template if necessary
426
0
0
if (!exists($self->{template})) {
427
# calculate cols
428
0
$self->{cols} = 0;
429
0
foreach my $rowRef (@{$self->{data}}) {
0
430
0
0
if (scalar(@{$rowRef}) > $self->{cols}) {
0
431
0
$self->{cols} = scalar(@{$rowRef});
0
432
}
433
}
434
0
0
if (defined($self->{column_names})) {
435
0
0
if (scalar(@{$self->{column_names}}) > $self->{cols}) {
0
436
0
$self->{cols} = scalar(@{$self->{column_names}});
0
437
}
438
}
439
440
0
$self->_create_default_template;
441
}
442
443
0
my $template = $self->{template};
444
445
446
447
# fill in the template
448
0
0
if ($args_type eq 'ARRAY') {
449
# handle array case
450
0
my @pager_list;
451
0
0
if (defined($self->{column_names})) {
452
0
my %row;
453
0
my $x = 0;
454
0
foreach my $col_name (@{$self->{column_names}}) {
0
455
0
$row{"PAGER_DATA_COL_$x"} = "$col_name ";
456
0
$x++;
457
}
458
0
push(@pager_list, \%row);
459
}
460
461
0
foreach my $rowRef (@{$self->{data}}) {
0
462
0
my %row;
463
0
my $x = 0;
464
0
foreach my $value (@{$rowRef}) {
0
465
0
0
$value = '' unless (defined($value));
466
0
$row{"PAGER_DATA_COL_$x"} = $value;
467
0
$x++;
468
}
469
0
0
if ($x) {
470
0
push(@pager_list, \%row);
471
}
472
}
473
0
$template->param('PAGER_DATA_LIST', \@pager_list);
474
} else {
475
# handle the hash case
476
0
$template->param(PAGER_DATA_LIST => $self->{data});
477
}
478
479
# generate next and prev
480
0
0
if (($self->{offset} + $self->{page_size}) < $self->{rows}) {
481
0
my $next_offset = $self->{offset} + $self->{page_size};
482
0
$template->param('PAGER_NEXT', "
483
}
484
0
0
if ($self->{offset} > 0) {
485
0
my $prev_offset = $self->{offset} - $self->{page_size};
486
0
0
if ($prev_offset < 0) {
487
0
$prev_offset = 0;
488
}
489
;
490
0
$template->param('PAGER_PREV', "
491
}
492
493
# generate jump zone
494
0
my %jump_links;
495
0
my $between_pages = 0;
496
0
my $this_page_number = (($self->{offset} / $self->{page_size}) + 1);
497
0
0
if ($this_page_number =~ /\./) {
498
0
$this_page_number = int($this_page_number) + 1;
499
0
$between_pages = 1;
500
}
501
0
$jump_links{0} = [$self->{offset}, $this_page_number];
502
503
504
# forward jumps
505
0
for (my $x = 1; $x <= 6; $x++) {
506
0
my $offset = ($self->{offset} + ($self->{page_size} * $x));
507
0
0
if ($offset < $self->{rows}) {
508
0
$jump_links{$x} = [$offset, ($this_page_number + $x)];
509
} else {
510
0
last;
511
}
512
}
513
514
# backward jumps
515
0
for (my $x = 1; $x <= 6; $x++) {
516
0
my $offset = ($self->{offset} - ($self->{page_size} * $x));
517
0
0
if ($offset >= 0) {
0
518
0
$jump_links{"-$x"} = [$offset, ($this_page_number - $x)];
519
} elsif ($between_pages) {
520
0
$jump_links{"-$x"} = [0, ($this_page_number - $x)];
521
0
$between_pages = 0;
522
} else {
523
0
last;
524
}
525
}
526
527
# output the jumps
528
0
my $jump_string = "";
529
0
my $did_others = 0;
530
0
0
if (exists $jump_links{-6}) {
531
0
$jump_string .= "... \n";
532
}
533
0
for (my $x = -5; $x <= 5; $x++) {
534
0
0
if (exists $jump_links{$x}) {
535
0
0
if ($x != 0) {
536
0
$jump_string .= "$jump_links{$x}[1] \n";
537
0
$did_others = 1;
538
} else {
539
0
$jump_string .= "$jump_links{$x}[1] \n";
540
}
541
}
542
}
543
544
0
0
if (exists $jump_links{6}) {
545
0
$jump_string .= "... \n";
546
}
547
548
549
0
0
if ($did_others) {
550
0
$template->param('PAGER_JUMP', $jump_string);
551
}
552
553
554
# Did the user specify a javascript_presubmit?
555
0
my $javascript_presubmit = $self->{javascript_presubmit};
556
0
0
if ($javascript_presubmit) {
557
0
$javascript_presubmit = <
558
if (!($javascript_presubmit)) {
559
return;
560
}
561
EOJS
562
} else {
563
0
$javascript_presubmit = ' // No javascript_presubmit specified';
564
}
565
566
0
$template->param('PAGER_JAVASCRIPT', <
567
594
END
595
596
}
597
598
# dynamically generates a template for the appropriate number of
599
# columns.
600
sub _create_default_template {
601
0
0
my $self = shift;
602
0
my $cols = $self->{cols};
603
604
0
my $cell_space_color = $self->{cell_space_color}; # default: '#000000'
605
0
my $cell_background_color = $self->{cell_background_color}; # default: '#ffffff'
606
0
my $nav_background_color = $self->{nav_background_color}; # default: '#DDDDDD'
607
608
0
my $template_text = <
609
610
611
632
633
634
END
635
636
0
$self->{template} = HTML::Template->new(scalarref => \$template_text);
637
}
638
639
=head2 C
640
641
This method returns the HTML