summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-06-23 17:08:54 -0500
committerJesse Luehrs <doy@tozt.net>2012-06-23 17:08:54 -0500
commitefb4439ddf61def3dda4edd4af4b9c237e88d20f (patch)
treeccc1ff46077201b99ea94dda45cd20ac885fe514
parent28a8bed6e1effb76068f9d83d912669a20269bcd (diff)
downloadsmartmatch-efb4439ddf61def3dda4edd4af4b9c237e88d20f.tar.gz
smartmatch-efb4439ddf61def3dda4edd4af4b9c237e88d20f.zip
use real function calls instead of anon subs
-rw-r--r--lib/smartmatch.pm24
-rw-r--r--smartmatch.xs32
2 files changed, 37 insertions, 19 deletions
diff --git a/lib/smartmatch.pm b/lib/smartmatch.pm
index fb6e038..0524799 100644
--- a/lib/smartmatch.pm
+++ b/lib/smartmatch.pm
@@ -6,6 +6,8 @@ use 5.010;
use parent 'DynaLoader';
use B::Hooks::OP::Check;
+use Module::Runtime 'use_package_optimistically';
+use Package::Stash;
sub dl_load_flags { 0x01 }
@@ -51,18 +53,28 @@ the core perl smart matching behavior.
=cut
+my $anon = 1;
+
sub import {
my $package = shift;
my ($cb) = @_;
- if (!ref($cb)) {
- my $engine = "smartmatch::engine::$cb";
- eval "require $engine; 1"
- or die "Couldn't load smartmatch engine $engine: $@";
- $cb = $engine->can('match') unless ref($cb);
+ my $engine;
+
+ if (ref($cb)) {
+ $engine = 'smartmatch::engine::__ANON__::' . $anon;
+ my $anon_stash = Package::Stash->new($engine);
+ $anon_stash->add_symbol('&match' => $cb);
+ $anon++;
+ }
+ else {
+ $engine = "smartmatch::engine::$cb";
+ use_package_optimistically($engine);
+ die "$engine does not implement a 'match' function"
+ unless $engine->can('match');
}
- register($cb);
+ register($engine);
}
sub unimport {
diff --git a/smartmatch.xs b/smartmatch.xs
index 5fa0280..49a13a8 100644
--- a/smartmatch.xs
+++ b/smartmatch.xs
@@ -38,10 +38,11 @@ STATIC OP*
smartmatch_cb(pTHX_ OP *o, void *user_data)
{
OP *left, *right, *cb_op, *list, *new;
- SV **cb;
+ SV **engine;
+ SV *cb_name;
- cb = hv_fetchs(GvHV(PL_hintgv), "smartmatch_cb", 0);
- if (!cb) {
+ engine = hv_fetchs(GvHV(PL_hintgv), "smartmatch_engine", 0);
+ if (!engine) {
return o;
}
@@ -91,11 +92,16 @@ smartmatch_cb(pTHX_ OP *o, void *user_data)
}
#endif
- cb_op = newCVREF(0, newSVOP(OP_CONST, 0, newSVsv(*cb)));
+ cb_name = newSVsv(*engine);
+ sv_catpv(cb_name, "::match");
+
+ cb_op = newUNOP(OP_RV2CV, 0, newGVOP(OP_GV, 0, gv_fetchsv(cb_name, 0, SVt_PVCV)));
list = newLISTOP(OP_LIST, 0, left, right);
new = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, list, cb_op));
+ SvREFCNT_dec(cb_name);
+
return new;
}
@@ -113,20 +119,20 @@ BOOT:
hook_op_check_smartmatch();
void
-register (cb)
- SV *cb;
+register (engine)
+ SV *engine;
CODE:
- if (!SvROK(cb) || SvTYPE(SvRV(cb)) != SVt_PVCV) {
- croak("not a coderef");
+ if (SvROK(engine)) {
+ croak("not an engine name");
}
PL_hints |= HINT_LOCALIZE_HH;
gv_HVadd(PL_hintgv);
- SvREFCNT_inc(cb);
- if (!hv_stores(GvHV(PL_hintgv), "smartmatch_cb", cb)) {
- SvREFCNT_dec(cb);
- croak("couldn't store the callback");
+ SvREFCNT_inc(engine);
+ if (!hv_stores(GvHV(PL_hintgv), "smartmatch_engine", engine)) {
+ SvREFCNT_dec(engine);
+ croak("couldn't store the engine");
}
void
@@ -135,4 +141,4 @@ unregister ()
PL_hints |= HINT_LOCALIZE_HH;
gv_HVadd(PL_hintgv);
- hv_delete(GvHV(PL_hintgv), "smartmatch_cb", 13, G_DISCARD);
+ hv_delete(GvHV(PL_hintgv), "smartmatch_engine", 17, G_DISCARD);