added has_available_type_export introspection utility function

diff --git a/Changes b/Changes
index 2a70deb..8e11ede 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+0.09    ...
+        - Added MooseX::Types::Util::has_available_type_export($p, $n) to
+          allow introspection of available types for other libraries wanting
+          to use type export names for type specifications.
+
 0.08    Mon Dec  09 19:00:00 EST 2008
         - Added experimental support for recursive type constraints.  Pod and
           tests for this feature.  Let the madness begin.

diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm
index cda0f45..9e1cf94 100644 (file)
--- a/lib/MooseX/Types.pm
+++ b/lib/MooseX/Types.pm
@@ -20,7 +20,7 @@ use Carp::Clan                      qw( ^MooseX::Types );
 use namespace::clean -except => [qw( meta )];
 
 use 5.008;
-our $VERSION = 0.08;
+our $VERSION = 0.09;
 my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'};
 
 =head1 SYNOPSIS

diff --git a/lib/MooseX/Types/Base.pm b/lib/MooseX/Types/Base.pm
index 15ba3e4..3b2b40e 100644 (file)
--- a/lib/MooseX/Types/Base.pm
+++ b/lib/MooseX/Types/Base.pm
@@ -67,7 +67,10 @@ sub import {
         # the type itself
         push @{ $ex_spec{exports} }, 
             $type_short,
-            sub { $wrapper->type_export_generator($type_short, $type_full) };
+            sub { 
+                bless $wrapper->type_export_generator($type_short, $type_full),
+                    'MooseX::Types::EXPORTED_TYPE_CONSTRAINT';
+            };
 
         # the check helper
         push @{ $ex_spec{exports} },

diff --git a/lib/MooseX/Types/Util.pm b/lib/MooseX/Types/Util.pm
index 5bd5bcf..10e3a38 100644 (file)
--- a/lib/MooseX/Types/Util.pm
+++ b/lib/MooseX/Types/Util.pm
@@ -18,7 +18,7 @@ L<MooseX::Types> might need.
 
 =cut
 
-our @EXPORT_OK = qw( filter_tags );
+our @EXPORT_OK = qw( filter_tags has_available_type_export );
 
 =head1 FUNCTIONS
 
@@ -43,6 +43,56 @@ sub filter_tags {
     return \%tags, \@other;
 }
 
+=head2 has_available_type_export
+
+  TypeConstraint | Undef = has_available_type_export($package, $name);
+
+This function allows you to introspect if a given type export is available 
+I<at this point in time>. This means that the C<$package> must have imported
+a typeconstraint with the name C<$name>, and it must be still in its symbol
+table.
+
+Two arguments are expected:
+
+=over 4
+
+=item $package
+
+The name of the package to introspect.
+
+=item $name
+
+The name of the type export to introspect.
+
+=back
+
+B<Note> that the C<$name> is the I<exported> name of the type, not the declared
+one. This means that if you use L<Sub::Exporter>s functionality to rename an import
+like this:
+
+  use MyTypes Str => { -as => 'MyStr' };
+
+you would have to introspect this type like this:
+
+  has_available_type_export $package, 'MyStr';
+
+The return value will be either the type constraint that belongs to the export
+or an undefined value.
+
+=cut
+
+sub has_available_type_export {
+    my ($package, $name) = @_;
+
+    my $sub = $package->can($name)
+        or return undef;
+
+    return undef
+        unless $sub->isa('MooseX::Types::EXPORTED_TYPE_CONSTRAINT');
+
+    return $sub->();
+}
+
 =head1 SEE ALSO
 
 L<MooseX::Types::Moose>, L<Exporter>

diff --git a/t/16_introspection.t b/t/16_introspection.t
new file mode 100644 (file)
index 0000000..688baec
--- /dev/null
+++ b/t/16_introspection.t
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Data::Dump qw( pp );
+use Test::More tests => 1;
+
+do {
+    package IntrospectionTest;
+    use IntrospectTypeExports   __PACKAGE__, qw( TwentyThree NonEmptyStr MyNonEmptyStr );
+    use TestLibrary             qw( TwentyThree );
+    use IntrospectTypeExports   __PACKAGE__, qw( TwentyThree NonEmptyStr MyNonEmptyStr );
+    use TestLibrary             NonEmptyStr => { -as => 'MyNonEmptyStr' };
+    use IntrospectTypeExports   __PACKAGE__, qw( TwentyThree NonEmptyStr MyNonEmptyStr );
+    BEGIN { 
+        no strict 'refs'; 
+        delete ${'IntrospectionTest::'}{TwentyThree};
+    }
+};
+
+use IntrospectTypeExports IntrospectionTest => qw( TwentyThree NonEmptyStr MyNonEmptyStr );
+
+my $P = 'IntrospectionTest';
+
+is_deeply(IntrospectTypeExports->get_memory, [
+
+    [$P, TwentyThree    => undef],
+    [$P, NonEmptyStr    => undef],
+    [$P, MyNonEmptyStr  => undef],
+
+    [$P, TwentyThree    => 'TestLibrary::TwentyThree'],
+    [$P, NonEmptyStr    => undef],
+    [$P, MyNonEmptyStr  => undef],
+
+    [$P, TwentyThree    => 'TestLibrary::TwentyThree'],
+    [$P, NonEmptyStr    => undef],
+    [$P, MyNonEmptyStr  => 'TestLibrary::NonEmptyStr'],
+
+    [$P, TwentyThree    => undef],
+    [$P, NonEmptyStr    => undef],
+    [$P, MyNonEmptyStr  => 'TestLibrary::NonEmptyStr'],
+
+], 'all calls to has_available_type_export returned correct results');
+

diff --git a/t/lib/IntrospectTypeExports.pm b/t/lib/IntrospectTypeExports.pm
new file mode 100644 (file)
index 0000000..2f37ced
--- /dev/null
+++ b/t/lib/IntrospectTypeExports.pm
@@ -0,0 +1,20 @@
+package IntrospectTypeExports;
+use strict;
+use warnings;
+
+use MooseX::Types::Util qw( has_available_type_export );
+
+my @Memory;
+
+sub import {
+    my ($class, $package, @types) = @_;
+
+    for my $type (@types) {
+        my $tc     = has_available_type_export($package, $type);
+        push @Memory, [$package, $type, $tc ? $tc->name : undef];
+    }
+}
+
+sub get_memory { \@Memory }
+
+1;