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.017";
   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 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 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 Articles;
 208       $articles = _variable_class("Articles");
 209     }
 210
 211     return $articles;
 212   }
 213 }
 214
 215 {
 216   my $products;
 217   sub _products {
 218     unless ($products) {
 219       require Products;
 220       $products = _variable_class("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 DevHelp::Report;
 262   my $reports = DevHelp::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