optional case-insensitivity for searching
[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
10dd37f9 7our $VERSION = "1.021";
234312d8 8
34c37938 9sub _base_variables {
234312d8 10 my ($self, %opts) = @_;
34c37938 11
234312d8 12 return
34c37938 13 (
234312d8 14 site => BSE::TB::Site->new,
da08a72b
TC
15 articles => \&_articles,
16 products => \&_products,
234312d8
TC
17 url =>
18 ($opts{admin} || $opts{admin_links}
464d00ea
TC
19 ? sub { _url_common($_[0]->admin, $_[1]) }
20 : sub { _url_common($_[0]->link, $_[1]) }
234312d8 21 ),
c6369510
TC
22 abs_url => sub {
23 my ($url) = @_;
24
25 $url =~ /^\w+:/ and return $url;
26
27 return BSE::Cfg->single->entryErr("site", "url") . $url;
28 },
234312d8
TC
29 admin => $opts{admin},
30 admin_links => $opts{admin_links},
31 dumper => sub {
32 require Data::Dumper;
33 return escape_html(Data::Dumper::Dumper(shift));
34 },
35 categorize_tags => \&_categorize_tags,
11af7272 36 date => \&_date_format,
50dc3219 37 now => \&_date_now,
11af7272
TC
38 number => sub {
39 require BSE::Util::Format;
40 return BSE::Util::Format::bse_number(@_);
41 },
82f52c80
TC
42 debug => sub {
43 print STDERR @_, "\n";
44 return "";
45 },
f2cddbc1
TC
46 json => sub {
47 require JSON;
48 return JSON->new->allow_nonref->encode($_[0]);
49 },
e4e76f68 50 report_data => \&_report_data,
34c37938
TC
51 );
52}
53
54sub variables {
55 my ($self, %opts) = @_;
56
57 return
58 +{
59 $self->_base_variables(%opts),
60 };
61}
62
63sub dyn_variables {
64 my ($self, %opts) = @_;
65
66 my $req = $opts{request} or die "No request parameter";
67 my $cgi = $req->cgi;
68 return
69 +{
70 $self->_base_variables(%opts),
71 paged => sub { return _paged($cgi, @_) },
72 };
234312d8
TC
73}
74
464d00ea
TC
75sub _url_common {
76 my ($base, $extras) = @_;
77
78 if ($extras && ref $extras) {
79 my @extras;
80 for my $key (keys %$extras) {
81 my $value = $extras->{$key};
82 if (ref $value) {
83 push @extras, map { "$key=" . escape_uri($_) } @$value;
84 }
85 else {
86 push @extras, "$key=" . escape_uri($value);
87 }
88 }
89
90 if (@extras) {
91 $base .= $base =~ /\?/ ? "&" : "?";
92 $base .= join("&", @extras);
93 }
94 }
95
96 return $base;
97}
98
234312d8 99sub _categorize_tags {
a4f7ff75 100 my ($tags, $selected_tags, $opts) = @_;
234312d8 101
e0ed81d7 102 require BSE::TB::Articles;
234312d8 103
b6a28bd1
TC
104 if ($opts && $opts->{members} && !$opts->{counts}) {
105 my %counts;
106 my %tags = map { $_->id => $_->name } @$tags;
107 for my $entry (@{$opts->{members}}) {
108 ++$counts{$tags{$entry->tag_id}};
109 }
110 $opts->{counts} = \%counts;
111 }
112
e0ed81d7 113 return BSE::TB::Articles->categorize_tags($tags, $selected_tags, $opts);
234312d8
TC
114}
115
34c37938
TC
116sub _paged {
117 my ($cgi, $list, $opts) = @_;
118
119 $opts ||= {};
120 my $ppname = $opts->{ppname} || "pp";
121 my $pp = $cgi->param($ppname) || $opts->{pp} || 20;
122 my $pname = $opts->{pname} || "p";
123 my $p = $cgi->param($pname) || 1;
b2859782 124 $p =~ /\A[0-9]+\z/ or $p = 1;
34c37938
TC
125
126 my $pcount = @$list ? int((@$list + $pp - 1) / $pp) : 1;
127
128 $p > $pcount and $p = $pcount;
129 my $startindex = ($p - 1 ) * $pp;
130 my $endindex = $startindex + $pp - 1;
131 $endindex > $#$list and $endindex = $#$list;
132
133 my @pages;
134 my $gap_name = $opts->{gap} || "...";
135 my $gap = { page => $gap_name, link => 0, gap => 1 };
136 my $pages_size = $opts->{pages_size} || 20;
137 my $bcount = int(($pages_size - 1) * 2 / 3);
138 if ($pcount <= $pages_size) {
139 @pages = map +{ page => $_, gap => 0, link => $_ != $p }, 1 .. $pcount;
140 }
141 elsif ($p < $bcount) {
142 @pages =
143 (
144 ( map +{ page => $_, gap => 0, link => $_ != $p }, 1 .. $bcount ),
145 $gap,
146 ( map +{ page => $_, gap => 0, link => 1 },
147 ($pcount - ($pages_size - $bcount) + 1) .. $pcount ),
148 );
149 }
150 elsif ($p > $pcount - int($pages_size * 2 / 3)) {
151 @pages =
152 (
153 ( map +{ page => $_, gap => 0, link => 1 },
154 1 .. ($pages_size - 1 - $bcount)),
155 $gap,
156 ( map +{ page => $_, gap => 0, link => $_ != $p },
157 ( $pcount - $bcount + 1 ) .. $pcount )
158 );
159 }
160 else {
161 my $ends = int(($pages_size - 2) / 4);
162 my $mid_size = $pages_size - 2 - $ends * 2;
163 my $mid_start = $p - int($mid_size / 2);
164 my $mid_end = $mid_start + $mid_size - 1;
165 @pages =
166 (
167 ( map +{ page => $_, gap => 0, link => 1 }, 1 .. $ends ),
168 $gap,
169 ( map +{ page => $_, gap => 0, link => $_ != $p },
170 $mid_start .. $mid_end ),
171 $gap,
172 ( map +{ page => $_, gap => 0, link => 1 },
173 $pcount - $ends + 1 .. $pcount ),
174 );
175 }
176
177 return
178 {
179 page => $p,
180 pp => $pp,
181 pagecount => $pcount,
182 start => $startindex,
183 end => $endindex,
184 startnum => $startindex + 1,
185 items => [ @{$list}[$startindex .. $endindex ] ],
186 is_first_page => $p == 1,
187 is_last_page => $p == $pcount,
188 next_page => ( $p < $pcount ? $p + 1 : 0 ),
189 previous_page => ($p > 1 ? $p - 1 : 0 ),
190 pages => \@pages,
8f685a21
TC
191 pname => $pname,
192 ppname => $ppname,
34c37938
TC
193 };
194}
195
da08a72b
TC
196sub _variable_class {
197 my ($class) = @_;
198
199 require Squirrel::Template;
200 return Squirrel::Template::Expr::WrapClass->new($class);
201}
202
203{
204 my $articles;
205 sub _articles {
206 unless ($articles) {
e0ed81d7
AO
207 require BSE::TB::Articles;
208 $articles = _variable_class("BSE::TB::Articles");
da08a72b
TC
209 }
210
211 return $articles;
212 }
213}
214
215{
216 my $products;
217 sub _products {
218 unless ($products) {
10dd37f9
AO
219 require BSE::TB::Products;
220 $products = _variable_class("BSE::TB::Products");
da08a72b
TC
221 }
222
223 return $products;
224 }
225}
226
11af7272
TC
227# format an SQL format date
228sub _date_format {
229 my ($format, $date) = @_;
230
231 my ($year, $month, $day, $hour, $min, $sec) =
844ccd44
TC
232 $date =~ /^\s*(\d+)-(\d+)\D+(\d+)(?:\D+(\d+)\D+(\d+)\D+(\d+))?/;
233 unless (defined $year) {
234 ($hour, $min, $sec) = $date =~ /^(\d+)\D+(\d+)\D+(\d+)/;
844ccd44
TC
235
236 # values that won't make strftime crazy
237 ($year, $month, $day) = ( 2000, 1, 1 );
238 }
11af7272
TC
239 $hour = $min = $sec = 0 unless defined $sec;
240 $year -= 1900;
241 --$month;
242 # passing the isdst as 0 seems to provide a more accurate result than
243 # -1 on glibc.
244 require DevHelp::Date;
245 return DevHelp::Date::dh_strftime($format, $sec, $min, $hour, $day, $month, $year, -1, -1, -1);
246}
247
248sub _date_now {
249 my ($fmt) = @_;
250
251 $fmt ||= "%d-%b-%Y";
252 require DevHelp::Date;
253 return DevHelp::Date::dh_strftime($fmt, localtime);
254}
255
e4e76f68
TC
256sub _report_data {
257 my ($report_name, $params, $opts) = @_;
258
259 $params ||= [];
260 $opts ||= {};
49caac56
TC
261 require BSE::Report;
262 my $reports = BSE::Report->new(BSE::Cfg->single);
e4e76f68
TC
263 my $msg;
264 my $result = $reports->report_data
265 (
266 $report_name,
267 BSE::DB->single,
268 \$msg,
269 $params,
49caac56 270 %$opts
e4e76f68
TC
271 )
272 or return $msg;
273
274 return $result;
275}
276
234312d8
TC
2771;
278
279=head1 NAME
280
281BSE::Variables - commonly set variables
282
283=head1 SYNOPSIS
284
285 # in perl code
286 require BSE::Variables;
287 $foo->set_variable(bse => BSE::Variables->variables(%opts));
288
289 # in templates
290 <:.set level1 = bse.site.children :>
da08a72b 291 <:= bse.url(article) | html :>
234312d8
TC
292 <:= tagcats = bse.categorize_tags(article.tag_objects) :>
293 <:.if bse.admin:>...
da08a72b 294 <:= bse.dumper(somevar) :> lots of noise
234312d8
TC
295
296=head1 DESCRIPTION
297
298Common BSE functionality for use from the new template tags.
299
34c37938
TC
300=head1 COMMON VALUES
301
234312d8
TC
302=over
303
304=item bse.site
305
306a BSE::TB::Site object, behaves like an article in owning files and
69a71145 307images, and having children.
234312d8
TC
308
309=item bse.url(somearticle)
310
464d00ea
TC
311=item bse.url(somearticle, extraargs)
312
234312d8
TC
313Return the article admin link in admin (or admin_links) mode,
314otherwise the normal article link.
315
464d00ea
TC
316If supplied, C<extraargs> should be a hash containing extra arguments.
317
c6369510
TC
318=item bse.abs_url(url)
319
320Return an absolute form of C<url>. This is always relative to the main site url.
321
234312d8
TC
322=item bse.admin
323
324Return true in admin mode.
325
326=item bse.admin_links
327
328Return true in admin_links mode
329
f2cddbc1
TC
330=item bse.json(data)
331
332Return C<data> as JSON. This will fail for perl objects.
333
234312d8
TC
334=item dumper(value)
335
336Dump the value in perl syntax using L<Data::Dumper>.
337
a4f7ff75 338=item categorize_tags(tags)
234312d8
TC
339
340Returns the given tags as a list of tag categories, each category has
341a name (of the category) and a list of tags in that category.
342
da08a72b
TC
343=item articles
344
345=item products
346
347The article and product collections.
348
11af7272
TC
349=item date(format, when)
350
351Format an SQL date/time.
352
353=item now(format)
354
355Format the current date/time.
356
f8424ae4
TC
357=item number(format, value)
358
359Format I<value> according to the rules defied by I<format> in the
360config file. See L<BSE::Util::Format/bse_number> for details.
361
234312d8
TC
362=back
363
34c37938
TC
364=head1 DYNAMIC ONLY VARIABLES
365
366=over
367
368=item bse.pages(list)
369
370=item bse.pages(list, options)
371
372Paginate the contents of C<list>.
373
374If C<options> is supplied it should be a hash optionally containing
375any of the following keys:
376
377=over
378
379=item *
380
381C<ppname> - the name of the items per page CGI parameter. Default:
382"pp".
383
384=item *
385
386C<pp> - the default number of items per page. Default: 20.
387
388=item *
389
390C<p> - the name of the page number CGI parameter. Default: "p".
391
392=item *
393
394C<gap> - the text for the C<page> value in the page list for gap
395entries. Default: "...".
396
397=item *
398
399C<pages_size> - the desired maximum number of entries in the pages
400list. Default: 20. This should be at least 10.
401
402=back
403
404Returns a hash with the following keys:
405
406=over
407
408=item *
409
410page - the current page number
411
412=item *
413
8f685a21
TC
414pagecount - the number of pages.
415
416=item *
417
34c37938
TC
418pp - the number of items per page.
419
420=item *
421
422start - the start index within the original list for the items list.
423
424=item *
425
426end - the end index within the original list for the items list.
427
428=item *
429
430startnum - the starting number within the list for the items list.
431Always C<startindex>+1.
432
433=item *
434
435items - a list of items for the current page.
436
437=item *
438
439is_first_page - true for the first page.
440
441=item *
442
443is_last_page - true for the last page.
444
445=item *
446
447next_page - the page number of the next page, 0 if none.
448
449=item *
450
451previous_page - the page number of the previous page, 0 if none.
452
453=item *
454
455pages - a list of pages, each with the keys:
456
457=over
458
459=item *
460
461page - the page number or the gap value if this entry represents a
462gap.
463
464=item *
465
466gap - true if this entry is a gap.
467
468=item *
469
470link - true if this entry should be a link. false for gaps and the
471current page.
472
473=back
474
8f685a21
TC
475=item *
476
477pname - the name of the page number parameter
478
479=item *
480
481ppname - the name of the items per page parameter
482
34c37938
TC
483=back
484
485=back
486
234312d8
TC
487=head1 AUTHOR
488
489Tony Cook <tony@develop-help.com>
490
491=cut