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