fix TODO test to test for the right thing
[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
a4f7ff75 7our $VERSION = "1.005";
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 75sub _categorize_tags {
a4f7ff75 76 my ($tags, $selected_tags, $opts) = @_;
234312d8 77
a4f7ff75 78 require Articles;
234312d8 79
a4f7ff75 80 return Articles->categorize_tags($tags, $selected_tags, $opts);
234312d8
TC
81}
82
34c37938
TC
83sub _paged {
84 my ($cgi, $list, $opts) = @_;
85
86 $opts ||= {};
87 my $ppname = $opts->{ppname} || "pp";
88 my $pp = $cgi->param($ppname) || $opts->{pp} || 20;
89 my $pname = $opts->{pname} || "p";
90 my $p = $cgi->param($pname) || 1;
91 $p =~ /\A[0-9]\z/ or $p = 1;
92
93 my $pcount = @$list ? int((@$list + $pp - 1) / $pp) : 1;
94
95 $p > $pcount and $p = $pcount;
96 my $startindex = ($p - 1 ) * $pp;
97 my $endindex = $startindex + $pp - 1;
98 $endindex > $#$list and $endindex = $#$list;
99
100 my @pages;
101 my $gap_name = $opts->{gap} || "...";
102 my $gap = { page => $gap_name, link => 0, gap => 1 };
103 my $pages_size = $opts->{pages_size} || 20;
104 my $bcount = int(($pages_size - 1) * 2 / 3);
105 if ($pcount <= $pages_size) {
106 @pages = map +{ page => $_, gap => 0, link => $_ != $p }, 1 .. $pcount;
107 }
108 elsif ($p < $bcount) {
109 @pages =
110 (
111 ( map +{ page => $_, gap => 0, link => $_ != $p }, 1 .. $bcount ),
112 $gap,
113 ( map +{ page => $_, gap => 0, link => 1 },
114 ($pcount - ($pages_size - $bcount) + 1) .. $pcount ),
115 );
116 }
117 elsif ($p > $pcount - int($pages_size * 2 / 3)) {
118 @pages =
119 (
120 ( map +{ page => $_, gap => 0, link => 1 },
121 1 .. ($pages_size - 1 - $bcount)),
122 $gap,
123 ( map +{ page => $_, gap => 0, link => $_ != $p },
124 ( $pcount - $bcount + 1 ) .. $pcount )
125 );
126 }
127 else {
128 my $ends = int(($pages_size - 2) / 4);
129 my $mid_size = $pages_size - 2 - $ends * 2;
130 my $mid_start = $p - int($mid_size / 2);
131 my $mid_end = $mid_start + $mid_size - 1;
132 @pages =
133 (
134 ( map +{ page => $_, gap => 0, link => 1 }, 1 .. $ends ),
135 $gap,
136 ( map +{ page => $_, gap => 0, link => $_ != $p },
137 $mid_start .. $mid_end ),
138 $gap,
139 ( map +{ page => $_, gap => 0, link => 1 },
140 $pcount - $ends + 1 .. $pcount ),
141 );
142 }
143
144 return
145 {
146 page => $p,
147 pp => $pp,
148 pagecount => $pcount,
149 start => $startindex,
150 end => $endindex,
151 startnum => $startindex + 1,
152 items => [ @{$list}[$startindex .. $endindex ] ],
153 is_first_page => $p == 1,
154 is_last_page => $p == $pcount,
155 next_page => ( $p < $pcount ? $p + 1 : 0 ),
156 previous_page => ($p > 1 ? $p - 1 : 0 ),
157 pages => \@pages,
8f685a21
TC
158 pname => $pname,
159 ppname => $ppname,
34c37938
TC
160 };
161}
162
234312d8
TC
1631;
164
165=head1 NAME
166
167BSE::Variables - commonly set variables
168
169=head1 SYNOPSIS
170
171 # in perl code
172 require BSE::Variables;
173 $foo->set_variable(bse => BSE::Variables->variables(%opts));
174
175 # in templates
176 <:.set level1 = bse.site.children :>
177 <:= url(article) | html :>
178 <:= tagcats = bse.categorize_tags(article.tag_objects) :>
179 <:.if bse.admin:>...
180 <:= dumper(somevar) :> lots of noise
181
182=head1 DESCRIPTION
183
184Common BSE functionality for use from the new template tags.
185
34c37938
TC
186=head1 COMMON VALUES
187
234312d8
TC
188=over
189
190=item bse.site
191
192a BSE::TB::Site object, behaves like an article in owning files and
193images, and having children.w
194
195=item bse.url(somearticle)
196
464d00ea
TC
197=item bse.url(somearticle, extraargs)
198
234312d8
TC
199Return the article admin link in admin (or admin_links) mode,
200otherwise the normal article link.
201
464d00ea
TC
202If supplied, C<extraargs> should be a hash containing extra arguments.
203
234312d8
TC
204=item bse.admin
205
206Return true in admin mode.
207
208=item bse.admin_links
209
210Return true in admin_links mode
211
212=item dumper(value)
213
214Dump the value in perl syntax using L<Data::Dumper>.
215
a4f7ff75 216=item categorize_tags(tags)
234312d8
TC
217
218Returns the given tags as a list of tag categories, each category has
219a name (of the category) and a list of tags in that category.
220
221=back
222
34c37938
TC
223=head1 DYNAMIC ONLY VARIABLES
224
225=over
226
227=item bse.pages(list)
228
229=item bse.pages(list, options)
230
231Paginate the contents of C<list>.
232
233If C<options> is supplied it should be a hash optionally containing
234any of the following keys:
235
236=over
237
238=item *
239
240C<ppname> - the name of the items per page CGI parameter. Default:
241"pp".
242
243=item *
244
245C<pp> - the default number of items per page. Default: 20.
246
247=item *
248
249C<p> - the name of the page number CGI parameter. Default: "p".
250
251=item *
252
253C<gap> - the text for the C<page> value in the page list for gap
254entries. Default: "...".
255
256=item *
257
258C<pages_size> - the desired maximum number of entries in the pages
259list. Default: 20. This should be at least 10.
260
261=back
262
263Returns a hash with the following keys:
264
265=over
266
267=item *
268
269page - the current page number
270
271=item *
272
8f685a21
TC
273pagecount - the number of pages.
274
275=item *
276
34c37938
TC
277pp - the number of items per page.
278
279=item *
280
281start - the start index within the original list for the items list.
282
283=item *
284
285end - the end index within the original list for the items list.
286
287=item *
288
289startnum - the starting number within the list for the items list.
290Always C<startindex>+1.
291
292=item *
293
294items - a list of items for the current page.
295
296=item *
297
298is_first_page - true for the first page.
299
300=item *
301
302is_last_page - true for the last page.
303
304=item *
305
306next_page - the page number of the next page, 0 if none.
307
308=item *
309
310previous_page - the page number of the previous page, 0 if none.
311
312=item *
313
314pages - a list of pages, each with the keys:
315
316=over
317
318=item *
319
320page - the page number or the gap value if this entry represents a
321gap.
322
323=item *
324
325gap - true if this entry is a gap.
326
327=item *
328
329link - true if this entry should be a link. false for gaps and the
330current page.
331
332=back
333
8f685a21
TC
334=item *
335
336pname - the name of the page number parameter
337
338=item *
339
340ppname - the name of the items per page parameter
341
34c37938
TC
342=back
343
344=back
345
234312d8
TC
346=head1 AUTHOR
347
348Tony Cook <tony@develop-help.com>
349
350=cut