From c532e4c2fbf7c481ca264232db7d228ec83ebd37 Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>
Date: Wed, 1 Apr 2015 16:13:25 +0100
Subject: [PATCH] fix rt #103247: re-bless installed type subs
---
lib/MooseX/Types/Structured.pm | 33 ++++++++++++++++++++++++++++++++-
t/regressions/02-blessed-type-subs.t | 8 ++++++++
2 files changed, 40 insertions(+), 1 deletion(-)
create mode 100644 t/regressions/02-blessed-type-subs.t
diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index d639aaf..fba1ad8 100644
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -15,12 +15,43 @@ use Scalar::Util qw(blessed);
use namespace::clean 0.08;
use MooseX::Types 0.22 -declare => [qw(Dict Map Tuple Optional)];
use Sub::Exporter 0.982 -setup => {
- installer => method_installer,
+ installer => \&mxtype_installer,
exports => [ qw(Dict Map Tuple Optional slurpy) ],
};
use if MooseX::Types->VERSION >= 0.42,
'namespace::autoclean' => -except => 'import'; # TODO:
https://github.com/rjbs/Sub-Exporter/issues/8
+# MooseX::Types requires that the type subs be blessed into a special
+# package; method_installer wraps the coderefs, so the things we
+# install are not blessed. This installed remembers what was blessed,
+# and re-blesses whatever was installed
+sub mxtype_installer {
+ my ($arg,$to_export) = @_;
+
+ my $scan = sub {
+ for (my $i = 0; $i < @$to_export; $i += 2) {
+ my ($as, $code) = @$to_export[ $i, $i+1 ];
+ next if ref $as;
+ $_[0]->($i,$code);
+ }
+ };
+ my @blesses;
+ $scan->(
+ sub{
+ $blesses[$_[0]] = blessed($_[1]);
+ }
+ );
+
+ method_installer()->($arg,$to_export);
+
+ $scan->(
+ sub{
+ my $class = $blesses[$_[0]] or return;
+ bless $_[1],$class;
+ }
+ );
+}
+
=head1 SYNOPSIS
The following is example usage for this module.
diff --git a/t/regressions/02-blessed-type-subs.t b/t/regressions/02-blessed-type-subs.t
new file mode 100644
index 0000000..370e71d
--- /dev/null
+++ b/t/regressions/02-blessed-type-subs.t
@@ -0,0 +1,8 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests=>1;
+use MooseX::Types::Structured 'Dict';
+use MooseX::Types::Util 'has_available_type_export';
+
+ok(has_available_type_export('main','Dict'),"Dict is recognized");
--
2.0.5
