[Moose-commits] r7780 - in MooseX-Types/trunk: . lib/MooseX
lib/MooseX/Types t t/lib
phaylon at code2.0beta.co.uk
phaylon at code2.0beta.co.uk
Sun Feb 22 19:11:26 GMT 2009
Author: phaylon
Date: 2009-02-22 11:11:26 -0800 (Sun, 22 Feb 2009)
New Revision: 7780
Added:
MooseX-Types/trunk/t/16_introspection.t
MooseX-Types/trunk/t/lib/IntrospectTypeExports.pm
Modified:
MooseX-Types/trunk/Changes
MooseX-Types/trunk/lib/MooseX/Types.pm
MooseX-Types/trunk/lib/MooseX/Types/Base.pm
MooseX-Types/trunk/lib/MooseX/Types/Util.pm
Log:
added has_available_type_export introspection utility function
Modified: MooseX-Types/trunk/Changes
===================================================================
--- MooseX-Types/trunk/Changes 2009-02-22 16:28:58 UTC (rev 7779)
+++ MooseX-Types/trunk/Changes 2009-02-22 19:11:26 UTC (rev 7780)
@@ -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.
Modified: MooseX-Types/trunk/lib/MooseX/Types/Base.pm
===================================================================
--- MooseX-Types/trunk/lib/MooseX/Types/Base.pm 2009-02-22 16:28:58 UTC (rev 7779)
+++ MooseX-Types/trunk/lib/MooseX/Types/Base.pm 2009-02-22 19:11:26 UTC (rev 7780)
@@ -67,7 +67,10 @@
# 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} },
Modified: MooseX-Types/trunk/lib/MooseX/Types/Util.pm
===================================================================
--- MooseX-Types/trunk/lib/MooseX/Types/Util.pm 2009-02-22 16:28:58 UTC (rev 7779)
+++ MooseX-Types/trunk/lib/MooseX/Types/Util.pm 2009-02-22 19:11:26 UTC (rev 7780)
@@ -18,7 +18,7 @@
=cut
-our @EXPORT_OK = qw( filter_tags );
+our @EXPORT_OK = qw( filter_tags has_available_type_export );
=head1 FUNCTIONS
@@ -43,6 +43,56 @@
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>
Modified: MooseX-Types/trunk/lib/MooseX/Types.pm
===================================================================
--- MooseX-Types/trunk/lib/MooseX/Types.pm 2009-02-22 16:28:58 UTC (rev 7779)
+++ MooseX-Types/trunk/lib/MooseX/Types.pm 2009-02-22 19:11:26 UTC (rev 7780)
@@ -20,7 +20,7 @@
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
Added: MooseX-Types/trunk/t/16_introspection.t
===================================================================
--- MooseX-Types/trunk/t/16_introspection.t (rev 0)
+++ MooseX-Types/trunk/t/16_introspection.t 2009-02-22 19:11:26 UTC (rev 7780)
@@ -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');
+
Added: MooseX-Types/trunk/t/lib/IntrospectTypeExports.pm
===================================================================
--- MooseX-Types/trunk/t/lib/IntrospectTypeExports.pm (rev 0)
+++ MooseX-Types/trunk/t/lib/IntrospectTypeExports.pm 2009-02-22 19:11:26 UTC (rev 7780)
@@ -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;
More information about the Moose-commits
mailing list