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