From: phaylon Date: Tue, 19 Feb 2008 16:48:36 +0000 (+0000) Subject: switched to Sub::Exporter X-Git-Tag: 0.06~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types.git;a=commitdiff_plain;h=16ddefbf6d5e6918471483ebaad42b52fd560cea switched to Sub::Exporter --- diff --git a/Changes b/Changes index db1b8b5..a2b51c1 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,8 @@ 0.05 ... - - ... + - moved export mechanism to Sub::Exporter. ::Base contains + a bunch of wrapping logic to allow the export-along functionality + for the helper symbols - removed vestigial load of Sub::UpLevel since it breaks the argument display in confess() diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm index c93591f..f97ff02 100644 --- a/lib/MooseX/Types.pm +++ b/lib/MooseX/Types.pm @@ -1,4 +1,5 @@ package MooseX::Types; +use Moose; =head1 NAME @@ -13,9 +14,7 @@ use Moose::Util::TypeConstraints; 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 )]; @@ -162,6 +161,12 @@ you want all of them, use the C<:all> tag. For example: MooseX::Types comes with a library of Moose' built-in types called L. +The exporting mechanism is, since version 0.5, implemented via a wrapper +around L. 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 @@ -266,19 +271,19 @@ sub import { # 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 @@ -351,7 +356,10 @@ a type's actual full name. =head1 SEE ALSO -L, L, L +L, +L, +L, +L =head1 AUTHOR AND COPYRIGHT diff --git a/lib/MooseX/Types/Base.pm b/lib/MooseX/Types/Base.pm index f5d32b7..15ba3e4 100644 --- a/lib/MooseX/Types/Base.pm +++ b/lib/MooseX/Types/Base.pm @@ -1,4 +1,5 @@ package MooseX::Types::Base; +use Moose; =head1 NAME @@ -6,14 +7,11 @@ MooseX::Types::Base - Type library base class =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 )]; @@ -41,74 +39,77 @@ L for syntax details on this. 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 diff --git a/lib/MooseX/Types/Wrapper.pm b/lib/MooseX/Types/Wrapper.pm index 86d0373..a5955e8 100644 --- a/lib/MooseX/Types/Wrapper.pm +++ b/lib/MooseX/Types/Wrapper.pm @@ -7,7 +7,7 @@ MooseX::Types::Wrapper - Wrap exports from a library package MooseX::Types::Wrapper; use Moose; -use Carp qw( croak ); +use Carp::Clan qw( ^MooseX::Types ); use Class::MOP; use namespace::clean -except => [qw( meta )]; @@ -37,10 +37,10 @@ sub import { = ($l eq 'Moose' ? 'MooseX::Types::Moose' : $l ); Class::MOP::load_class($library_class); - $library_class->import( @{ $libraries{ $l } }, { + $library_class->import({ -into => scalar(caller), -wrapper => $class, - }); + }, @{ $libraries{ $l } }); } return 1; } diff --git a/t/10_moose-types.t b/t/10_moose-types.t index 9ba7721..fd5508b 100644 --- a/t/10_moose-types.t +++ b/t/10_moose-types.t @@ -5,7 +5,7 @@ use strict; use Test::More; use FindBin; use lib "$FindBin::Bin/lib"; -use MooseX::Types::Moose ':all'; +use MooseX::Types::Moose ':all', 'Bool'; my @types = MooseX::Types::Moose->type_names; @@ -13,7 +13,12 @@ plan tests => @types * 3; for my $t (@types) { ok my $code = __PACKAGE__->can($t), "$t() was exported"; - is $code->(), $t, "$t() returns '$t'"; + if ($code) { + is $code->(), $t, "$t() returns '$t'"; + } + else { + diag "Skipping $t() call test"; + } ok __PACKAGE__->can("is_$t"), "is_$t() was exported"; } diff --git a/t/11_library-definition.t b/t/11_library-definition.t index 59d77b5..5aec836 100644 --- a/t/11_library-definition.t +++ b/t/11_library-definition.t @@ -5,14 +5,15 @@ use strict; 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) { @@ -41,6 +42,10 @@ 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"; diff --git a/t/lib/TestLibrary.pm b/t/lib/TestLibrary.pm index 2eb20dd..1799e03 100644 --- a/t/lib/TestLibrary.pm +++ b/t/lib/TestLibrary.pm @@ -4,7 +4,7 @@ use strict; use MooseX::Types::Moose qw( Str ArrayRef Int ); use MooseX::Types - -declare => [qw( NonEmptyStr IntArrayRef TwentyThree )]; + -declare => [qw( NonEmptyStr IntArrayRef TwentyThree Foo2Alias )]; subtype NonEmptyStr, as Str, @@ -29,4 +29,8 @@ subtype TwentyThree, where { $_ == 23 }, message { 'Int is not 23' }; +subtype Foo2Alias, + as Str, + where { 1 }; + 1;