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