move Debbugs to lib

[debbugs.git] / lib / Debbugs / Bug / Tag.pm

diff --git a/lib/Debbugs/Bug/Tag.pm b/lib/Debbugs/Bug/Tag.pm
new file mode 100644 (file)
index 0000000..06dfb3f
--- /dev/null
+++ b/lib/Debbugs/Bug/Tag.pm
@@ -0,0 +1,212 @@
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Bug::Tag;
+
+=head1 NAME
+
+Debbugs::Bug::Tag -- OO interface to bug tags
+
+=head1 SYNOPSIS
+
+   use Debbugs::Bug::Tag;
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::clean;
+use v5.10; # for state
+
+use Debbugs::User;
+use List::AllUtils qw(uniq);
+use Debbugs::Config qw(:config);
+use Carp qw(croak);
+
+state $valid_tags =
+    {map {($_,1)} @{$config{tags}}};
+
+state $short_tags =
+   {%{$config{tags_single_letter}}};
+
+extends 'Debbugs::OOBase';
+
+around BUILDARGS => sub {
+    my $orig = shift;
+    my $class = shift;
+    if (@_ == 1 && !ref $_[0]) {
+       return $class->$orig(keywords => $_[0]);
+    } else {
+       return $class->$orig(@_);
+    }
+};
+
+sub BUILD {
+    my $self = shift;
+    my $args = shift;
+    if (exists $args->{keywords}) {
+        my @tags;
+        if (ref($args->{keywords})) {
+            @tags = @{$args->{keywords}}
+        } else {
+            @tags = split /[, ]/,$args->{keywords};
+        }
+        return unless @tags;
+        $self->_set_tag(map {($_,1)} @tags);
+        delete $args->{keywords};
+    }
+}
+
+has tags => (is => 'ro',
+            isa => 'HashRef[Str]',
+            traits => ['Hash'],
+            lazy => 1,
+            reader => '_tags',
+            builder => '_build_tags',
+            handles => {has_tags => 'count',
+                         _set_tag => 'set',
+                         unset_tag => 'delete',
+                        },
+           );
+has usertags => (is => 'ro',
+                isa => 'HashRef[Str]',
+                lazy => 1,
+                 traits => ['Hash'],
+                 handles => {unset_usertag => 'delete',
+                             has_usertags => 'count',
+                            },
+                reader => '_usertags',
+                builder => '_build_usertags',
+               );
+
+sub has_any_tags {
+    my $self = shift;
+    return ($self->has_tags || $self->has_usertags);
+}
+
+has bug => (is => 'ro',
+            isa => 'Debbugs::Bug',
+            required => 1,
+           );
+
+has users => (is => 'ro',
+              isa => 'ArrayRef[Debbugs::User]',
+              default => sub {[]},
+             );
+
+sub _build_tags {
+    return {};
+}
+
+sub _build_usertags {
+    my $self = shift;
+    local $_;
+    my $t = {};
+    my $id = $self->bug->id;
+    for my $user (@{$self->users}) {
+        for my $tag ($user->tags_on_bug($id)) {
+            $t->{$tag} = $user->email;
+        }
+    }
+    return $t;
+}
+
+sub is_set {
+    return ($_[0]->tag_is_set($_[1]) or
+        $_[0]->usertag_is_set($_[1]));
+}
+
+sub tag_is_set {
+    return exists $_[0]->_tags->{$_[1]} ? 1 : 0;
+}
+
+sub usertag_is_set {
+    return exists $_[0]->_usertags->{$_[1]} ? 1 : 0;
+}
+
+sub set_tag {
+    my $self = shift;
+    for my $tag (@_) {
+       if (not $self->valid_tag($tag)) {
+           confess("Invalid tag $tag");
+       }
+       $self->_tags->{$tag} = 1;
+    }
+    return $self;
+}
+
+sub valid_tag {
+    return exists $valid_tags->{$_[1]}?1:0;
+}
+
+sub as_string {
+    my $self = shift;
+    return $self->join_all(' ');
+}
+
+sub join_all {
+    my $self = shift;
+    my $joiner = shift;
+    $joiner //= ', ';
+    return join($joiner,$self->all_tags);
+}
+
+sub join_usertags {
+    my $self = shift;
+    my $joiner = shift;
+    $joiner //= ', ';
+    return join($joiner,$self->usertags);
+}
+
+sub join_tags {
+    my $self = shift;
+    my $joiner = shift;
+    $joiner //= ', ';
+    return join($joiner,$self->tags);
+}
+
+sub all_tags {
+    return uniq sort $_[0]->tags,$_[0]->usertags;
+}
+
+sub tags {
+    return sort keys %{$_[0]->_tags}
+}
+
+sub short_tags {
+    my $self = shift;
+    my @r;
+    for my $tag ($self->tags) {
+       next unless exists $short_tags->{$tag};
+       push @r,
+          {long => $tag,
+           short => $short_tags->{$tag},
+          };
+    }
+    if (wantarray) {
+       return @r;
+    } else {
+       return [@r];
+    }
+}
+
+sub usertags {
+    return sort keys %{$_[0]->_usertags}
+}
+
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End: