complex tags for BSE
authorTony Cook <tony@develop-help.com>
Wed, 15 Jun 2011 06:20:24 +0000 (16:20 +1000)
committerTony Cook <tony@develop-help.com>
Fri, 1 Jul 2011 10:42:17 +0000 (20:42 +1000)
39 files changed:
MANIFEST
schema/bse.sql
site/cgi-bin/modules/Article.pm
site/cgi-bin/modules/Articles.pm
site/cgi-bin/modules/BSE/Dynamic/Article.pm
site/cgi-bin/modules/BSE/Dynamic/Catalog.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Edit/Site.pm
site/cgi-bin/modules/BSE/Request/Base.pm
site/cgi-bin/modules/BSE/Request/Test.pm
site/cgi-bin/modules/BSE/TB/Tag.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/TagMember.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/TagMembers.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/TagOwner.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/TagOwners.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/Tags.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/UI/Dispatch.pm
site/cgi-bin/modules/BSE/Util/DynamicTags.pm
site/cgi-bin/modules/BSE/Util/Tags.pm
site/cgi-bin/modules/DevHelp/Tags/Iterate.pm
site/cgi-bin/modules/Generate.pm
site/data/db/bse_msg_base.data
site/data/db/bse_msg_defaults.data
site/data/db/sql_statements.data
site/htdocs/css/style-main.css
site/htdocs/js/admin_edit.js [new file with mode: 0644]
site/templates/admin/edit_0.tmpl
site/templates/admin/edit_1.tmpl
site/templates/admin/edit_catalog.tmpl
site/templates/admin/edit_product.tmpl
site/templates/admin/edit_seminar.tmpl
site/templates/admin/include/edit_common.tmpl [new file with mode: 0644]
site/templates/admin/include/site_menu.tmpl [new file with mode: 0644]
site/templates/admin/tags.tmpl [new file with mode: 0644]
site/templates/catalog/tagged.tmpl [new file with mode: 0644]
site/util/mysql.str
t/t00smoke.t
t/t11save.t
t/t90dyncat.t

index 4c71953..d999990 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -211,6 +211,12 @@ site/cgi-bin/modules/BSE/TB/SiteUserGroups.pm
 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/TagMember.pm
+site/cgi-bin/modules/BSE/TB/TagMembers.pm
+site/cgi-bin/modules/BSE/TB/TagOwner.pm
+site/cgi-bin/modules/BSE/TB/TagOwners.pm
+site/cgi-bin/modules/BSE/TB/Tags.pm
 site/cgi-bin/modules/BSE/Template.pm
 site/cgi-bin/modules/BSE/Thumb/Imager.pm
 site/cgi-bin/modules/BSE/Thumb/Imager/Colourize.pm
@@ -453,6 +459,7 @@ site/htdocs/images/videoclose.png
 site/htdocs/js/admin-ui/debug.js
 site/htdocs/js/admin-ui/menu.js
 site/htdocs/js/admin.js
+site/htdocs/js/admin_edit.js
 site/htdocs/js/admin_messages.js
 site/htdocs/js/admin_prodopts.js
 site/htdocs/js/admin_siteusers.js
@@ -510,6 +517,8 @@ site/templates/admin/helpicon.tmpl  Help icon template for admin templates
 site/templates/admin/image_edit.tmpl   Edit a single image
 site/templates/admin/include/auditentry.tmpl
 site/templates/admin/include/audithead.tmpl
+site/templates/admin/include/edit_common.tmpl
+site/templates/admin/include/site_menu.tmpl
 site/templates/admin/interestemail.tmpl
 site/templates/admin/locations/add.tmpl
 site/templates/admin/locations/delete.tmpl
@@ -576,6 +585,7 @@ 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/tags.tmpl
 site/templates/admin/user_book_seminar.tmpl
 site/templates/admin/user_edit_seminar.tmpl
 site/templates/admin/user_unbook_seminar.tmpl
@@ -615,6 +625,7 @@ site/templates/cart_base.tmpl
 site/templates/catalog.tmpl
 site/templates/catalog/multi.tmpl
 site/templates/catalog/shop_subcat.tmpl
+site/templates/catalog/tagged.tmpl
 site/templates/checkout_base.tmpl
 site/templates/checkoutcard_base.tmpl
 site/templates/checkoutconfirm_base.tmpl
index 307309c..8d1511f 100644 (file)
@@ -1,3 +1,6 @@
+drop table if exists bse_tag_members;
+drop table if exists bse_tags;
+
 -- represents sections, articles
 DROP TABLE IF EXISTS article;
 CREATE TABLE article (
@@ -1272,3 +1275,25 @@ create table bse_price_tier_prices (
   unique tier_product(tier_id, product_id)
 );
 
+create table bse_tags (
+  id integer not null auto_increment primary key,
+
+  -- typically "BA" for BSE article
+  owner_type char(2) not null,
+  cat varchar(80) not null,
+  val varchar(80) not null,
+
+  unique cat_val(owner_type, cat, val)
+);
+
+create table bse_tag_members (
+  id integer not null auto_increment primary key,
+
+  -- typically BA for BSE article
+  owner_type char(2) not null,
+  owner_id integer not null,
+  tag_id integer not null,
+
+  unique art_tag(owner_id, tag_id),
+  index by_tag(tag_id)
+);
index 9893b91..57ce262 100644 (file)
@@ -3,11 +3,12 @@ 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/;
+@ISA = qw/Squirrel::Row BSE::TB::SiteCommon BSE::TB::TagOwner/;
 use Carp 'confess';
 
-our $VERSION = "1.003";
+our $VERSION = "1.005";
 
 sub columns {
   return qw/id parentid displayOrder title titleImage body
@@ -187,6 +188,8 @@ sub remove {
 
   $cfg or confess "No \$cfg supplied to ", ref $self, "->remove";
 
+  $self->remove_tags;
+
   $self->remove_images($cfg);
 
   for my $file ($self->files) {
@@ -292,4 +295,8 @@ sub is_linked {
   return $self->flags !~ /D/;
 }
 
+sub tag_owner_type {
+  return "BA";
+}
+
 1;
index 0aacb09..b5da9e2 100644 (file)
@@ -2,10 +2,11 @@ package Articles;
 use strict;
 use Squirrel::Table;
 use vars qw(@ISA $VERSION);
-@ISA = qw(Squirrel::Table);
+require BSE::TB::TagOwners;
+@ISA = qw(Squirrel::Table BSE::TB::TagOwners);
 use Article;
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
 sub rowClass {
   return 'Article';
@@ -154,4 +155,16 @@ 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" },
+    );
+}
+
 1;
index 7ecacaf..7a92223 100644 (file)
@@ -5,7 +5,7 @@ use BSE::Template;
 use BSE::Util::HTML;
 use base qw(BSE::Util::DynamicTags);
 
-our $VERSION = "1.001";
+our $VERSION = "1.002";
 
 sub new {
   my ($class, $req, %opts) = @_;
@@ -23,6 +23,7 @@ sub new {
 sub generate {
   my ($self, $article, $template) = @_;
 
+  $self->{article} = $article;
   my %acts;
   if ($self->{admin}) {
     %acts = ( $self->tags($article), BSE::Util::Tags->secure($self->{req}) );
@@ -50,6 +51,10 @@ sub generate {
   return $result;
 }
 
+sub article {
+  $_[0]{article};
+}
+
 sub tags {
   my ($self, $article) = @_;
   
index b2cfb0b..3845e93 100644 (file)
@@ -2,7 +2,7 @@ package BSE::Dynamic::Catalog;
 use strict;
 use base 'BSE::Dynamic::Article';
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
 # no specific behavious yet
 
@@ -16,12 +16,12 @@ sub tags {
   return
     (
      $self->SUPER::tags($article),
-     $self->dyn_article_iterator('dynallprods', 'dynallprod', $article,
+     $self->dyn_article_iterator('dynallprods', 'dynallprod', undef,
                                 \$allprod_index, \$allprod_data),
      dynmoveallprod =>
      [ tag_dynmove => $self, \$allprod_index, \$allprod_data, 
        "stepparent=$article->{id}" ],
-     $self->dyn_article_iterator('dynallcats', 'dynallcat', $article,
+     $self->dyn_article_iterator('dynallcats', 'dynallcat', undef,
                                 \$allcat_index, \$allcat_data),
      dynmoveallcat =>
      [ tag_dynmove => $self, \$allcat_index, \$allcat_data,
@@ -31,13 +31,13 @@ sub tags {
 }
 
 sub iter_dynallprods {
-  my ($self, $article, $args) = @_;
+  my ($self, $unused, $args) = @_;
 
   my $result = $self->get_cached('dynallprods');
   $result
     and return $result;
 
-  $result = $self->access_filter($article->all_visible_products);
+  $result = $self->access_filter($self->article->all_visible_products);
 
   $self->set_cached(dynallprods => $result);
 
@@ -45,13 +45,13 @@ sub iter_dynallprods {
 }
 
 sub iter_dynallcats {
-  my ($self, $article, $args) = @_;
+  my ($self, $unused, $args) = @_;
 
   my $result = $self->get_cached('dynallcats');
   $result
     and return $result;
 
-  $result = $self->access_filter($article->all_visible_catalogs);
+  $result = $self->access_filter($self->article->all_visible_catalogs);
 
   $self->set_cached(dynallcats => $result);
 
index 93df5c9..b0d3c58 100644 (file)
@@ -13,7 +13,7 @@ use BSE::Util::ContentType qw(content_type);
 use DevHelp::Date qw(dh_parse_date dh_parse_sql_date);
 use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
 
-our $VERSION = "1.007";
+our $VERSION = "1.009";
 
 =head1 NAME
 
@@ -1122,6 +1122,15 @@ sub tag_image {
   }
 }
 
+sub iter_tags {
+  my ($self, $article) = @_;
+
+  $article->{id}
+    or return;
+
+  return $article->tag_objects;
+}
+
 sub low_edit_tags {
   my ($self, $acts, $request, $article, $articles, $msg, $errors) = @_;
 
@@ -1165,6 +1174,7 @@ sub low_edit_tags {
   my @groups;
   my $current_group;
   my $it = BSE::Util::Iterate->new;
+  my $ito = BSE::Util::Iterate::Objects->new;
   return
     (
      $request->admin_tags,
@@ -1266,6 +1276,12 @@ sub low_edit_tags {
      $it->make_iterator([ iter_file_stores => $self], 
                        'file_store', 'file_stores'),
      ifGroupRequired => [ \&tag_ifGroupRequired, $article, \$current_group ],
+     $ito->make
+     (
+      single => "tag",
+      plural => "tags",
+      code => [ iter_tags => $self, $article ],
+     ),
     );
 }
 
@@ -1568,6 +1584,21 @@ sub save_new {
     $errors{parentid} = "Invalid parent selection (template bug)";
   }
   $self->validate(\%data, $articles, \%errors);
+
+  my $save_tags = $cgi->param("_save_tags");
+  my @tags;
+  if ($save_tags) {
+    @tags = grep /\S/, $cgi->param("tags");
+    my $error;
+    for my $tag (@tags) {
+      BSE::TB::Tags->valid_name($tag, \$error)
+         or last;
+    }
+    if ($error) {
+      $errors{tags} = "msg:bse/admin/edit/badtag/$error";
+    }
+  }
+
   if (keys %errors) {
     if ($req->is_ajax) {
       return $req->json_content
@@ -1709,6 +1740,11 @@ sub save_new {
     $article = $articles->getByPkey($article->{id});
   }
 
+  if ($save_tags) {
+    my $error;
+    $article->set_tags(\@tags, \$error);
+  }
+
   use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
@@ -1764,6 +1800,10 @@ sub _article_data {
     [
      map $_->data_only, $article->files,
     ];
+  $article_data->{tags} =
+    [
+     $article->tags, # just the names
+    ];
 
   return $article_data;
 }
@@ -1846,6 +1886,20 @@ sub save {
       $article->{template} =~ m|\.\.|) {
     $errors{template} = "Please only select templates from the list provided";
   }
+
+  my $save_tags = $cgi->param("_save_tags");
+  my @tags;
+  if ($save_tags) {
+    @tags = grep /\S/, $cgi->param("tags");
+    my $error;
+    for my $tag (@tags) {
+      BSE::TB::Tags->valid_name($tag, \$error)
+         or last;
+    }
+    if ($error) {
+      $errors{tags} = "msg:bse/admin/edit/badtag/$error";
+    }
+  }
   $self->validate_old($article, \%data, $articles, \%errors, scalar $req->is_ajax)
     or return $self->_service_error($req, $article, $articles, undef, \%errors, "FIELD");
   $self->save_thumbnail($cgi, $article, \%data)
@@ -1948,6 +2002,11 @@ sub save {
 
   $article->save();
 
+  if ($save_tags) {
+    my $error;
+    $article->set_tags(\@tags, \$error);
+  }
+
   # fix the kids too
   my @extra_regen;
   @extra_regen = $self->update_child_dynamic($article, $articles, $req);
index c6169b6..c7f7f0b 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::Edit::Site;
 use strict;
 
-our $VERSION = "1.000";
+our $VERSION = "1.004";
 
 use base 'BSE::Edit::Article';
 use BSE::TB::Site;
@@ -22,6 +22,15 @@ my @site_actions =
      a_edit_image a_save_image a_order_images filelist fileadd fileswap filedel 
      filesave a_edit_file a_save_file a_tree a_csrfp a_article a_config);
 
+my %more_site_actions =
+  (
+   a_tagshow => "req_tagshow",
+   a_tags => "req_tagshow",
+   a_tagrename => "req_tagrename",
+   a_tagdelete => "req_tagdelete",
+   a_tagcleanup => "req_tagcleanup",
+  );
+
 sub article_actions {
   my ($self) = @_;
 
@@ -29,6 +38,8 @@ sub article_actions {
   my %valid;
   @valid{@site_actions} = @actions{@site_actions};
 
+  @valid{keys %more_site_actions} = values %more_site_actions;
+
   %valid;
 }
 
@@ -56,4 +67,188 @@ sub validate_image_name {
   return 0;
 }
 
+sub req_tagshow {
+  my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+  my $cgi = $req->cgi;
+  my $cat = $cgi->param("cat");
+  my $nocat = $cgi->param("nocat");
+  my @opts;
+  if ($cat) {
+    push @opts, [ like => "cat", "$cat%" ];
+  }
+  elsif ($nocat) {
+    push @opts, [ "=" => "cat", "" ];
+  }
+  my @tags = Articles->all_tags(@opts);
+
+  if ($req->is_ajax) {
+    my @json = map $_->json_data, @tags;
+    if ($cgi->param("showarts")) {
+      for my $i (0 .. $#tags) {
+       my $tag = $tags[$i];
+       my $json = $json[$i];
+       $json->{articles} = [ Articles->getIdsByTag($tag) ];
+      }
+    }
+
+    return $req->json_content
+      (
+       success => 1,
+       tags => \@json,
+      );
+  }
+
+  require BSE::Util::Iterate;
+  my $ito = BSE::Util::Iterate::Objects->new;
+  my $ita = BSE::Util::Iterate::Article->new(cfg => $req->cfg);
+  my $tag;
+  my %acts;
+  %acts =
+    (
+     $ito->make_paged
+     (
+      single => "systag",
+      plural => "systags",
+      data => \@tags,
+      name => "systag",
+      cgi => $req->cgi,
+      perpage_parm => "pp=50",
+      session => $req->session,
+      store => \$tag,
+     ),
+     $ita->make
+     (
+      single => "systagart",
+      plural => "systagarts",
+      code => sub { Articles->getByTag($tag) },
+      nocache => 1,
+     ),
+     $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors),
+    );
+  return $req->response("admin/tags", \%acts);
+}
+
+sub req_tagrename {
+  my ($self, $req, $article, $articles) = @_;
+
+  my $cgi = $req->cgi;
+  my $id = $cgi->param("tag_id");
+  my $name = $cgi->param("name");
+
+  my %errors;
+  my $tag;
+  unless (defined $id && $id =~ /^[0-9]+$/) {
+    $errors{id} = "msg:bse/admin/edit/tags/bad_id";
+  }
+  unless ($errors{id}) {
+    $tag = BSE::TB::Tags->getByPkey($id);
+    unless ($tag) {
+      $errors{tag_id} = "msg:bse/admin/edit/tags/unknown";
+    }
+  }
+
+  my $error;
+  unless (defined $name && BSE::TB::Tags->valid_name($name, \$error)) {
+    my $msgid = "invalid_$error";
+    $errors{name} = "msg:bse/admin/edit/tags/$msgid";
+  }
+
+  if ($tag && !$errors{name}) {
+    my $other = Articles->getTagByName($name);
+    if ($other) {
+      if ($other->id != $tag->id) {
+       $errors{name} = "msg:bse/admin/edit/tags/duplicate:$name";
+      }
+      elsif ($tag->name eq $name) {
+       $errors{name} = "msg:bse/admin/edit/tags/nochange";
+      }
+    }
+  }
+
+  if (%errors) {
+    if ($req->is_ajax) {
+      return $req->field_error(\%errors);
+    }
+    else {
+      return $self->req_tags($req, $article, $articles, undef, \%errors);
+    }
+  }
+
+  my $old_name = $tag->name;
+  $tag->set_name($name);
+  $tag->save;
+
+  if ($req->is_ajax) {
+    return $req->json_content
+      (
+       success => 1,
+       tag => $tag->json_data,
+      );
+  }
+
+  $req->flash("msg:bse/admin/edit/tags/saved", [ $old_name, $tag->name ]);
+  return $self->refresh($article, $cgi, undef, undef, "&a_tags=1");
+}
+
+sub req_tagdelete {
+  my ($self, $req, $article, $articles) = @_;
+
+  my $cgi = $req->cgi;
+  my $id = $cgi->param("tag_id");
+
+  my %errors;
+  my $tag;
+  unless (defined $id && $id =~ /^[0-9]+$/) {
+    $errors{id} = "msg:bse/admin/edit/tags/bad_id";
+  }
+  unless ($errors{id}) {
+    $tag = BSE::TB::Tags->getByPkey($id);
+    unless ($tag) {
+      $errors{tag_id} = "msg:bse/admin/edit/tags/unknown";
+    }
+  }
+
+  if (%errors) {
+    if ($req->is_ajax) {
+      return $req->field_error(\%errors);
+    }
+    else {
+      return $self->req_tags($req, $article, $articles, undef, \%errors);
+    }
+  }
+
+  my $name = $tag->name;
+
+  $tag->remove;
+
+  if ($req->is_ajax) {
+    return $req->json_content
+      (
+       success => 1,
+      );
+  }
+
+  $req->flash("msg:bse/admin/edit/tags/removed", [ $name ]);
+  return $self->refresh($article, $cgi, undef, undef, "&a_tags=1");
+}
+
+sub req_tagcleanup {
+  my ($self, $req, $article, $articles) = @_;
+
+  require BSE::TB::Tags;
+  my $count = 0 + BSE::TB::Tags->cleanup();
+
+  if ($req->is_ajax) {
+    return $req->json_content
+      (
+       success => 1,
+       count => $count,
+      );
+  }
+
+  $req->flash("msg:bse/admin/edit/tags/cleanup", [ $count ]);
+  return $self->refresh($article, $req->cgi, undef, undef, "&a_tags=1");
+}
+
 1;
index d690fd2..83d1ca9 100644 (file)
@@ -5,7 +5,7 @@ use BSE::Cfg;
 use BSE::Util::HTML;
 use Carp qw(cluck confess);
 
-our $VERSION = "1.003";
+our $VERSION = "1.005";
 
 sub new {
   my ($class, %opts) = @_;
@@ -889,6 +889,25 @@ sub json_content {
   return $json_result;
 }
 
+sub field_error {
+  my ($self, $errors) = @_;
+
+  my %errors = %$errors;
+  for my $key (keys %errors) {
+    if ($errors{$key} =~ /^msg:/) {
+      $errors{$key} = $self->_str_msg($errors{$key});
+    }
+  }
+
+  return $self->json_content
+    (
+     success => 0,
+     error_code => "FIELD",
+     errors => \%errors,
+     message => "Fields failed validation",
+    );
+}
+
 =item get_csrf_token($name)
 
 Generate a csrf token for the given name.
index 15f1d7e..90d2c47 100644 (file)
@@ -2,7 +2,7 @@ package BSE::Request::Test;
 use strict;
 use base 'BSE::Request::Base';
 
-our $VERSION = "1.002";
+our $VERSION = "1.003";
 
 sub new {
   my ($class, %opts) = @_;
@@ -29,25 +29,33 @@ sub is_ajax {
   $_[0]{is_ajax};
 }
 
-package BSE::Request::Base::Test;
+package BSE::Request::Test::CGI;
+use Carp qw(confess);
 
 sub param {
   my $self = shift;
   if (@_) {
     my $name = shift;
     if (@_) {
+      die "Unabled to delete $name key in test";
     }
     else {
-      if (ref $self->{$name}) {
-       if (wantarray) {
-         return @{$self->{$name}};
+      my $value = $self->{$name};
+      if (defined $value) {
+       if (ref $value) {
+         if (wantarray) {
+           return @{$self->{$name}};
+         }
+         else {
+           return $self->{$name}[-1];
+         }
        }
        else {
-         return $self->{$name}[-1];
+         return $value;
        }
       }
       else {
-       return $self->{$name};
+       return;
       }
     }
   }
diff --git a/site/cgi-bin/modules/BSE/TB/Tag.pm b/site/cgi-bin/modules/BSE/TB/Tag.pm
new file mode 100644 (file)
index 0000000..0baaf51
--- /dev/null
@@ -0,0 +1,61 @@
+package BSE::TB::Tag;
+use strict;
+use base 'Squirrel::Row';
+
+our $VERSION = "1.002";
+
+sub columns {
+  qw(id owner_type cat val);
+}
+
+sub table { 'bse_tags' }
+
+sub set_name {
+  my ($self, $name) = @_;
+
+  my ($cat, $val) = BSE::TB::Tags->split_name($name);
+  $self->set_cat($cat);
+  $self->set_val($val);
+}
+
+sub name {
+  my ($self) = @_;
+
+  my $cat = $self->cat;
+  return length $cat ? "$cat: " . $self->val : $self->val;
+}
+
+sub canon_name {
+  my ($self) = @_;
+
+  return lc $self->name;
+}
+
+sub eq_name {
+  my ($self, $name) = @_;
+
+  my $error;
+  my ($canon) = BSE::TB::Tags->canon_name($name, \$error)
+    or return;
+
+  return $canon eq $self->canon_name;
+}
+
+sub remove {
+  my ($self) = @_;
+
+  BSE::DB->single->run("BSE::TB::TagMembers.deleteTag" => $self->id);
+
+  $self->SUPER::remove();
+}
+
+sub json_data {
+  my ($self) = @_;
+
+  my $data = $self->data_only;
+  $data->{name} = $self->name;
+
+  return $data;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/TagMember.pm b/site/cgi-bin/modules/BSE/TB/TagMember.pm
new file mode 100644 (file)
index 0000000..d4225ae
--- /dev/null
@@ -0,0 +1,12 @@
+package BSE::TB::TagMember;
+use strict;
+use base 'Squirrel::Row';
+
+our $VERSION = "1.000";
+
+sub columns { qw(id owner_type owner_id tag_id) }
+
+sub table { 'bse_tag_members' }
+
+1;
+
diff --git a/site/cgi-bin/modules/BSE/TB/TagMembers.pm b/site/cgi-bin/modules/BSE/TB/TagMembers.pm
new file mode 100644 (file)
index 0000000..42d988f
--- /dev/null
@@ -0,0 +1,25 @@
+package BSE::TB::TagMembers;
+use strict;
+use base 'Squirrel::Table';
+use BSE::TB::TagMember;
+
+our $VERSION = "1.000";
+
+sub rowClass {
+  return 'BSE::TB::TagMember';
+}
+
+sub remove_by_tag {
+  my ($class, $owner, $tag) = @_;
+  BSE::DB->single->run("TagMembers.removeByTag",
+                      $owner->tag_owner_type, $owner->id, $tag->id);
+}
+
+sub remove_owned_by {
+  my ($class, $owner) = @_;
+
+  BSE::DB->single->run("TagMembers.remove_owned_by" =>
+                      $owner->tag_owner_type, $owner->id);
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/TagOwner.pm b/site/cgi-bin/modules/BSE/TB/TagOwner.pm
new file mode 100644 (file)
index 0000000..d1127e9
--- /dev/null
@@ -0,0 +1,118 @@
+# mix-in (or close) for classes that keep tags
+# currently just articles
+# the owner class should implement a tag_owner_type method
+package BSE::TB::TagOwner;
+use strict;
+use BSE::TB::Tags;
+use BSE::TB::TagMembers;
+
+our $VERSION = "1.001";
+
+sub set_tags {
+  my ($self, $rtags, $rerror) = @_;
+
+  my @current_tags = $self->tag_objects;
+  my %current = map { $_->canon_name => $_ } @current_tags;
+  my %remove = %current;
+  my %save;
+  my %add;
+  for my $name (@$rtags) {
+    my $work = BSE::TB::Tags->name($name, $rerror);
+    defined $work or return;
+
+    my $lower = lc $work;
+    if ($current{$lower}) {
+      delete $remove{$lower};
+      if (!$save{$lower} && $name ne $current{$lower}->name) {
+       $save{$lower} = $name;
+      }
+    }
+    else {
+      $add{$lower} = $name;
+    }
+  }
+
+  for my $add (values %add) {
+    # look for or make the tag
+    my $tag = BSE::TB::Tags->getByName($self->tag_owner_type, $add);
+    if ($tag) {
+      if ($tag->name ne $add && !$save{lc $add}) {
+       $current{lc $add} = $tag;
+       $save{lc $add} = $add;
+      }
+    }
+    else {
+      $tag = BSE::TB::Tags->make_with_name($self->tag_owner_type, $add);
+    }
+
+    # add the reference
+    BSE::TB::TagMembers->make
+       (
+        owner_type => $self->tag_owner_type,
+        owner_id => $self->id,
+        tag_id => $tag->id,
+       );
+  }
+
+  for my $save (keys %save) {
+    my $new_name = $save{$save};
+    my $tag = $current{$save};
+    $tag->set_name($new_name);
+    $tag->save;
+  }
+
+  # remove any leftovers
+  for my $remove (values %remove) {
+    BSE::TB::TagMembers->remove_by_tag($self, $remove);
+  }
+
+  return 1;
+}
+
+# remove all tags
+sub remove_tags {
+  my ($self) = @_;
+
+  BSE::TB::TagMembers->remove_owned_by($self);
+}
+
+sub tag_objects {
+  my ($self) = @_;
+
+  return BSE::TB::Tags->getSpecial(object_tags => $self->tag_owner_type, $self->id);
+}
+
+sub tags {
+  my ($self) = @_;
+
+  return map $_->name, $self->tag_objects;
+}
+
+sub tag_ids {
+  my ($self) = @_;
+
+  return map $_->{id}, BSE::DB->single->run("Tag_ids.by_owner", $self->tag_owner_type, $self->id);
+}
+
+sub has_tags {
+  my ($self, $rtags) = @_;
+
+  my %my_tag_ids = map { $_ => 1 } $self->tag_ids;
+
+  # make sure we have objects, if there's no tag, we don't have that
+  # tage and can immediately return false
+  for my $tag (@$rtags) {
+    my $work = $tag;
+    unless (ref $work) {
+      $work = BSE::TB::Tags->getByName($self->tag_owner_type, $tag)
+       or return;
+    }
+
+    $my_tag_ids{$tag->id}
+      or return;
+  }
+
+  return 1;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/TagOwners.pm b/site/cgi-bin/modules/BSE/TB/TagOwners.pm
new file mode 100644 (file)
index 0000000..0edc6ea
--- /dev/null
@@ -0,0 +1,30 @@
+# mix-in (or close) for classes that keep tags
+# currently just articles
+# the owner row class should implement a tag_owner_type method
+package BSE::TB::TagOwners;
+use strict;
+use BSE::TB::Tags;
+use BSE::TB::TagMembers;
+
+our $VERSION = "1.001";
+
+sub getTagByName {
+  my ($self, $name) = @_;
+
+  return BSE::TB::Tags->getByName($self->rowClass->tag_owner_type, $name);
+}
+
+# return articles that use the given tag
+sub getByTag {
+  my ($self, $tag) = @_;
+
+  return $self->getSpecial(byTag => $tag->id);
+}
+
+sub getIdsByTag {
+  my ($self, $tag) = @_;
+
+  return BSE::TB::TagMembers->getColumnBy(owner_id => [ tag_id => $tag->id ]);
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/Tags.pm b/site/cgi-bin/modules/BSE/TB/Tags.pm
new file mode 100644 (file)
index 0000000..903fbf2
--- /dev/null
@@ -0,0 +1,98 @@
+package BSE::TB::Tags;
+use strict;
+use base 'Squirrel::Table';
+use BSE::TB::Tag;
+
+our $VERSION = "1.002";
+
+sub rowClass {
+  return 'BSE::TB::Tag';
+}
+
+sub split_name {
+  my ($class, $name) = @_;
+
+  my $cat = "";
+  if ($name =~ s/^([^:]+): *//) {
+    $cat = $1;
+    $cat =~ s/^\s+//;
+    $cat =~ s/\s+$//;
+  }
+  my $value = $name;
+  $value =~ s/^\s+//;
+  $value =~ s/\s+$//;
+
+  return ($cat, $value);
+}
+
+my $bad_char = qr/[\\\/\x00-\x1F\x80-\x9F]/;
+
+sub valid_name {
+  my ($class, $name, $error) = @_;
+
+  unless ($name =~ /\S/) {
+    $$error = "empty";
+    return;
+  }
+
+  my ($cat, $val) = $class->split_name($name);
+
+  if ($cat =~ $bad_char || $val =~ /$bad_char/) {
+    $$error = "badchars";
+    return;
+  }
+
+  return ($cat, $val);
+}
+
+sub make_name {
+  my ($self, $cat, $val) = @_;
+
+  return length $cat ? "$cat: $val" : $val;
+}
+
+sub name {
+  my ($self, $name, $rerror) = @_;
+
+  my ($cat, $val) = $self->valid_name($name, $rerror)
+    or return;
+
+  return $self->make_name($cat, $val);
+}
+
+sub canon_name {
+  my ($self, $name, $error) = @_;
+
+  my $res = $self->name($name, $error);
+  defined $res
+    or return;
+
+  return lc $res;
+}
+
+sub getByName {
+  my ($self, $owner_type, $name) = @_;
+
+  my ($cat, $val) = $self->split_name($name);
+  return $self->getBy(owner_type => $owner_type,
+                     cat => $cat,
+                     val => $val);
+}
+
+sub make_with_name {
+  my ($self, $owner_type, $name) = @_;
+
+  my ($cat, $val) = $self->split_name($name);
+  return $self->make
+    (
+     owner_type => $owner_type,
+     cat => $cat,
+     val => $val,
+    );
+}
+
+sub cleanup {
+  return BSE::DB->single->run("bseTagsCleanup");
+}
+
+1;
index f83401f..6437074 100644 (file)
@@ -2,7 +2,7 @@ package BSE::UI::Dispatch;
 use strict;
 use Carp 'confess';
 
-our $VERSION = "1.002";
+our $VERSION = "1.003";
 
 sub new {
   my ($class, %opts) = @_;
@@ -117,20 +117,7 @@ sub error {
 sub _field_error {
   my ($self, $req, $errors) = @_;
 
-  my %errors = %$errors;
-  for my $key (keys %errors) {
-    if ($errors{$key} =~ /^msg:/) {
-      $errors{$key} = $req->_str_msg($errors{$key});
-    }
-  }
-
-  return $req->json_content
-    (
-     success => 0,
-     error_code => "FIELD",
-     errors => \%errors,
-     message => "Fields failed validation",
-    );
+  return $req->field_error($errors);
 }
 
 sub controller_id {
index 45c2e4a..267ef53 100644 (file)
@@ -6,20 +6,50 @@ use base 'BSE::ThumbLow';
 use base 'BSE::TagFormats';
 use BSE::CfgInfo qw(custom_class);
 
-our $VERSION = "1.007";
+our $VERSION = "1.017";
+
+=head1 NAME
+
+BSE::Util::DynamicTags - common dynamic page tags for BSE.
+
+=head1 SYNOPSIS
+
+  # in the code
+  my %acts =
+    (
+     $req->dyn_user_tags(),
+     ...
+    );
+
+  # in the page
+
+  <:usr userId:>
+  ...
+
+=head1 DESCRIPTION
+
+This module defines the common set of tags available on public dynamic
+pages.
+
+=head1 METHODS
+
+=over
+
+=item new
+
+Create a new tags object, accepts a single parameter which is a
+L<BSE::Request> object.
+
+=cut
 
 sub new {
   my ($class, $req) = @_;
   return bless { req => $req }, $class;
 }
 
-=item Common dynamic tags
-
-=over
-
-=item *
+=item tags
 
-paid_files, paid_file - iterates over the files the user has paid for.
+Returns the common tags.
 
 =back
 
@@ -43,7 +73,10 @@ sub tags {
      $self->dyn_article_iterator('dynallkids_of3', 'dynofallkid3'),
      $self->dyn_article_iterator('dynchildren_of', 'dynofchild'),
      $self->dyn_iterator('dyncart', 'dyncartitem'),
-     $self->dyn_article_iterator('wishlist', 'wishlistentry', $req),
+     $self->dyn_article_iterator('wishlist', 'wishlistentry'),
+     $self->dyn_iterator('dynunused_tagcats', 'dynunused_tagcat'),
+     $self->dyn_iterator('dynunused_tags', 'dynunused_tag'),
+     $self->dyn_iterator('dyntags', 'dyntag'),
      url => [ tag_url => $self ],
      dyncarttotalcost => [ tag_dyncarttotal => $self, 'total_cost' ],
      dyncarttotalunits => [ tag_dyncarttotal => $self, 'total_units' ],
@@ -74,18 +107,60 @@ sub _custom_tags {
   return custom_class($self->cfg)->dynamic_tags($self->req);
 }
 
+=item cfg
+
+Return a cfg object.
+
+=cut
+
 sub cfg {
   return $_[0]{req}->cfg;
 }
 
+=item cgi
+
+Return the cgi object.
+
+=cut
+
 sub cgi {
   return $_[0]{req}->cgi;
 }
 
+=item req
+
+Return the request object.
+
+=cut
+
 sub req {
   return $_[0]{req};
 }
 
+=item admin_mode
+
+Return true if in admin mode.
+
+=cut
+
+sub admin_mode {
+  return 0;
+}
+
+=head1 COMMON DYNAMIC TAGS
+
+=over
+
+=item ifUser
+=synopsis <:if User:><:user userId:><:or:>Not logged in<:eif:>
+
+With parameters, check if there is a user currenly logged in.
+
+Without, check if the given attribute of the currently logged in user
+is a true perl value.
+
+=cut
+
 sub tag_ifUser {
   my ($req, $args) = @_;
 
@@ -99,6 +174,15 @@ sub tag_ifUser {
   }
 }
 
+=item user
+
+Retrieve an attribute from the currently logged in user.
+
+Returns an empty string if the user isn't logged in or if the
+attribute is unknown.
+
+=cut
+
 sub tag_user {
   my ($req, $args) = @_;
 
@@ -111,6 +195,14 @@ sub tag_user {
   escape_html($siteuser->{$args});
 }
 
+=item ifUserCanSee
+=synopsis <:ifUserCanSee 3:><a href="/shop/">See the shop</a><:or:><:eif:>
+
+Tests if the currently logged in siteuser has access to the named or
+numbered article.
+
+=cut
+
 sub tag_ifUserCanSee {
   my ($req, $args) = @_;
 
@@ -134,6 +226,14 @@ sub tag_ifUserCanSee {
   $req->siteuser_has_access($article);
 }
 
+=item ifUserMemberOf
+
+Test if the currently logged in user is a member of the named group.
+
+Accepts [] style parameters.
+
+=cut
+
 sub tag_ifUserMemberOf {
   my ($self, $args, $acts, $func, $templater) = @_;
 
@@ -157,6 +257,15 @@ sub tag_ifUserMemberOf {
   return $group->contains_user($user);
 }
 
+=item dyntarget
+=synopsis <:dyntarget user a_logon 1:>
+
+Generate a url to the specified script with the given parameters.
+
+Accepts [] style parameters.
+
+=cut
+
 sub tag_dyntarget {
   my ($self, $args, $acts, $func, $templater) = @_;
 
@@ -171,6 +280,14 @@ sub tag_dyntarget {
   return escape_html($req->user_url($script, $target, @options));
 }
 
+=item url
+=synopsis <:url dynofallkid:>
+
+Generate a link to the specified article, taking admin mode into
+account.
+
+=cut
+
 sub tag_url {
   my ($self, $name, $acts, $func, $templater) = @_;
 
@@ -194,6 +311,12 @@ sub tag_url {
   return escape_html($value);
 }
 
+=item iterator dynlevel1s
+
+Iterate over level 1 articles.
+
+=cut
+
 sub iter_dynlevel1s {
   my ($self, $unused, $args) = @_;
 
@@ -208,6 +331,12 @@ sub iter_dynlevel1s {
   return $result;
 }
 
+=item iterator dynlevel2s
+
+Iterate over the children of the dynlevel1 article.
+
+=cut
+
 sub iter_dynlevel2s {
   my ($self, $unused, $args) = @_;
 
@@ -226,6 +355,12 @@ sub iter_dynlevel2s {
   return $result;
 }
 
+=item iterator dynlevel3s
+
+Iterate over the children of the dynlevel2 article.
+
+=cut
+
 sub iter_dynlevel3s {
   my ($self, $unused, $args) = @_;
 
@@ -244,6 +379,15 @@ sub iter_dynlevel3s {
   return $result;
 }
 
+=item dynallkids_of
+
+Also dynallkids_of2, dynallkids_of3
+
+Iterate over all children of the each of the specified article names
+or ids.
+
+=cut
+
 sub iter_dynallkids_of {
   my ($self, $unused, $args, $acts, $templater, $state) = @_;
 
@@ -266,6 +410,13 @@ sub iter_dynallkids_of {
 *iter_dynallkids_of2 = \&iter_dynallkids_of;
 *iter_dynallkids_of3 = \&iter_dynallkids_of;
 
+=item dynchildren_of
+
+Iterate over direct children of each of the specified article names or
+ids.
+
+=cut
+
 sub iter_dynchildren_of {
   my ($self, $unused, $args, $acts, $templater) = @_;
 
@@ -281,6 +432,12 @@ sub iter_dynchildren_of {
   return $self->access_filter( map Articles->listedChildren($_), @ids);
 }
 
+=item iterator dyncart
+
+Iterate over the contents of the cart.
+
+=cut
+
 sub iter_dyncart {
   my ($self, $unused, $args) = @_;
 
@@ -290,6 +447,12 @@ sub iter_dyncart {
   return $cart->{cart};
 }
 
+=item dyncarttotal
+
+The total cost of the items in the cart, in cents.
+
+=cut
+
 sub tag_dyncarttotal {
   my ($self, $field, $args) = @_;
 
@@ -415,461 +578,245 @@ sub _find_articles {
   return;
 }
 
+=item iterator wishlist
+
+Iterate over the items in the logged in user's wishlist.
+
+=cut
+
 sub iter_wishlist {
-  my ($self, $req) = @_;
+  my ($self) = @_;
 
-  my $user = $req->siteuser
+  my $user = $self->req->siteuser
     or return [];
   return [ $user->wishlist ];
 }
 
-sub access_filter {
-  my ($self, @articles) = @_;
-
-  my $req = $self->{req};
+=item iterator dynunused_tagcats
 
-  my $admin_sees_all = $req->cfg->entry('basic', 'admin_sees_all', 1);
+Iterate over the the tag categories of unused tags in the articles
+selected by the given tags: and filter: parameters.
 
-  $admin_sees_all && $self->{admin} and 
-    return \@articles;
+You must supply a tags: filter, even if it's just "".
 
-  return [ grep $req->siteuser_has_access($_), @articles ];
-}
+There will be an iteration with an empty I<name> for each tag without
+a category.
 
-my $cols_re; # cache for below
+If a parameter "onlyone" is supplied then the list of tag categories
+will not include tag categories that appear in the tags filter.
 
-sub _get_filter {
-  my ($self, $rargs) = @_;
+Each entry has:
 
-  if ($$rargs =~ s/filter:\s+(.*)\z//s) {
-    my $expr = $1;
-    my $orig_expr = $expr;
-    unless ($cols_re) {
-      require Articles;
-      my $cols_expr = '(' . join('|', Article->columns) . ')';
-      $cols_re = qr/\[$cols_expr\]/;
-    }
-    $expr =~ s/$cols_re/\$article->{$1}/g;
-    $expr =~ s/ARTICLE/\$article/g;
-    #print STDERR "Expr $expr\n";
-    my $filter;
-    $filter = eval 'sub { my $article = shift; '.$expr.'; }';
-    if ($@) {
-      print STDERR "** Failed to compile filter expression >>$expr<< built from >>$orig_expr<<\n";
-      return;
-    }
+=over
 
-    return $filter;
-  }
-  else {
-    return;
-  }
-}
+=item * name - name of the category
 
-sub _do_filter {
-  my ($self, $filter, $articles) = @_;
+=item * nocat - a category-less tag
 
-  $filter
-    or return $articles;
+=item * ind - a unique key for this category.
 
-  return [ grep $filter->($_), @$articles ];
-}
+=back
 
-sub _dyn_iterate_reset {
-  my ($self, $state, $args, $acts, $name, $templater) = @_;
+=cut
 
-  my $rindex = $state->{rindex};
-  my $rdata = $state->{rdata};
-  my $method = "iter_$state->{plural}";
-  my $filter = $self->_get_filter(\$args);
-  $$rdata = $self->
-    _do_filter($filter, $self->$method($state->{context}, $args, $acts, $templater, $state));
-  
-  $$rindex = -1;
+sub iter_dynunused_tagcats {
+  my ($self, $unused, $args, $acts, $templater, $state) = @_;
 
-  $state->{previous} = undef;
-  $state->{item} = undef;
-  if (@$$rdata) {
-    $state->{next} = $$rdata->[0];
+  unless ($args =~ s/^(\w+)\s*//) {
+    print STDERR "dynunused_tagcats: missing iterator name\n";
+    return [];
   }
-  else {
-    $state->{next} = undef;
+
+  my $iter = $1;
+  my $method = "iter_$iter";
+  unless ($self->can($method)) {
+    print STDERR "* Unknown iterator $iter *\n";
+    return [];
   }
 
-  1;
-}
+  my $only_one = $args =~ s/^\s*onlyone\s+//;
 
-sub _dyn_iterate {
-  my ($self, $state) = @_;
+  my $context = $self->{context}{$iter};
+  my %state =
+    (
+     plural => $iter,
+     single => "unknown",
+     context => $context,
+    );
 
-  my $rindex = $state->{rindex};
-  my $rdata = $state->{rdata};
-  my $single = $state->{single};
-  if (++$$rindex < @$$rdata) {
-    $state->{previous} = $state->{item};
-    $state->{item} = $state->{next};
-    if ($$rindex < $#$$rdata) {
-      $state->{next} = $$rdata->[$$rindex+1];
+  my $filter = $self->{filter};
+  my $selected_tags = $filter->{tags};
+  my $ignored = $self->_do_filter(\%state, $filter, $self->$method($context, $args, $acts, $templater, \%state));
+  keys %$filter
+    or $self->{filter} = undef;
+
+  my %selected_cats = map { $_ => 1 }
+    map { lc ((BSE::TB::Tags->split_name($_))[0]) }
+      @{$selected_tags || []};
+
+  my %cats;
+  my $tags = $self->{tags}{$iter};
+ TAG:
+  for my $tag (keys %$tags) {
+    my $count = $tags->{$tag};
+    my ($cat, $val) = BSE::TB::Tags->split_name($tag);
+    my $ind = lc(length $cat ? "$cat:" : $val);
+    my $can_cat = lc $cat;
+
+    if ($only_one && length $cat && $selected_cats{$can_cat}) {
+      next TAG;
     }
-    else {
-      $state->{next} = undef;
+
+    unless ($cats{$ind}) {
+      $cats{$ind} =
+       {
+        name => $cat,
+        ind => $ind,
+        vals => [],
+        nocat => (length($cat) == 0),
+       };
     }
-    $self->{req}->set_article("previous_$single" => $state->{previous});
-    $self->{req}->set_article($single => $state->{item});
-    $self->{req}->set_article("next_$single" => $state->{next});
-    return 1;
+    push @{$cats{$ind}{vals}}, 
+      {
+       name => $tag,
+       val => $val,
+       cat => $cat,
+       count => $count,
+      };
   }
-  else {
-    $self->{req}->set_article($single => undef);
-    return;
+
+  # sort each value set
+  for my $cat (values %cats) {
+    my $newvals =  [ sort { lc($a->{val}) cmp lc($b->{val}) } @{$cat->{vals}} ];
+    $cat->{vals} = $newvals;
   }
+
+  my $cats =
+    [
+     sort
+     {
+       $b->{nocat} <=> $a->{nocat}
+        || $a->{ind} cmp $b->{ind}
+     } values %cats
+    ];
+
+  return $cats;
 }
 
-sub _dyn_item_low {
-  my ($self, $item, $args) = @_;
+=item iterator dynunsed_tags
 
-  $item or return '';
-  my $value = $item->{$args};
-  defined $value 
-    or return '';
+Iterate over the unused tags in a category from dynunused_tagcats.
 
-  return escape_html($value);
-}
+Each entry has:
 
-sub _dyn_item {
-  my ($self, $state, $args) = @_;
+=over
 
-  my $rindex = $state->{rindex};
-  my $rdata = $state->{rdata};
-  my $item = $state->{item};
-  unless ($state->{item}) {
-    return "** $state->{single} only usable inside iterator $state->{plural} **";
-  }
+=item * name - the full name of the tag, including category
 
-  return $self->_dyn_item_low($item, $args);
-}
+=item * cat - the category only
 
-sub _dyn_next {
-  my ($self, $state, $args) = @_;
+=item * val - the value only
 
-  return $self->_dyn_item_low($state->{next}, $args);
-}
+=back
 
-sub _dyn_previous {
-  my ($self, $state, $args) = @_;
+=cut
 
-  return $self->_dyn_item_low($state->{previous}, $args);
+sub iter_dynunused_tags {
+  my ($self, $unused, $args) = @_;
+
+  my $cat = $self->{current}{dynunused_tagcats}
+    or return;
+
+  return $cat->{vals};
 }
 
-sub _dyn_item_object_low {
-  my ($self, $item, $args, $state) = @_;
+=item dyntags
+=synopsis <:iterator begin dyntags [lcgi tags]:>
 
-  $item
-    or return '';
-  $item->can($args)
-    or return "* $args not valid for $state->{single} *";
-  my $value = $item->$args;
-  defined $value 
-    or return '';
+Iterate over a list of tags.
 
-  return escape_html($value);
-}
+=cut
 
-sub _dyn_item_object {
-  my ($self, $state, $args) = @_;
+sub iter_dyntags {
+  my ($self, $unused, $args, $acts, $templater) = @_;
 
-  unless ($state->{item}) {
-    return "** $state->{single} only usable inside iterator $state->{plural} **";
+  my @tags = grep /\S/, map { split '/' } $templater->get_parms($args, $acts);
+
+  my @out;
+  for my $tag (@tags) {
+    my ($cat, $val) = BSE::TB::Tags->split_name($tag);
+
+    push @out,
+      {
+       name => BSE::TB::Tags->make_name($cat, $val),
+       cat => $cat,
+       val => $val
+      };
   }
 
-  return $self->_dyn_item_object_low($state->{item}, $args, $state);
+  return \@out;
 }
 
-sub _dyn_next_obj {
-  my ($self, $state, $args) = @_;
+sub access_filter {
+  my ($self, @articles) = @_;
 
-  return $self->_dyn_item_object_low($state->{next}, $args, $state);
-}
+  my $req = $self->{req};
 
-sub _dyn_previous_obj {
-  my ($self, $state, $args) = @_;
-
-  return $self->_dyn_item_object_low($state->{previous}, $args, $state);
-}
-
-sub _dyn_ifNext {
-  my ($self, $state) = @_;
-
-  return defined $state->{next};
-}
-
-sub _dyn_ifPrevious {
-  my ($self, $state) = @_;
-
-  return defined $state->{previous};
-}
-
-sub _dyn_article {
-  my ($self, $state, $args) = @_;
-
-  my $rindex = $state->{rindex};
-  my $rdata = $state->{rdata};
-  unless ($state->{item}) {
-    return "** $state->{single} only usable inside iterator $state->{plural} **";
-  }
-
-  my $item = $state->{item}
-    or return '';
-
-  return tag_article($item, $self->{req}->cfg, $args);
-}
-
-sub _dyn_next_article {
-  my ($self, $state, $args) = @_;
-
-  $state->{next} or return '';
-
-  return tag_article($state->{next}, $self->{req}->cfg, $args);
-}
-
-sub _dyn_previous_article {
-  my ($self, $state, $args) = @_;
-
-  $state->{previous} or return '';
-
-  return tag_article($state->{previous}, $self->{req}->cfg, $args);
-}
-
-sub _dyn_index {
-  my ($self, $rindex, $rdata, $single) = @_;
-
-  if ($$rindex < 0 || $$rindex >= @$$rdata) {
-    return "** $single only valid inside iterator **";
-  }
-
-  return $$rindex;
-}
-
-sub _dyn_number {
-  my ($self, $rindex, $rdata, $single) = @_;
-
-  if ($$rindex < 0 || $$rindex >= @$$rdata) {
-    return "** $single only valid inside iterator **";
-  }
-
-  return 1 + $$rindex;
-}
-
-sub _dyn_count {
-  my ($self, $rdata, $rindex, $plural, $context, $args, $acts, $name, 
-      $templater) = @_;
+  my $admin_sees_all = $req->cfg->entry('basic', 'admin_sees_all', 1);
 
-  my $filter = $self->_get_filter(\$args);
-  my $method = "iter_$plural";
-  my $data = $self->_do_filter($filter, $self->$method($context, $args, $acts, $templater));
+  $admin_sees_all && $self->{admin} and 
+    return \@articles;
 
-  return scalar @$data;
+  return [ grep $req->siteuser_has_access($_), @articles ];
 }
 
-sub _dyn_if_first {
-  my ($self, $rindex, $rdata) = @_;
+=item dthumbimage
 
-  $$rindex == 0;
-}
+Either:
 
-sub _dyn_if_last {
-  my ($self, $rindex, $rdata) = @_;
+=over
 
-  $$rindex == $#$$rdata;
-}
+C<< dynthumbimage I<article> I<geometry> I<image> I<field> >>
 
-sub dyn_iterator {
-  my ($self, $plural, $single, $context, $rindex, $rdata) = @_;
+or
 
-  my $method = $plural;
-  my $index;
-  defined $rindex or $rindex = \$index;
-  my $data;
-  defined $rdata or $rdata = \$data;
-  my %state =
-    (
-     plural => $plural,
-     single => $single,
-     rindex => $rindex,
-     rdata => $rdata,
-     context => $context,
-    );
-  return
-    (
-     "iterate_${plural}_reset" =>
-     [ _dyn_iterate_reset => $self, \%state ],
-     "iterate_$plural" =>
-     [ _dyn_iterate => $self, \%state ],
-     $single => 
-     [ _dyn_item => $self, \%state ],
-     "${single}_index" =>
-     [ _dyn_index => $self, $rindex, $rdata, $single ],
-     "${single}_number" =>
-     [ _dyn_number => $self, $rindex, $rdata ],
-     "${single}_count" =>
-     [ _dyn_count => $self, $rindex, $rdata, $plural, $context ],
-     "if\u$plural" =>
-     [ _dyn_count => $self, $rindex, $rdata, $plural, $context ],
-     "ifLast\u$single" => [ _dyn_if_last => $self, $rindex, $rdata ],
-     "ifFirst\u$single" => [ _dyn_if_first => $self, $rindex, $rdata ],
-     "next_$single" => [ _dyn_next => $self, \%state ],
-     "previous_$single" => [ _dyn_previous => $self, \%state ],
-     "ifNext\u$single" => [ _dyn_ifNext => $self, \%state ],
-     "ifPrevious\u$single" => [ _dyn_ifPrevious => $self, \%state ],
-    );
-}
+C<< dthumbimage I<article> I<geometry> I<image> >>
 
-sub dyn_iterator_obj {
-  my ($self, $plural, $single, $context, $rindex, $rdata) = @_;
+=back
 
-  my $method = $plural;
-  my $index;
-  defined $rindex or $rindex = \$index;
-  my $data;
-  defined $rdata or $rdata = \$data;
-  my %state =
-    (
-     plural => $plural,
-     single => $single,
-     rindex => $rindex,
-     rdata => $rdata,
-     context => $context,
-    );
-  return
-    (
-     "iterate_${plural}_reset" =>
-     [ _dyn_iterate_reset => $self, \%state ],
-     "iterate_$plural" =>
-     [ _dyn_iterate => $self, \%state ],
-     $single => 
-     [ _dyn_item_object => $self, \%state ],
-     "${single}_index" =>
-     [ _dyn_index => $self, $rindex, $rdata, $single ],
-     "${single}_number" =>
-     [ _dyn_number => $self, $rindex, $rdata ],
-     "${single}_count" =>
-     [ _dyn_count => $self, $rindex, $rdata, $plural, $context ],
-     "if\u$plural" =>
-     [ _dyn_count => $self, $rindex, $rdata, $plural, $context ],
-     "ifLast\u$single" => [ _dyn_if_last => $self, $rindex, $rdata ],
-     "ifFirst\u$single" => [ _dyn_if_first => $self, $rindex, $rdata ],
-     "next_$single" => [ _dyn_next_obj => $self, \%state ],
-     "previous_$single" => [ _dyn_previous_obj => $self, \%state ],
-     "ifNext\u$single" => [ _dyn_ifNext => $self, \%state ],
-     "ifPrevious\u$single" => [ _dyn_ifPrevious => $self, \%state ],
-    );
-}
+Similar to thumbimage/gthumbimage, this allows you to retrieve images
+from a given article, which article can either be a number or a named
+article in the current context.
 
-sub _dyn_article_move {
-  my ($self, $state, $args, $acts, $func, $templater) = @_;
+geometry and field are as for the static thumbimage tag.
 
-  $state->{parentid}
-    or return '';
+image is a comma separated list of match operators, eg:
 
-  return $self->tag_dynmove($state->{rindex}, $state->{rdata},
-                           "stepparent=$state->{parentid}",
-                           $args, $acts, $templater);
-}
+  <:dthumbimage result search search,/^display_$/,1 :>
 
-sub dyn_article_iterator {
-  my ($self, $plural, $single, $context, $rindex, $rdata) = @_;
+on a search page will display either the image with an id of search,
+the first image found with an identifier starting with "display_" or
+the first image of the article.
 
-  my $method = $plural;
-  my $index;
-  defined $rindex or $rindex = \$index;
-  my $data;
-  defined $rdata or $rdata = \$data;
-  my %state =
-    (
-     plural => $plural,
-     single => $single,
-     rindex => $rindex,
-     rdata => $rdata,
-     context => $context,
-    );
-  return
-    (
-     "iterate_${plural}_reset" =>
-     [ _dyn_iterate_reset => $self, \%state ],
-     "iterate_$plural" =>
-     [ _dyn_iterate => $self, \%state],
-     $single => 
-     [ _dyn_article => $self, \%state ],
-     "${single}_index" =>
-     [ _dyn_index => $self, $rindex, $rdata, $single ],
-     "${single}_number" =>
-     [ _dyn_number => $self, $rindex, $rdata ],
-     "${single}_count" =>
-     [ _dyn_count => $self, $rindex, $rdata, $plural, $context ],
-     "if\u$plural" =>
-     [ _dyn_count => $self, $rindex, $rdata, $plural, $context ],
-     "ifLast\u$single" => [ _dyn_if_last => $self, $rindex, $rdata ],
-     "ifFirst\u$single" => [ _dyn_if_first => $self, $rindex, $rdata ],
-     "next_$single" => [ _dyn_next_article => $self, \%state ],
-     "previous_$single" => [ _dyn_previous_article => $self, \%state ],
-     "ifNext\u$single" => [ _dyn_ifNext => $self, \%state ],
-     "ifPrevious\u$single" => [ _dyn_ifPrevious => $self, \%state ],
-     "move_$single" => [ _dyn_article_move => $self, \%state ],
-    );
-}
+Possible match operators are:
 
-sub get_cached {
-  my ($self, $id) = @_;
+=over
 
-  return $self->{_cache}{$id};
-}
+=item *
 
-sub set_cached {
-  my ($self, $id, $value) = @_;
+/regexp/ - a regular expression matched against the image identifier
 
-  $self->{_cache}{$id} = $value;
-}
+=item *
 
-sub _cart {
-  my ($self) = @_;
+index - a numeric image index, where 1 is the first image
 
-  my $dyncart = $self->get_cached('cart');
-  $dyncart and return $dyncart;
+=item *
 
-  my $cart = $self->{req}->session->{cart}
-    or return { cart => [], total_cost => 0, total_units => 0 };
+identifier - a literal image identifier
 
-  my @cart;
-  my $total_cost = 0;
-  my $total_units = 0;
-  for my $item (@$cart) {
-    require Products;
-    my $product = Products->getByPkey($item->{productId});
-    my $extended = $product->price(user => scalar $self->{req}->siteuser) 
-      * $item->{units};
-    my $link = $product->link;
-    $link =~ /^\w+:/ 
-      or $link = $self->{req}->cfg->entryErr('site', 'url') . $link;
-    push @cart,
-      {
-       ( map { $_ => $product->{$_} } $product->columns ),
-       %$item,
-       extended => $extended,
-       link => $link,
-      };
-    $total_cost += $extended;
-    $total_units += $item->{units};
-  }
-  my $result = 
-    {
-     cart => \@cart,
-     total_cost => $total_cost,
-     total_units => $total_units,
-    };
-  $self->set_cached(cart => $result);
+=back
 
-  return $result;
-}
+=cut
 
 sub tag_dthumbimage {
   my ($self, $args) = @_;
@@ -912,8 +859,22 @@ sub tag_dthumbimage {
   return $self->_thumbimage_low($geometry, $im, $field, $self->{req}->cfg);
 }
 
-sub tag_dgthumbimage {
-  my ($self, $args, $acts, $func, $templater) = @_;
+=item dgthumbimage
+
+=over
+
+C<<dgthumbimage I<geometry> I<name> I<field> >>
+
+C<<dgthumbimage I<geometry> I<name> >>
+
+=back
+
+Format a thumbnail for a global image, in dynamic context.
+
+=cut
+
+sub tag_dgthumbimage {
+  my ($self, $args, $acts, $func, $templater) = @_;
 
   my ($geometry, $name, $field) = 
     DevHelp::Tags->get_parms($args, $acts, $templater);
@@ -1061,6 +1022,12 @@ sub iter_userfiles {
   return [];
 }
 
+=item iterator paid_files
+
+Iterates over the files the user has paid for.
+
+=cut
+
 sub iter_paidfiles {
   my ($self, $unused, $args) = @_;
 
@@ -1070,10 +1037,6 @@ sub iter_paidfiles {
   return [ $user->paid_files ];
 }
 
-sub admin_mode {
-  return 0;
-}
-
 sub tag_dynmove {
   my ($self, $rindex, $rrdata, $url_prefix, $args, $acts, $templater) = @_;
 
@@ -1176,58 +1139,709 @@ sub tag_ifTieredPricing {
   return scalar @tiers;
 }
 
-1;
+=back
 
-=head1 NAME
+=head2 Dynamic iterator filter syntax
+
+There a two types filters:
+
+=over
+
+=item * code filters - filters specified as perl code
+
+=item * tag filters - filtering on tags (articles only)
+
+=back
+
+=head3 Code filters
 
-BSE::Util::DynamicTags - basic dynamic page tags
+Specified as:
 
-=head1 REFERENCE
+=over
+
+C<< filter: I<perl code> >>
+
+=back
+
+The text C<ARTICLE> is replaced with the article being tested.
+
+The text C<<[I<column-name>]>> is replaced with that attribute of the
+article.
+
+=head3 Tag filters
+
+Should be a simple [] expression specifying the tags to filter on:
 
 =over
 
-=item dthumbimage article geometry image field
+C<tags: [lcgi tags]>
 
-=item dthumbimage article geometry image
+=back
 
-Similar to thumbimage/gthumbimage, this allows you to retrieve images
-from a given article, which article can either be a number or a named
-article in the current context.
+=cut
 
-geometry and field are as for the static thumbimage tag.
+my $cols_re; # cache for below
 
-image is a comma separated list of match operators, eg:
+sub _get_filter {
+  my ($self, $state, $rargs, $acts, $templater) = @_;
 
-  <:dthumbimage result search search,/^display_$/,1 :>
+  my %filter;
 
-on a search page will display either the image with an id of search,
-the first image found with an identifier starting with "display_" or
-the first image of the article.
+  if ($$rargs =~ s/tags:\s*(.*)\z//s) {
+    my $expr = $1;
+    my @match = $templater->get_parms($expr, $acts);
 
-Possible match operators are:
+    # always add the tags filter even if no tags were listed
+    # this means the other tag stuff continues to work
+    my @tags = grep length, map split('/'), @match;
+
+    $filter{tags} = \@tags;
+  }
+
+  if ($$rargs =~ s/filter:\s+(.*)\z//s) {
+    my $expr = $1;
+    my $orig_expr = $expr;
+    unless ($cols_re) {
+      require Articles;
+      my $cols_expr = '(' . join('|', Article->columns) . ')';
+      $cols_re = qr/\[$cols_expr\]/;
+    }
+    $expr =~ s/$cols_re/\$article->{$1}/g;
+    $expr =~ s/ARTICLE/\$article/g;
+    #print STDERR "Expr $expr\n";
+    my $filter;
+    $filter = eval 'sub { my $article = shift; '.$expr.'; }';
+    if ($@) {
+      print STDERR "** Failed to compile filter expression >>$expr<< built from >>$orig_expr<<\n";
+      return;
+    }
+
+    $filter{code} = $filter;
+  }
+
+  return \%filter;
+}
+
+sub _do_filter {
+  my ($self, $state, $filter, $articles) = @_;
+
+  $filter
+    or return $articles;
+
+  if (my $code = delete $filter->{code}) {
+    $articles = [ grep $code->($_), @$articles ];
+  }
+
+  if (my $tags = delete $filter->{tags}) {
+    my @out;
+    my %extras;
+
+  ARTICLE:
+    for my $art (@$articles) {
+      my %tags = map { $_ => 1 } $art->tags;
+      for my $tag (@$tags) {
+       $tags{$tag}
+         or next ARTICLE;
+       delete $tags{$tag};
+      }
+      push @out, $art;
+      ++$extras{$_} for keys %tags; # as long as they exist
+    }
+    $self->{tags}{$state->{plural}} = \%extras;
+
+    $articles = \@out;
+  }
+
+  return $articles;
+}
+
+my $paged_re =
+  qr(
+      \bpaged:
+       (?:(\w+)=)?  # optional per page variable
+       ([0-9]+)?    # optional per page default
+       (?:,(\w+))?  # optional page selector
+   )x;
+
+sub _get_paged {
+  my ($self, $state, $rargs) = @_;
+
+  my $paged;
+  if ($$rargs =~ s/$paged_re//) {
+    $paged =
+      {
+       pp => $1 || "pp",
+       perpage => $2 || 20,
+       p => $3 || "p",
+      };
+  }
+
+  return $paged;
+}
+
+sub _do_paged {
+  my ($self, $state, $paged, $articles) = @_;
+
+  $state->{totalcount} = @$articles;
+
+  unless ($paged) {
+    $state->{page} = 1;
+    $state->{pagecount} = 1;
+    $state->{poffset} = 0;
+    $state->{perpage} = @$articles;
+    $state->{nextpage} = '';
+    $state->{prevpage} = '';
+    $state->{firstnumber} = 1;
+    $state->{lastnumber} = @$articles;
+    return $articles;
+  }
+
+  my ($page) = $self->cgi->param($paged->{p});
+  defined $page or $page = 1;
+  $page =~ /^[0-9]+$/ or $page = 1;
+  $page >= 1 or $page = 1;
+
+  my ($pp) = $self->cgi->param($paged->{pp});
+  defined $pp or $pp = $paged->{perpage};
+  $pp =~ /^[0-9]+$/ or $pp = 20;
+  $pp = int($pp);
+  $pp >= 1 or $pp = 20;
+  $state->{perpage} = $pp;
+
+  $state->{pagecount} = int((@$articles + $pp - 1) / $pp);
+  $state->{pagecount} == 0 and $state->{pagecount} = 1;
+  $page <= $state->{pagecount} or $page = $state->{pagecount};
+
+  $state->{page} = $page;
+  $state->{nextpage} = $page < $state->{pagecount} ? $page + 1 : '';
+  $state->{prevpage} = $page > 1 ? $page - 1 : '';
+  $state->{poffset} = ($page - 1) * $pp;
+  $state->{firstnumber} = 1 + $state->{poffset};
+  my $end = $state->{poffset} + $pp - 1;
+  $state->{lastnumber} = 1 + $end;
+  $end < @$articles or $end = $#$articles;
+
+  return [ @$articles[$state->{poffset} .. $end] ];
+}
+
+=head2 Common dynamic iterator tags
 
 =over
 
 =item *
 
-/regexp/ - a regular expression matched against the image identifier
+I<single> I<field> - access to the fields of the current item in the
+iteration.
 
 =item *
 
-index - a numeric image index, where 1 is the first image
+I<single>C<_index> - the current index (zero-based) of the iteration.
 
 =item *
 
-identifier - a literal image identifier
+I<single>C<_number> - the current number (one-based) of the iteration.
+
+=item *
+
+I<single>C<_count> I<...> - the number of items matched
+
+=item *
+
+C<if>I<Plural> I<...> - test if there are any items matched.
+
+=item *
+
+C<ifLast>I<Single> - test if this is the last item in the iteration.
+
+=item *
+
+C<ifFirst>I<Single> - test if this is the first item in the iteration.
+
+=item *
+
+C<next_>I<single> I<field> - retrieve values from the next item in the
+iteration.
+
+=item *
+
+C<previous_>I<single> I<field> - retrieve values from the previous
+item in the iteration.
+
+=item *
+
+C<ifNext>I<Single> - test if there is a next item in the iteration.
+
+=item *
+
+C<ifPrevious>I<Single> - test if there is a previous item in the
+iteration.
 
 =back
 
-=item dgthumbimage geometry name field
+For article iterators only:
+
+=over
 
-=item dgthumbimage geometry name
+=item *
 
-Format a thumbnail for a global image, in dynamic context.
+C<move_>I<single> - in admin mode, a UI element to allow the article
+to be moved up/down one position.
 
 =back
 
 =cut
+
+sub _dyn_iterate_populate {
+  my ($self, $state, $args, $acts, $name, $templater) = @_;
+
+  my $method = "iter_$state->{plural}";
+  my $paged = $self->_get_paged($state, \$args);
+  local $self->{filter} = $self->_get_filter($state, \$args, $acts, $templater);
+  my $items = $self->_do_filter
+    ($state, $self->{filter}, $self->$method
+     ($state->{context}, $args, $acts, $templater, $state));
+
+  return $self->_do_paged($state, $paged, $items);
+}
+
+sub _dyn_iterate_reset {
+  my ($self, $state, $args, $acts, $name, $templater) = @_;
+
+  my $rindex = $state->{rindex};
+  my $rdata = $state->{rdata};
+  $$rdata = $self->_dyn_iterate_populate($state, $args, $acts, $name, $templater);
+  $$rindex = -1;
+
+  $state->{previous} = undef;
+  $state->{item} = undef;
+  if (@$$rdata) {
+    $state->{next} = $$rdata->[0];
+  }
+  else {
+    $state->{next} = undef;
+  }
+
+  1;
+}
+
+sub _dyn_iterate {
+  my ($self, $state) = @_;
+
+  my $rindex = $state->{rindex};
+  my $rdata = $state->{rdata};
+  my $single = $state->{single};
+  if (++$$rindex < @$$rdata) {
+    $state->{previous} = $state->{item};
+    $state->{item} = $state->{next};
+    if ($$rindex < $#$$rdata) {
+      $state->{next} = $$rdata->[$$rindex+1];
+    }
+    else {
+      $state->{next} = undef;
+    }
+    $self->{req}->set_article("previous_$single" => $state->{previous});
+    $self->{req}->set_article($single => $state->{item});
+    $self->{req}->set_article("next_$single" => $state->{next});
+    $self->{current}{$state->{plural}} = $state->{item};
+    return 1;
+  }
+  else {
+    $self->{req}->set_article($single => undef);
+    $self->{current}{$state->{plural}} = undef;
+    return;
+  }
+}
+
+sub _dyn_item_low {
+  my ($self, $item, $args) = @_;
+
+  $item or return '';
+  my $value = $item->{$args};
+  defined $value 
+    or return '';
+
+  return escape_html($value);
+}
+
+sub _dyn_item {
+  my ($self, $state, $args) = @_;
+
+  my $rindex = $state->{rindex};
+  my $rdata = $state->{rdata};
+  my $item = $state->{item};
+  unless ($state->{item}) {
+    return "** $state->{single} only usable inside iterator $state->{plural} **";
+  }
+
+  return $self->_dyn_item_low($item, $args);
+}
+
+sub _dyn_next {
+  my ($self, $state, $args) = @_;
+
+  return $self->_dyn_item_low($state->{next}, $args);
+}
+
+sub _dyn_previous {
+  my ($self, $state, $args) = @_;
+
+  return $self->_dyn_item_low($state->{previous}, $args);
+}
+
+sub _dyn_item_object_low {
+  my ($self, $item, $args, $state) = @_;
+
+  $item
+    or return '';
+  $item->can($args)
+    or return "* $args not valid for $state->{single} *";
+  my $value = $item->$args;
+  defined $value 
+    or return '';
+
+  return escape_html($value);
+}
+
+sub _dyn_item_object {
+  my ($self, $state, $args) = @_;
+
+  unless ($state->{item}) {
+    return "** $state->{single} only usable inside iterator $state->{plural} **";
+  }
+
+  return $self->_dyn_item_object_low($state->{item}, $args, $state);
+}
+
+sub _dyn_next_obj {
+  my ($self, $state, $args) = @_;
+
+  return $self->_dyn_item_object_low($state->{next}, $args, $state);
+}
+
+sub _dyn_previous_obj {
+  my ($self, $state, $args) = @_;
+
+  return $self->_dyn_item_object_low($state->{previous}, $args, $state);
+}
+
+sub _dyn_ifNext {
+  my ($self, $state) = @_;
+
+  return defined $state->{next};
+}
+
+sub _dyn_ifPrevious {
+  my ($self, $state) = @_;
+
+  return defined $state->{previous};
+}
+
+sub _dyn_article {
+  my ($self, $state, $args) = @_;
+
+  my $rindex = $state->{rindex};
+  my $rdata = $state->{rdata};
+  unless ($state->{item}) {
+    return "** $state->{single} only usable inside iterator $state->{plural} **";
+  }
+
+  my $item = $state->{item}
+    or return '';
+
+  return tag_article($item, $self->{req}->cfg, $args);
+}
+
+sub _dyn_next_article {
+  my ($self, $state, $args) = @_;
+
+  $state->{next} or return '';
+
+  return tag_article($state->{next}, $self->{req}->cfg, $args);
+}
+
+sub _dyn_previous_article {
+  my ($self, $state, $args) = @_;
+
+  $state->{previous} or return '';
+
+  return tag_article($state->{previous}, $self->{req}->cfg, $args);
+}
+
+sub _dyn_index {
+  my ($self, $state) = @_;
+
+  my $rindex = $state->{rindex};
+  if ($$rindex < 0 || $$rindex >= @${$state->{rdata}}) {
+    return "** $state->{single} only valid inside iterator **";
+  }
+
+  return $state->{poffset} + $$rindex;
+}
+
+sub _dyn_number {
+  my ($self, $state) = @_;
+
+  my $rindex = $state->{rindex};
+  if ($$rindex < 0 || $$rindex >= @${$state->{rdata}}) {
+    return "** $state->{single} only valid inside iterator **";
+  }
+
+  return $state->{poffset} + 1 + $$rindex;
+}
+
+sub _dyn_count {
+  my ($self, $state, $args, $acts, $name, $templater) = @_;
+
+  my $data = $self->_dyn_iterate_populate($state, $args, $acts, $name, $templater);
+
+  return scalar @$data;
+}
+
+sub _dyn_if_first {
+  my ($self, $rindex, $rdata) = @_;
+
+  $$rindex == 0;
+}
+
+sub _dyn_if_last {
+  my ($self, $rindex, $rdata) = @_;
+
+  $$rindex == $#$$rdata;
+}
+
+sub dyn_iterator {
+  my ($self, $plural, $single, $context, $rindex, $rdata) = @_;
+
+  my $method = $plural;
+  my $index;
+  defined $rindex or $rindex = \$index;
+  my $data;
+  defined $rdata or $rdata = \$data;
+  my %state =
+    (
+     plural => $plural,
+     single => $single,
+     rindex => $rindex,
+     rdata => $rdata,
+     context => $context,
+     poffset => 0,
+    );
+  return
+    (
+     "iterate_${plural}_reset" =>
+     [ _dyn_iterate_reset => $self, \%state ],
+     "iterate_$plural" =>
+     [ _dyn_iterate => $self, \%state ],
+     $single => 
+     [ _dyn_item => $self, \%state ],
+     "${single}_index" =>
+     [ _dyn_index => $self, \%state ],
+     "${single}_number" =>
+     [ _dyn_number => $self, \%state ],
+     "${single}_count" =>
+     [ _dyn_count => $self, \%state ],
+     "if\u$plural" =>
+     [ _dyn_count => $self, \%state ],
+     "ifLast\u$single" => [ _dyn_if_last => $self, $rindex, $rdata ],
+     "ifFirst\u$single" => [ _dyn_if_first => $self, $rindex, $rdata ],
+     "next_$single" => [ _dyn_next => $self, \%state ],
+     "previous_$single" => [ _dyn_previous => $self, \%state ],
+     "ifNext\u$single" => [ _dyn_ifNext => $self, \%state ],
+     "ifPrevious\u$single" => [ _dyn_ifPrevious => $self, \%state ],
+    );
+}
+
+sub dyn_iterator_obj {
+  my ($self, $plural, $single, $context, $rindex, $rdata) = @_;
+
+  my $method = $plural;
+  my $index;
+  defined $rindex or $rindex = \$index;
+  my $data;
+  defined $rdata or $rdata = \$data;
+  my %state =
+    (
+     plural => $plural,
+     single => $single,
+     rindex => $rindex,
+     rdata => $rdata,
+     context => $context,
+     poffset => 0,
+    );
+  return
+    (
+     "iterate_${plural}_reset" =>
+     [ _dyn_iterate_reset => $self, \%state ],
+     "iterate_$plural" =>
+     [ _dyn_iterate => $self, \%state ],
+     $single => 
+     [ _dyn_item_object => $self, \%state ],
+     "${single}_index" =>
+     [ _dyn_index => $self, \%state ],
+     "${single}_number" =>
+     [ _dyn_number => $self, \%state ],
+     "${single}_count" =>
+     [ _dyn_count => $self, \%state ],
+     "if\u$plural" =>
+     [ _dyn_count => $self, \%state ],
+     "ifLast\u$single" => [ _dyn_if_last => $self, $rindex, $rdata ],
+     "ifFirst\u$single" => [ _dyn_if_first => $self, $rindex, $rdata ],
+     "next_$single" => [ _dyn_next_obj => $self, \%state ],
+     "previous_$single" => [ _dyn_previous_obj => $self, \%state ],
+     "ifNext\u$single" => [ _dyn_ifNext => $self, \%state ],
+     "ifPrevious\u$single" => [ _dyn_ifPrevious => $self, \%state ],
+    );
+}
+
+sub _dyn_article_move {
+  my ($self, $state, $args, $acts, $func, $templater) = @_;
+
+  $state->{parentid}
+    or return '';
+
+  return $self->tag_dynmove($state->{rindex}, $state->{rdata},
+                           "stepparent=$state->{parentid}",
+                           $args, $acts, $templater);
+}
+
+sub dyn_article_iterator {
+  my ($self, $plural, $single, $context, $rindex, $rdata) = @_;
+
+  my $method = $plural;
+  my $index;
+  defined $rindex or $rindex = \$index;
+  my $data;
+  defined $rdata or $rdata = \$data;
+  my %state =
+    (
+     plural => $plural,
+     single => $single,
+     rindex => $rindex,
+     rdata => $rdata,
+     context => $context,
+     poffset => 0,
+    );
+  $self->{context}{$plural} = $context;
+
+  require BSE::Util::Iterate;
+  my $it = BSE::Util::Iterate->new;
+  return
+    (
+     "iterate_${plural}_reset" =>
+     [ _dyn_iterate_reset => $self, \%state ],
+     "iterate_$plural" =>
+     [ _dyn_iterate => $self, \%state],
+     $single => 
+     [ _dyn_article => $self, \%state ],
+     "${single}_index" =>
+     [ _dyn_index => $self, \%state ],
+     "${single}_number" =>
+     [ _dyn_number => $self, \%state ],
+     "${single}_count" =>
+     [ _dyn_count => $self, \%state ],
+     "if\u$plural" =>
+     [ _dyn_count => $self, \%state ],
+     "ifLast\u$single" => [ _dyn_if_last => $self, $rindex, $rdata ],
+     "ifFirst\u$single" => [ _dyn_if_first => $self, $rindex, $rdata ],
+     "next_$single" => [ _dyn_next_article => $self, \%state ],
+     "previous_$single" => [ _dyn_previous_article => $self, \%state ],
+     "ifNext\u$single" => [ _dyn_ifNext => $self, \%state ],
+     "ifPrevious\u$single" => [ _dyn_ifPrevious => $self, \%state ],
+     "move_$single" => [ _dyn_article_move => $self, \%state ],
+     "${plural}_page" => [ _dyn_state => $self, \%state, "page" ],
+     "${plural}_perpage" => [ _dyn_state => $self, \%state, "perpage" ],
+     "${plural}_nextpage" => [ _dyn_state => $self, \%state, "nextpage" ],
+     "${plural}_prevpage" => [ _dyn_state => $self, \%state, "prevpage" ],
+     "${plural}_pagecount" => [ _dyn_state => $self, \%state, "pagecount" ],
+     "${single}_totalcount" => [ _dyn_state => $self, \%state, "totalcount" ],
+     "${plural}_firstnumber" => [ _dyn_state => $self, \%state, "firstnumber" ],
+     "${plural}_lastnumber" => [ _dyn_state => $self, \%state, "lastnumber" ],
+     $it->make
+     (
+      single => "${single}_pagec",
+      plural => "${plural}_pagec",
+      code => [ _dyn_iter_pages => $self, \%state ],
+     ),
+    );
+}
+
+sub _dyn_state {
+  my ($self, $state, $name) = @_;
+
+  return $state->{$name};
+}
+
+sub _dyn_iter_pages {
+  my ($self, $state) = @_;
+
+  my @pages;
+  for my $page (1 .. $state->{pagecount}) {
+    push @pages,
+      {
+       page => $page,
+       first => $page == 1,
+       last => $page == $state->{pagecount},
+       current => $page == $state->{page},
+       next => $page == $state->{pagecount} ? '' : $page+1,
+       prev => $page == 1 ? '' : $page-1,
+      };
+  }
+
+  return @pages;
+}
+
+sub get_cached {
+  my ($self, $id) = @_;
+
+  return $self->{_cache}{$id};
+}
+
+sub set_cached {
+  my ($self, $id, $value) = @_;
+
+  $self->{_cache}{$id} = $value;
+}
+
+sub _cart {
+  my ($self) = @_;
+
+  my $dyncart = $self->get_cached('cart');
+  $dyncart and return $dyncart;
+
+  my $cart = $self->{req}->session->{cart}
+    or return { cart => [], total_cost => 0, total_units => 0 };
+
+  my @cart;
+  my $total_cost = 0;
+  my $total_units = 0;
+  for my $item (@$cart) {
+    require Products;
+    my $product = Products->getByPkey($item->{productId});
+    my $extended = $product->price(user => scalar $self->{req}->siteuser) 
+      * $item->{units};
+    my $link = $product->link;
+    $link =~ /^\w+:/ 
+      or $link = $self->{req}->cfg->entryErr('site', 'url') . $link;
+    push @cart,
+      {
+       ( map { $_ => $product->{$_} } $product->columns ),
+       %$item,
+       extended => $extended,
+       link => $link,
+      };
+    $total_cost += $extended;
+    $total_units += $item->{units};
+  }
+  my $result = 
+    {
+     cart => \@cart,
+     total_cost => $total_cost,
+     total_units => $total_units,
+    };
+  $self->set_cached(cart => $result);
+
+  return $result;
+}
+
+1;
+
index 42ce432..a59ef6b 100644 (file)
@@ -8,7 +8,7 @@ use vars qw(@EXPORT_OK @ISA);
 @ISA = qw(Exporter);
 require Exporter;
 
-our $VERSION = "1.010";
+our $VERSION = "1.013";
 
 sub _get_parms {
   my ($acts, $args) = @_;
@@ -490,6 +490,9 @@ sub basic {
        my @value = $cgi->param($_[0]);
        escape_html("@value");
      },
+     lcgi => [ tag_lcgi => $class, $cgi ],
+     deltag => [ tag_deltag => $class ],
+     ifTagIn => [ tag_ifTagIn => $class ],
      old => [ \&tag_old, $cgi ],
      oldi => [ \&tag_oldi, $cgi ],
      $it->make_iterator(\&DevHelp::Tags::iter_get_repeat, 'repeat', 'repeats'),
@@ -502,6 +505,66 @@ sub basic {
     );
 }
 
+sub tag_lcgi {
+  my ($self, $cgi, $args) = @_;
+
+  $cgi or return '';
+  my $sep = "/";
+  if ($args =~ s/^\"([^\"\w]+)\"\s+//) {
+    $sep = $1;
+  }
+
+  return escape_html(join $sep, $cgi->param($args));
+}
+
+sub tag_deltag {
+  my ($self, $args, $acts, $func, $templater) = @_;
+
+  my $sep = "/";
+  if ($args =~ s/^\"([^\"\w]+)\"\s+//) {
+    $sep = $1;
+  }
+
+  require BSE::TB::Tags;
+  my ($del, @tags) = $templater->get_parms($args, $acts);
+  my $error;
+  my %del = map { BSE::TB::Tags->canon_name($_, \$error) => 1 }
+    split /\Q$sep/, $del;
+
+  return join $sep,
+    grep !$del{lc $_},
+      map BSE::TB::Tags->name($_, \$error),
+       map { split /\Q$sep/ }
+         @tags;
+}
+
+sub tag_ifTagIn {
+  my ($self, $args, $acts, $func, $templater) = @_;
+
+  my $sep = "/";
+  if ($args =~ s/^\"([^\"\w]+)\"\s+//) {
+    $sep = $1;
+  }
+
+  require BSE::TB::Tags;
+  my $error;
+  my ($check, @tags) = $templater->get_parms($args, $acts);
+  @tags = map BSE::TB::Tags->name($_, \$error),
+    map { split /\Q$sep/ }
+      @tags;
+
+  $check = BSE::TB::Tags->canon_name($check, \$error)
+    or return 0;
+
+  for my $tag (@tags) {
+    if (lc $tag eq $check) {
+      return 1;
+    }
+  }
+
+  return 0;
+}
+
 sub common {
   my ($class, $req) = @_;
 
index 08fc9e4..7124806 100644 (file)
@@ -2,7 +2,7 @@ package DevHelp::Tags::Iterate;
 use strict;
 use Carp qw(confess);
 
-our $VERSION = "1.003";
+our $VERSION = "1.004";
 
 sub new {
   my ($class, %opts) = @_;
@@ -284,7 +284,7 @@ sub make_paged {
   my $perpage = ref $state{perpage_parm} ? ${$state{perpage_parm}} : $state{perpage_parm};
   unless ($perpage =~ /^\d+$/) {
     my ($name, $count) = $perpage =~ /^(\w+)=(\d+)$/
-      or confess "Invalid perpage '$perpage'";
+      or confess "Invalid perpage_parm '$perpage'";
     $name ||= 'pp';
     $count ||= 10;
     my $work = $state{cgi}->param($name);
index 972276b..16b4b12 100644 (file)
@@ -11,7 +11,7 @@ use BSE::Util::Iterate;
 use base 'BSE::ThumbLow';
 use base 'BSE::TagFormats';
 
-our $VERSION = "1.002";
+our $VERSION = "1.003";
 
 my $excerptSize = 300;
 
@@ -865,7 +865,8 @@ sub baseActs {
      sub {
        my ($name, $acts, $func, $templater) = @_;
        my $item = $self->{admin_links} ? 'admin' : 'link';
-       $acts->{$name} or return "<:url $name:>";
+       $acts->{$name}
+        or die "ENOIMPL\n";
        my $url = $templater->perform($acts, $name, $item);
        if (!$self->{admin} && $self->{admin_links}) {
         $url .= $url =~ /\?/ ? "&" : "?";
index ea763dc..d3b948c 100644 (file)
@@ -74,6 +74,36 @@ description: Article editor messages
 id: bse/admin/edit/uplabelsect
 description: label in parent list to make article a section
 
+id: bse/admin/edit/tags/
+description: System tags management
+
+id: bse/admin/edit/tags/saved
+description: flashed when a tag is renamed successfully.  $1 - old name, $2 - new name
+
+id: bse/admin/edit/tags/removed
+description: flashed when a tag is removed successfully.  $1 - tag name
+
+id: bse/admin/edit/tags/cleanup
+description: flashed after tags are cleaned up
+
+id: bse/admin/edit/tags/invalid_empty
+description: field error if the tag name is empty
+
+id: bse/admin/edit/tags/invalid_badchars
+description: field error if the tag name contains invalid characters
+
+id: bse/admin/edit/tags/bad_id
+description: tag_id field error if the tag id isn't present or isn't numeric
+
+id: bse/admin/edit/tags/unknown
+description: tag_id field error if the tag id supplied doesn't exist
+
+id: bse/admin/edit/tags/duplicate
+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/shop/
 description: Shop Administration
 
index 8ffb78c..4a2baef 100644 (file)
@@ -40,6 +40,33 @@ message: The order containing this file hasn't been filled.  Please contact us.
 id: bse/admin/edit/uplabelsect
 message: -- move up a level -- become a section
 
+id: bse/admin/edit/tags/saved
+message: Tag renamed from '%1:s' to '%2:s'
+
+id: bse/admin/edit/tags/removed
+message: Tag '%1:s' removed.
+
+id: bse/admin/edit/tags/cleanup
+message: Deleted %1:d unused tags
+
+id: bse/admin/edit/tags/invalid_empty
+message: Tags must have a non-empty name
+
+id: bse/admin/edit/tags/invalid_badchars
+message: Tags cannot contain control characters, backslash (\) or forward slash (/)
+
+id: bse/admin/edit/tags/bad_id
+message: Invalid tag id
+
+id: bse/admin/edit/tags/unknown
+message: Unknown tag id
+
+id: bse/admin/edit/tags/duplicate
+message: There is already a tag with name '%1:s'
+
+id: bse/admin/edit/tags/nochange
+message: No changes to save
+
 id: bse/admin/message/noid
 message: Missing id parameter
 
index be656ac..dfd74f4 100644 (file)
@@ -1,5 +1,5 @@
 --
-# VERSION=1.002
+# VERSION=1.003
 name: bse_siteuserSeminarBookingsDetail
 sql_statement: <<SQL
 select ar.*, pr.*, se.*, ss.*, sb.*,
@@ -461,3 +461,56 @@ sql_statement: <<SQL
 delete from bse_price_tier_prices
 where product_id = ?
 SQL
+
+name: TagMembers.removeByTag
+sql_statement: <<SQL
+delete from bse_tag_members
+where owner_type = ?
+  and owner_id = ?
+  and tag_id = ?
+SQL
+
+name: TagMembers.remove_owned_by
+sql_statement: <<SQL
+delete from bse_tag_members
+where owner_type = ?
+  and owner_id = ?
+SQL
+
+name: Tags.object_tags
+sql_statement: <<SQL
+select t.*
+from bse_tags t, bse_tag_members tm
+where t.id = tm.tag_id
+  and tm.owner_type = ?
+  and tm.owner_id = ?
+order by t.cat, t.val
+SQL
+
+name: Tag_ids.by_owner
+sql_statement: <<SQL
+select tag_id as "id"
+from bse_tag_members
+where owner_type = ?
+  and owner_id = ?
+SQL
+
+name: TagMembers.deleteTag
+sql_statement: <<SQL
+delete from bse_tag_members
+where tag_id = ?
+SQL
+
+name: Articles.byTag
+sql_statement: <<SQL
+select a.*
+from article a, bse_tag_members m
+where a.id = m.owner_id
+  and m.tag_id = ?
+SQL
+
+name: bseTagsCleanup
+sql_statement: <<SQL
+delete from bse_tags
+where id not in (select tag_id from bse_tag_members);
+SQL
index dce30ce..c3331a0 100644 (file)
@@ -146,3 +146,28 @@ form td.submit { text-align: right; }
   /*border: 1px solid #44F;*/
 }
 
+div.unusedtags {
+  padding-left: 1em;
+  padding-bottom: 0.5em;
+}
+
+div.pagelist {
+  padding: 2px 0px;
+}
+
+div.pagelist a,
+div.pagelist span {
+  padding: 2px 4px;
+}
+
+div.pagelist span {
+  background-color: #E8E8E9;
+}
+
+div.pagelist a {
+  background-color: #FFF0E0;
+}
+
+div.pagelist a:hover {
+  background-color: #FFE0C0;
+}
diff --git a/site/htdocs/js/admin_edit.js b/site/htdocs/js/admin_edit.js
new file mode 100644 (file)
index 0000000..28f1e91
--- /dev/null
@@ -0,0 +1,31 @@
+Event.observe(document, "dom:loaded", function () {
+  var add = new Element("a", { href: "#" });
+  add.update("Add");
+  var add_div = new Element("div");
+  add_div.appendChild(add);
+
+  add.observe("click", function(add_div, ev) {
+    var new_tag = new Element("input", { type: "text", name: "tags" });
+    var new_div = new Element("div", { className: "tag" });
+    new_div.appendChild(new_tag);
+    var new_del = new Element("a", { href: "#" });
+    new_del.update("Delete");
+    new_del.observe("click", function(div, ev) {
+      new_div.remove();
+      ev.stop();
+    }.bind(this, new_div));
+    new_div.appendChild(new_del);
+    $("tags").insertBefore(new_div, add_div);
+    ev.stop();
+  }.bind(this, add_div));
+  $("tags").appendChild(add_div);
+  $$('#tags div.tag').each(function(div) {
+    var del = new Element("a", { href: "#" });
+    del.update("Delete");
+    div.appendChild(del);
+    del.observe("click", function(div, ev) {
+      div.remove();
+      ev.stop();
+    }.bind(this, div));
+  });
+});
index 197aafc..af885f1 100644 (file)
@@ -3,10 +3,7 @@
 <:ifMessage:> 
 <p><b><:message:></b></p>
 <:or:><:eif:>
-<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> | 
-<a href="<:script:>?id=-1&amp;_t=img">Global Images</a> | 
-<a href="<:script:>?id=-1&amp;_t=file">Global Files</a> | </p>
-
+<:include admin/include/site_menu.tmpl:>
 <:if Or [iadminuser_count] [iadmingroup_count]:>
       <form action="/cgi-bin/admin/adminusers.pl">
   <input type="hidden" name="id" value="<: article id:>" />
index 64ab724..14716e2 100644 (file)
@@ -1,4 +1,4 @@
-<:wrap admin/base.tmpl title=>[cond [ifNew] [cat "New " [articleType]] [cat "Edit " [articleType] ": " [article title]]]:>
+<:wrap admin/base.tmpl title=>[cond [ifNew] [cat "New " [articleType]] [cat "Edit " [articleType] ": " [article title]]], js => "admin_edit.js":>
 <h1><:ifNew:>New<:or:>Edit<:eif:> <:articleType:></h1>
 <:if Message:> 
 <div id="message" <:ifError:>class="error"<:or:><:eif:>><:message:></div>
@@ -46,7 +46,7 @@
 <:eif:>
   <form enctype="multipart/form-data" method="post" action="<:script:>" name="edit">
 
-    <input type="hidden" name="lastModified" value="<: old lastModified article lastModified :>" />
+    <input type="hidden" name="lastModified" value="<:article lastModified :>" />
     <input type="hidden" name="type" value="Article" />
     <input type="hidden" name="level" value="<: level :>" />
     <input type="hidden" name="id" value="<: article id :>" />
             </td>
             <td class="help"><:help edit threshold:> <:error_img threshold:></td>
           </tr>
-          <tr> 
-            <th>Keywords:</th>
-            <td> 
-              <:ifFieldPerm keyword:><input type="text" name="keyword" maxlength="255" size="60" value="<: old keyword default keyword :>" />
-              (comma separated)<:or:><: article threshold :><:eif:></td>
-            <td class="help"><:help edit keywords:> <:error_img keyword:></td>
-          </tr>
-          <tr> 
-            <th>Always Dynamic:</th>
-            <td> 
-              <:ifFieldPerm force_dynamic:><input type="hidden" name="save_force_dynamic" value="1" /><input type="checkbox" name="force_dynamic" value="1" <:if Article force_dynamic :>checked="checked"<:or Article:><:eif Article:> />
-              <:or:><:ifArticle force_dynamic :>Yes<:or Article:>No<:eif Article:><:eif:></td>
-            <td class="help"><:help edit keywords:> <:error_img keyword:></td>
-          </tr>
+<:include admin/include/edit_common.tmpl:>
 <:include admin/article_custom.tmpl optional:>
           <tr> 
             <th>Thumbnail image:</th>
index 83babac..900e3ad 100644 (file)
@@ -1,4 +1,4 @@
-<:wrap admin/base.tmpl title => "Edit Catalog":>
+<:wrap admin/base.tmpl title => "Edit Catalog", js => "admin_edit.js":>
 <h1>Edit Catalog:</h1>
 <:ifMessage:> 
 <p><b><:message:></b></p>
             </td>
             <td class="help"><:help catalog threshold:> <:error_img threshold:></td>
           </tr>
-          <tr> 
-            <th> Keywords: </th>
-            <td> 
-              <:ifFieldPerm keyword:><input type="text" name="keyword" maxlength="255" size="60" value="<: old keyword default keyword :>" /><:or:><: article threshold :><:eif:>
-              (comma separated) </td>
-            <td class="help"><:help catalog keywords:> <:error_img keyword:></td>
-          </tr>
-          <tr> 
-            <th>Always Dynamic:</th>
-            <td> 
-              <:ifFieldPerm force_dynamic:><input type="hidden" name="save_force_dynamic" value="1" /><input type="checkbox" name="force_dynamic" value="1" <:if Article force_dynamic :>checked="checked"<:or Article:><:eif Article:> />
-              <:or:><:ifArticle force_dynamic :>Yes<:or Article:>No<:eif Article:><:eif:></td>
-            <td class="help"><:help edit keywords:> <:error_img keyword:></td>
-          </tr>
+<:include admin/include/edit_common.tmpl:>
 <:include admin/catalog_custom.tmpl optional:>
           <tr> 
             <th>Thumbnail image:</th>
index f7b9b87..4a7a66e 100644 (file)
@@ -1,4 +1,4 @@
-<:wrap admin/base.tmpl title => [cond [ifNew] "Add Product" "Edit Product"], menuitem=>"edit", showtitle=>"1" :>
+<:wrap admin/base.tmpl title => [cond [ifNew] "Add Product" "Edit Product"], menuitem=>"edit", showtitle=>"1", js => "admin_edit.js" :>
 <:ifMessage:>
 <p><b><:message:></b></p>
 <:or:><:eif:> 
             </td>
             <td class="help"><:help product threshold:> <:error_img threshold:></td>
           </tr>
-          <tr> 
-            <th> Keywords: </th>
-            <td> 
-              <:ifFieldPerm keyword:><input type="text" name="keyword" maxlength="255" size="60" value="<: old keyword default keyword :>" /><:or:><: article threshold :><:eif:>
-              (comma separated) </td>
-            <td class="help"><:help catalog keywords:> <:error_img keyword:></td>
-          </tr>
-          <tr> 
-            <th>Always Dynamic:</th>
-            <td> 
-              <:ifFieldPerm force_dynamic:><input type="hidden" name="save_force_dynamic" value="1" /><input type="checkbox" name="force_dynamic" value="1" <:if Article force_dynamic :>checked="checked"<:or Article:><:eif Article:> />
-              <:or:><:ifArticle force_dynamic :>Yes<:or Article:>No<:eif Article:><:eif:></td>
-            <td class="help"><:help edit keywords:> <:error_img keyword:></td>
-          </tr>
+<:include admin/include/edit_common.tmpl:>
           <tr> 
             <th>Options:</th>
             <td> 
index 221fad7..fcc804c 100644 (file)
@@ -1,4 +1,4 @@
-<:wrap admin/base.tmpl title => "Edit Seminar":>
+<:wrap admin/base.tmpl title => "Edit Seminar", js => "admin_edit.js":>
 <h1>Shop Administration</h1>
 <:ifMessage:>
 <p><b><:message:></b></p>
               (<:alloptions:>)<:or:><:seminar options:><:eif:> </td>
             <td class="help"><:help product options:> <:error_img options:></td>
           </tr>
-          <tr> 
-            <th> Keywords: </th>
-            <td width="100%"> 
-              <:ifFieldPerm keyword:><input type="text" name="keyword" maxlength="255" size="60" value="<: old keyword default keyword :>" /><:or:><: article threshold :><:eif:>
-              (comma separated) </td>
-            <td class="help"><:help catalog keywords:> <:error_img keyword:></td>
-          </tr>
-          <tr> 
-            <th>Always Dynamic:</th>
-            <td width="100%"> 
-              <:ifFieldPerm force_dynamic:><input type="hidden" name="save_force_dynamic" value="1" /><input type="checkbox" name="force_dynamic" value="1" <:if Article force_dynamic :>checked="checked"<:or Article:><:eif Article:> />
-              <:or:><:ifArticle force_dynamic :>Yes<:or Article:>No<:eif Article:><:eif:></td>
-            <td class="help"><:help edit keywords:> <:error_img keyword:></td>
-          </tr>
+<:include admin/include/edit_common.tmpl:>
 <:include admin/seminar_custom.tmpl optional:>
           <tr> 
             <th>Thumbnail image:</th>
diff --git a/site/templates/admin/include/edit_common.tmpl b/site/templates/admin/include/edit_common.tmpl
new file mode 100644 (file)
index 0000000..083817e
--- /dev/null
@@ -0,0 +1,27 @@
+          <tr> 
+            <th>Keywords:</th>
+            <td> 
+              <:ifFieldPerm keyword:><input type="text" name="keyword" maxlength="255" size="60" value="<: old keyword default keyword :>" />
+              (comma separated)<:or:><: article threshold :><:eif:></td>
+            <td class="help"><:help edit keywords:> <:error_img keyword:></td>
+          </tr>
+         <tr>
+           <th>Tags</th>
+           <td>
+             <input type="hidden" name="_save_tags" value="1" />
+             <div id="tags">
+             <:iterator begin tags:>
+             <div class="tag"><input type="text" name="tags" value="<:tag name:>" /></div>
+             <:iterator end tags:>
+             <div class="tag"><input type="text" name="tags" value="" /></div>
+             </div>
+           </td>
+           <td class="help"><:help edit tags:><:error_img tags:></td>
+         </tr>
+          <tr> 
+            <th>Always Dynamic:</th>
+            <td> 
+              <:ifFieldPerm force_dynamic:><input type="hidden" name="save_force_dynamic" value="1" /><input type="checkbox" name="force_dynamic" value="1" <:if Article force_dynamic :>checked="checked"<:or Article:><:eif Article:> />
+              <:or:><:ifArticle force_dynamic :>Yes<:or Article:>No<:eif Article:><:eif:></td>
+            <td class="help"><:help edit keywords:> <:error_img keyword:></td>
+          </tr>
diff --git a/site/templates/admin/include/site_menu.tmpl b/site/templates/admin/include/site_menu.tmpl
new file mode 100644 (file)
index 0000000..48383a1
--- /dev/null
@@ -0,0 +1,5 @@
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> | 
+<a href="<:script:>?id=-1&amp;_t=img">Global Images</a> | 
+<a href="<:script:>?id=-1&amp;_t=file">Global Files</a> |
+<a href="<:script:>?id=-1&amp;a_tags=1">Tags</a> |
+</p>
diff --git a/site/templates/admin/tags.tmpl b/site/templates/admin/tags.tmpl
new file mode 100644 (file)
index 0000000..f582aae
--- /dev/null
@@ -0,0 +1,31 @@
+<:wrap admin/base.tmpl title => "System Article Tags", showtitle => 1 :>
+<:ifMessage:><p class="message"><:message:></p><:or:><:eif:>
+<:include admin/include/site_menu.tmpl:>
+<p>| <a href="<:script:>?id=-1&amp;a_tags=1<:ifCgi showarts:><:or:>&amp;showarts=1<:eif:>"><:ifCgi showarts:>Hide<:or:>Show<:eif:> articles for each tag</a> |
+<a href="<:script:>?id=-1&amp;a_tagcleanup=1">Cleanup unused tags</a> |
+</p>
+<form action="<:script:>"><input type="hidden" name="id" value="-1" />Filter Category: <input type="text" name="cat" value="<:cgi cat:>" /> <label><input type="checkbox" name="nocat" <:ifCgi nocat:>checked="checked" <:or:><:eif:>/>Uncategorized only</label> <input type="submit" name="a_tags" value="Filter" /></form>
+<ul>
+<:iterator begin systags:>
+<li class="tag" id="tag_<:systag id:>"><form action="<:script:>#tag_<:systag id:>" method="post">
+<input type="hidden" name="id" value="-1" />
+<input type="hidden" name="tag_id" value="<:systag id:>" />
+<input type="text" name="name" value="<:ifAnd [cgi a_tagsave] [ifEq [cgi tag_id] [systag id]]:><:cgi name:><:or:><:systag name:><:eif:>" />
+<:ifEq [cgi tag_id] [systag id]:><:error_img name:><:or:><:eif:>
+<input type="submit" name="a_tagrename" value="Save" />
+<input type="submit" name="a_tagdelete" value="Delete" />
+</form>
+<:if Cgi showarts:>
+<:if Systagarts:>
+<ul>
+<:iterator begin systagarts:>
+<li><a href="<:script:>?id=<:systagart id:>"><:systagart title:></a></li>
+<:iterator end systagarts:>
+</ul>
+<:or Systagarts:>
+<p>No articles use this tag.</p>
+<:eif Systagarts:>
+<:or Cgi:><:eif Cgi:>
+</li>
+<:iterator end systags:>
+</ul>
diff --git a/site/templates/catalog/tagged.tmpl b/site/templates/catalog/tagged.tmpl
new file mode 100644 (file)
index 0000000..cdba313
--- /dev/null
@@ -0,0 +1,52 @@
+<:wrap base.tmpl:> <:embed start:><:admin:>
+<:ifDynamic:><:or:><p>I need to be dynamic</p><:eif:>
+<:iterator begin dynallprods tags:[lcgi tags] paged:pp=10 :><:iterator end dynallprods:>
+<p>Page count: <:dynallprods_pagecount:></p>
+<:if Eq [dynallprods_pagecount] 1:><:or Eq:>
+<div class="pagelist">Pages:
+  <:ifDynallprods_prevpage:><a href="<:url dynarticle:><:cond [ifMatch [url dynarticle] "\\?"] & ? :>p=<:dynallprods_prevpage:>&amp;tags=<:lcgi tags |u:>&amp;pp=<:dynallprods_perpage:>">&lt; &lt; Previous</a>
+  <:or:><span>&lt; &lt; Previous</span><:eif:>
+  <:ifDynallprods_nextpage:><a href="<:url dynarticle:><:cond [ifMatch [url dynarticle] "\\?"] & ? :>p=<:dynallprods_nextpage:>&amp;tags=<:lcgi tags |u:>&amp;pp=<:dynallprods_perpage:>">Next &gt; &gt;</a>
+  <:or:><span>Next &gt; &gt;</span><:eif:>
+<:iterator begin dynallprods_pagec:>
+  <:if Dynallprod_pagec current:>
+    <span><:dynallprod_pagec page:></span>
+  <:or Dynallprod_pagec:>
+    <a href="<:url dynarticle:><:cond [ifMatch [url dynarticle] "\\?"] & ? :>p=<:dynallprod_pagec page:>&amp;tags=<:lcgi tags |u:>&amp;pp=<:dynallprods_perpage:>"><:dynallprod_pagec page:></a>
+  <:eif Dynallprod_pagec:>
+<:iterator end dynallprods_pagec:>
+</div>
+<:eif Eq:>
+<:if Dyntags [lcgi tags]:>
+<p>Selected:
+<:iterator begin dyntags [lcgi tags] :>
+  <a href="<:url dynarticle:><:cond [ifMatch [url dynarticle] "\\?"] & ? :>p=<:dynallprods_page:>&amp;tags=<:deltag [dyntag name] [lcgi tags] |u:>&amp;pp=<:dynallprods_perpage:>"><:dyntag name:></a>
+<:iterator end dyntags:>
+</p>
+<:or Dyntags:><:eif Dyntags:>
+<:if Dynunused_tagcats dynallprods:>
+<div>Refine (<:dynallprod_totalcount:> products found):</div>
+<div class="unusedtags">
+<:iterator begin dynunused_tagcats dynallprods:>
+<div><:ifDynunused_tagcat nocat:><:or:><:dynunused_tagcat name:>:<:eif:>
+<:iterator begin dynunused_tags:><a href="<:url dynarticle:><:cond [ifMatch [url dynarticle] "\\?"] & ? :>p=<:dynallprods_page:>&amp;tags=<:lcgi tags |u:>/<:dynunused_tag name |u:>&amp;pp=<:dynallprods_perpage:>"><:dynunused_tag val:></a> <:iterator end dynunused_tags:></div>
+<:iterator end dynunused_tagcats:>
+</div>
+<:or Dynunused_tagcats:><:eif Dynunused_tagcats:>
+<:switch:><:case dynallprod_count tags:[lcgi tags] paged:pp=10 :>
+<form method="post" action="/cgi-bin/shop.pl">
+<input type="hidden" name="r" value="<:url dynarticle:><:cond [ifMatch [url dynarticle] "\\?"] & ? :>p=<:dynallprods_page:>&amp;tags=<:lcgi tags |u:>&amp;pp=<:dynallprods_perpage:>" />
+<div id="products">
+<:iterator begin dynallprods tags:[lcgi tags] paged:pp=10 :>
+<div class="product">
+<div><:dynallprod title:><span class="price">$<:money price dynallprod:></span></div>
+<a href="<:dyntarget shop add id [dynallprod id]:>&amp;r=<:url dynarticle |U:><:cond [ifMatch [url dynarticle] "\?"] %26 %3F:>tags=<:lcgi tags|u:>%26p=<:dynallprods_page:>" class="add">Add to cart</a>
+<:dthumbimage dynallprod editor hero,1 :>
+</div>
+<:iterator end dynallprods:>
+</div>
+</form>
+<:case default:>
+<div>No matches</div>
+<:endswitch:>
+<:embed end:>
index 6dfcfc3..5e2db23 100644 (file)
@@ -401,6 +401,23 @@ 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_members
+Engine MyISAM
+Column id;int(11);NO;NULL;auto_increment
+Column owner_type;char(2);NO;NULL;
+Column owner_id;int(11);NO;NULL;
+Column tag_id;int(11);NO;NULL;
+Index PRIMARY;1;[id]
+Index art_tag;1;[owner_id;tag_id]
+Index by_tag;0;[tag_id]
+Table bse_tags
+Engine MyISAM
+Column id;int(11);NO;NULL;auto_increment
+Column owner_type;char(2);NO;NULL;
+Column cat;varchar(80);NO;NULL;
+Column val;varchar(80);NO;NULL;
+Index PRIMARY;1;[id]
+Index cat_val;1;[owner_type;cat;val]
 Table bse_user_subscribed
 Engine MyISAM
 Column subscription_id;int(11);NO;NULL;
index 182220d..13cae3d 100644 (file)
@@ -36,7 +36,7 @@ else {
           qr!User\s+Logon!s);
 }
 fetch_ok($ua, "shop admin page", "$baseurl/cgi-bin/admin/shopadmin.pl",
-        qr!Shop\s+administration!s);
+        qr!Shop\s+Administration!s);
 fetch_ok($ua, "add article form", "$baseurl/cgi-bin/admin/add.pl",
         qr!New\s+Page\sLev3!s);
 fetch_ok($ua, "add catalog form", "$baseurl/cgi-bin/admin/add.pl?type=Catalog",
@@ -52,7 +52,7 @@ fetch_ok($ua, "user list", "$baseurl/cgi-bin/admin/adminusers.pl",
 fetch_ok($ua, "group list", "$baseurl/cgi-bin/admin/adminusers.pl?a_groups=1",
         qr!Admin\sGroups!s);
 fetch_ok($ua, "subscriptions", "$baseurl/cgi-bin/admin/subs.pl",
-        qr/Subscriptions\s+List/);
+        qr/Newsletter\s+List/);
 fetch_ok($ua, "reports", "$baseurl/cgi-bin/admin/report.pl",
         qr/Reports/);
 # does a refresh unless the user is logged on
index 287edba..c83885c 100644 (file)
@@ -3,7 +3,9 @@ use strict;
 use BSE::Test qw(make_ua base_url);
 use JSON;
 use DevHelp::HTML;
-use Test::More tests => 193;
+use Test::More tests => 241;
+
+$| = 1;
 
 my $ua = make_ua;
 my $baseurl = base_url;
@@ -49,6 +51,8 @@ SKIP:
       delete $data->{article}{$field};
     }
     is_deeply($data->{article}, \%temp, "check it matches what we saved");
+    ok($data->{article}{tags}, "has a tags member");
+    is_deeply($data->{article}{tags}, [], "which is an empty array ref");
   }
 
   my @fields = grep 
@@ -77,6 +81,28 @@ SKIP:
     }
   }
 
+  my $tag_name1 = "YHUIOP";
+  my $tag_name2 = "zyx: alpha";
+  { # save tags
+    my %reqdata =
+      (
+       save => 1,
+       id => $art->{id},
+       _save_tags => 1,
+       tags => [ $tag_name2, " $tag_name1 " ],
+       lastModified => $art->{lastModified},
+      );
+    my $data = do_req($add_url, \%reqdata, "set tags");
+  SKIP:
+    {
+      $data or skip("Not json from setting tags", 2);
+      ok($data->{success}, "success flag set");
+      is_deeply($data->{article}{tags}, [ $tag_name1, $tag_name2 ],
+               "check tags saved");
+      $art = $data->{article};
+    }
+  }
+
   { # grab the tree
     my %tree_req =
       (
@@ -94,6 +120,118 @@ SKIP:
     ok($art->{lastModified}, "entries have a lastModified");
   }
 
+  { # grab the tags
+    my %tag_req =
+      (
+       a_tags => 1,
+       id => -1,
+      );
+    my $data = do_req($add_url, \%tag_req, "fetch tags");
+  SKIP:
+    {
+      $data or skip("not a json response", 4);
+      ok($data->{tags}, "it has tags");
+      my ($xyz_tag) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
+      ok($xyz_tag, "check we found the tag we set");
+      is($xyz_tag->{cat}, "zyx", "check cat");
+      is($xyz_tag->{val}, "alpha", "check val");
+    }
+  }
+
+  my $tag1;
+  my $tag2;
+  { # grab them with article ids
+    my %tag_req =
+      (
+       a_tags => 1,
+       id => -1,
+       showarts => 1,
+      );
+    my $data = do_req($add_url, \%tag_req, "fetch tags");
+  SKIP:
+    {
+      $data or skip("not a json response", 6);
+      ok($data->{tags}, "it has tags");
+      ($tag1) = grep $_->{name} eq $tag_name1, @{$data->{tags}};
+      ($tag2) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
+      ok($tag2, "check we found the tag we set");
+      is($tag2->{cat}, "zyx", "check cat");
+      is($tag2->{val}, "alpha", "check val");
+      ok($tag2->{articles}, "has articles");
+      ok(grep($_ == $art->{id}, @{$tag2->{articles}}),
+             "has our article id in it");
+    }
+  }
+
+ SKIP:
+  { # delete a tag globally
+    $tag2
+      or skip("didn't find the tag we want to remove", 6);
+    my %del_req =
+      (
+       a_tagdelete => 1,
+       id => -1,
+       tag_id => $tag2->{id},
+      );
+    my $data = do_req($add_url, \%del_req, "delete tag");
+  SKIP:
+    {
+      $data or skip("not a json response", 7);
+      ok($data->{success}, "successful");
+
+      # refetch tag list and make sure it's gone
+      my %get_req =
+       (
+        a_tags => 1,
+        id => -1,
+       );
+      my $tags_data = do_req($add_url, \%get_req, "refetch tags");
+      my ($tag) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
+      ok(!$tag, "should be gone");
+
+      # try to delete it again
+      my $redel_data = do_req($add_url, \%del_req, "delete should fail");
+      $redel_data
+       or skip("not a json response", 3);
+      ok(!$redel_data->{success}, "should fail");
+      is($redel_data->{error_code}, "FIELD", "check error code");
+      ok($redel_data->{errors}{tag_id}, "and error message on field");
+    }
+  }
+
+  { # rename a tag
+    my %ren_req =
+      (
+       a_tagrename => 1,
+       id => -1,
+       tag_id => $tag1->{id},
+       name => $tag_name2, # rename over just removed tag
+      );
+
+    my $data = do_req($add_url, \%ren_req, "rename tag");
+  SKIP:
+    {
+      $data
+       or skip("not a json response", 4);
+      ok($data->{success}, "successful");
+      ok($data->{tag}, "returned updated tag");
+      is($data->{tag}{name}, $tag_name2, "check name saved");
+    }
+  }
+
+  { # refetch the article to check the tags
+    my %fetch_req =
+      (
+       a_article => 1,
+       id => $art->{id},
+      );
+    my $data = do_req($add_url, \%fetch_req, "fetch just saved")
+      or skip("no json", 2);
+    ok($data->{success}, "check success");
+    is_deeply($data->{article}{tags}, [ $tag_name2 ],
+             "check the tags");
+  }
+
   # error handling on save
  SKIP:
   { # bad title
@@ -311,14 +449,47 @@ SKIP:
   }
 }
 
+SKIP:
+{ # tag cleanup
+  my %clean_req =
+    (
+     a_tagcleanup => 1,
+     id => -1,
+    );
+  my $data = do_req($add_url, \%clean_req, "tag cleanup");
+  $data
+    or skip("no json response", 2);
+  ok($data->{success}, "successful");
+  ok($data->{count}, "should have cleaned up something");
+}
+
 sub do_req {
   my ($url, $req_data, $comment) = @_;
 
-  my $content = join "&", map "$_=" . escape_uri($req_data->{$_}), keys %$req_data;
+  my @entries;
+  for my $key (keys %$req_data) {
+    my $value = $req_data->{$key};
+    if (ref $value) {
+      for my $val (@$value) {
+       push @entries, "$key=" . escape_uri($val);
+      }
+    }
+    else {
+      push @entries, "$key=" . escape_uri($value);
+    }
+  }
+  my $content = join("&", @entries);
+
+  print <<EOS;
+# Request:
+# URL: $add_url
+# Content: $content
+EOS
+
   my $req = HTTP::Request->new(POST => $add_url, \@ajax_hdr);
 
   $req->content($content);
-  
+
   my $resp = $ua->request($req);
   ok($resp->is_success, "$comment successful at http level");
   my $data = eval { from_json($resp->decoded_content) };
index 3837188..a367b18 100644 (file)
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use BSE::Test ();
-use Test::More tests => 23;
+use Test::More tests => 83;
 use File::Spec;
 use FindBin;
 my $cgidir = File::Spec->catdir(BSE::Test::base_dir, 'cgi-bin');
@@ -17,7 +17,21 @@ require BSE::TB::ProductOptionValues;
 require BSE::API;
 require BSE::Dynamic::Catalog;
 require BSE::Request::Test;
-my $req = BSE::Request::Test->new(cfg => $cfg);
+
+$| = 1;
+
+my %cgi =
+  (
+   test1 => "one",
+   test2 => [ qw/two three/ ],
+   test3 => "Size: Medium",
+   test4 => [ "Size: Medium", "Colour: Red" ],
+   test5 => "Size:Medium/Colour:Red/Style:Pretty",
+   test6 => "/Size:Medium//Colour:Red/",
+   pp => 5,
+   p => 2,
+  );
+my $req = BSE::Request::Test->new(cfg => $cfg, params => \%cgi);
 my $gen = BSE::Dynamic::Catalog->new($req);
 BSE::API->import(qw/bse_make_catalog bse_make_product bse_add_step_child/);
 
@@ -33,6 +47,7 @@ my $parent = bse_make_catalog
 ok($parent, "made a catalog");
 is($parent->{generator}, "Generate::Catalog", "check generator");
 
+sleep 1;
 my $parent2 = bse_make_catalog
   (
    cfg => $cfg,
@@ -54,9 +69,10 @@ my $parent3 = bse_make_catalog
 
 # add some products
 my @prods;
+my %prods;
 my $price = 1000;
 my %prod_order;
-for my $title (qw/prod1 prod2 prod3/) {
+for my $title (qw/prod1 prod2 prod3 prod4 prod5 prod6 prod7 prod8 prod9 prod10/) {
   my $prod = bse_make_product
     (
      cfg => $cfg,
@@ -68,6 +84,7 @@ for my $title (qw/prod1 prod2 prod3/) {
     );
   ok($prod, "make product $title/$prod->{id}");
   unshift @prods, $prod;
+  $prods{$prod->title} = $prod;
   $prod_order{$prod->{displayOrder}} = 1;
   $price += 500;
 }
@@ -93,7 +110,7 @@ BSE::TB::ProductOptionValues->make
    display_order => $order++,
   );
 
-is(scalar keys %prod_order, 3, "make sure display orders unique");
+is(scalar keys %prod_order, 10, "make sure display orders unique");
 
 my $prod4 = bse_make_product
   (
@@ -121,6 +138,33 @@ bse_add_step_child
    child => $parent2
   );
 
+{
+  my %tags =
+    (
+     prod1 => [ "Size: Small", "Colour: Red", "ABC" ],
+     prod2 => [ "Size: Small", "Colour: Blue" ],
+     prod3 => [ "Size: Small", "Colour: Green", "ABC" ],
+     prod4 => [ "Size: Medium", "Colour: Red" ],
+     prod5 => [ "Size: Medium", "Colour: Blue", "Colour: Purple" ],
+     prod6 => [ "Size: Medium", "Colour: Green" ],
+     prod7 => [ "Size: Medium", "Colour: Black" ],
+     prod8 => [ "Size: Large", "Colour: Red" ],
+     prod9 => [ "Size: Large", "Colour: Blue" ],
+     prod10 => [ "Size: Large", "Colour: Green", "XYZ" ],
+    );
+  # set some tags
+  for my $key (sort keys %tags) {
+    my $error;
+    ok($prods{$key}->set_tags($tags{$key}, \$error),
+       "set tags on $key")
+      or print("# error: $error");
+
+    my @set = sort @{$tags{$key}};
+    my @tags = sort $prods{$key}->tags;
+    is_deeply(\@set, \@tags, "check tags set for $key");
+  }
+}
+
 dyn_template_test "dynallprods", $parent, <<TEMPLATE, <<EXPECTED;
 <:iterator begin dynallprods:><:
 dynallprod id:><:ifDynAnyProductOptions:> options<:or:><:eif:>
@@ -130,6 +174,108 @@ $prod4->{id}
 $prods[0]{id}
 $prods[1]{id}
 $prods[2]{id} options
+$prods[3]{id}
+$prods[4]{id}
+$prods[5]{id}
+$prods[6]{id}
+$prods[7]{id}
+$prods[8]{id}
+$prods[9]{id}
+
+EXPECTED
+
+dyn_template_test "dynallprods tag filter", $parent, <<TEMPLATE, <<EXPECTED;
+<:iterator begin dynallprods tags: "Size: Small" :><:
+dynallprod title:>
+<:iterator end dynallprods:>
+TEMPLATE
+prod3
+prod2
+prod1
+
+EXPECTED
+
+dyn_template_test "dynallprods tag filter cgi", $parent, <<TEMPLATE, <<EXPECTED;
+<:iterator begin dynallprods tags: [lcgi test3] :><:
+dynallprod title:>
+<:iterator end dynallprods:>
+TEMPLATE
+prod7
+prod6
+prod5
+prod4
+
+EXPECTED
+
+dyn_template_test "dynallprods tag filter", $parent, <<TEMPLATE, <<EXPECTED;
+<:iterator begin dynunused_tagcats dynallprods tags: "Size: Small" :><:
+ifDynunused_tagcat nocat:><:or:><:
+dynunused_tagcat name:>:
+<:eif
+:><:iterator begin dynunused_tags:> <:dynunused_tag val:> (<:dynunused_tag count:>)
+<:iterator end dynunused_tags:><:iterator end dynunused_tagcats :>
+TEMPLATE
+ ABC (2)
+Colour:
+ Blue (1)
+ Green (1)
+ Red (1)
+
+EXPECTED
+
+dyn_template_test "unused tags no highlander", $parent, <<TEMPLATE, <<EXPECTED;
+<:iterator begin dynunused_tagcats dynallprods tags: "Colour: Blue" :><:
+ifDynunused_tagcat nocat:><:or:><:
+dynunused_tagcat name:>:
+<:eif
+:><:iterator begin dynunused_tags:> <:dynunused_tag val:> (<:dynunused_tag count:>)
+<:iterator end dynunused_tags:><:iterator end dynunused_tagcats :>
+TEMPLATE
+Colour:
+ Purple (1)
+Size:
+ Large (1)
+ Medium (1)
+ Small (1)
+
+EXPECTED
+
+dyn_template_test "unused tags highlander", $parent, <<TEMPLATE, <<EXPECTED;
+<:iterator begin dynunused_tagcats dynallprods onlyone tags: "Colour: Blue" :><:
+ifDynunused_tagcat nocat:><:or:><:
+dynunused_tagcat name:>:
+<:eif
+:><:iterator begin dynunused_tags:> <:dynunused_tag val:> (<:dynunused_tag count:>)
+<:iterator end dynunused_tags:><:iterator end dynunused_tagcats :>
+TEMPLATE
+Size:
+ Large (1)
+ Medium (1)
+ Small (1)
+
+EXPECTED
+
+dyn_template_test "dyntags", $parent, <<TEMPLATE, <<EXPECTED;
+<:iterator begin dyntags "Size:  Small/Colour: Red/XYZ" :><:
+dyntag name:>|<:dyntag cat:>|<:dyntag val:>|
+<:iterator end dyntags :>
+<:iterator begin dyntags [lcgi test5] :><:
+dyntag name:>|<:dyntag cat:>|<:dyntag val:>|
+<:iterator end dyntags :>
+<:iterator begin dyntags [lcgi test6] :><:
+dyntag name:>|<:dyntag cat:>|<:dyntag val:>|
+<:iterator end dyntags :>
+TEMPLATE
+Size: Small|Size|Small|
+Colour: Red|Colour|Red|
+XYZ||XYZ|
+
+Size: Medium|Size|Medium|
+Colour: Red|Colour|Red|
+Style: Pretty|Style|Pretty|
+
+Size: Medium|Size|Medium|
+Colour: Red|Colour|Red|
 
 EXPECTED
 
@@ -157,10 +303,10 @@ EXPECTED
 $req->session->{cart} =
   [
    {
-    productId => $prods[0]{id},
+    productId => $prods{prod3}{id},
     units => 1,
-    price => scalar $prods[0]->price(),
-    title => scalar $prods[0]->title,
+    price => scalar $prods{prod3}->price(),
+    title => scalar $prods{prod3}->title,
    }
   ];
 
@@ -175,6 +321,105 @@ prod3 20.00
 Total: 20.00
 EXPECTED
 
+dyn_template_test "cgi", $parent, <<TEMPLATE, <<EXPECTED;
+><:cgi unknown:><
+><:cgi test1:><
+><:cgi test2:><
+TEMPLATE
+><
+>one<
+>two three<
+EXPECTED
+
+dyn_template_test "lcgi", $parent, <<TEMPLATE, <<EXPECTED;
+><:lcgi unknown:><
+><:lcgi test1:><
+><:lcgi test2:><
+><:lcgi "," test1:><
+><:lcgi "," test2:><
+><:lcgi ")(" test2:><
+TEMPLATE
+><
+>one<
+>two/three<
+>one<
+>two,three<
+>two)(three<
+EXPECTED
+
+dyn_template_test "deltag", $parent, <<TEMPLATE, <<EXPECTED;
+><:deltag "Size: Medium" [lcgi test4]:><
+><:deltag "Size:Medium" [lcgi test4]:><
+><:deltag "Size:Medium/Colour:Red" [lcgi test5]:><
+><:deltag "Size:Medium" [lcgi test5]:><
+<:iterator begin dyntags [lcgi test5]
+:><:dyntag name:> - <:deltag [dyntag name] [lcgi test5]:>
+<:iterator end dyntags:>
+TEMPLATE
+>Colour: Red<
+>Colour: Red<
+>Style: Pretty<
+>Colour: Red/Style: Pretty<
+Size: Medium - Colour: Red/Style: Pretty
+Colour: Red - Size: Medium/Style: Pretty
+Style: Pretty - Size: Medium/Colour: Red
+
+EXPECTED
+
+dyn_template_test "ifTagIn", $parent, <<TEMPLATE, <<EXPECTED;
+<:ifTagIn "Size:medium" [lcgi test5]:>1<:or:>0<:eif:>
+<:ifTagIn "Size: Huge" [lcgi test5]:>1<:or:>0<:eif:>
+<:ifTagIn "Size: Medium" [lcgi test5]:>1<:or:>0<:eif:>
+<:ifTagIn "DEF" [lcgi test5]:>1<:or:>0<:eif:>
+TEMPLATE
+1
+0
+1
+0
+EXPECTED
+
+dyn_template_test "paged default", $parent, <<TEMPLATE, <<EXPECTED;
+<:iterator begin dynallprods paged: :><:iterator end dynallprods:>
+Current page: <:dynallprods_page:>
+Page count: <:dynallprods_pagecount:>
+Next page: <:dynallprods_nextpage:>
+Previous page: <:dynallprods_prevpage:>
+Total count: <:dynallprod_totalcount:>
+Count: <:dynallprod_count paged: :>
+First number this page: <:dynallprods_firstnumber:>
+Last number this page: <:dynallprods_lastnumber:>
+Perpage: <:dynallprods_perpage:>
+Pages: <:iterator begin dynallprods_pagec
+:><:dynallprod_pagec page
+:><:ifDynallprod_pagec current:>c<:or:><:eif
+:><:ifDynallprod_pagec first:>f<:or:><:eif
+:><:ifDynallprod_pagec last:>l<:or:><:eif
+:><:ifDynallprod_pagec next:>n<:dynallprod_pagec next:><:or:><:eif
+:><:ifDynallprod_pagec prev:>p<:dynallprod_pagec prev:><:or:><:eif:> <:iterator end dynallprods_pagec
+:>
+<:iterator begin dynallprods paged:
+:><:dynallprod_number:> <:dynallprod title:>
+<:iterator end dynallprods:>
+TEMPLATE
+
+Current page: 2
+Page count: 3
+Next page: 3
+Previous page: 1
+Total count: 11
+Count: 5
+First number this page: 6
+Last number this page: 10
+Perpage: 5
+Pages: 1fn2 2cn3p1 3lp2 
+6 prod6
+7 prod5
+8 prod4
+9 prod3
+10 prod2
+
+EXPECTED
+
 $prod4->remove($cfg);
 for my $prod (@prods) {
   $prod->remove($cfg);
@@ -183,6 +428,7 @@ $parent3->remove($cfg);
 $parent2->remove($cfg);
 $parent->remove($cfg);
 
+# produces three test results
 sub dyn_template_test($$$$) {
   my ($tag, $article, $template, $expected) = @_;