From f7096a53acc214ed1e8e32fcf3fc111a400eeeeb Mon Sep 17 00:00:00 2001
From: Ash Berlin <ash_github@firemirror.com>
Date: Thu, 29 Jan 2009 09:14:46 +0000
Subject: [PATCH] Refactor the way we run the coderefs with an eye towards
 finally

---
 Makefile.PL               |   1 +
 TryCatch.xs               |  18 +++++--
 lib/TryCatch.pm           |  21 ++------
 lib/TryCatch/Exception.pm | 105 ++++++++++++++++++++++++++------------
 t/nested.t                |  17 ++++++
 5 files changed, 107 insertions(+), 55 deletions(-)
 create mode 100644 t/nested.t

diff --git a/Makefile.PL b/Makefile.PL
index 43062b0..59e24d3 100644
--- a/Makefile.PL
+++ b/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';
diff --git a/TryCatch.xs b/TryCatch.xs
index 08e6242..f1b859f 100644
--- a/TryCatch.xs
+++ b/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);
diff --git a/lib/TryCatch.pm b/lib/TryCatch.pm
index 8b9eb46..82b192c 100644
--- a/lib/TryCatch.pm
+++ b/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);
   }
 }
diff --git a/lib/TryCatch/Exception.pm b/lib/TryCatch/Exception.pm
index caa59f7..0b0dee9 100644
--- a/lib/TryCatch/Exception.pm
+++ b/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;
diff --git a/t/nested.t b/t/nested.t
new file mode 100644
index 0000000..9bc8207
--- /dev/null
+++ b/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");