implement tag category management
authorTony Cook <tony@develop-help.com>
Thu, 14 Jun 2012 06:04:13 +0000 (16:04 +1000)
committerTony Cook <tony@develop-help.com>
Wed, 20 Jun 2012 04:43:37 +0000 (14:43 +1000)
20 files changed:
MANIFEST
schema/bse.sql
site/cgi-bin/modules/Articles.pm
site/cgi-bin/modules/BSE/Edit/Site.pm
site/cgi-bin/modules/BSE/Request/Base.pm
site/cgi-bin/modules/BSE/TB/TagCategories.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/TagCategory.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/TagCategoryDep.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/TagCategoryDeps.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/TagOwners.pm
site/cgi-bin/modules/BSE/TB/Tags.pm
site/cgi-bin/modules/BSE/Variables.pm
site/data/db/bse_msg_base.data
site/data/db/bse_msg_defaults.data
site/data/db/sql_statements.data
site/templates/admin/tagcat.tmpl [new file with mode: 0644]
site/templates/admin/tagcats.tmpl [new file with mode: 0644]
site/util/mysql.str
t/t000load.t
t/t15api.t

index 700e922..e416890 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -218,6 +218,10 @@ site/cgi-bin/modules/BSE/TB/Subscription.pm
 site/cgi-bin/modules/BSE/TB/Subscription/Calc.pm
 site/cgi-bin/modules/BSE/TB/Subscriptions.pm
 site/cgi-bin/modules/BSE/TB/Tag.pm
+site/cgi-bin/modules/BSE/TB/TagCategories.pm
+site/cgi-bin/modules/BSE/TB/TagCategory.pm
+site/cgi-bin/modules/BSE/TB/TagCategoryDep.pm
+site/cgi-bin/modules/BSE/TB/TagCategoryDeps.pm
 site/cgi-bin/modules/BSE/TB/TagMember.pm
 site/cgi-bin/modules/BSE/TB/TagMembers.pm
 site/cgi-bin/modules/BSE/TB/TagOwner.pm
@@ -375,6 +379,7 @@ site/docs/bse.pod
 site/docs/BSE::TB::SiteCommon.html
 site/docs/BSE::TB::TagOwner.html
 site/docs/BSE::UI::Affiliate.html
+site/docs/BSE::Variables.html
 site/docs/bse_import.pod
 site/docs/bsedbschema.odt
 site/docs/bsedbschema.pdf
@@ -629,6 +634,8 @@ site/templates/admin/subscr/detail.tmpl
 site/templates/admin/subscr/detail_delete.tmpl
 site/templates/admin/subscr/edit.tmpl
 site/templates/admin/subscr/list.tmpl
+site/templates/admin/tagcat.tmpl
+site/templates/admin/tagcats.tmpl
 site/templates/admin/tags.tmpl
 site/templates/admin/user_book_seminar.tmpl
 site/templates/admin/user_edit_seminar.tmpl
index 9d0652a..7d6cfaa 100644 (file)
@@ -1294,3 +1294,23 @@ create table bse_tag_members (
   unique art_tag(owner_id, tag_id),
   index by_tag(tag_id)
 );
+
+create table bse_tag_categories (
+  id integer not null auto_increment primary key,
+
+  cat varchar(80) not null,
+
+  owner_type char(2) not null,
+
+  unique cat(cat, owner_type)
+);
+
+create table bse_tag_category_deps (
+  id integer not null auto_increment primary key,
+
+  cat_id integer not null,
+
+  depname varchar(160) not null,
+
+  unique cat_dep(cat_id, depname)
+);
index eed847b..565d049 100644 (file)
@@ -6,7 +6,7 @@ require BSE::TB::TagOwners;
 @ISA = qw(Squirrel::Table BSE::TB::TagOwners);
 use Article;
 
-our $VERSION = "1.003";
+our $VERSION = "1.004";
 
 sub rowClass {
   return 'Article';
@@ -167,18 +167,6 @@ sub reorder_child {
   return 1;
 }
 
-sub all_tags {
-  my ($self, @more_rules) = @_;
-  return BSE::TB::Tags->getBy2
-    (
-     [ 
-      [ owner_type => Article->tag_owner_type ],
-      @more_rules
-     ],
-     { order => "cat, val" },
-    );
-}
-
 sub categories {
   my $cfg = BSE::Cfg->single;
 
index 9b2b4dd..a7a5d63 100644 (file)
@@ -1,7 +1,21 @@
 package BSE::Edit::Site;
 use strict;
 
-our $VERSION = "1.007";
+=head1 NAME
+
+BSE::Edit::Site - edit interface for the site itself.
+
+=head1 SYNOPSIS
+
+  add.pl?id=-1...
+
+=head1 METHODS
+
+=over
+
+=cut
+
+our $VERSION = "1.008";
 
 use base 'BSE::Edit::Article';
 use BSE::TB::Site;
@@ -29,6 +43,9 @@ my %more_site_actions =
    a_tagrename => "req_tagrename",
    a_tagdelete => "req_tagdelete",
    a_tagcleanup => "req_tagcleanup",
+   a_tagcats => "req_tagcats",
+   a_tagcat => "req_tagcat",
+   a_tagcatsave => "req_tagcatsave",
   );
 
 sub article_actions {
@@ -259,4 +276,243 @@ sub req_tagcleanup {
   return $self->refresh($article, $req->cgi, undef, undef, "&a_tags=1");
 }
 
+=item Target tagcats
+
+Display a list of tag categories.
+
+Populates standard edit tags and variables.
+
+Extra variables:
+
+=over
+
+=item *
+
+cats - a list of tag categories, each with only key C<cat> set.
+
+=back
+
+For ajax the result is like:
+
+  {
+    success: 1,
+    cats => [ { cat:name }, { cat: name } ]
+  }
+
+Template: C<admin/tagcats>.
+
+=cut
+
+sub req_tagcats {
+  my ($self, $req, $article, $articles) = @_;
+
+  my @cats = Articles->all_tag_categories;
+
+  if ($req->is_ajax) {
+    my @json = map $_->{cat}, @cats;
+
+    return $req->json_content
+      (
+       success => 1,
+       cats => \@json,
+      );
+  }
+
+  $req->set_variable(tagcats => \@cats);
+  my %acts;
+  %acts =
+    (
+     $self->low_edit_tags(\%acts, $req, $article, $articles),
+    );
+
+  return $req->dyn_response("admin/tagcats", \%acts);
+}
+
+=item target tagcat
+
+Display details for a tag category, allowing changes to the tag
+dependencies.
+
+Parameters:
+
+=over
+
+=item *
+
+cat - the name of the tag category to display
+
+=back
+
+Populates standard edit tags and variables.
+
+Extra variables:
+
+=over
+
+=item *
+
+cat - the category object, see L<BSE::TB::TagCategory>.
+
+=back
+
+For ajax the result is like:
+
+  {
+    success: 1,
+    cat => { deps: [ "somecat:", "somecat: foo" ], cat: "name" }
+  }
+
+Template: C<admin/tagcat>.
+
+=cut
+
+sub req_tagcat {
+  my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+  my $catname = $req->cgi->param("cat");
+  my $error;
+  my ($workcat) = BSE::TB::Tags->valid_category($catname, \$error);
+  my %errors;
+  unless (defined $workcat) {
+    $errors{cat} = "Invalid category name: $error";
+  }
+  if (keys %errors) {
+    $req->is_ajax
+      and return $req->json_content
+       (
+        success => 0,
+        errors => \%errors,
+       );
+    
+    return $self->req_tagcats($req, $article, $articles, undef, \%errors);
+  }
+
+  my $cat = Articles->tag_category($workcat)
+    or return $self->req_tagcats($req, $article, $articles,
+                                "Cannot find or create tag category '$workcat'");
+
+  if ($req->is_ajax) {
+    
+    return $req->json_content
+      (
+       success => 1,
+       cat => $cat->json_data,
+      );
+  }
+
+  $req->set_variable(cat => $cat);
+  my %acts;
+  %acts =
+    (
+     $self->low_edit_tags(\%acts, $req, $article, $articles),
+    );
+
+  return $req->dyn_response("admin/tagcat", \%acts);
+}
+
+=item target tagcatsave
+
+Save changes to a tag category.
+
+Parameters:
+
+=over
+
+=item *
+
+cat - the category to save to
+
+=item *
+
+dep - zero or more dependencies.  This B<replaces> the list of
+dependencies for the category.
+
+=back
+
+For ajax the result is like:
+
+  {
+    success: 1,
+    cat => { deps: [ "somecat:", "somecat: foo" ], cat: "name" }
+  }
+
+CSRF token: C<admin_tagcatsave>.
+
+=cut
+
+sub req_tagcatsave {
+  my ($self, $req, $article, $articles) = @_;
+
+  $req->check_csrf("admin_tagcatsave")
+    or return $self->csrf_error($req, "admin_tagcatsave", "Saving Tag Category");
+
+  my $catname = $req->cgi->param("cat");
+  my $error;
+  my ($workcat) = BSE::TB::Tags->valid_category($catname, \$error);
+  my %errors;
+  unless (defined $workcat) {
+    $errors{cat} = "Invalid category name: $error";
+  }
+  if (keys %errors) {
+    $req->is_ajax
+      and return $req->json_content
+       (
+        success => 0,
+        errors => \%errors,
+       );
+    
+    return $self->req_tagcats($req, $article, $articles, undef, \%errors);
+  }
+
+  my $cat = Articles->tag_category($workcat)
+    or return $self->req_tagcats($req, $article, $articles,
+                                "Cannot find or create tag category '$workcat'");
+
+  my @deps = $req->cgi->param("dep");
+  my @errors;
+  for my $dep (@deps) {
+    my $error;
+    if (!(() = BSE::TB::Tags->name($dep, \$error))
+       & !(() = BSE::TB::Tags->valid_category($dep, \$error))) {
+      push @errors, "$dep is not a valid category or tag";
+    }
+  }
+
+  if (@errors) {
+    $errors{dep} = \@errors;
+    $req->is_ajax
+      and return $req->json_content
+       (
+        success => 0,
+        errors => \%errors,
+       );
+    return $self->req_tagcat($req, $article, $articles, undef, \%errors);
+  }
+
+  my $error;
+  unless ($cat->set_deps(\@deps, \$error)) {
+    $errors{dep} = "Error setting dependencies: $error";
+    return $self->req_tagcat($req, $article, $articles, undef, \%errors);
+  }
+
+  if ($req->is_ajax) {
+    return $req->dyn_response
+      (
+       success => 1,
+       cat => $cat->json_data,
+      );
+  }
+
+  $req->flash("msg:bse/admin/edit/tags/tagcatsave", [ $cat->cat ]);
+  return $self->refresh($article, $req->cgi, undef, undef, "&a_tagcat=1");
+}
+
 1;
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
index 3c7de36..66b2f34 100644 (file)
@@ -5,7 +5,7 @@ use BSE::Cfg;
 use BSE::Util::HTML;
 use Carp qw(cluck confess);
 
-our $VERSION = "1.012";
+our $VERSION = "1.013";
 
 sub new {
   my ($class, %opts) = @_;
@@ -460,7 +460,7 @@ sub _set_vars {
   $self->set_variable(cfg => $self->cfg);
   $self->set_variable(assert_dynamic => 1);
   require BSE::Variables;
-  $self->set_variable(bse => BSE::Variables->variables);
+  $self->set_variable(bse => BSE::Variables->dyn_variables(request => $self));
 }
 
 sub dyn_response {
diff --git a/site/cgi-bin/modules/BSE/TB/TagCategories.pm b/site/cgi-bin/modules/BSE/TB/TagCategories.pm
new file mode 100644 (file)
index 0000000..c105051
--- /dev/null
@@ -0,0 +1,12 @@
+package BSE::TB::TagCategories;
+use strict;
+use base 'Squirrel::Table';
+use BSE::TB::TagCategory;
+
+our $VERSION = "1.000";
+
+sub rowClass {
+  return 'BSE::TB::TagCategory';
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/TagCategory.pm b/site/cgi-bin/modules/BSE/TB/TagCategory.pm
new file mode 100644 (file)
index 0000000..0d4b822
--- /dev/null
@@ -0,0 +1,175 @@
+package BSE::TB::TagCategory;
+use strict;
+use base 'Squirrel::Row';
+
+=head1 NAME
+
+BSE::TB::TagCategory - represents a tag category
+
+=head1 SYNOPSIS
+
+  my $cat = Article->tag_category($name);
+
+  my @deps = $cat->deps;
+
+  $cat->set_deps(\@deps, \$error) or die;
+
+=head1 METHODS
+
+=over
+
+=cut
+
+our $VERSION = "1.000";
+
+sub columns {
+  qw(id cat owner_type);
+}
+
+sub table { 'bse_tag_categories' }
+
+=item remove
+
+Remove the category entry.
+
+This B<does not> remove tags in this category.
+
+=cut
+
+sub remove {
+  my ($self) = @_;
+
+  BSE::DB->single->run("BSE::TB::TagCategoryDeps.deleteCat" => $self->id);
+
+  $self->SUPER::remove();
+}
+
+=item json_data
+
+Return a JSON representable form of the category.
+
+=cut
+
+sub json_data {
+  my ($self) = @_;
+
+  my $data = $self->data_only;
+  $data->{name} = $self->name;
+  $data->{dependencies} = [ $self->deps ];
+
+  return $data;
+}
+
+=item deps
+
+Returns the dependencies for the category as a list of strings.
+
+=cut
+
+sub deps {
+  my ($self) = @_;
+
+  require BSE::TB::TagCategoryDeps;
+  return BSE::TB::TagCategoryDeps->getColumnBy
+    (
+     "depname",
+     [
+      [ cat_id => $self->id ],
+     ],
+     { order => "depname" },
+    );
+}
+
+=item set_deps(\@deps, \$error)
+
+Replace the list of tag dependencies for the category.
+
+Returns true on success.
+
+Returns false on failure storing an error code in $error.
+
+=cut
+
+sub set_deps {
+  my ($self, $deps, $error) = @_;
+
+  # check validity
+  my @workdeps;
+  for my $dep (@$deps) {
+    my $name;
+    my $error;
+    if ((($name) = BSE::TB::Tags->name($dep))
+       || ($name = BSE::TB::Tags->valid_category($dep))) {
+      push @workdeps, $name;
+    }
+    else {
+      $$error = "badtag";
+      return;
+    }
+  }
+
+  my @current_deps = $self->_deps;
+  my %unused_deps = map { lc $_->depname => $_ } @current_deps;
+
+  my %seen;
+  # remove duplicates
+  @workdeps = grep !$seen{lc $_}++, @workdeps;
+
+  my @add_deps;
+  for my $dep (@workdeps) {
+    unless (delete $unused_deps{lc $dep}) {
+      push @add_deps, $dep;
+    }
+  }
+
+  for my $add (@add_deps) {
+    BSE::TB::TagCategoryDeps->make
+       (
+        cat_id => $self->id,
+        depname => $add,
+       );
+  }
+
+  for my $del (values %unused_deps) {
+    $del->remove;
+  }
+
+  return 1;
+}
+
+=back
+
+=head1 INTERNAL METHODS
+
+=over
+
+=item _deps
+
+Returns the tage dependencies as objects.
+
+=cut
+
+sub _deps {
+  my ($self) = @_;
+
+  require BSE::TB::TagCategoryDeps;
+  return BSE::TB::TagCategoryDeps->getBy2
+    (
+     [
+      [ cat_id => $self->id ],
+     ],
+     { order => "depname" },
+    );
+}
+
+
+1;
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
+
diff --git a/site/cgi-bin/modules/BSE/TB/TagCategoryDep.pm b/site/cgi-bin/modules/BSE/TB/TagCategoryDep.pm
new file mode 100644 (file)
index 0000000..30654a7
--- /dev/null
@@ -0,0 +1,19 @@
+package BSE::TB::TagCategoryDep;
+use strict;
+use base 'Squirrel::Row';
+
+our $VERSION = "1.000";
+
+sub columns {
+  qw(id cat_id depname);
+}
+
+sub table { 'bse_tag_category_deps' }
+
+sub json_data {
+  my ($self) = @_;
+
+  return $self->data_only;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/TagCategoryDeps.pm b/site/cgi-bin/modules/BSE/TB/TagCategoryDeps.pm
new file mode 100644 (file)
index 0000000..e666bc1
--- /dev/null
@@ -0,0 +1,12 @@
+package BSE::TB::TagCategoryDeps;
+use strict;
+use base 'Squirrel::Table';
+use BSE::TB::TagCategoryDep;
+
+our $VERSION = "1.000";
+
+sub rowClass {
+  return 'BSE::TB::TagCategoryDep';
+}
+
+1;
index 0edc6ea..bfe5b73 100644 (file)
@@ -6,7 +6,32 @@ use strict;
 use BSE::TB::Tags;
 use BSE::TB::TagMembers;
 
-our $VERSION = "1.001";
+=head1 NAME
+
+BSE::TB::TagOwners - mixin for collections that have tags on their members.
+
+=head1 SYNOPSIS
+
+  use base 'BSE::TB::TagOwners';
+
+=head1 DESCRIPTION
+
+Provides a mixin to collections such as L<Articles> for access to tag
+information.
+
+=head1 METHODS
+
+=over
+
+=cut
+
+our $VERSION = "1.002";
+
+=item getTagByName($name)
+
+Retrieve the tag object for the given tag name.
+
+=cut
 
 sub getTagByName {
   my ($self, $name) = @_;
@@ -14,6 +39,13 @@ sub getTagByName {
   return BSE::TB::Tags->getByName($self->rowClass->tag_owner_type, $name);
 }
 
+=item getByTag($tag)
+
+Retrieve objects within the collection (such as articles) that have
+the given tag.
+
+=cut
+
 # return articles that use the given tag
 sub getByTag {
   my ($self, $tag) = @_;
@@ -21,10 +53,90 @@ sub getByTag {
   return $self->getSpecial(byTag => $tag->id);
 }
 
+=item getIdsByTag($tag)
+
+Retrieve object ids for objects within the collection with the given
+tag.
+
+=cut
+
 sub getIdsByTag {
   my ($self, $tag) = @_;
 
   return BSE::TB::TagMembers->getColumnBy(owner_id => [ tag_id => $tag->id ]);
 }
 
+=item all_tags
+
+Retrieve all tags specified for the collection.
+
+=cut
+
+sub all_tags {
+  my ($self, @more_rules) = @_;
+  return BSE::TB::Tags->getBy2
+    (
+     [ 
+      [ owner_type => $self->rowClass->tag_owner_type ],
+      @more_rules
+     ],
+     { order => "cat, val" },
+    );
+}
+
+=item all_tag_categories
+
+Retrieve a list of all tag categories.
+
+=cut
+
+sub all_tag_categories {
+  my ($self, @more_rules) = @_;
+
+  return BSE::DB->query
+    (
+     'TagOwners.allCats' => $self->rowClass->tag_owner_type
+    );
+}
+
+=item tag_category($catname)
+
+Return a L<tag category object|BSE::TB::TagCategory> for the given
+category name, creating it if necessary.
+
+=cut
+
+sub tag_category {
+  my ($self, $catname) = @_;
+
+  require BSE::TB::TagCategories;
+  my ($cat) = BSE::TB::TagCategories->getBy
+    (
+     cat => $catname,
+     owner_type => $self->rowClass->tag_owner_type,
+    );
+  unless ($cat) {
+    $cat = BSE::TB::TagCategories->make
+      (
+       cat => $catname,
+       owner_type => $self->rowClass->tag_owner_type,
+      );
+  }
+
+  return $cat;
+}
+
 1;
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=head1 SEE ALSO
+
+L<BSE::TB::TagOwner>, L<Articles>, L<BSE::TB::Tags>,
+L<BSE::TB::TagCategory>
+
+=cut
index 903fbf2..9ef8acc 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use base 'Squirrel::Table';
 use BSE::TB::Tag;
 
-our $VERSION = "1.002";
+our $VERSION = "1.003";
 
 sub rowClass {
   return 'BSE::TB::Tag';
@@ -42,9 +42,44 @@ sub valid_name {
     return;
   }
 
+  unless ($val =~ /\S/) {
+    $$error = "emptyvalue";
+    return;
+  }
+
   return ($cat, $val);
 }
 
+=item valid_category
+
+Test that the supplied category name is valid.
+
+It must contain a trailing colon.
+
+Returns the canonical form of the tag category.
+
+=cut
+
+sub valid_category {
+  my ($class, $catname, $error) = @_;
+
+  if ($catname =~ /$bad_char/) {
+    $$error = "badchars";
+    return;
+  }
+
+  $catname =~ s/^\s+//;
+  $catname =~ s/\s+\z//;
+  $catname =~ s/\s+:\z/:/;
+
+  unless ($catname =~ /:\z/) {
+    $$error = "nocolon";
+    return;
+  }
+
+  return $catname;
+}
+
 sub make_name {
   my ($self, $cat, $val) = @_;
 
index af0311e..1a1db45 100644 (file)
@@ -4,13 +4,13 @@ use Scalar::Util qw(blessed);
 use BSE::TB::Site;
 use BSE::Util::HTML;
 
-our $VERSION = "1.002";
+our $VERSION = "1.003";
 
-sub variables {
+sub _base_variables {
   my ($self, %opts) = @_;
-  my $site;
+
   return
-    {
+    (
      site => BSE::TB::Site->new,
      url => 
      ($opts{admin} || $opts{admin_links}
@@ -24,7 +24,28 @@ sub variables {
        return escape_html(Data::Dumper::Dumper(shift));
      },
      categorize_tags => \&_categorize_tags,
-    };
+    );
+}
+
+sub variables {
+  my ($self, %opts) = @_;
+
+  return
+    +{
+      $self->_base_variables(%opts),
+     };
+}
+
+sub dyn_variables {
+  my ($self, %opts) = @_;
+
+  my $req = $opts{request} or die "No request parameter";
+  my $cgi = $req->cgi;
+  return
+    +{
+      $self->_base_variables(%opts),
+      paged => sub { return _paged($cgi, @_) },
+     };
 }
 
 sub _url_common {
@@ -77,6 +98,84 @@ sub _categorize_tags {
   return [ sort { lc $a->{name} cmp $b->{name} } values %cats ];
 }
 
+sub _paged {
+  my ($cgi, $list, $opts) = @_;
+
+  $opts ||= {};
+  my $ppname = $opts->{ppname} || "pp";
+  my $pp = $cgi->param($ppname) || $opts->{pp} || 20;
+  my $pname = $opts->{pname} || "p";
+  my $p = $cgi->param($pname) || 1;
+  $p =~ /\A[0-9]\z/ or $p = 1;
+
+  my $pcount = @$list ? int((@$list + $pp - 1) / $pp) : 1;
+
+  $p > $pcount and $p = $pcount;
+  my $startindex = ($p - 1 ) * $pp;
+  my $endindex = $startindex + $pp - 1;
+  $endindex > $#$list and $endindex = $#$list;
+
+  my @pages;
+  my $gap_name = $opts->{gap} || "...";
+  my $gap = { page => $gap_name, link => 0, gap => 1 };
+  my $pages_size = $opts->{pages_size} || 20;
+  my $bcount = int(($pages_size - 1) * 2 / 3);
+  if ($pcount <= $pages_size) {
+    @pages = map +{ page => $_, gap => 0, link => $_ != $p }, 1 .. $pcount;
+  }
+  elsif ($p < $bcount) {
+    @pages =
+      (
+       ( map +{ page => $_, gap => 0, link => $_ != $p }, 1 .. $bcount ),
+       $gap,
+       ( map +{ page => $_, gap => 0, link => 1 },
+        ($pcount - ($pages_size - $bcount) + 1) .. $pcount ),
+      );
+  }
+  elsif ($p > $pcount - int($pages_size * 2 / 3)) {
+    @pages =
+      (
+       ( map +{ page => $_, gap => 0, link => 1 },
+        1 .. ($pages_size - 1 - $bcount)),
+       $gap,
+       ( map +{ page => $_, gap => 0, link => $_ != $p },
+        ( $pcount - $bcount + 1 ) .. $pcount )
+      );
+  }
+  else {
+    my $ends = int(($pages_size - 2) / 4);
+    my $mid_size = $pages_size - 2 - $ends * 2;
+    my $mid_start = $p - int($mid_size / 2);
+    my $mid_end = $mid_start + $mid_size - 1;
+    @pages = 
+      (
+       ( map +{ page => $_, gap => 0, link => 1 }, 1 .. $ends ),
+       $gap,
+       ( map +{ page => $_, gap => 0, link => $_ != $p },
+        $mid_start .. $mid_end ),
+       $gap,
+       ( map +{ page => $_, gap => 0, link => 1 },
+        $pcount - $ends + 1 .. $pcount ),
+      );
+  }
+
+  return
+    {
+     page => $p,
+     pp => $pp,
+     pagecount => $pcount,
+     start => $startindex,
+     end => $endindex,
+     startnum => $startindex + 1,
+     items => [ @{$list}[$startindex .. $endindex ] ],
+     is_first_page => $p == 1,
+     is_last_page => $p == $pcount,
+     next_page => ( $p < $pcount ? $p + 1 : 0 ),
+     previous_page => ($p > 1 ? $p - 1 : 0 ),
+     pages => \@pages,
+    };
+}
+
 1;
 
 =head1 NAME
@@ -100,6 +199,8 @@ BSE::Variables - commonly set variables
 
 Common BSE functionality for use from the new template tags.
 
+=head1 COMMON VALUES
+
 =over
 
 =item bse.site
@@ -135,6 +236,117 @@ a name (of the category) and a list of tags in that category.
 
 =back
 
+=head1 DYNAMIC ONLY VARIABLES
+
+=over
+
+=item bse.pages(list)
+
+=item bse.pages(list, options)
+
+Paginate the contents of C<list>.
+
+If C<options> is supplied it should be a hash optionally containing
+any of the following keys:
+
+=over
+
+=item *
+
+C<ppname> - the name of the items per page CGI parameter.  Default:
+"pp".
+
+=item *
+
+C<pp> - the default number of items per page.  Default: 20.
+
+=item *
+
+C<p> - the name of the page number CGI parameter.  Default: "p".
+
+=item *
+
+C<gap> - the text for the C<page> value in the page list for gap
+entries.  Default: "...".
+
+=item *
+
+C<pages_size> - the desired maximum number of entries in the pages
+list.  Default: 20.  This should be at least 10.
+
+=back
+
+Returns a hash with the following keys:
+
+=over
+
+=item *
+
+page - the current page number
+
+=item *
+
+pp - the number of items per page.
+
+=item *
+
+start - the start index within the original list for the items list.
+
+=item *
+
+end - the end index within the original list for the items list.
+
+=item *
+
+startnum - the starting number within the list for the items list.
+Always C<startindex>+1.
+
+=item *
+
+items - a list of items for the current page.
+
+=item *
+
+is_first_page - true for the first page.
+
+=item *
+
+is_last_page - true for the last page.
+
+=item *
+
+next_page - the page number of the next page, 0 if none.
+
+=item *
+
+previous_page - the page number of the previous page, 0 if none.
+
+=item *
+
+pages - a list of pages, each with the keys:
+
+=over
+
+=item *
+
+page - the page number or the gap value if this entry represents a
+gap.
+
+=item *
+
+gap - true if this entry is a gap.
+
+=item *
+
+link - true if this entry should be a link.  false for gaps and the
+current page.
+
+=back
+
+=back
+
+=back
+
 =head1 AUTHOR
 
 Tony Cook <tony@develop-help.com>
index fdc646b..fe671b8 100644 (file)
@@ -143,6 +143,9 @@ description: name field error if you try to rename a tag to match another
 id: bse/admin/edit/tags/nochange
 description: name field error if no change is saved
 
+id: bse/admin/edit/tags/tagcatsave
+description: changes to a tag category were saved successfully. %1 is the category name.
+
 id: bse/admin/edit/category/
 description: Category field errors
 
index 97856d4..beab50e 100644 (file)
@@ -94,6 +94,9 @@ message: There is already a tag with name '%1:s'
 id: bse/admin/edit/tags/nochange
 message: No changes to save
 
+id: bse/admin/edit/tags/tagcatsave
+message: Saved tag category '%1:s'
+
 id: bse/admin/edit/category/unknown
 message: Unknown article category
 
index 84f2c0f..4c0367a 100644 (file)
@@ -596,3 +596,17 @@ where t.id = m.tag_id
   )
 SQL
 
+name: TagCategoryDeps.deleteCat
+sql_statement: <<SQL
+delete from bse_tag_category_deps
+where cat_id = ?
+SQL
+
+name: TagOwners.allCats
+sql_statement: <<SQL
+select distinct concat(t.cat, ':') as cat
+from bse_tags t
+where owner_type = ?
+  and t.cat <> ''
+order by cat
+SQL
diff --git a/site/templates/admin/tagcat.tmpl b/site/templates/admin/tagcat.tmpl
new file mode 100644 (file)
index 0000000..74c1d95
--- /dev/null
@@ -0,0 +1,16 @@
+<:wrap admin/base.tmpl title => "Tag Category", showtitle => 1 :>
+<:ifMessage:><p class="message"><:message:></p><:or:><:eif:>
+<:include admin/include/site_menu.tmpl:>
+<p>Parents:</p>
+<form method="post" action="<:= bse.admin_url2("add") :>">
+<input type="hidden" name="cat" value="<:= cat.cat |html :>" />
+<input type="hidden" name="id" value="-1" />
+<:csrfp admin_tagcatsave hidden :>
+<ul id="tagcatdeps">
+<:.for dep in cat.deps :>
+<li><input type="text" name="dep" value="<:= dep |html:>" /></li>
+<:.end for:>
+<li><input type="text" name="dep" value="" /></li>
+</ul>
+<input type="submit" name="a_tagcatsave" value="Save dependencies" />
+</form>
diff --git a/site/templates/admin/tagcats.tmpl b/site/templates/admin/tagcats.tmpl
new file mode 100644 (file)
index 0000000..5de51dd
--- /dev/null
@@ -0,0 +1,17 @@
+<:wrap admin/base.tmpl title => "Tag Categories", showtitle => 1 :>
+<:ifMessage:><p class="message"><:message:></p><:or:><:eif:>
+<:include admin/include/site_menu.tmpl:>
+<:.set pcats = bse.paged(tagcats) :>
+<ul>
+<:.for cat in pcats.items :>
+<li><a href="<:= cfg.admin_url2("add", "tagcat", { "id":-1, "cat":cat.cat}) |html:>"><:= cat.cat | html :></a></li>
+<:.end for:>
+<div class="pagelist">
+<:.for p in pcats.pages :>
+<:.if p.link :>
+<a href="<:= cfg.admin_url2("add", "tagcats", { "id":-1, "p":p.page, "pp":pcats.pp }) | html:>"><:= p.page |html :></a>
+<:.else:>
+<span><:= p.page |html:></span>
+<:.end if:>
+<:.end for:>
+</div>
index 2c5ac41..6ba0214 100644 (file)
@@ -465,6 +465,20 @@ Column description;text;NO;NULL;
 Column max_lapsed;int(11);NO;NULL;
 Index PRIMARY;1;[subscription_id]
 Index text_id;1;[text_id]
+Table bse_tag_categories
+Engine MyISAM
+Column id;int(11);NO;NULL;auto_increment
+Column cat;varchar(80);NO;NULL;
+Column owner_type;char(2);NO;NULL;
+Index PRIMARY;1;[id]
+Index cat;1;[cat;owner_type]
+Table bse_tag_category_deps
+Engine MyISAM
+Column id;int(11);NO;NULL;auto_increment
+Column cat_id;int(11);NO;NULL;
+Column depname;varchar(160);NO;NULL;
+Index PRIMARY;1;[id]
+Index cat_dep;1;[cat_id;depname]
 Table bse_tag_members
 Engine MyISAM
 Column id;int(11);NO;NULL;auto_increment
index 3506c98..7fee588 100644 (file)
@@ -1,16 +1,29 @@
 #!perl -w
 use strict;
-use Test::More tests => 13;
+use Test::More tests => 26;
 use_ok("BSE::Cfg");
 use_ok("Squirrel::Template");
 use_ok("BSE::Template");
 use_ok("DevHelp::Date");
 use_ok("DevHelp::Formatter");
 use_ok("DevHelp::HTML");
-use_ok("BSE::UI::Page");
-use_ok("BSE::UserReg");
 use_ok("BSE::Variables");
+use_ok("BSE::TB::Tag");
+use_ok("BSE::TB::Tags");
+use_ok("BSE::TB::TagCategory");
+use_ok("BSE::TB::TagCategories");
+use_ok("BSE::TB::TagOwner");
+use_ok("BSE::TB::TagOwners");
+use_ok("Article");
+use_ok("Articles");
 use_ok('Generate');
 use_ok('Generate::Article');
 use_ok('Generate::Product');
 use_ok('Generate::Catalog');
+use_ok('BSE::Edit::Article');
+use_ok('BSE::Edit::Site');
+use_ok('BSE::Edit::Catalog');
+use_ok('BSE::Edit::Product');
+use_ok('BSE::Edit::Seminar');
+use_ok("BSE::UI::Page");
+use_ok("BSE::UserReg");
index 57319ca..39e4b4c 100644 (file)
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use BSE::Test qw(make_ua base_url);
-use Test::More tests => 24;
+use Test::More tests => 32;
 use File::Spec;
 use Carp qw(confess);
 
@@ -97,5 +97,33 @@ my $im2;
   print "# ", $thumb_res->content_type, "\n";
 }
 
+{
+  my $error;
+  ok($art->set_tags([ "colour: red", "size: large" ], \$error),
+     "set some tags should succeed");
+  my $cat = Articles->tag_category("colour");
+  ok($cat, "get the 'colour' tag cat");
+  my @orig_deps = $cat->deps;
+
+  ok($cat->set_deps([], \$error), "empty deps list")
+    or diag "setting deps empty: ", $error;
+
+  ok($cat->set_deps([ "abc:", "def :", "efg: ", "alpha:beta" ], \$error),
+     "set deps");
+  is_deeply([$cat->deps],
+           [ "abc:", "alpha: beta", "def:", "efg:" ],
+           "check they were set");
+
+  ok($cat->set_deps([ "abc:", "hij:" ], \$error),
+     "set deps that add and remove to the list");
+
+  is_deeply([$cat->deps],
+           [ "abc:", "hij:" ],
+           "check they were set");
+
+  ok($cat->set_deps(\@orig_deps, \$error), "restore deps list")
+    or diag "restoring deps: ", $error;
+}
+
 ok($child->remove($cfg), "remove child");
 ok($art->remove($cfg), "remove article");