--- /dev/null
+=head1 NAME
+
+MooseX::Types::CheckedUtilExports - Wrap L<Moose::Util::TypeConstraints> to be
+safer for L<MooseX::Types>
+
+=cut
+
+package MooseX::Types::CheckedUtilExports;
+
+use strict;
+use warnings;
+use Moose::Util::TypeConstraints ();
+use Moose::Exporter;
+use Sub::Name;
+use Carp;
+
+use namespace::clean -except => 'meta';
+
+my $StringFoundMsg =
+q{WARNING: String found where Type expected (did you use a => instead of a , ?)};
+
+my @exports = qw/type subtype maybe_type duck_type enum coerce from as/;
+
+=head1 DESCRIPTION
+
+Prevents errors like:
+
+ subtype Foo =>
+ ...
+
+Which should be written as:
+
+ subtype Foo,
+ ...
+
+When using L<MooseX::Types>. Exported by that module.
+
+Exports checked versions of the following subs:
+
+C<type> C<subtype> C<maybe_type> C<duck_type> C<enum> C<coerce> C<from> C<as>
+
+While C<class_type> and C<role_type> will also register the type in the library.
+
+From L<Moose::Util::TypeConstraints>. See that module for syntax.
+
+=cut
+
+Moose::Exporter->setup_import_methods(
+ with_caller => [ @exports, 'class_type', 'role_type' ]
+);
+
+for my $export (@exports) {
+ no strict 'refs';
+
+ *{$export} = sub {
+ my $caller = shift;
+
+ local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+
+ carp $StringFoundMsg
+ unless ref($_[0]) ||
+ $_[0] =~ /\b::\b/ || # qualified type
+ $caller->get_registered_class_type($_[0]) ||
+ $caller->get_registered_role_type($_[0]);
+
+ goto &{"Moose::Util::TypeConstraints::$export"};
+ }
+}
+
+sub class_type {
+ my $caller = shift;
+
+ $caller->register_class_type(
+ Moose::Util::TypeConstraints::class_type(@_)
+ );
+}
+
+sub role_type ($;$) {
+ my ($caller, $name, $opts) = @_;
+
+ $caller->register_role_type(
+ Moose::Util::TypeConstraints::role_type($name, $opts)
+ );
+}
+
+=head1 SEE ALSO
+
+L<MooseX::Types>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
+1;
--- /dev/null
+=head1 NAME
+
+MooseX::Types::Combine - Combine type libraries for exporting
+
+=cut
+
+package MooseX::Types::Combine;
+
+use strict;
+use warnings;
+use Class::MOP ();
+
+=head1 SYNOPSIS
+
+ package CombinedTypeLib;
+
+ use base 'MooseX::Types::Combined';
+
+ __PACKAGE__->provide_types_from(qw/TypeLib1 TypeLib2/);
+
+ package UserClass;
+
+ use CombinedTypeLib qw/Type1 Type2 ... /;
+
+=head1 DESCRIPTION
+
+Allows you to export types from multiple type libraries.
+
+Libraries on the right side of the type libs passed to L</provide_types_from>
+take precedence over those on the left in case of conflicts.
+
+=cut
+
+sub import {
+ my ($class, @types) = @_;
+ my $caller = caller;
+
+ my @type_libs = $class->provide_types_from;
+ Class::MOP::load_class($_) for @type_libs;
+
+ my %types = map {
+ my $lib = $_;
+ map +($_ => $lib), $lib->type_names
+ } @type_libs;
+
+ my %from;
+ push @{ $from{ $types{ $_ } } }, $_ for @types;
+
+ $_->import({ -into => $caller }, @{ $from{ $_ } })
+ for keys %from;
+}
+
+=head1 CLASS METHODS
+
+=head2 provide_types_from
+
+Sets or returns a list of type libraries to re-export from.
+
+=cut
+
+sub provide_types_from {
+ my ($class, @libs) = @_;
+
+ my $store =
+ do { no strict 'refs'; \@{ "${class}::__MOOSEX_TYPELIBRARY_LIBRARIES" } };
+
+ @$store = @libs if @libs;
+
+ @$store;
+}
+
+=head1 SEE ALSO
+
+L<MooseX::Types>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
+1;
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+# remove this when CheckedUtilExports croaks instead of carps
+$SIG{__WARN__} = sub { die @_ };
+
+my $missing_comma_test = q{
+ package TypeLib1;
+
+ use MooseX::Types -declare => ['Foo'];
+ use MooseX::Types::Moose 'Str';
+
+ subtype Foo #,
+ as Str,
+ where { /foo/ },
+ message { 'not a Foo' };
+
+ 1;
+};
+
+eval $missing_comma_test;
+like $@, qr/forget a comma/, 'missing comma error';
+
+my $string_as_type_test = q{
+ package TypeLib2;
+
+ use MooseX::Types -declare => ['Foo'];
+ use MooseX::Types::Moose 'Str';
+
+ subtype Foo => # should be ,
+ as Str,
+ where { /foo/ },
+ message { 'not a Foo' };
+
+ 1;
+};
+
+eval $string_as_type_test;
+like $@, qr/String found where Type expected/, 'string instead of Type error';
+
+my $fully_qualified_type = q{
+ package TypeLib3;
+
+ use MooseX::Types -declare => ['Foo'];
+ use MooseX::Types::Moose 'Str';
+
+ subtype TypeLib3::Foo =>
+ as Str,
+ where { /foo/ },
+ message { 'not a Foo' };
+
+ 1;
+};
+
+eval $fully_qualified_type;
+is $@, '', "fully qualified type doesn't throw error";
+
+my $class_type = q{
+ package TypeLib4;
+
+ use MooseX::Types -declare => ['Foo'];
+ use MooseX::Types::Moose 'Str';
+
+ class_type 'mtfnpy';
+
+ coerce mtfnpy =>
+ from Str,
+ via { bless \$_, 'mtfnpy' };
+
+ 1;
+};
+eval $class_type;
+is $@, '', "declared class_types don't throw error";
+
+my $role_type = q{
+ package TypeLib5;
+
+ use MooseX::Types -declare => ['Foo'];
+ use MooseX::Types::Moose 'Str';
+
+ role_type 'mtfnpy';
+
+ coerce mtfnpy =>
+ from Str,
+ via { bless \$_, 'mtfnpy' };
+
+ 1;
+};
+eval $role_type;
+is $@, '', "declared role_types don't throw error";
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 4;
+
+BEGIN { use_ok 'Combined', qw/Foo2Alias MTFNPY NonEmptyStr/ }
+
+# test that a type from TestLibrary was exported
+ok Foo2Alias;
+
+# test that a type from TestLibrary2 was exported
+ok MTFNPY;
+
+is NonEmptyStr->name, 'TestLibrary2::NonEmptyStr',
+ 'precedence for conflicting types is correct';
--- /dev/null
+package Combined;
+
+use strict;
+use warnings;
+
+use base 'MooseX::Types::Combine';
+
+__PACKAGE__->provide_types_from(qw/TestLibrary TestLibrary2/);
+
+1;
--- /dev/null
+package TestLibrary2;
+
+use MooseX::Types
+ -declare => [qw( MTFNPY NonEmptyStr )];
+use MooseX::Types::Moose 'Str';
+
+subtype MTFNPY,
+ as Str,
+ where { length $_ },
+ message { 'MTFNPY must not be empty' };
+
+subtype NonEmptyStr,
+ as Str,
+ where { length $_ },
+ message { 'Str must not be empty' };
+
+1;
projects / gitmo/MooseX-Types.git / commitdiff