site/cgi-bin/modules/BSE/TB/TagOwner.pm

   1 # mix-in (or close) for classes that keep tags
   2 # currently just articles
   3 # the owner class should implement a tag_owner_type method
   4 package BSE::TB::TagOwner;
   5 use strict;
   6 use BSE::TB::Tags;
   7 use BSE::TB::TagMembers;
   8
   9 our $VERSION = "1.002";
  10
  11 =head1 NAME
  12
  13 BSE::TB::TagOwner - mixin for objects with tags
  14
  15 =head1 SYNOPSIS
  16
  17   my $article = ...;
  18
  19   $article->set_tags([ qw/tag1 tag2/ ], \$error);
  20   $article->remove_tags;
  21
  22   my @tags = $article->tag_objects;
  23   my @tag_names = $article->tags;
  24   my @tag_ids = $article->tag_ids;
  25
  26   if ($article->has_tags([ "tag1", "tag2" ])) {
  27     ...
  28   }
  29
  30 =head1 DESCRIPTION
  31
  32 This class is a mix-in that implements tags for the mixed-into object.
  33
  34 =head1 METHODS PROVIDED
  35
  36 =over
  37
  38 =item set_tags(\@tags, \$error)
  39
  40 Set the specified tags on the object, replacing all existing tags.
  41
  42 =cut
  43
  44 sub set_tags {
  45   my ($self, $rtags, $rerror) = @_;
  46
  47   my @current_tags = $self->tag_objects;
  48   my %current = map { $_->canon_name => $_ } @current_tags;
  49   my %remove = %current;
  50   my %save;
  51   my %add;
  52   for my $name (@$rtags) {
  53     my $work = BSE::TB::Tags->name($name, $rerror);
  54     defined $work or return;
  55
  56     my $lower = lc $work;
  57     if ($current{$lower}) {
  58       delete $remove{$lower};
  59       if (!$save{$lower} && $name ne $current{$lower}->name) {
  60         $save{$lower} = $name;
  61       }
  62     }
  63     else {
  64       $add{$lower} = $name;
  65     }
  66   }
  67
  68   for my $add (values %add) {
  69     # look for or make the tag
  70     my $tag = BSE::TB::Tags->getByName($self->tag_owner_type, $add);
  71     if ($tag) {
  72       if ($tag->name ne $add && !$save{lc $add}) {
  73         $current{lc $add} = $tag;
  74         $save{lc $add} = $add;
  75       }
  76     }
  77     else {
  78       $tag = BSE::TB::Tags->make_with_name($self->tag_owner_type, $add);
  79     }
  80
  81     # add the reference
  82     BSE::TB::TagMembers->make
  83         (
  84          owner_type => $self->tag_owner_type,
  85          owner_id => $self->id,
  86          tag_id => $tag->id,
  87         );
  88   }
  89
  90   for my $save (keys %save) {
  91     my $new_name = $save{$save};
  92     my $tag = $current{$save};
  93     $tag->set_name($new_name);
  94     $tag->save;
  95   }
  96
  97   # remove any leftovers
  98   for my $remove (values %remove) {
  99     BSE::TB::TagMembers->remove_by_tag($self, $remove);
 100   }
 101
 102   return 1;
 103 }
 104
 105 =item remove_tags
 106
 107 Remove all tags from the object.
 108
 109 =cut
 110
 111 sub remove_tags {
 112   my ($self) = @_;
 113
 114   BSE::TB::TagMembers->remove_owned_by($self);
 115 }
 116
 117 =item tag_objects
 118
 119 Return all existing tags on the object as tag objects.
 120
 121 =cut
 122
 123 sub tag_objects {
 124   my ($self) = @_;
 125
 126   return BSE::TB::Tags->getSpecial(object_tags => $self->tag_owner_type, $self->id);
 127 }
 128
 129 =item tags
 130
 131 Returns all existing tags on the object as tag names.
 132
 133 =cut
 134
 135 sub tags {
 136   my ($self) = @_;
 137
 138   return map $_->name, $self->tag_objects;
 139 }
 140
 141 =item tag_ids
 142
 143 Returns all existing tags on the object as tag ids.
 144
 145 =cut
 146
 147 sub tag_ids {
 148   my ($self) = @_;
 149
 150   return map $_->{id}, BSE::DB->single->run("Tag_ids.by_owner", $self->tag_owner_type, $self->id);
 151 }
 152
 153 =item has_tags(\@tags)
 154
 155 Check that all of the specified tags are on the object.
 156
 157 =cut
 158
 159 sub has_tags {
 160   my ($self, $rtags) = @_;
 161
 162   my %my_tag_ids = map { $_ => 1 } $self->tag_ids;
 163
 164   # make sure we have objects, if there's no tag, we don't have that
 165   # tage and can immediately return false
 166   for my $tag (@$rtags) {
 167     my $work = $tag;
 168     unless (ref $work) {
 169       $work = BSE::TB::Tags->getByName($self->tag_owner_type, $tag)
 170         or return;
 171     }
 172
 173     $my_tag_ids{$tag->id}
 174       or return;
 175   }
 176
 177   return 1;
 178 }
 179
 180 1;
 181
 182 __END__
 183
 184 =back
 185
 186 =head1 REQUIRED METHODS
 187
 188 These need to be implemented by the class that wants tags.
 189
 190 =over
 191
 192 =item tag_owner_type
 193
 194 Return a short constant string identifying owner class of the tags.
 195
 196 =item id
 197
 198 The numeric id of the specific owner object of the tags.
 199
 200 =back
 201
 202 =head1 AUTHOR
 203
 204 Tony Cook <tony@develop-help.com>
 205
 206 =cut
 207