3b178b7dbf3ea11633efeb161abe308324c98992
[bse.git] / site / cgi-bin / modules / BSE / Variables.pm
1 package BSE::Variables;
2 use strict;
3 use Scalar::Util qw(blessed);
4 use BSE::TB::Site;
5 use BSE::Util::HTML;
6
7 our $VERSION = "1.021";
8
9 sub _base_variables {
10   my ($self, %opts) = @_;
11
12   return
13     (
14      site => BSE::TB::Site->new,
15      articles => \&_articles,
16      products => \&_products,
17      url => 
18      ($opts{admin} || $opts{admin_links}
19       ? sub { _url_common($_[0]->admin, $_[1]) }
20       : sub { _url_common($_[0]->link, $_[1]) }
21      ),
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      },
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,
36      date => \&_date_format,
37      now => \&_date_now,
38      number => sub {
39        require BSE::Util::Format;
40        return BSE::Util::Format::bse_number(@_);
41      },
42      debug => sub {
43        print STDERR @_, "\n";
44        return "";
45      },
46      json => sub {
47        require JSON;
48        return JSON->new->allow_nonref->encode($_[0]);
49      },
50      report_data => \&_report_data,
51     );
52 }
53
54 sub variables {
55   my ($self, %opts) = @_;
56
57   return
58     +{
59       $self->_base_variables(%opts),
60      };
61 }
62
63 sub 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      };
73 }
74
75 sub _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
99 sub _categorize_tags {
100   my ($tags, $selected_tags, $opts) = @_;
101
102   require BSE::TB::Articles;
103
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
113   return BSE::TB::Articles->categorize_tags($tags, $selected_tags, $opts);
114 }
115
116 sub _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;
124   $p =~ /\A[0-9]+\z/ or $p = 1;
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,
191      pname => $pname,
192      ppname => $ppname,
193     };
194 }
195
196 sub _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) {
207       require BSE::TB::Articles;
208       $articles = _variable_class("BSE::TB::Articles");
209     }
210
211     return $articles;
212   }
213 }
214
215 {
216   my $products;
217   sub _products {
218     unless ($products) {
219       require BSE::TB::Products;
220       $products = _variable_class("BSE::TB::Products");
221     }
222
223     return $products;
224   }
225 }
226
227 # format an SQL format date
228 sub _date_format {
229   my ($format, $date) = @_;
230
231   my ($year, $month, $day, $hour, $min, $sec) = 
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+)/;
235
236     # values that won't make strftime crazy
237     ($year, $month, $day) = ( 2000, 1, 1 );
238   }
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
248 sub _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
256 sub _report_data {
257   my ($report_name, $params, $opts) = @_;
258
259   $params ||= [];
260   $opts ||= {};
261   require BSE::Report;
262   my $reports = BSE::Report->new(BSE::Cfg->single);
263   my $msg;
264   my $result = $reports->report_data
265     (
266      $report_name,
267      BSE::DB->single,
268      \$msg,
269      $params,
270      %$opts
271     )
272       or return $msg;
273
274   return $result;
275 }
276
277 1;
278
279 =head1 NAME
280
281 BSE::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 :>
291   <:= bse.url(article) | html :>
292   <:= tagcats = bse.categorize_tags(article.tag_objects) :>
293   <:.if bse.admin:>...
294   <:= bse.dumper(somevar) :> lots of noise
295
296 =head1 DESCRIPTION
297
298 Common BSE functionality for use from the new template tags.
299
300 =head1 COMMON VALUES
301
302 =over
303
304 =item bse.site
305
306 a BSE::TB::Site object, behaves like an article in owning files and
307 images, and having children.
308
309 =item bse.url(somearticle)
310
311 =item bse.url(somearticle, extraargs)
312
313 Return the article admin link in admin (or admin_links) mode,
314 otherwise the normal article link.
315
316 If supplied, C<extraargs> should be a hash containing extra arguments.
317
318 =item bse.abs_url(url)
319
320 Return an absolute form of C<url>.  This is always relative to the main site url.
321
322 =item bse.admin
323
324 Return true in admin mode.
325
326 =item bse.admin_links
327
328 Return true in admin_links mode
329
330 =item bse.json(data)
331
332 Return C<data> as JSON.  This will fail for perl objects.
333
334 =item dumper(value)
335
336 Dump the value in perl syntax using L<Data::Dumper>.
337
338 =item categorize_tags(tags)
339
340 Returns the given tags as a list of tag categories, each category has
341 a name (of the category) and a list of tags in that category.
342
343 =item articles
344
345 =item products
346
347 The article and product collections.
348
349 =item date(format, when)
350
351 Format an SQL date/time.
352
353 =item now(format)
354
355 Format the current date/time.
356
357 =item number(format, value)
358
359 Format I<value> according to the rules defied by I<format> in the
360 config file.  See L<BSE::Util::Format/bse_number> for details.
361
362 =back
363
364 =head1 DYNAMIC ONLY VARIABLES
365
366 =over
367
368 =item bse.pages(list)
369
370 =item bse.pages(list, options)
371
372 Paginate the contents of C<list>.
373
374 If C<options> is supplied it should be a hash optionally containing
375 any of the following keys:
376
377 =over
378
379 =item *
380
381 C<ppname> - the name of the items per page CGI parameter.  Default:
382 "pp".
383
384 =item *
385
386 C<pp> - the default number of items per page.  Default: 20.
387
388 =item *
389
390 C<p> - the name of the page number CGI parameter.  Default: "p".
391
392 =item *
393
394 C<gap> - the text for the C<page> value in the page list for gap
395 entries.  Default: "...".
396
397 =item *
398
399 C<pages_size> - the desired maximum number of entries in the pages
400 list.  Default: 20.  This should be at least 10.
401
402 =back
403
404 Returns a hash with the following keys:
405
406 =over
407
408 =item *
409
410 page - the current page number
411
412 =item *
413
414 pagecount - the number of pages.
415
416 =item *
417
418 pp - the number of items per page.
419
420 =item *
421
422 start - the start index within the original list for the items list.
423
424 =item *
425
426 end - the end index within the original list for the items list.
427
428 =item *
429
430 startnum - the starting number within the list for the items list.
431 Always C<startindex>+1.
432
433 =item *
434
435 items - a list of items for the current page.
436
437 =item *
438
439 is_first_page - true for the first page.
440
441 =item *
442
443 is_last_page - true for the last page.
444
445 =item *
446
447 next_page - the page number of the next page, 0 if none.
448
449 =item *
450
451 previous_page - the page number of the previous page, 0 if none.
452
453 =item *
454
455 pages - a list of pages, each with the keys:
456
457 =over
458
459 =item *
460
461 page - the page number or the gap value if this entry represents a
462 gap.
463
464 =item *
465
466 gap - true if this entry is a gap.
467
468 =item *
469
470 link - true if this entry should be a link.  false for gaps and the
471 current page.
472
473 =back
474
475 =item *
476
477 pname - the name of the page number parameter
478
479 =item *
480
481 ppname - the name of the items per page parameter
482
483 =back
484
485 =back
486
487 =head1 AUTHOR
488
489 Tony Cook <tony@develop-help.com>
490
491 =cut