allow use of the new template system from static pages

[bse.git] / site / cgi-bin / modules / Article.pm

package Article;
use strict;
# represents an article from the database
use Squirrel::Row;
use BSE::TB::SiteCommon;
use BSE::TB::TagOwner;
use vars qw/@ISA/;
@ISA = qw/Squirrel::Row BSE::TB::SiteCommon BSE::TB::TagOwner/;
use Carp 'confess';

our $VERSION = "1.012";

=head1 NAME

Article - article objects for BSE.

=head1 SYNOPSIS

  use BSE::API qw(bse_make_article);

  my $article = bse_make_article(...)

  my $article = Articles->getByPkey($id);

=head1 DESCRIPTION

Implements the base article object for BSE.

=head1 USEFUL METHODS

=over

=cut

sub columns {
  return qw/id parentid displayOrder title titleImage body
    thumbImage thumbWidth thumbHeight imagePos
    release expire keyword template link admin threshold
    summaryLength generator level listed lastModified flags
    customDate1 customDate2 customStr1 customStr2
    customInt1 customInt2 customInt3 customInt4 
    lastModifiedBy created createdBy author pageTitle
    force_dynamic cached_dynamic inherit_siteuser_rights
    metaDescription metaKeywords summary menu titleAlias linkAlias
    category/;
}

sub table {
  'article';
}

sub numeric {
  qw(id listed parentid threshold summaryLength level 
     customInt1 customInt2 customInt3 customInt4 menu);
}

=item section

Return the article's section.

=cut

sub section {
  my ($self) = @_;

  my $section = $self;
  while ($section->{parentid} > 0
	 and my $parent = Articles->getByPkey($section->{parentid})) {
    $section = $parent;
  }

  return $section;
}

=item parent

Return the article's parent.

=cut

sub parent {
  my ($self) = @_;
  $self->{parentid} == -1 and return;
  return Articles->getByPkey($self->{parentid});
}

sub update_dynamic {
  my ($self, $cfg) = @_;

  $cfg && $cfg->can('entry')
    or confess 'update_dynamic called without $cfg';

  # conditional in case something strange is in the config file
  my $dynamic = $cfg->entry('basic', 'all_dynamic', 0) ? 1 : 0;

  if (!$dynamic && $self->generator =~ /\bCatalog\b/) {
    require Products;
    my @tiers = Products->pricing_tiers;
    @tiers and $dynamic = 1;
  }

  $dynamic or $dynamic = $self->{force_dynamic};

  $dynamic or $dynamic = $self->is_access_controlled;

  $dynamic or $dynamic = $self->force_dynamic_inherited;

  $self->{cached_dynamic} = $dynamic;
}

=item is_dynamic

Return true if the article is rendered dynamically.

=cut

sub is_dynamic {
  $_[0]{cached_dynamic};
}

sub is_accessible_to {
  my ($self, $group) = @_;

  my $groupid = ref $group ? $group->{id} : $group;

  my @rows = BSE::DB->query(articleAccessibleToGroup => $self->{id}, $groupid);

  scalar @rows;
}

sub group_ids {
  my ($self) = @_;

  map $_->{id}, BSE::DB->query(siteuserGroupsForArticle => $self->{id});
}

sub add_group_id {
  my ($self, $id) = @_;

  eval {
    BSE::DB->single->run(articleAddSiteUserGroup => $self->{id}, $id);
  };
}

sub remove_group_id {
  my ($self, $id) = @_;

  BSE::DB->single->run(articleDeleteSiteUserGroup => $self->{id}, $id);
}

sub is_access_controlled {
  my ($self) = @_;

  my @group_ids = $self->group_ids;
  return 1 if @group_ids;

  return 0
    unless $self->{inherit_siteuser_rights};

  my $parent = $self->parent
    or return 0;

  return $parent->is_access_controlled;
}

sub force_dynamic_inherited {
  my ($self) = @_;

  my $parent = $self->parent
    or return 0;

  $parent->{force_dynamic} && $parent->{flags} =~ /F/
    and return 1;
  
  return $parent->force_dynamic_inherited;
}

sub link_to_filename {
  my ($self, $cfg, $link) = @_;

  $cfg ||= BSE::Cfg->single;

  defined $link or $link = $self->{link};

  length $link or return;

  my $filename = $link;

  # remove any appended title,
  $filename =~ s!(.)/\w+$!$1!;
  $filename =~ s{^\w+://[\w.-]+(?::\d+)?}{};
  $filename = $cfg->content_base_path() . $filename;
  if ($filename =~ m(/$)) {
    $filename .= $cfg->entry("basic", "index_file", "index.html");
  }
  $filename =~ s!//+!/!;
  
  return $filename;
}

sub cached_filename {
  my ($self, $cfg) = @_;

  $cfg ||= BSE::Cfg->single;

  my $dynamic_path = $cfg->entryVar('paths', 'dynamic_cache');
  return $dynamic_path . "/" . $self->{id} . ".html";
}

sub html_filename {
  my ($self, $cfg) = @_;

  $cfg ||= BSE::Cfg->single;

  return $self->is_dynamic
    ? $self->cached_filename($cfg)
      : $self->link_to_filename($cfg);
}

sub remove_html {
  my ($self, $cfg) = @_;

  my $filename = $self->html_filename($cfg)
    or return 1;

  unlink $filename
    or return;

  return 1;
}

sub remove {
  my ($self, $cfg) = @_;

  $cfg or confess "No \$cfg supplied to ", ref $self, "->remove";

  $self->remove_tags;

  $self->remove_images($cfg);

  for my $file ($self->files) {
    $file->remove($cfg);
  }
  
  # remove any step(child|parent) links
  require OtherParents;
  my @steprels = OtherParents->anylinks($self->{id});
  for my $link (@steprels) {
    $link->remove();
  }

  # remove the static page
  $self->remove_html($cfg);
  
  $self->SUPER::remove();
}

sub all_parents {
  my ($self) = @_;

  my @result = $self->step_parents;
  if ($self->{parentid} > 0 && !grep $_->{id} eq $self->{parentid}, @result) {
    push @result, $self->parent;
  }

  return @result;
}

sub is_step_ancestor {
  my ($self, $other, $max) = @_;

  my $other_id = ref $other ? $other->{id} : $other;
  my %seen;

  $max ||= 10;

  # early exit if possible
  return 1 if $self->{parentid} == $other_id;

  my @all_parents = $self->all_parents;
  return 1 if grep $_->{id} == $other_id, @all_parents;
  my @work = map [ 0, $_], grep !$seen{$_}++, @all_parents;
  while (@work) {
    my $entry = shift @work;
    my ($level, $workart) = @$entry;

    $level++;
    if ($level < $max) {
      @all_parents = $workart->all_parents;
      return 1 if grep $_->{id} == $other_id, @all_parents;
      push @work, map [ $level, $_ ], grep !$seen{$_}++, @all_parents;
    }
  }

  return 0;
}

sub possible_stepparents {
  my $self = shift;

  return BSE::DB->query(articlePossibleStepparents => $self->{id}, $self->{id});
}

sub possible_stepchildren {
  my $self = shift;

  return BSE::DB->query(articlePossibleStepchildren => $self->{id}, $self->{id});
}

sub link {
  my ($self, $cfg) = @_;

  if ($self->flags =~ /P/) {
    my $parent = $self->parent;
    $parent and return $parent->link($cfg);
  }

  $self->is_linked
    or return "";

  $cfg ||= BSE::Cfg->single;

  unless ($self->{linkAlias} && $cfg->entry('basic', 'use_alias', 1)) {
    return $self->{link};
  }

  my $prefix = $cfg->entry('basic', 'alias_prefix', '');
  my $link;
  if ($cfg->entry('basic', 'alias_recursive')) {
    my @steps = $self->{linkAlias};
    my $article = $self;
    while ($article = $article->parent) {
      if ($article->{linkAlias}) {
	unshift @steps, $article->{linkAlias};
      }
    }
    $link = join('/', $prefix, @steps);
  }
  else {
    $link = $prefix . '/' . $self->{linkAlias};
  }
  if ($cfg->entry('basic', 'alias_suffix', 1)) {
    my $title = $self->{title};
    $title =~ tr/a-zA-Z0-9/_/cs;
    $link .= '/' . $title;
  }
  return $link;
}

=item admin

Return the admin link for the article.

=cut

sub admin {
  my ($self) = @_;

  return BSE::Cfg->single->admin_url("admin", { id => $self->id });
}

sub is_linked {
  my ($self) = @_;

  return $self->flags !~ /D/;
}

sub tag_owner_type {
  return "BA";
}

# the time used for expiry/release comparisons
sub _expire_release_datetime {
  my ($year, $month, $day) = (localtime)[5,4,3];
  my $today = sprintf("%04d-%02d-%02d 00:00:00ZZZ", $year+1900, $month+1, $day);
}

=item is_expired

Returns true if the article expiry date has passed.

=cut

sub is_expired {
  my $self = shift;

  return $self->expire lt _expire_release_datetime();
}

=item is_released

Returns true if the article release date has passed (ie. the article
has been released.)

=cut

sub is_released {
  my $self = shift;

  return $self->release le _expire_release_datetime();
}

=item listed_in_menu

Return true if the article should be listed in menus.

=cut

sub listed_in_menu {
  my $self = shift;

  return $self->listed == 1;
}

=item ancestors

Returns a list of ancestors of self.

=cut

sub ancestors {
  my ($self) = @_;

  unless ($self->{_ancestors}) {
    my @ancestors;
    my $work = $self;
    while ($work->parentid != -1) {
      $work = $work->parent;
      push @ancestors, $work;
    }

    $self->{_ancestors} = \@ancestors;
  }

  return @{$self->{_ancestors}};
}

=item is_descendant_of($ancestor)

Return true if the supplied article is a descendant of self.

=cut

sub is_descendant_of {
  my ($self, $ancestor) = @_;

  for my $anc ($self->ancestors) {
    return 1 if $anc->id == $ancestor->id;
  }

  return 0;
}

sub restricted_methods {
  my ($self, $name) = @_;

  return $self->SUPER::restricted_methods($name)
    || $name =~ /^(?:update_|remove_|add_)/;
}

1;

__END__

=back

=head1 BASE CLASSES

L<BSE::TB::SiteCommon>

L<BSE::TB::TagOwner>

L<Squirrel::Row>

=head1 AUTHOR

Tony Cook <tony@develop-help.com>

=cut