From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 24 Jan 2011 13:47:29 +0000 (+0000)
Subject: initial sketch
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Fmaster;p=p5sagit%2FSub-ScalarLike.git

initial sketch
---

d8316caf2ff271054636aad018ce318b775fb820
diff --git a/lib/Sub/ScalarLike.pm b/lib/Sub/ScalarLike.pm
new file mode 100644
index 0000000..4190400
--- /dev/null
+++ b/lib/Sub/ScalarLike.pm
@@ -0,0 +1,46 @@
+package Sub::ScalarLike;
+
+use strict;
+use warnings FATAL => 'all';
+use Variable::Magic qw(wizard cast dispell);
+
+my $wiz = wizard
+  data => sub { +{ guard => 0, pkg => $_[1] } },
+  fetch => sub {
+    my ($var, $data, $name) = @_;
+
+    return if $data->{guard};
+    local $data->{guard} = 1;
+
+    my $pkg = $data->{pkg};
+
+    return if $pkg->can($name);
+
+    return if $name =~ /^__/; # __PACKAGE__ et. al.
+
+    my $fqn = join '::', $pkg, $name;
+
+    my $sub = sub () :lvalue { $pkg->_SCOPE->{$name} };
+
+    { no strict 'refs'; *$fqn = $sub }
+
+    return
+  };
+
+sub setup_for {
+  my ($pkg) = @_;
+  {
+   no strict 'refs';
+   cast %{"${pkg}::"}, $wiz, $pkg;
+  }
+}
+
+sub teardown_for {
+  my ($pkg) = @_;
+  {
+   no strict 'refs';
+   dispell %{"${pkg}::"}, $wiz;
+  }
+}
+
+1;
diff --git a/t/simple.t b/t/simple.t
new file mode 100644
index 0000000..cd99ea1
--- /dev/null
+++ b/t/simple.t
@@ -0,0 +1,29 @@
+use strict;
+use warnings FATAL => 'all';
+use Sub::ScalarLike ();
+use Test::More;
+
+BEGIN {
+  package Spoon;
+
+  my %scope; sub _SCOPE { \%scope }
+
+  BEGIN { Sub::ScalarLike::setup_for(__PACKAGE__) }
+
+  sub froom {
+    foo = bar + baz;
+  }
+
+  BEGIN { Sub::ScalarLike::teardown_for(__PACKAGE__) }
+}
+
+ok(Spoon->can($_), "sub for $_ created") for qw(foo bar baz);
+
+Spoon->_SCOPE->{bar} = 1;
+Spoon->_SCOPE->{baz} = 2;
+
+Spoon::froom();
+
+cmp_ok(Spoon->_SCOPE->{foo}, '==', 3, 'bareword assign also works');
+
+done_testing;