initial (non-working) implementation

6 files changed, 112 insertions, 0 deletions

diff --git a/Lexical.xs b/Lexical.xs
new file mode 100644
index 0000000..1ae3923
--- /dev/null
+++ b/Lexical.xs
@@ -0,0 +1,26 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+MODULE = Exporter::Lexical  PACKAGE = Exporter::Lexical
+
+PROTOTYPES: DISABLE
+
+void
+lexical_import(SV *name, CV *cv)
+  CODE:
+    PADLIST *pl;
+    PADOFFSET off;
+    if (!PL_compcv)
+        Perl_croak(aTHX_
+                "lexical_import can only be called at compile time");
+    pl = CvPADLIST(PL_compcv);
+    ENTER;
+    SAVESPTR(PL_comppad_name); PL_comppad_name = PadlistNAMES(pl);
+    SAVESPTR(PL_comppad);      PL_comppad      = PadlistARRAY(pl)[1];
+    SAVESPTR(PL_curpad);       PL_curpad       = PadARRAY(PL_comppad);
+    off = pad_add_name_sv(sv_2mortal(newSVpvf("&%"SVf,name)),
+                        padadd_STATE, 0, 0);
+    SvREFCNT_dec(PL_curpad[off]);
+    PL_curpad[off] = SvREFCNT_inc(cv);
+    LEAVE;
diff --git a/dist.ini b/dist.ini
index f3e2e7a..32ae86f 100644
--- a/dist.ini
+++ b/dist.ini
@@ -11,3 +11,5 @@ bugtracker_web = https://github.com/doy/exporter-lexical/issues
 bugtracker_mailto =
 
 [AutoPrereqs]
+
+[ContributorsFromGit]
diff --git a/lib/Exporter/Lexical.pm b/lib/Exporter/Lexical.pm
index e69de29..d7f0ee3 100644
--- a/lib/Exporter/Lexical.pm
+++ b/lib/Exporter/Lexical.pm
@@ -0,0 +1,40 @@
+package Exporter::Lexical;
+use strict;
+use warnings;
+# ABSTRACT: exporter for lexical subs
+
+use XSLoader;
+XSLoader::load(
+    __PACKAGE__,
+    # we need to be careful not to touch $VERSION at compile time, otherwise
+    # DynaLoader will assume it's set and check against it, which will cause
+    # fail when being run in the checkout without dzil having set the actual
+    # $VERSION
+    exists $Exporter::Lexical::{VERSION}
+        ? ${ $Exporter::Lexical::{VERSION} } : (),
+);
+
+sub import {
+    my $package = shift;
+    my $caller = caller;
+
+    my $import = sub {
+        my $caller_stash = do {
+            no strict 'refs';
+            \%{ $caller . '::' };
+        };
+        my @exports = @{ $caller_stash->{EXPORT} };
+        my %exports = map { $_ => \&{ $caller_stash->{$_} } } @exports;
+
+        for my $export (keys %exports) {
+            lexical_import($export, $exports{$export});
+        }
+    };
+
+    {
+        no strict 'refs';
+        *{ $caller . '::import' } = $import;
+    }
+}
+
+1;
diff --git a/t/basic.t b/t/basic.t
new file mode 100644
index 0000000..f7321e9
--- /dev/null
+++ b/t/basic.t
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Exporter::Lexical ();
+
+sub foo { 'foo' }
+
+is(foo(), "foo");
+{
+    BEGIN { Exporter::Lexical::lexical_import(foo => sub { "FOO" }) }
+    is(foo(), "FOO");
+}
+is(foo(), "foo");
+
+done_testing;
diff --git a/t/exporter.t b/t/exporter.t
new file mode 100644
index 0000000..da39d6a
--- /dev/null
+++ b/t/exporter.t
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+
+sub foo { 'foo' }
+
+is(foo(), "foo");
+{
+    use Foo;
+    is(foo(), "FOO");
+}
+is(foo(), "foo");
+
+done_testing;
diff --git a/t/lib/Foo.pm b/t/lib/Foo.pm
new file mode 100644
index 0000000..14521ad
--- /dev/null
+++ b/t/lib/Foo.pm
@@ -0,0 +1,11 @@
+package Foo;
+use strict;
+use warnings;
+
+use Exporter::Lexical;
+
+our @EXPORT = ('foo');
+
+sub foo { "FOO" }
+
+1;