a mechanism for accumulating default tags

lib/Throwable/X.pm

@@ -2,6 +2,14 @@ package Throwable::X;
 use Moose::Role;
 # ABSTRACT: useful eXtra behavior for Throwable exceptions
 
+=head1 SYNOPSIS
+
+Write an exception class:
+
+  package X::Bad
+
+=cut
+
 use namespace::autoclean;
 
 use Moose::Util::TypeConstraints -default => { -prefix => 'tc_' };
@@ -90,16 +98,46 @@ sub has_tag {
 
 sub tags {
   my ($self) = @_;
-  return wantarray ? @{ $self->_tags } : $self->_tags->[-1];
+
+  # Poor man's uniq:
+  my %tags = map {; $_ => 1 }
+             (@{ $self->_default_tags }, @{ $self->_instance_tags });
+
+  return wantarray ? keys %tags : (keys %tags)[0];
 }
 
-has tags => (
+has instance_tags => (
+  is     => 'ro',
+  isa    => 'ArrayRef[Throwable::X::_Tag]',
+  reader => '_instance_tags',
+  init_arg => 'tags',
+  default  => sub { [] },
+);
+
+has _default_tags => (
   is      => 'ro',
-  isa     => 'ArrayRef[Throwable::X::_Tag]',
-  reader  => '_tags',
-  default => sub { [] },
+  builder => '_build_default_tags',
 );
 
+sub _build_default_tags {
+  # This code stolen happily from Moose::Object::BUILDALL -- rjbs, 2010-10-18
+
+  # NOTE: we ask Perl if we even need to do this first, to avoid extra meta
+  # level calls
+  return [] unless $_[0]->can('x_tags');
+
+  my @tags;
+
+  my ($self, $params) = @_;
+  foreach my $method (
+    reverse Class::MOP::class_of($self)->find_all_methods_by_name('x_tags')
+  ) {
+    push @tags, $method->{code}->execute($self, $params);
+  }
+
+  return \@tags;
+}
+
 sub payload {
   my ($self) = @_;
 

t/exception.t

@@ -9,6 +9,8 @@ use Test::More;
 
   with 'Throwable::X';
 
+  sub x_tags { qw(whatever) }
+
   has size => (
     is   => 'ro',
     isa  => 'Int',
@@ -53,8 +55,8 @@ use Test::More;
   );
 
   ok(
-    $err->has_tag('foo-bar') && $err->has_tag('zug') && ! $err->has_tag('xyz'),
-    "...and its tags seem correct",
+    $err->has_tag('foo-bar') && $err->has_tag('whatever') && ! $err->has_tag('xyz'),
+    "...and its tags seem correct via ->has_tag",
   );
 }