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     for my $user (@{$self->users}) {
 113         for my $tag ($user->tags_on_bug($self->bug->id)) {
 114             $t->{$tag} = $user->email;
 115         }
 116     }
 117     return $t;
 118 }
 119
 120 sub is_set {
 121     return ($_[0]->tag_is_set($_[1]) or
 122         $_[0]->usertag_is_set($_[1]));
 123 }
 124
 125 sub tag_is_set {
 126     return exists $_[0]->_tags->{$_[1]} ? 1 : 0;
 127 }
 128
 129 sub usertag_is_set {
 130     return exists $_[0]->_usertags->{$_[1]} ? 1 : 0;
 131 }
 132
 133 sub set_tag {
 134     my $self = shift;
 135     for my $tag (@_) {
 136         if (not $self->valid_tag($tag)) {
 137             confess("Invalid tag $tag");
 138         }
 139         $self->_tags->{$tag} = 1;
 140     }
 141     return $self;
 142 }
 143
 144 sub valid_tag {
 145     return exists $valid_tags->{$_[1]}?1:0;
 146 }
 147
 148 sub as_string {
 149     my $self = shift;
 150     return $self->join_all(' ');
 151 }
 152
 153 sub join_all {
 154     my $self = shift;
 155     my $joiner = shift;
 156     $joiner //= ', ';
 157     return join($joiner,$self->all_tags);
 158 }
 159
 160 sub join_usertags {
 161     my $self = shift;
 162     my $joiner = shift;
 163     $joiner //= ', ';
 164     return join($joiner,$self->usertags);
 165 }
 166
 167 sub join_tags {
 168     my $self = shift;
 169     my $joiner = shift;
 170     $joiner //= ', ';
 171     return join($joiner,$self->tags);
 172 }
 173
 174 sub all_tags {
 175     return uniq sort $_[0]->tags,$_[0]->usertags;
 176 }
 177
 178 sub tags {
 179     return sort keys %{$_[0]->_tags}
 180 }
 181
 182 sub short_tags {
 183     my $self = shift;
 184     my @r;
 185     for my $tag ($self->tags) {
 186         next unless exists $short_tags->{$tag};
 187         push @r,
 188            {long => $tag,
 189             short => $short_tags->{$tag},
 190            };
 191     }
 192     if (wantarray) {
 193         return @r;
 194     } else {
 195        return [@r];
 196     }
 197 }
 198
 199 sub usertags {
 200     return sort keys %{$_[0]->_usertags}
 201 }
 202
 203 no Mouse;
 204 1;
 205
 206
 207 __END__
 208 # Local Variables:
 209 # indent-tabs-mode: nil
 210 # cperl-indent-level: 4
 211 # End: