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         my @tags = split / /,$_[0];
  45         my %tags;
  46         @tags{@tags} = (1) x @tags;
  47         return $class->$orig(tags => \%tags);
  48     } else {
  49         return $class->$orig(@_);
  50     }
  51 };
  52
  53 has tags => (is => 'ro',
  54              isa => 'HashRef[Str]',
  55              traits => ['Hash'],
  56              lazy => 1,
  57              reader => '_tags',
  58              builder => '_build_tags',
  59              handles => {has_tags => 'count'}
  60             );
  61 has usertags => (is => 'ro',
  62                  isa => 'HashRef[Str]',
  63                  lazy => 1,
  64                  reader => '_usertags',
  65                  builder => '_build_usertags',
  66                 );
  67
  68 sub _build_tags {
  69     return {};
  70 }
  71
  72 sub _build_usertags {
  73     return {};
  74 }
  75
  76 sub is_set {
  77     return ($_[0]->tag_is_set($_[1]) or
  78         $_[0]->usertag_is_set($_[1]));
  79 }
  80
  81 sub tag_is_set {
  82     return exists $_[0]->_tags->{$_[1]} ? 1 : 0;
  83 }
  84
  85 sub usertag_is_set {
  86     return exists $_[0]->_usertags->{$_[1]} ? 1 : 0;
  87 }
  88
  89 sub unset_tag {
  90     my $self = shift;
  91     delete $self->_tags->{$_} foreach @_;
  92 }
  93
  94 sub unset_usertag {
  95     my $self = shift;
  96     delete $self->_usertags->{$_} foreach @_;
  97 }
  98
  99 sub set_tag {
 100     my $self = shift;
 101     for my $tag (@_) {
 102         if (not $self->valid_tag($tag)) {
 103             confess("Invalid tag $tag");
 104         }
 105         $self->_tags->{$tag} = 1;
 106     }
 107     return $self;
 108 }
 109
 110 sub valid_tag {
 111     return exists $valid_tags->{$_[1]}?1:0;
 112 }
 113
 114 sub as_string {
 115     my $self = shift;
 116     return $self->join_all(' ');
 117 }
 118
 119 sub join_all {
 120     my $self = shift;
 121     my $joiner = shift;
 122     $joiner //= ', ';
 123     return join($joiner,$self->all_tags);
 124 }
 125
 126 sub all_tags {
 127     return uniq sort $_[0]->tags,$_[0]->usertags;
 128 }
 129
 130 sub tags {
 131     return sort keys %{$_[0]->_tags}
 132 }
 133
 134 sub short_tags {
 135     my $self = shift;
 136     my @r;
 137     for my $tag ($self->tags) {
 138         next unless exists $short_tags->{$tag};
 139         push @r,
 140            {long => $tag,
 141             short => $short_tags->{$tag},
 142            };
 143     }
 144     if (wantarray) {
 145         return @r;
 146     } else {
 147        return [@r];
 148     }
 149 }
 150
 151 sub usertags {
 152     return sort keys %{$_[0]->_usertags}
 153 }
 154
 155 no Mouse;
 156 1;
 157
 158
 159 __END__
 160 # Local Variables:
 161 # indent-tabs-mode: nil
 162 # cperl-indent-level: 4
 163 # End: