Refactor the way we run the coderefs with an eye towards finally

Makefile.PL

@@ -16,6 +16,7 @@ requires 'B::Hooks::OP::Check' => 0.15;
 requires 'B::Hooks::OP::PPAddr' => 0.02;
 requires 'Devel::Declare';
 requires 'Moose';
+requires 'MooseX::Types::Moose';
 requires 'Scope::Upper' => 0.06;
 
 resources repository => 'http://github.com/ashb/trycatch/tree/master';

TryCatch.xs

@@ -7,16 +7,24 @@
 
 STATIC OP* unwind_return (pTHX_ OP *op, void *user_data) {
   dSP;
+  SV* ctx;
   CV *unwind;
 
   PERL_UNUSED_VAR(user_data);
-  PUSHMARK(SP);
-  XPUSHs(sv_2mortal(newSViv(3)));
-  PUTBACK;
 
-  call_pv("Scope::Upper::CALLER", G_SCALAR);
+  ctx = get_sv("TryCatch::Exception::CTX", 0);
+  if (ctx) {
+    XPUSHs(ctx);
+    PUTBACK;
+  } else {
+    PUSHMARK(SP);
+    XPUSHs(sv_2mortal(newSViv(3)));
+    PUTBACK;
+
+    call_pv("Scope::Upper::CALLER", G_SCALAR);
 
-  SPAGAIN;
+    SPAGAIN;
+  }
 
 
   // call_pv("Scope::Upper::unwind", G_VOID);

lib/TryCatch.pm

@@ -49,25 +49,10 @@ use Carp qw/croak/;
 
 # The actual try call itself. Nothing to do with parsing.
 sub try {
-  my ($sub, $terminal) = @_;
-
-  local $@;
-  my $ctx = want_at SUB(CALLER(1));
-  eval {
-    if ($ctx) {
-      my @ret = $sub->(); 
-    } elsif (defined $ctx) {
-      my $ret = $sub->();
-    } else {
-      $sub->();
-    }
-  };
-
+  my ($sub) = @_;
 
-  # If we get here there was either no explicit return or an error
+  return new TryCatch::Exception( try => $sub, ctx => SUB(CALLER(1)) );
 
-  return "TryCatch::Exception::Handled" unless defined($@);
-  return bless { error => $@ }, "TryCatch::Exception";
 }
 
 # Where we store all the TCs for catch blocks created at compile time
@@ -160,7 +145,7 @@ sub block_postlude {
     $ctx->set_linestr($linestr);
     $TryCatch::PARSE_CATCH_NEXT = 1;
   } else {
-    substr($linestr, $offset, 0) = ");";
+    substr($linestr, $offset, 0) = ")->run;";
     $ctx->set_linestr($linestr);
   }
 }

lib/TryCatch/Exception.pm

@@ -1,48 +1,89 @@
 package TryCatch::Exception;
 
-use strict;
-use warnings;
+use Moose;
+
+use MooseX::Types::Moose qw/CodeRef ArrayRef/;
 
 use Scope::Upper qw/unwind want_at :words/;
-use namespace::clean;
+use namespace::clean -except => 'meta';
 
-sub catch {
-  my ($self, @conds) = @_;
-  my $sub = pop @conds;
-  die "no code to catch!" unless ref $sub && ref $sub eq 'CODE';
-
-  local $@;
-  for my $cond (@conds) {
-    if (ref $cond) {
-      local *_ = \$self->{error};
-      return $self unless $cond->();
-    }
-    else {
-      my $tc = TryCatch->get_tc($cond);
-      return $self unless $tc->check($self->{error});
-    }
-
+has try => (
+  is => 'ro',
+  isa => CodeRef,
+  required => 1
+);
+
+has catches => (
+  is => 'ro',
+  isa => ArrayRef[ArrayRef[CodeRef]],
+  default => sub { [] }
+);
+
+has ctx => (
+  is => 'ro',
+  required => 1
+);
+
+our $CTX;
+
+sub _run_block {
+  my ($self, $code) = @_;
+
+  my $wa = want_at $CTX;
+  if ($wa) {
+    my @ret = $code->(); 
+  } elsif (defined $wa) {
+    my $ret = $code->();
+  } else {
+    $code->();
   }
+}
 
-  # If we get here then the conditions match
+sub run {
+  my ($self) = @_;
+  local $CTX = $CTX;
+  my $ctx = $CTX;
 
-  my $ctx = want_at SUB(CALLER(1));
+  unless (defined $CTX) {
+    $CTX = $ctx = $self->ctx;
+  }
+
+  local $@;
   eval {
-    $@ = $self->{error};
-    if ($ctx) {
-      my @ret = $sub->(); 
-    } elsif (defined $ctx) {
-      my $ret = $sub->();
-    } else {
-      $sub->();
-    }
+    $self->_run_block($self->try);
   };
 
-  return "TryCatch::Exception::Handled";
+  # If we get here there was either no explicit return or an error
+  return unless defined($@);
+  my $err = $@;
+
+  CATCH: for my $catch ( @{$self->catches} ) {
+    my $sub = pop @$catch;
+    for my $cond (@$catch) {
+      if (ref $cond) {
+        local *_ = \$err;
+        next CATCH unless $cond->();
+      }
+      else {
+        my $tc = TryCatch->get_tc($cond);
+        next CATCH unless $tc->check($err);
+      }
+
+    }
+
+    $self->_run_block($sub);
+  }
+
+  return;
 }
 
-package TryCatch::Exception::Handled;
+sub catch {
+  my ($self, @conds) = @_;
+  push @{$self->catches}, [@conds];
+  return $self;
+
+}
 
-sub catch {}
+__PACKAGE__->meta->make_immutable;
 
 1;

t/nested.t

@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+BEGIN { use_ok "TryCatch" or BAIL_OUT("Cannot load TryCatch") };
+
+sub nested_1 {
+  try {
+    try {
+      return "from nested_1";
+    }
+    catch ($e) {
+    }
+  }
+}
+
+is( nested_1(), "from nested_1", "nested return");