lib/MooseX/Types/CheckedUtilExports.pm

   1 =head1 NAME
   2
   3 MooseX::Types::CheckedUtilExports - Wrap L<Moose::Util::TypeConstraints> to be
   4 safer for L<MooseX::Types>
   5
   6 =cut
   7
   8 package MooseX::Types::CheckedUtilExports;
   9
  10 use strict;
  11 use warnings;
  12 use Moose::Util::TypeConstraints ();
  13 use Moose::Exporter;
  14 use Sub::Name;
  15 use Carp;
  16
  17 use namespace::clean -except => 'meta';
  18
  19 my $StringFoundMsg =
  20 q{WARNING: String found where Type expected (did you use a => instead of a , ?)};
  21
  22 my @exports = qw/type subtype maybe_type duck_type enum coerce from as/;
  23
  24 =head1 DESCRIPTION
  25
  26 Prevents errors like:
  27
  28     subtype Foo =>
  29     ...
  30
  31 Which should be written as:
  32
  33     subtype Foo,
  34     ...
  35
  36 When using L<MooseX::Types>. Exported by that module.
  37
  38 Exports checked versions of the following subs:
  39
  40 C<type> C<subtype> C<maybe_type> C<duck_type> C<enum> C<coerce> C<from> C<as>
  41
  42 While C<class_type> and C<role_type> will also register the type in the library.
  43
  44 From L<Moose::Util::TypeConstraints>. See that module for syntax.
  45
  46 =cut
  47
  48 for my $export (@exports) {
  49     no strict 'refs';
  50
  51     *{$export} = sub {
  52         my $caller = shift;
  53
  54         local $Carp::CarpLevel = $Carp::CarpLevel + 1;
  55
  56         carp $StringFoundMsg
  57             unless ref($_[0]) ||
  58                 $_[0] =~ /\b::\b/ || # qualified type
  59                 $caller->get_registered_class_type($_[0]) ||
  60                 $caller->get_registered_role_type($_[0]);
  61
  62         goto &{"Moose::Util::TypeConstraints::$export"};
  63     }
  64 }
  65
  66 Moose::Exporter->setup_import_methods(
  67     with_caller => [ @exports, 'class_type', 'role_type' ]
  68 );
  69
  70 sub class_type {
  71     my $caller = shift;
  72
  73     $caller->register_class_type(
  74         Moose::Util::TypeConstraints::class_type(@_)
  75     );
  76 }
  77
  78 sub role_type ($;$) {
  79     my ($caller, $name, $opts) = @_;
  80
  81     $caller->register_role_type(
  82         Moose::Util::TypeConstraints::role_type($name, $opts)
  83     );
  84 }
  85
  86 =head1 SEE ALSO
  87
  88 L<MooseX::Types>
  89
  90 =head1 LICENSE
  91
  92 This program is free software; you can redistribute it and/or modify
  93 it under the same terms as perl itself.
  94
  95 =cut
  96
  97 1;