allow filtering the tag category list
[bse.git] / site / cgi-bin / modules / BSE / Variables.pm
CommitLineData
234312d8
TC
1package BSE::Variables;
2use strict;
3use Scalar::Util qw(blessed);
69dfe3a1 4use BSE::TB::Site;
464d00ea 5use BSE::Util::HTML;
234312d8 6
34c37938 7our $VERSION = "1.003";
234312d8 8
34c37938 9sub _base_variables {
234312d8 10 my ($self, %opts) = @_;
34c37938 11
234312d8 12 return
34c37938 13 (
234312d8
TC
14 site => BSE::TB::Site->new,
15 url =>
16 ($opts{admin} || $opts{admin_links}
464d00ea
TC
17 ? sub { _url_common($_[0]->admin, $_[1]) }
18 : sub { _url_common($_[0]->link, $_[1]) }
234312d8
TC
19 ),
20 admin => $opts{admin},
21 admin_links => $opts{admin_links},
22 dumper => sub {
23 require Data::Dumper;
24 return escape_html(Data::Dumper::Dumper(shift));
25 },
26 categorize_tags => \&_categorize_tags,
34c37938
TC
27 );
28}
29
30sub variables {
31 my ($self, %opts) = @_;
32
33 return
34 +{
35 $self->_base_variables(%opts),
36 };
37}
38
39sub dyn_variables {
40 my ($self, %opts) = @_;
41
42 my $req = $opts{request} or die "No request parameter";
43 my $cgi = $req->cgi;
44 return
45 +{
46 $self->_base_variables(%opts),
47 paged => sub { return _paged($cgi, @_) },
48 };
234312d8
TC
49}
50
464d00ea
TC
51sub _url_common {
52 my ($base, $extras) = @_;
53
54 if ($extras && ref $extras) {
55 my @extras;
56 for my $key (keys %$extras) {
57 my $value = $extras->{$key};
58 if (ref $value) {
59 push @extras, map { "$key=" . escape_uri($_) } @$value;
60 }
61 else {
62 push @extras, "$key=" . escape_uri($value);
63 }
64 }
65
66 if (@extras) {
67 $base .= $base =~ /\?/ ? "&" : "?";
68 $base .= join("&", @extras);
69 }
70 }
71
72 return $base;
73}
74
234312d8
TC
75sub _categorize_tags {
76 my ($tags) = @_;
77
78 $DB::single = 1;
79 require BSE::TB::Tags;
80 my %cats;
81 for my $tag (@$tags) {
82 my $work = blessed $tag ? $tag->json_data : $tag;
83 my $cat = lc $tag->{cat};
84 unless ($cats{$cat}) {
85 $cats{$cat} =
86 {
87 name => $tag->{cat},
88 tags => [],
89 };
90 }
91 push @{$cats{$cat}{tags}}, $tag;
92 }
93
94 for my $cat (values %cats) {
95 @{$cat->{tags}} = sort { lc $a->{val} cmp lc $b->{val} } @{$cat->{tags}};
96 }
97
98 return [ sort { lc $a->{name} cmp $b->{name} } values %cats ];
99}
100
34c37938
TC
101sub _paged {
102 my ($cgi, $list, $opts) = @_;
103
104 $opts ||= {};
105 my $ppname = $opts->{ppname} || "pp";
106 my $pp = $cgi->param($ppname) || $opts->{pp} || 20;
107 my $pname = $opts->{pname} || "p";
108 my $p = $cgi->param($pname) || 1;
109 $p =~ /\A[0-9]\z/ or $p = 1;
110
111 my $pcount = @$list ? int((@$list + $pp - 1) / $pp) : 1;
112
113 $p > $pcount and $p = $pcount;
114 my $startindex = ($p - 1 ) * $pp;
115 my $endindex = $startindex + $pp - 1;
116 $endindex > $#$list and $endindex = $#$list;
117
118 my @pages;
119 my $gap_name = $opts->{gap} || "...";
120 my $gap = { page => $gap_name, link => 0, gap => 1 };
121 my $pages_size = $opts->{pages_size} || 20;
122 my $bcount = int(($pages_size - 1) * 2 / 3);
123 if ($pcount <= $pages_size) {
124 @pages = map +{ page => $_, gap => 0, link => $_ != $p }, 1 .. $pcount;
125 }
126 elsif ($p < $bcount) {
127 @pages =
128 (
129 ( map +{ page => $_, gap => 0, link => $_ != $p }, 1 .. $bcount ),
130 $gap,
131 ( map +{ page => $_, gap => 0, link => 1 },
132 ($pcount - ($pages_size - $bcount) + 1) .. $pcount ),
133 );
134 }
135 elsif ($p > $pcount - int($pages_size * 2 / 3)) {
136 @pages =
137 (
138 ( map +{ page => $_, gap => 0, link => 1 },
139 1 .. ($pages_size - 1 - $bcount)),
140 $gap,
141 ( map +{ page => $_, gap => 0, link => $_ != $p },
142 ( $pcount - $bcount + 1 ) .. $pcount )
143 );
144 }
145 else {
146 my $ends = int(($pages_size - 2) / 4);
147 my $mid_size = $pages_size - 2 - $ends * 2;
148 my $mid_start = $p - int($mid_size / 2);
149 my $mid_end = $mid_start + $mid_size - 1;
150 @pages =
151 (
152 ( map +{ page => $_, gap => 0, link => 1 }, 1 .. $ends ),
153 $gap,
154 ( map +{ page => $_, gap => 0, link => $_ != $p },
155 $mid_start .. $mid_end ),
156 $gap,
157 ( map +{ page => $_, gap => 0, link => 1 },
158 $pcount - $ends + 1 .. $pcount ),
159 );
160 }
161
162 return
163 {
164 page => $p,
165 pp => $pp,
166 pagecount => $pcount,
167 start => $startindex,
168 end => $endindex,
169 startnum => $startindex + 1,
170 items => [ @{$list}[$startindex .. $endindex ] ],
171 is_first_page => $p == 1,
172 is_last_page => $p == $pcount,
173 next_page => ( $p < $pcount ? $p + 1 : 0 ),
174 previous_page => ($p > 1 ? $p - 1 : 0 ),
175 pages => \@pages,
176 };
177}
178
234312d8
TC
1791;
180
181=head1 NAME
182
183BSE::Variables - commonly set variables
184
185=head1 SYNOPSIS
186
187 # in perl code
188 require BSE::Variables;
189 $foo->set_variable(bse => BSE::Variables->variables(%opts));
190
191 # in templates
192 <:.set level1 = bse.site.children :>
193 <:= url(article) | html :>
194 <:= tagcats = bse.categorize_tags(article.tag_objects) :>
195 <:.if bse.admin:>...
196 <:= dumper(somevar) :> lots of noise
197
198=head1 DESCRIPTION
199
200Common BSE functionality for use from the new template tags.
201
34c37938
TC
202=head1 COMMON VALUES
203
234312d8
TC
204=over
205
206=item bse.site
207
208a BSE::TB::Site object, behaves like an article in owning files and
209images, and having children.w
210
211=item bse.url(somearticle)
212
464d00ea
TC
213=item bse.url(somearticle, extraargs)
214
234312d8
TC
215Return the article admin link in admin (or admin_links) mode,
216otherwise the normal article link.
217
464d00ea
TC
218If supplied, C<extraargs> should be a hash containing extra arguments.
219
234312d8
TC
220=item bse.admin
221
222Return true in admin mode.
223
224=item bse.admin_links
225
226Return true in admin_links mode
227
228=item dumper(value)
229
230Dump the value in perl syntax using L<Data::Dumper>.
231
232=item categorize_keys(tags)
233
234Returns the given tags as a list of tag categories, each category has
235a name (of the category) and a list of tags in that category.
236
237=back
238
34c37938
TC
239=head1 DYNAMIC ONLY VARIABLES
240
241=over
242
243=item bse.pages(list)
244
245=item bse.pages(list, options)
246
247Paginate the contents of C<list>.
248
249If C<options> is supplied it should be a hash optionally containing
250any of the following keys:
251
252=over
253
254=item *
255
256C<ppname> - the name of the items per page CGI parameter. Default:
257"pp".
258
259=item *
260
261C<pp> - the default number of items per page. Default: 20.
262
263=item *
264
265C<p> - the name of the page number CGI parameter. Default: "p".
266
267=item *
268
269C<gap> - the text for the C<page> value in the page list for gap
270entries. Default: "...".
271
272=item *
273
274C<pages_size> - the desired maximum number of entries in the pages
275list. Default: 20. This should be at least 10.
276
277=back
278
279Returns a hash with the following keys:
280
281=over
282
283=item *
284
285page - the current page number
286
287=item *
288
289pp - the number of items per page.
290
291=item *
292
293start - the start index within the original list for the items list.
294
295=item *
296
297end - the end index within the original list for the items list.
298
299=item *
300
301startnum - the starting number within the list for the items list.
302Always C<startindex>+1.
303
304=item *
305
306items - a list of items for the current page.
307
308=item *
309
310is_first_page - true for the first page.
311
312=item *
313
314is_last_page - true for the last page.
315
316=item *
317
318next_page - the page number of the next page, 0 if none.
319
320=item *
321
322previous_page - the page number of the previous page, 0 if none.
323
324=item *
325
326pages - a list of pages, each with the keys:
327
328=over
329
330=item *
331
332page - the page number or the gap value if this entry represents a
333gap.
334
335=item *
336
337gap - true if this entry is a gap.
338
339=item *
340
341link - true if this entry should be a link. false for gaps and the
342current page.
343
344=back
345
346=back
347
348=back
349
234312d8
TC
350=head1 AUTHOR
351
352Tony Cook <tony@develop-help.com>
353
354=cut