package MooseX::Types;
+use Moose;
=head1 NAME
use MooseX::Types::Base ();
use MooseX::Types::Util qw( filter_tags );
use MooseX::Types::UndefinedType;
-use Sub::Install qw( install_sub );
-use Carp qw( croak );
-use Moose;
+use Carp::Clan qw( ^MooseX::Types );
use namespace::clean -except => [qw( meta )];
MooseX::Types comes with a library of Moose' built-in types called
L<MooseX::Types::Moose>.
+The exporting mechanism is, since version 0.5, implemented via a wrapper
+around L<Sub::Exporter>. This means you can do something like this:
+
+ use MyLibrary TypeA => { -as => 'MyTypeA' },
+ TypeB => { -as => 'MyTypeB' };
+
=head1 WRAPPING A LIBRARY
You can define your own wrapper subclasses to manipulate the behaviour
# generate predeclared type helpers
if (my @orig_declare = @{ $args{ -declare } || [] }) {
my ($tags, $declare) = filter_tags @orig_declare;
+ my @to_export;
for my $type (@$declare) {
croak "Cannot create a type containing '::' ($type) at the moment"
if $type =~ /::/;
+ # add type to library and remember to export
$callee->add_type($type);
- $callee->export_type_into(
- $callee, $type,
- sprintf($UndefMsg, $type, $callee),
- -full => 1,
- );
+ push @to_export, $type;
}
+
+ $callee->import({ -full => 1, -into => $callee }, @to_export);
}
# run type constraints import
=head1 SEE ALSO
-L<Moose>, L<Moose::Util::TypeConstraints>, L<MooseX::Types::Moose>
+L<Moose>,
+L<Moose::Util::TypeConstraints>,
+L<MooseX::Types::Moose>,
+L<Sub::Exporter>
=head1 AUTHOR AND COPYRIGHT
package MooseX::Types::Base;
+use Moose;
=head1 NAME
=cut
-#use warnings;
-#use strict;
-
-use Sub::Install qw( install_sub );
+#use Data::Dump qw( dump );
use Carp::Clan qw( ^MooseX::Types );
use MooseX::Types::Util qw( filter_tags );
+use Sub::Exporter qw( build_exporter );
use Moose::Util::TypeConstraints;
-use Moose;
use namespace::clean -except => [qw( meta )];
sub import {
my ($class, @args) = @_;
- # separate tags from types and possible options
- my ($options) = grep { ref $_ eq 'HASH' } @args;
- my ($tags, $types)
- = filter_tags
- grep { ref $_ ne 'HASH' }
- @args;
- my $callee = ($options && $options->{ -into } || scalar(caller));
+ # filter or create options hash for S:E
+ my $options = (@args and (ref($args[0]) eq 'HASH')) ? $args[0] : undef;
+ unless ($options) {
+ $options = {foo => 23};
+ unshift @args, $options;
+ }
- # :all replaces types with full list
- @$types = $class->type_names if $tags->{all};
+ # all types known to us
+ my @types = $class->type_names;
+ # determine the wrapper, -into is supported for compatibility reasons
+ my $wrapper = $options->{ -wrapper } || 'MooseX::Types';
+ $args[0]->{into} = $options->{ -into }
+ if exists $options->{ -into };
+
+ my (%ex_spec, %ex_util);
TYPE:
- # export all requested types
- for my $type (@$types) {
- $class->export_type_into(
- $callee,
- $type,
- sprintf($UndefMsg, $type, $class),
- ($options ? %$options : ()),
- );
+ for my $type_short (@types) {
+
+ # find type name and object, create undefined message
+ my $type_full = $class->get_type($type_short)
+ or croak "No fully qualified type name stored for '$type_short'";
+ my $type_cons = find_type_constraint($type_full);
+ my $undef_msg = sprintf($UndefMsg, $type_short, $class);
+
+ # the type itself
+ push @{ $ex_spec{exports} },
+ $type_short,
+ sub { $wrapper->type_export_generator($type_short, $type_full) };
+
+ # the check helper
+ push @{ $ex_spec{exports} },
+ "is_${type_short}",
+ sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) };
+
+ # only export coercion helper if full (for libraries) or coercion is defined
+ next TYPE
+ unless $options->{ -full }
+ or ($type_cons and $type_cons->has_coercion);
+ push @{ $ex_spec{exports} },
+ "to_${type_short}",
+ sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) };
+ $ex_util{ $type_short }{to}++; # shortcut to remember this exists
}
- return 1;
-}
-
-=head2 export_type_into
-Exports one specific type into a target package.
+ # create S:E exporter and increase export level unless specified explicitly
+ my $exporter = build_exporter \%ex_spec;
+ $options->{into_level}++
+ unless $options->{into};
-=cut
+ # remember requested symbols to determine what helpers to auto-export
+ my %was_requested =
+ map { ($_ => 1) }
+ grep { not ref }
+ @args;
-sub export_type_into {
- my ($class, $target, $type, $undef_msg, %args) = @_;
-
- # the real type name and its type object
- my $full = $class->get_type($type)
- or croak "No fully qualified type name stored for '$type'";
- my $tobj = find_type_constraint($full);
-
- # a possible wrapper around library functionality
- my $wrap = $args{ -wrapper } || 'MooseX::Types';
-
- # install Type name constant
- install_sub({
- code => $wrap->type_export_generator($type, $full),
- into => $target,
- as => $type,
- });
-
- # install is_Type test function
- install_sub({
- code => $wrap->check_export_generator($type, $full, $undef_msg),
- into => $target,
- as => "is_$type",
- });
-
- # only install to_Type coercion handler if type can coerce
- # or if we want to provide them anyway, e.g. declarations
- if ($args{ -full } or $tobj and $tobj->has_coercion) {
-
- # install to_Type coercion handler
- install_sub({
- code => $wrap->coercion_export_generator($type, $full, $undef_msg),
- into => $target,
- as => "to_$type",
- });
+ # determine which additional symbols (helpers) to export along
+ my %add;
+ EXPORT:
+ for my $type (grep { exists $was_requested{ $_ } } @types) {
+ $add{ "is_$type" }++
+ unless $was_requested{ "is_$type" };
+ next EXPORT
+ unless exists $ex_util{ $type }{to};
+ $add{ "to_$type" }++
+ unless $was_requested{ "to_$type" };
}
- return 1;
+ # and on to the real exporter
+ my @new_args = (@args, keys %add);
+ return $class->$exporter(@new_args);
}
=head2 get_type
use Test::More;
use FindBin;
use lib "$FindBin::Bin/lib";
-use TestLibrary ':all';
+use TestLibrary qw( NonEmptyStr IntArrayRef ),
+ Foo2Alias => { -as => 'Foo' };
my @tests = (
[ 'NonEmptyStr', 12, "12", [], "foobar", "" ],
[ 'IntArrayRef', 12, [12], {}, [17, 23], {} ],
);
-plan tests => (@tests * 8) + 3;
+plan tests => (@tests * 8) + 5;
# new array ref so we can safely shift from it
for my $data (map { [@$_] } @tests) {
}
}
+# aliasing test
+ok my $code = __PACKAGE__->can('Foo'), 'aliased type exported under correct symbol';
+is $code->(), 'TestLibrary::Foo2Alias', 'aliased type returns unaliased type name';
+
# coercion not available
ok ! __PACKAGE__->can('to_TwentyThree'), "type without coercion doesn't have to_* helper";
projects / gitmo/MooseX-Types.git / commitdiff