Debbugs/Bug/Tag.pm

   1 # This module is part of debbugs, and
   2 # is released under the terms of the GPL version 2, or any later
   3 # version (at your option). See the file README and COPYING for more
   4 # information.
   5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
   6
   7 package Debbugs::Bug::Tag;
   8
   9 =head1 NAME
  10
  11 Debbugs::Bug::Tag -- OO interface to bug tags
  12
  13 =head1 SYNOPSIS
  14
  15    use Debbugs::Bug::Tag;
  16
  17 =head1 DESCRIPTION
  18
  19
  20
  21 =cut
  22
  23 use Mouse;
  24 use strictures 2;
  25 use namespace::clean;
  26 use v5.10; # for state
  27
  28 use Debbugs::User;
  29 use List::AllUtils qw(uniq);
  30 use Debbugs::Config qw(:config);
  31 use Carp qw(croak);
  32
  33 state $valid_tags =
  34     {map {($_,1)} @{$config{tags}}};
  35
  36 state $short_tags =
  37    {%{$config{tags_single_letter}}};
  38
  39 extends 'Debbugs::OOBase';
  40
  41 around BUILDARGS => sub {
  42     my $orig = shift;
  43     my $class = shift;
  44     if (@_ == 1 && !ref $_[0]) {
  45         return $class->$orig(keywords => $_[0]);
  46     } else {
  47         return $class->$orig(@_);
  48     }
  49 };
  50
  51 sub BUILD {
  52     my $self = shift;
  53     my $args = shift;
  54     if (exists $args->{keywords}) {
  55         my @tags;
  56         if (ref($args->{keywords})) {
  57             @tags = @{$args->{keywords}}
  58         } else {
  59             @tags = split /[, ]/,$args->{keywords};
  60         }
  61         return unless @tags;
  62         $self->_set_tag(map {($_,1)} @tags);
  63         delete $args->{keywords};
  64     }
  65 }
  66
  67 has tags => (is => 'ro',
  68              isa => 'HashRef[Str]',
  69              traits => ['Hash'],
  70              lazy => 1,
  71              reader => '_tags',
  72              builder => '_build_tags',
  73              handles => {has_tags => 'count',
  74                          _set_tag => 'set',
  75                          unset_tag => 'delete',
  76                         },
  77             );
  78 has usertags => (is => 'ro',
  79                  isa => 'HashRef[Str]',
  80                  lazy => 1,
  81                  traits => ['Hash'],
  82                  handles => {unset_usertag => 'delete',
  83                              has_usertags => 'count',
  84                             },
  85                  reader => '_usertags',
  86                  builder => '_build_usertags',
  87                 );
  88
  89 sub has_any_tags {
  90     my $self = shift;
  91     return ($self->has_tags || $self->has_usertags);
  92 }
  93
  94 has bug => (is => 'ro',
  95             isa => 'Debbugs::Bug',
  96             required => 1,
  97            );
  98
  99 has users => (is => 'ro',
 100               isa => 'ArrayRef[Debbugs::User]',
 101               default => sub {[]},
 102              );
 103
 104 sub _build_tags {
 105     return {};
 106 }
 107
 108 sub _build_usertags {
 109     my $self = shift;
 110     local $_;
 111     my $t = {};
 112     my $id = $self->bug->id;
 113     for my $user (@{$self->users}) {
 114         for my $tag ($user->tags_on_bug($id)) {
 115             $t->{$tag} = $user->email;
 116         }
 117     }
 118     return $t;
 119 }
 120
 121 sub is_set {
 122     return ($_[0]->tag_is_set($_[1]) or
 123         $_[0]->usertag_is_set($_[1]));
 124 }
 125
 126 sub tag_is_set {
 127     return exists $_[0]->_tags->{$_[1]} ? 1 : 0;
 128 }
 129
 130 sub usertag_is_set {
 131     return exists $_[0]->_usertags->{$_[1]} ? 1 : 0;
 132 }
 133
 134 sub set_tag {
 135     my $self = shift;
 136     for my $tag (@_) {
 137         if (not $self->valid_tag($tag)) {
 138             confess("Invalid tag $tag");
 139         }
 140         $self->_tags->{$tag} = 1;
 141     }
 142     return $self;
 143 }
 144
 145 sub valid_tag {
 146     return exists $valid_tags->{$_[1]}?1:0;
 147 }
 148
 149 sub as_string {
 150     my $self = shift;
 151     return $self->join_all(' ');
 152 }
 153
 154 sub join_all {
 155     my $self = shift;
 156     my $joiner = shift;
 157     $joiner //= ', ';
 158     return join($joiner,$self->all_tags);
 159 }
 160
 161 sub join_usertags {
 162     my $self = shift;
 163     my $joiner = shift;
 164     $joiner //= ', ';
 165     return join($joiner,$self->usertags);
 166 }
 167
 168 sub join_tags {
 169     my $self = shift;
 170     my $joiner = shift;
 171     $joiner //= ', ';
 172     return join($joiner,$self->tags);
 173 }
 174
 175 sub all_tags {
 176     return uniq sort $_[0]->tags,$_[0]->usertags;
 177 }
 178
 179 sub tags {
 180     return sort keys %{$_[0]->_tags}
 181 }
 182
 183 sub short_tags {
 184     my $self = shift;
 185     my @r;
 186     for my $tag ($self->tags) {
 187         next unless exists $short_tags->{$tag};
 188         push @r,
 189            {long => $tag,
 190             short => $short_tags->{$tag},
 191            };
 192     }
 193     if (wantarray) {
 194         return @r;
 195     } else {
 196        return [@r];
 197     }
 198 }
 199
 200 sub usertags {
 201     return sort keys %{$_[0]->_usertags}
 202 }
 203
 204 no Mouse;
 205 1;
 206
 207
 208 __END__
 209 # Local Variables:
 210 # indent-tabs-mode: nil
 211 # cperl-indent-level: 4
 212 # End: