File Coverage

blib/lib/Mojolicious/Plugin/TagHelpers/Pagination.pm
Criterion Covered Total %
statement 101 104 97.1
branch 46 52 88.4
condition 42 52 80.7
subroutine 9 9 100.0
pod 2 3 66.6
total 200 220 90.9


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::TagHelpers::Pagination;
2 1     1   1077 use Mojo::Base 'Mojolicious::Plugin';
  1         3  
  1         8  
3 1     1   218 use Mojo::ByteStream 'b';
  1         12  
  1         54  
4 1     1   6 use Scalar::Util 'blessed';
  1         2  
  1         46  
5 1     1   6 use POSIX 'ceil';
  1         2  
  1         9  
6              
7             our $VERSION = 0.09;
8              
9             our @value_list =
10             qw/prev
11             next
12             current_start
13             current_end
14             page_start
15             page_end
16             separator
17             ellipsis
18             placeholder/;
19              
20             # Register plugin
21             sub register {
22 3     3 1 4824 my ($plugin, $mojo, $param) = @_;
23              
24 3   50     12 $param ||= {};
25              
26             # Load parameter from Config file
27 3 50       19 if (my $config_param = $mojo->config('TagHelpers-Pagination')) {
28 0         0 $param = { %$param, %$config_param };
29             };
30              
31 3         51 foreach (@value_list) {
32 27 100       63 $plugin->{$_} = $param->{$_} if defined $param->{$_};
33             };
34              
35             # Set 'current_start' and 'current_end' symbols,
36             # if 'current' template is available.
37             # Same for 'page'.
38 3         7 foreach (qw/page current/) {
39 6 100       16 if (defined $param->{$_}) {
40 1         18 @{$plugin}{"${_}_start", "${_}_end"} = split("{$_}", $param->{$_});
  1         6  
41 1   50     5 $plugin->{"${_}_end"} ||= '';
42             };
43             };
44              
45             # Default current start and current end symbols
46 3         7 for ($plugin) {
47 3   100     21 $_->{current_start} //= '[';
48 3   100     12 $_->{current_end} //= ']';
49 3   50     17 $_->{page_start} //= '';
50 3   50     14 $_->{page_end} //= '';
51 3   100     13 $_->{prev} //= '<';
52 3   100     14 $_->{next} //= '>';
53 3   100     14 $_->{separator} //= ' ';
54 3   100     14 $_->{ellipsis} //= '...';
55 3   100     11 $_->{placeholder} //= 'page';
56             };
57              
58             # Establish pagination helper
59             $mojo->helper(
60             pagination => sub {
61 39     39   26562 return b( $plugin->pagination( @_ ) );
62 3         23 });
63             };
64              
65              
66             # Pagination helper
67             sub pagination {
68 39     39 1 79 my $self = shift;
69 39         62 my $c = shift;
70              
71             # $_[0] = current page
72             # $_[1] = page count or -1
73             # $_[2] = template or Mojo::URL
74              
75 39 100       115 return '' unless $_[1];
76              
77             # No valid count given
78 36 50       185 local $_[1] = !$_[1] ? 1 : ceil($_[1]);
79 36   100     99 local $_[0] = $_[0] // 1;
80              
81             # New parameter hash
82             my %values =
83 36         83 map { $_ => $self->{$_} } @value_list;
  324         823  
84              
85             # Overwrite plugin defaults
86 36 100 66     154 if ($_[3] && ref $_[3] eq 'HASH') {
87 11         22 my $overwrite = $_[3];
88 11         24 foreach (@value_list) {
89 99 100       233 $values{$_} = $overwrite->{$_} if defined $overwrite->{$_};
90             };
91              
92 11         23 foreach (qw/page current/) {
93 22 100       57 if (defined $overwrite->{$_}) {
94 10         179 @values{$_ . '_start', $_ . '_end'} = split("{$_}", $overwrite->{$_});
95 10   50     48 $values{$_ . '_end'} ||= '';
96             };
97             };
98             };
99              
100             # Establish string variables
101 36         151 my ($p, $n, $cs, $ce, $ps, $pe, $s, $el, $ph) = @values{@value_list};
102             # prev next current_start current_end
103             # page_start page_end separator ellipsis placeholder
104              
105             # Template
106 36         69 my $t = $_[2];
107 36 100 66     123 if (blessed $t && blessed $t eq 'Mojo::URL') {
108 1         5 $t = $t->to_string;
109 1         844 $t =~ s/\%7[bB]$ph\%7[dD]/{$ph}/g;
110             };
111              
112 36 50       85 my $sub = sublink_gen($c, $t, $ps, $pe, $ph) or return '';
113              
114             # Pagination string
115 36         63 my $e;
116 36         71 my $counter = 1;
117              
118             # More than seven pages
119 36 100 100     203 if ($_[1] >= 7 ||
      100        
120              
121             # Or the number of pages is unknown
122             ($_[1] == -1 && $_[0] > 4)){
123              
124             # < [1] #2 #3
125             # The current page is 1
126 15 100       43 if ($_[0] == 1){
    100          
127 3         88 $e .= $sub->(undef, [$p, 'prev']) . $s .
128             $sub->(undef, [$cs . 1 . $ce, 'self']) . $s .
129             $sub->('2') . $s .
130             $sub->('3') . $s;
131             }
132              
133             # < #1 #2 #3
134             # The current page is 0
135             elsif ($_[0] == 0) {
136 1         30 $e .= $sub->(undef, [$p, 'prev']) . $s;
137 1         29 $e .= $sub->($_) . $s foreach (1 .. 3);
138             }
139              
140             # #< #1
141             # The current page is anywhere
142             else {
143 11         324 $e .= $sub->(($_[0] - 1), [$p, 'prev']) . $s .
144             $sub->('1') . $s;
145             };
146              
147             # [2] #3
148             # The current page is 2
149 15 50       63 if ($_[0] == 2) {
    100          
150 0         0 $e .= $sub->(undef, [$cs . 2 . $ce, 'self']) . $s .
151             $sub->('3') . $s;
152             }
153              
154             # ...
155             # The current page is beyond 3
156             elsif ($_[0] > 3) {
157 10         22 $e .= $el . $s;
158             };
159              
160             # #x-1 [x] #x+1
161             # The current page is beyond 2 and there are at least 2 pages to go
162 15 100 100     55 if (($_[0] >= 3) && ($_[0] <= ($_[1] - 2))) {
163 6         165 $e .= $sub->($_[0] - 1) . $s .
164             $sub->(undef, [$cs .$_[0] . $ce, 'self']) . $s .
165             $sub->($_[0] + 1) . $s;
166             };
167              
168             # ...
169             # There are at least 2 pages following the current page
170 15 100       43 if ($_[0] < ($_[1] - 2)){
171 10         22 $e .= $el . $s;
172             };
173              
174             # The current page is prefinal
175 15 100       49 if ($_[0] == ($_[1] - 1)){
    50          
    100          
176 1         28 $e .= $sub->($_[1] - 2) . $s .
177             $sub->(undef, [$cs . $_[0] . $ce, 'self']) . $s .
178             $sub->($_[1]) . $s .
179             $sub->($_[1], [$n, 'next']);
180             }
181              
182             # The current page is final
183             elsif ($_[0] == $_[1]) {
184 0         0 $e .= $sub->($_[0] - 1) . $s .
185             $sub->(undef, [$cs . $_[0] . $ce, 'self']) . $s .
186             $sub->(undef, [$n, 'next']);
187             }
188              
189             # Number is unknown
190             elsif ($_[1] == -1) {
191 4         112 $e .= $sub->($_[0] - 1) . $s .
192             $sub->(undef, [$cs . $_[0] . $ce, 'self']) . $s .
193             $el . $s .
194             $sub->($_[0] + 1, [$n, 'next']);
195             }
196              
197             # Number is anywhere in between
198             else {
199 10         274 $e .= $sub->($_[1]) . $s .
200             $sub->(($_[0] + 1), [$n, 'next']);
201             };
202             }
203              
204             # Counter < 7
205             else {
206              
207             # Previous
208 21 100       55 if ($_[0] > 1){
209 8         248 $e .= $sub->(($_[0] - 1), [$p, 'prev']) . $s;
210             } else {
211 13         378 $e .= $sub->(undef, [$p, 'prev']) . $s;
212             };
213              
214             # All numbers in between
215 21   100     101 while ($counter <= $_[1] || ($_[1] == -1 && $counter <= $_[0])){
      100        
216 46 100       98 if ($_[0] != $counter) {
217 33         871 $e .= $sub->($counter) . $s;
218             }
219              
220             # Current
221             else {
222 13         387 $e .= $sub->(undef, [$cs . $counter . $ce, 'self']) . $s;
223             };
224              
225 46         179 $counter++;
226             };
227              
228             # Ellipsis in case the number is not known
229 21 100       49 $e .= $el . $s if $_[1] == -1;
230              
231             # Next
232 21 100       46 if ($_[0] != $_[1]){
233 17         457 $e .= $sub->(($_[0] + 1), [$n, 'next']);
234             }
235              
236             else {
237 4         110 $e .= $sub->(undef, [$n, 'next']);
238             };
239             };
240              
241             # Pagination string
242 36         909 $e;
243             };
244              
245              
246             # Sublink function generator
247             sub sublink_gen {
248 36     36 0 65 my $c = shift;
249 36         82 my ($url, $ps, $pe, $ph) = @_;
250              
251 36         63 my $s = 'sub{';
252             # $_[0] = number
253             # $_[1] = number_shown
254              
255             # Url is template
256 36 100 66     124 if ($url && length($url) > 0) {
257 19         50 $s .= 'my $url=' . _quote($url) . ';';
258 19         48 $s .= 'if($_[0]){$url=~s/\{' . $ph . '\}/$_[0]/g}else{$url=undef};';
259             }
260              
261             # No template given
262             else {
263 17         49 $s .= 'my $url = $_[0];';
264             };
265              
266 36         77 $s .= q!my$n=$_[1]||! . _quote($ps) . '.$_[0].' . _quote($pe) . ';' .
267             q{my $rel='';} .
268             q{if(ref $n){$rel=' rel="'.$n->[1].'"';$n=$n->[0]};} .
269             q!if($url){$url=~s/&/&/g;! .
270             q{$url=~s/
271             q{$url=~s/>/>/g;} .
272             q{$url=~s/"/"/g;} .
273             q!$url=~s/'/'/g;};!;
274              
275             # Create sublink
276 36         75 $s .= q!return '' . $n . '';}!;
277              
278 36         10786 my $x = eval $s;
279              
280             # Log evaluation error and return
281 36 50 0     203 $c->app->log->warn($@) and return if $@;
282              
283 36         130 $x;
284             };
285              
286              
287             # Quote with a single quote
288             sub _quote {
289 91     91   150 my $str = shift;
290 91         183 $str =~ s/(['\\])/\\$1/g;
291 91         273 return qq{'$str'};
292             };
293              
294             1;
295              
296              
297             __END__