site/cgi-bin/modules/Article.pm

   1 package Article;
   2 use strict;
   3 # represents an article from the database
   4 use Squirrel::Row;
   5 use BSE::TB::SiteCommon;
   6 use BSE::TB::TagOwner;
   7 use vars qw/@ISA/;
   8 @ISA = qw/Squirrel::Row BSE::TB::SiteCommon BSE::TB::TagOwner/;
   9 use Carp 'confess';
  10
  11 our $VERSION = "1.012";
  12
  13 =head1 NAME
  14
  15 Article - article objects for BSE.
  16
  17 =head1 SYNOPSIS
  18
  19   use BSE::API qw(bse_make_article);
  20
  21   my $article = bse_make_article(...)
  22
  23   my $article = Articles->getByPkey($id);
  24
  25 =head1 DESCRIPTION
  26
  27 Implements the base article object for BSE.
  28
  29 =head1 USEFUL METHODS
  30
  31 =over
  32
  33 =cut
  34
  35 sub columns {
  36   return qw/id parentid displayOrder title titleImage body
  37     thumbImage thumbWidth thumbHeight imagePos
  38     release expire keyword template link admin threshold
  39     summaryLength generator level listed lastModified flags
  40     customDate1 customDate2 customStr1 customStr2
  41     customInt1 customInt2 customInt3 customInt4
  42     lastModifiedBy created createdBy author pageTitle
  43     force_dynamic cached_dynamic inherit_siteuser_rights
  44     metaDescription metaKeywords summary menu titleAlias linkAlias
  45     category/;
  46 }
  47
  48 sub table {
  49   'article';
  50 }
  51
  52 sub numeric {
  53   qw(id listed parentid threshold summaryLength level
  54      customInt1 customInt2 customInt3 customInt4 menu);
  55 }
  56
  57 =item section
  58
  59 Return the article's section.
  60
  61 =cut
  62
  63 sub section {
  64   my ($self) = @_;
  65
  66   my $section = $self;
  67   while ($section->{parentid} > 0
  68          and my $parent = Articles->getByPkey($section->{parentid})) {
  69     $section = $parent;
  70   }
  71
  72   return $section;
  73 }
  74
  75 =item parent
  76
  77 Return the article's parent.
  78
  79 =cut
  80
  81 sub parent {
  82   my ($self) = @_;
  83   $self->{parentid} == -1 and return;
  84   return Articles->getByPkey($self->{parentid});
  85 }
  86
  87 sub update_dynamic {
  88   my ($self, $cfg) = @_;
  89
  90   $cfg && $cfg->can('entry')
  91     or confess 'update_dynamic called without $cfg';
  92
  93   # conditional in case something strange is in the config file
  94   my $dynamic = $cfg->entry('basic', 'all_dynamic', 0) ? 1 : 0;
  95
  96   if (!$dynamic && $self->generator =~ /\bCatalog\b/) {
  97     require Products;
  98     my @tiers = Products->pricing_tiers;
  99     @tiers and $dynamic = 1;
 100   }
 101
 102   $dynamic or $dynamic = $self->{force_dynamic};
 103
 104   $dynamic or $dynamic = $self->is_access_controlled;
 105
 106   $dynamic or $dynamic = $self->force_dynamic_inherited;
 107
 108   $self->{cached_dynamic} = $dynamic;
 109 }
 110
 111 =item is_dynamic
 112
 113 Return true if the article is rendered dynamically.
 114
 115 =cut
 116
 117 sub is_dynamic {
 118   $_[0]{cached_dynamic};
 119 }
 120
 121 sub is_accessible_to {
 122   my ($self, $group) = @_;
 123
 124   my $groupid = ref $group ? $group->{id} : $group;
 125
 126   my @rows = BSE::DB->query(articleAccessibleToGroup => $self->{id}, $groupid);
 127
 128   scalar @rows;
 129 }
 130
 131 sub group_ids {
 132   my ($self) = @_;
 133
 134   map $_->{id}, BSE::DB->query(siteuserGroupsForArticle => $self->{id});
 135 }
 136
 137 sub add_group_id {
 138   my ($self, $id) = @_;
 139
 140   eval {
 141     BSE::DB->single->run(articleAddSiteUserGroup => $self->{id}, $id);
 142   };
 143 }
 144
 145 sub remove_group_id {
 146   my ($self, $id) = @_;
 147
 148   BSE::DB->single->run(articleDeleteSiteUserGroup => $self->{id}, $id);
 149 }
 150
 151 sub is_access_controlled {
 152   my ($self) = @_;
 153
 154   my @group_ids = $self->group_ids;
 155   return 1 if @group_ids;
 156
 157   return 0
 158     unless $self->{inherit_siteuser_rights};
 159
 160   my $parent = $self->parent
 161     or return 0;
 162
 163   return $parent->is_access_controlled;
 164 }
 165
 166 sub force_dynamic_inherited {
 167   my ($self) = @_;
 168
 169   my $parent = $self->parent
 170     or return 0;
 171
 172   $parent->{force_dynamic} && $parent->{flags} =~ /F/
 173     and return 1;
 174
 175   return $parent->force_dynamic_inherited;
 176 }
 177
 178 sub link_to_filename {
 179   my ($self, $cfg, $link) = @_;
 180
 181   $cfg ||= BSE::Cfg->single;
 182
 183   defined $link or $link = $self->{link};
 184
 185   length $link or return;
 186
 187   my $filename = $link;
 188
 189   # remove any appended title,
 190   $filename =~ s!(.)/\w+$!$1!;
 191   $filename =~ s{^\w+://[\w.-]+(?::\d+)?}{};
 192   $filename = $cfg->content_base_path() . $filename;
 193   if ($filename =~ m(/$)) {
 194     $filename .= $cfg->entry("basic", "index_file", "index.html");
 195   }
 196   $filename =~ s!//+!/!;
 197
 198   return $filename;
 199 }
 200
 201 sub cached_filename {
 202   my ($self, $cfg) = @_;
 203
 204   $cfg ||= BSE::Cfg->single;
 205
 206   my $dynamic_path = $cfg->entryVar('paths', 'dynamic_cache');
 207   return $dynamic_path . "/" . $self->{id} . ".html";
 208 }
 209
 210 sub html_filename {
 211   my ($self, $cfg) = @_;
 212
 213   $cfg ||= BSE::Cfg->single;
 214
 215   return $self->is_dynamic
 216     ? $self->cached_filename($cfg)
 217       : $self->link_to_filename($cfg);
 218 }
 219
 220 sub remove_html {
 221   my ($self, $cfg) = @_;
 222
 223   my $filename = $self->html_filename($cfg)
 224     or return 1;
 225
 226   unlink $filename
 227     or return;
 228
 229   return 1;
 230 }
 231
 232 sub remove {
 233   my ($self, $cfg) = @_;
 234
 235   $cfg or confess "No \$cfg supplied to ", ref $self, "->remove";
 236
 237   $self->remove_tags;
 238
 239   $self->remove_images($cfg);
 240
 241   for my $file ($self->files) {
 242     $file->remove($cfg);
 243   }
 244
 245   # remove any step(child|parent) links
 246   require OtherParents;
 247   my @steprels = OtherParents->anylinks($self->{id});
 248   for my $link (@steprels) {
 249     $link->remove();
 250   }
 251
 252   # remove the static page
 253   $self->remove_html($cfg);
 254
 255   $self->SUPER::remove();
 256 }
 257
 258 sub all_parents {
 259   my ($self) = @_;
 260
 261   my @result = $self->step_parents;
 262   if ($self->{parentid} > 0 && !grep $_->{id} eq $self->{parentid}, @result) {
 263     push @result, $self->parent;
 264   }
 265
 266   return @result;
 267 }
 268
 269 sub is_step_ancestor {
 270   my ($self, $other, $max) = @_;
 271
 272   my $other_id = ref $other ? $other->{id} : $other;
 273   my %seen;
 274
 275   $max ||= 10;
 276
 277   # early exit if possible
 278   return 1 if $self->{parentid} == $other_id;
 279
 280   my @all_parents = $self->all_parents;
 281   return 1 if grep $_->{id} == $other_id, @all_parents;
 282   my @work = map [ 0, $_], grep !$seen{$_}++, @all_parents;
 283   while (@work) {
 284     my $entry = shift @work;
 285     my ($level, $workart) = @$entry;
 286
 287     $level++;
 288     if ($level < $max) {
 289       @all_parents = $workart->all_parents;
 290       return 1 if grep $_->{id} == $other_id, @all_parents;
 291       push @work, map [ $level, $_ ], grep !$seen{$_}++, @all_parents;
 292     }
 293   }
 294
 295   return 0;
 296 }
 297
 298 sub possible_stepparents {
 299   my $self = shift;
 300
 301   return BSE::DB->query(articlePossibleStepparents => $self->{id}, $self->{id});
 302 }
 303
 304 sub possible_stepchildren {
 305   my $self = shift;
 306
 307   return BSE::DB->query(articlePossibleStepchildren => $self->{id}, $self->{id});
 308 }
 309
 310 sub link {
 311   my ($self, $cfg) = @_;
 312
 313   if ($self->flags =~ /P/) {
 314     my $parent = $self->parent;
 315     $parent and return $parent->link($cfg);
 316   }
 317
 318   $self->is_linked
 319     or return "";
 320
 321   $cfg ||= BSE::Cfg->single;
 322
 323   unless ($self->{linkAlias} && $cfg->entry('basic', 'use_alias', 1)) {
 324     return $self->{link};
 325   }
 326
 327   my $prefix = $cfg->entry('basic', 'alias_prefix', '');
 328   my $link;
 329   if ($cfg->entry('basic', 'alias_recursive')) {
 330     my @steps = $self->{linkAlias};
 331     my $article = $self;
 332     while ($article = $article->parent) {
 333       if ($article->{linkAlias}) {
 334         unshift @steps, $article->{linkAlias};
 335       }
 336     }
 337     $link = join('/', $prefix, @steps);
 338   }
 339   else {
 340     $link = $prefix . '/' . $self->{linkAlias};
 341   }
 342   if ($cfg->entry('basic', 'alias_suffix', 1)) {
 343     my $title = $self->{title};
 344     $title =~ tr/a-zA-Z0-9/_/cs;
 345     $link .= '/' . $title;
 346   }
 347   return $link;
 348 }
 349
 350 =item admin
 351
 352 Return the admin link for the article.
 353
 354 =cut
 355
 356 sub admin {
 357   my ($self) = @_;
 358
 359   return BSE::Cfg->single->admin_url("admin", { id => $self->id });
 360 }
 361
 362 sub is_linked {
 363   my ($self) = @_;
 364
 365   return $self->flags !~ /D/;
 366 }
 367
 368 sub tag_owner_type {
 369   return "BA";
 370 }
 371
 372 # the time used for expiry/release comparisons
 373 sub _expire_release_datetime {
 374   my ($year, $month, $day) = (localtime)[5,4,3];
 375   my $today = sprintf("%04d-%02d-%02d 00:00:00ZZZ", $year+1900, $month+1, $day);
 376 }
 377
 378 =item is_expired
 379
 380 Returns true if the article expiry date has passed.
 381
 382 =cut
 383
 384 sub is_expired {
 385   my $self = shift;
 386
 387   return $self->expire lt _expire_release_datetime();
 388 }
 389
 390 =item is_released
 391
 392 Returns true if the article release date has passed (ie. the article
 393 has been released.)
 394
 395 =cut
 396
 397 sub is_released {
 398   my $self = shift;
 399
 400   return $self->release le _expire_release_datetime();
 401 }
 402
 403 =item listed_in_menu
 404
 405 Return true if the article should be listed in menus.
 406
 407 =cut
 408
 409 sub listed_in_menu {
 410   my $self = shift;
 411
 412   return $self->listed == 1;
 413 }
 414
 415 =item ancestors
 416
 417 Returns a list of ancestors of self.
 418
 419 =cut
 420
 421 sub ancestors {
 422   my ($self) = @_;
 423
 424   unless ($self->{_ancestors}) {
 425     my @ancestors;
 426     my $work = $self;
 427     while ($work->parentid != -1) {
 428       $work = $work->parent;
 429       push @ancestors, $work;
 430     }
 431
 432     $self->{_ancestors} = \@ancestors;
 433   }
 434
 435   return @{$self->{_ancestors}};
 436 }
 437
 438 =item is_descendant_of($ancestor)
 439
 440 Return true if the supplied article is a descendant of self.
 441
 442 =cut
 443
 444 sub is_descendant_of {
 445   my ($self, $ancestor) = @_;
 446
 447   for my $anc ($self->ancestors) {
 448     return 1 if $anc->id == $ancestor->id;
 449   }
 450
 451   return 0;
 452 }
 453
 454 sub restricted_methods {
 455   my ($self, $name) = @_;
 456
 457   return $self->SUPER::restricted_methods($name)
 458     || $name =~ /^(?:update_|remove_|add_)/;
 459 }
 460
 461 1;
 462
 463 __END__
 464
 465 =back
 466
 467 =head1 BASE CLASSES
 468
 469 L<BSE::TB::SiteCommon>
 470
 471 L<BSE::TB::TagOwner>
 472
 473 L<Squirrel::Row>
 474
 475 =head1 AUTHOR
 476
 477 Tony Cook <tony@develop-help.com>
 478
 479 =cut