From 818958abaf7ad4f86101f88e74caf688b23be9a3 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Wed, 10 Jul 2013 14:17:52 -0400 Subject: initial (non-working) implementation --- Lexical.xs | 26 ++++++++++++++++++++++++++ dist.ini | 2 ++ lib/Exporter/Lexical.pm | 40 ++++++++++++++++++++++++++++++++++++++++ t/basic.t | 17 +++++++++++++++++ t/exporter.t | 16 ++++++++++++++++ t/lib/Foo.pm | 11 +++++++++++ 6 files changed, 112 insertions(+) create mode 100644 Lexical.xs create mode 100644 t/basic.t create mode 100644 t/exporter.t create mode 100644 t/lib/Foo.pm 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; -- cgit v1.2.3-54-g00ecf