From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 6 Nov 2011 23:28:15 +0000 (-0500)
Subject: Start with a copy of B::H::EOS 0.09
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=58b07c77d78b311fdb5123061055a68f957358f5;p=p5sagit%2FB-Hooks-EndOfScope-WithFallback.git

Start with a copy of B::H::EOS 0.09
---

58b07c77d78b311fdb5123061055a68f957358f5
diff --git a/lib/B/Hooks/EndOfScope.pm b/lib/B/Hooks/EndOfScope.pm
new file mode 100644
index 0000000..bfab9f0
--- /dev/null
+++ b/lib/B/Hooks/EndOfScope.pm
@@ -0,0 +1,65 @@
+use strict;
+use warnings;
+
+package B::Hooks::EndOfScope;
+# ABSTRACT: Execute code after a scope finished compilation
+
+use 5.008000;
+use Variable::Magic 0.34;
+
+use Sub::Exporter -setup => {
+    exports => ['on_scope_end'],
+    groups  => { default => ['on_scope_end'] },
+};
+
+
+=head1 SYNOPSIS
+
+    on_scope_end { ... };
+
+=head1 DESCRIPTION
+
+This module allows you to execute code when perl finished compiling the
+surrounding scope.
+
+=func on_scope_end
+
+    on_scope_end { ... };
+
+    on_scope_end $code;
+
+Registers C<$code> to be executed after the surrounding scope has been
+compiled.
+
+This is exported by default. See L<Sub::Exporter> on how to customize it.
+
+=cut
+
+{
+    my $wiz = Variable::Magic::wizard
+        data => sub { [$_[1]] },
+        free => sub { $_->() for @{ $_[1] }; () };
+
+    sub on_scope_end (&) {
+        my $cb = shift;
+
+        $^H |= 0x020000;
+
+        if (my $stack = Variable::Magic::getdata %^H, $wiz) {
+            push @{ $stack }, $cb;
+        }
+        else {
+            Variable::Magic::cast %^H, $wiz, $cb;
+        }
+    }
+}
+
+=head1 SEE ALSO
+
+L<Sub::Exporter>
+
+L<Variable::Magic>
+
+=cut
+
+1;
diff --git a/t/basic.t b/t/basic.t
new file mode 100644
index 0000000..f0b4c4e
--- /dev/null
+++ b/t/basic.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+BEGIN { use_ok('B::Hooks::EndOfScope') }
+
+BEGIN {
+    ok(exists &on_scope_end, 'on_scope_end imported');
+    is(prototype('on_scope_end'), '&', '.. and has the right prototype');
+}
+
+our ($i, $called);
+
+BEGIN { $i = 0 }
+
+sub foo {
+    BEGIN {
+        on_scope_end { $called = 1; $i = 42 };
+        on_scope_end { $i = 1 };
+    };
+
+    is($i, 1, 'value still set at runtime');
+}
+
+BEGIN {
+    ok($called, 'first callback invoked');
+    is($i, 1, '.. but the second is invoked later')
+}
+
+foo();
diff --git a/t/eval.t b/t/eval.t
new file mode 100644
index 0000000..7619149
--- /dev/null
+++ b/t/eval.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use B::Hooks::EndOfScope;
+
+our $called;
+
+sub foo {
+    BEGIN { on_scope_end { $called = 1 } }
+
+    # uncomment this to make the test pass
+    eval '42';
+}
+
+BEGIN {
+    ok($called, 'callback invoked');
+}
diff --git a/t/exception.t b/t/exception.t
new file mode 100644
index 0000000..87eb676
--- /dev/null
+++ b/t/exception.t
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+use B::Hooks::EndOfScope;
+
+eval q[
+    sub foo {
+        BEGIN {
+            on_scope_end { die 'bar' };
+        }
+    }
+];
+
+like($@, qr/^bar/);
+pass('no segfault');