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
  32 state $valid_tags =
  33     {map {($_,1)} @{$config{tags}}};
  34
  35 state $short_tags =
  36    {%{$config{tags_single_letter}}};
  37
  38 extends 'Debbugs::OOBase';
  39
  40 around BUILDARGS => sub {
  41     my $orig = shift;
  42     my $class = shift;
  43     if (@_ == 1 && !ref $_[0]) {
  44         return $class->$orig(keywords => $_[0]);
  45     } else {
  46         return $class->$orig(@_);
  47     }
  48 };
  49
  50 sub BUILD {
  51     my $self = shift;
  52     my $args = shift;
  53     if (exists $args->{keywords}) {
  54         my @tags = split /[, ]/,$args->{keywords};
  55         return unless @tags;
  56         $self->_set_tag(map {($_,1)} @tags);
  57         delete $args->{keywords};
  58     }
  59 }
  60
  61 has tags => (is => 'ro',
  62              isa => 'HashRef[Str]',
  63              traits => ['Hash'],
  64              lazy => 1,
  65              reader => '_tags',
  66              builder => '_build_tags',
  67              handles => {has_tags => 'count',
  68                          _set_tag => 'set',
  69                          unset_tag => 'delete',
  70                         },
  71             );
  72 has usertags => (is => 'ro',
  73                  isa => 'HashRef[Str]',
  74                  lazy => 1,
  75                  traits => ['Hash'],
  76                  handles => {unset_usertag => 'delete',
  77                              has_usertags => 'count',
  78                             },
  79                  reader => '_usertags',
  80                  builder => '_build_usertags',
  81                 );
  82
  83 sub has_any_tags {
  84     my $self = shift;
  85     return ($self->has_tags || $self->has_usertags);
  86 }
  87
  88 has bug => (is => 'ro',
  89             isa => 'Debbugs::Bug',
  90             required => 1,
  91            );
  92
  93 has users => (is => 'ro',
  94               isa => 'ArrayRef[Debbugs::User]',
  95               default => sub {[]},
  96              );
  97
  98 sub _build_tags {
  99     return {};
 100 }
 101
 102 sub _build_usertags {
 103     my $self = shift;
 104     local $_;
 105     my $t = {};
 106     for my $user (@{$self->users}) {
 107         for my $tag ($user->tags_on_bug($self->bug->id)) {
 108             $t->{$tag} = $user->email;
 109         }
 110     }
 111     return $t;
 112 }
 113
 114 sub is_set {
 115     return ($_[0]->tag_is_set($_[1]) or
 116         $_[0]->usertag_is_set($_[1]));
 117 }
 118
 119 sub tag_is_set {
 120     return exists $_[0]->_tags->{$_[1]} ? 1 : 0;
 121 }
 122
 123 sub usertag_is_set {
 124     return exists $_[0]->_usertags->{$_[1]} ? 1 : 0;
 125 }
 126
 127 sub set_tag {
 128     my $self = shift;
 129     for my $tag (@_) {
 130         if (not $self->valid_tag($tag)) {
 131             confess("Invalid tag $tag");
 132         }
 133         $self->_tags->{$tag} = 1;
 134     }
 135     return $self;
 136 }
 137
 138 sub valid_tag {
 139     return exists $valid_tags->{$_[1]}?1:0;
 140 }
 141
 142 sub as_string {
 143     my $self = shift;
 144     return $self->join_all(' ');
 145 }
 146
 147 sub join_all {
 148     my $self = shift;
 149     my $joiner = shift;
 150     $joiner //= ', ';
 151     return join($joiner,$self->all_tags);
 152 }
 153
 154 sub join_usertags {
 155     my $self = shift;
 156     my $joiner = shift;
 157     $joiner //= ', ';
 158     return join($joiner,$self->usertags);
 159 }
 160
 161 sub join_tags {
 162     my $self = shift;
 163     my $joiner = shift;
 164     $joiner //= ', ';
 165     return join($joiner,$self->tags);
 166 }
 167
 168 sub all_tags {
 169     return uniq sort $_[0]->tags,$_[0]->usertags;
 170 }
 171
 172 sub tags {
 173     return sort keys %{$_[0]->_tags}
 174 }
 175
 176 sub short_tags {
 177     my $self = shift;
 178     my @r;
 179     for my $tag ($self->tags) {
 180         next unless exists $short_tags->{$tag};
 181         push @r,
 182            {long => $tag,
 183             short => $short_tags->{$tag},
 184            };
 185     }
 186     if (wantarray) {
 187         return @r;
 188     } else {
 189        return [@r];
 190     }
 191 }
 192
 193 sub usertags {
 194     return sort keys %{$_[0]->_usertags}
 195 }
 196
 197 no Mouse;
 198 1;
 199
 200
 201 __END__
 202 # Local Variables:
 203 # indent-tabs-mode: nil
 204 # cperl-indent-level: 4
 205 # End: