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