Add missing deps

.gitignore

@@ -1,2 +1,5 @@
 .build
 Throwable-*
+*~
+.#*
+*#

Changes

@@ -2,6 +2,9 @@ Revision history for Throwable
 
 {{$NEXT}}
 
+0.200000  2012-09-20 14:12:34 America/New_York
+          port to Moo (FREW, MSTROUT, ILMARI)
+
 0.102080  2010-07-27 12:09:21 America/New_York
           refactor stack trace autocreation to StackTrace::Auto role
           make Throwable::Error immutable

dist.ini

@@ -6,6 +6,6 @@ copyright_holder = Ricardo SIGNES
 
 [@RJBS]
 
-[Prereq]
+[Prereqs]
 Devel::StackTrace = 1.21 ; frame_filter
-
+Class::Load = 0.20

lib/StackTrace/Auto.pm

@@ -1,5 +1,9 @@
 package StackTrace::Auto;
-use Moose::Role 0.87;
+use Moo::Role;
+use Sub::Quote ();
+use MooX::Types::MooseLike::Base qw(ArrayRef);
+use Class::Load ();
+
 # ABSTRACT: a role for generating stack traces during instantiation
 
 =head1 SYNOPSIS
@@ -33,29 +37,29 @@ In general, you will not need to think about this attribute.
 
 =cut
 
-{
-  use Moose::Util::TypeConstraints;
-
-  has stack_trace => (
-    is       => 'ro',
-    isa      => duck_type([ qw(as_string) ]),
-    builder  => '_build_stack_trace',
-    init_arg => undef,
-  );
-
-  my $tc = subtype as 'ClassName';
-  coerce $tc, from 'Str', via { Class::MOP::load_class($_); $_ };
-
-  has stack_trace_class => (
-    is      => 'ro',
-    isa     => $tc,
-    coerce  => 1,
-    lazy    => 1,
-    builder => '_build_stack_trace_class',
-  );
+has stack_trace => (
+  is       => 'ro',
+  isa      => Sub::Quote::quote_sub(q{
+    require Scalar::Util;
+    die "stack_trace must be have an 'as_string' method!" unless
+       Scalar::Util::blessed($_[0]) && $_[0]->can('as_string')
+  }),
+  builder  => '_build_stack_trace',
+  init_arg => undef,
+);
 
-  no Moose::Util::TypeConstraints;
-}
+has stack_trace_class => (
+  is      => 'ro',
+  isa     => Sub::Quote::quote_sub(q{
+      die "stack_trace_class must be a loaded class"
+          unless Class::Load::is_class_loaded($_[0]);
+  }),
+  coerce  => Sub::Quote::quote_sub(q{
+    Class::Load::load_class($_[0]);
+  }),
+  lazy    => 1,
+  builder => '_build_stack_trace_class',
+);
 
 =attr stack_trace_args
 
@@ -66,7 +70,7 @@ trace.  In general, you will not need to think about it.
 
 has stack_trace_args => (
   is      => 'ro',
-  isa     => 'ArrayRef',
+  isa     => ArrayRef,
   lazy    => 1,
   builder => '_build_stack_trace_args',
 );
@@ -78,18 +82,26 @@ sub _build_stack_trace_class {
 sub _build_stack_trace_args {
   my ($self) = @_;
   my $found_mark = 0;
-  my $uplevel = 3; # number of *raw* frames to go up after we found the marker
   return [
     frame_filter => sub {
       my ($raw) = @_;
-      if ($found_mark) {
-          return 1 unless $uplevel;
-          return !$uplevel--;
+      my $sub = $raw->{caller}->[3];
+      (my $package = $sub) =~ s/::\w+\z//;
+      if ($found_mark == 3) {
+          return 1;
+      }
+      elsif ($found_mark == 2) {
+        return 0 if $sub =~ /::new$/ && $self->isa($package);
+        $found_mark++;
+        return 1;
+      } elsif ($found_mark == 1) {
+        $found_mark++ if $sub =~ /::new$/ && $self->isa($package);
+        return 0;
       }
       else {
-        $found_mark = scalar $raw->{caller}->[3] =~ /__stack_marker$/;
+        $found_mark++ if $raw->{caller}->[3] =~ /::_build_stack_trace$/;
         return 0;
-    }
+      }
     },
   ];
 }
@@ -101,17 +113,5 @@ sub _build_stack_trace {
   );
 }
 
-around new => sub {
-  my $next = shift;
-  my $self = shift;
-  return $self->__stack_marker($next, @_);
-};
-
-sub __stack_marker {
-  my $self = shift;
-  my $next = shift;
-  return $self->$next(@_);
-}
-
-no Moose::Role;
+no Moo::Role;
 1;

lib/Throwable.pm

@@ -1,5 +1,9 @@
 package Throwable;
-use Moose::Role 0.87;
+use Moo::Role;
+use Sub::Quote ();
+use Scalar::Util ();
+use Carp ();
+
 # ABSTRACT: a role for classes that can be thrown
 
 =head1 SYNOPSIS
@@ -30,10 +34,13 @@ Throwable object is created.
 has 'previous_exception' => (
   is       => 'ro',
   init_arg => undef,
-  default  => sub {
-    return unless defined $@ and (ref $@ or length $@);
-    return $@;
-  },
+  default  => Sub::Quote::quote_sub(q{
+    if (defined $@ and (ref $@ or length $@)) {
+      $@;
+    } else {
+      undef;
+    }
+  }),
 );
 
 =method throw
@@ -50,14 +57,14 @@ If called on an object that does Throwable, the object will be rethrown.
 sub throw {
   my ($inv) = shift;
 
-  if (blessed $inv) {
-    confess "throw called on Throwable object with arguments" if @_;
+  if (Scalar::Util::blessed($inv)) {
+    Carp::confess "throw called on Throwable object with arguments" if @_;
     die $inv;
   }
 
   my $throwable = $inv->new(@_);
   die $throwable;
 }
 
-no Moose::Role;
+no Moo::Role;
 1;

lib/Throwable/Error.pm

@@ -1,5 +1,6 @@
 package Throwable::Error;
-use Moose 0.87;
+use Moo;
+use MooX::Types::MooseLike::Base qw(Str);
 with 'Throwable', 'StackTrace::Auto';
 # ABSTRACT: an easy-to-use class for error objects
 
@@ -54,7 +55,7 @@ error is stringified.
 
 has message => (
   is       => 'ro',
-  isa      => 'Str',
+  isa      => Str,
   required => 1,
 );
 
@@ -94,6 +95,4 @@ sub BUILDARGS {
   return $self->SUPER::BUILDARGS(@args);
 }
 
-__PACKAGE__->meta->make_immutable(inline_constructor => 0);
-no Moose;
 1;

t/basic.t

@@ -1,13 +1,23 @@
 #!perl
 use strict;
 use warnings;
-use Test::More tests => 9;
+use Test::More;
 
-{
-  package MyError;
-  use Moose;
-  extends 'Throwable::Error';
-  no Moose;
+my $extra_frames;
+BEGIN {
+  my $class = 'Moo';
+  $extra_frames = 0;
+  if ($Throwable::_TEST_MOOSE) {
+    $class = 'Moose';
+    $extra_frames++ # the "do" in xt/moose.t adds a frame
+  }
+  eval qq{
+    package MyError;
+    use $class;
+    extends 'Throwable::Error';
+
+    1;
+  } or die $@;
 }
 
 sub throw_x {
@@ -31,8 +41,34 @@ my $trace = $error->stack_trace;
 isa_ok($trace, 'Devel::StackTrace', 'the trace');
 
 my @frames = $trace->frames;
-is(@frames, 4, "we have four frames in our trace");
+is(@frames, 4 + $extra_frames, "we have four frames in our trace");
 is($frames[0]->subroutine, q{Throwable::throw},   'correct frame 0');
 is($frames[1]->subroutine, q{main::throw_x},      'correct frame 1');
 is($frames[2]->subroutine, q{main::call_throw_x}, 'correct frame 2');
 is($frames[3]->subroutine, q{(eval)},             'correct frame 3');
+
+{
+   eval { MyError->throw('shucks howdy'); };
+
+   my $error = $@;
+   isa_ok($error, 'MyError', 'the error');
+   is($error->message, q{shucks howdy}, "error message is correct");
+}
+
+{
+  package HasError;
+  sub new { bless { error => MyError->new("flabba") } }
+}
+
+sub create_error { HasError->new->{error} }
+
+{
+  my $error = create_error();
+
+  my @frames = $error->stack_trace->frames;
+  is(@frames, 2 + $extra_frames, "two frames from constructor");
+  is($frames[0]->subroutine, q{HasError::new}, 'correct constructor in frame 0');
+  is($frames[1]->subroutine, q{main::create_error}, 'correct frame 1');
+}
+
+done_testing();

xt/moose-coerce-class.t

@@ -0,0 +1,18 @@
+#!perl
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package MyClass;
+    use Moose;
+    with 'StackTrace::Auto';
+}
+
+ok(my $obj = eval { MyClass->new }, "Create Moose object")
+    or diag $@;
+
+isa_ok($obj, "MyClass");
+isa_ok($obj->stack_trace, "Devel::StackTrace", 'The trace');
+
+done_testing();

xt/moose.t

@@ -0,0 +1,6 @@
+#perl
+use strict;
+use warnings;
+
+$Throwable::_TEST_MOOSE = 1;
+do "t/basic.t";