lib/Moose/Util/TypeConstraints/Builtins.pm

   1 package Moose::Util::TypeConstraints::Builtins;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Scalar::Util qw( blessed reftype );
   7
   8 sub type { goto &Moose::Util::TypeConstraints::type }
   9 sub subtype { goto &Moose::Util::TypeConstraints::subtype }
  10 sub as { goto &Moose::Util::TypeConstraints::as }
  11 sub where (&) { goto &Moose::Util::TypeConstraints::where }
  12 sub optimize_as (&) { goto &Moose::Util::TypeConstraints::optimize_as }
  13
  14 sub define_builtins {
  15     my $registry = shift;
  16
  17     type 'Any'  => where {1};    # meta-type including all
  18     subtype 'Item' => as 'Any';  # base-type
  19
  20     subtype 'Undef'   => as 'Item' => where { !defined($_) };
  21     subtype 'Defined' => as 'Item' => where { defined($_) };
  22
  23     subtype 'Bool'
  24         => as 'Item'
  25         => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
  26
  27     subtype 'Value'
  28         => as 'Defined'
  29         => where { !ref($_) }
  30         => optimize_as
  31             \&Moose::Util::TypeConstraints::OptimizedConstraints::Value;
  32
  33     subtype 'Ref'
  34         => as 'Defined'
  35         => where { ref($_) }
  36         => optimize_as
  37             \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
  38
  39     subtype 'Str'
  40         => as 'Value'
  41         => where { ref(\$_) eq 'SCALAR' }
  42         => optimize_as
  43             \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
  44
  45     subtype 'Num'
  46         => as 'Str'
  47         => where { Scalar::Util::looks_like_number($_) }
  48         => optimize_as
  49             \&Moose::Util::TypeConstraints::OptimizedConstraints::Num;
  50
  51     subtype 'Int'
  52         => as 'Num'
  53         => where { "$_" =~ /^-?[0-9]+$/ }
  54         => optimize_as
  55             \&Moose::Util::TypeConstraints::OptimizedConstraints::Int;
  56
  57     subtype 'CodeRef'
  58         => as 'Ref'
  59         => where { ref($_) eq 'CODE' }
  60         => optimize_as
  61             \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef;
  62
  63     subtype 'RegexpRef'
  64         => as 'Ref'
  65         => where( \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef )
  66         => optimize_as
  67             \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef;
  68
  69     subtype 'GlobRef'
  70         => as 'Ref'
  71         => where { ref($_) eq 'GLOB' }
  72         => optimize_as
  73             \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef;
  74
  75     # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a
  76     # filehandle
  77     subtype 'FileHandle'
  78         => as 'GlobRef'
  79         => where {
  80             Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") );
  81         }
  82         => optimize_as
  83             \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle;
  84
  85     subtype 'Object'
  86         => as 'Ref'
  87         => where { blessed($_) }
  88         => optimize_as
  89             \&Moose::Util::TypeConstraints::OptimizedConstraints::Object;
  90
  91     # This type is deprecated.
  92     subtype 'Role'
  93         => as 'Object'
  94         => where { $_->can('does') }
  95         => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
  96
  97     subtype 'ClassName'
  98         => as 'Str'
  99         => where { Class::MOP::is_class_loaded($_) }
 100         => optimize_as
 101             \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
 102
 103     subtype 'RoleName'
 104         => as 'ClassName'
 105         => where {
 106             (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
 107         }
 108         => optimize_as
 109             \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName;
 110
 111     $registry->add_type_constraint(
 112         Moose::Meta::TypeConstraint::Parameterizable->new(
 113             name               => 'ScalarRef',
 114             package_defined_in => __PACKAGE__,
 115             parent =>
 116                 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
 117             constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' },
 118             optimized =>
 119                 \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef,
 120             constraint_generator => sub {
 121                 my $type_parameter = shift;
 122                 my $check = $type_parameter->_compiled_type_constraint;
 123                 return sub {
 124                     return $check->( ${$_} );
 125                 };
 126             }
 127         )
 128     );
 129
 130     $registry->add_type_constraint(
 131         Moose::Meta::TypeConstraint::Parameterizable->new(
 132             name               => 'ArrayRef',
 133             package_defined_in => __PACKAGE__,
 134             parent =>
 135                 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
 136             constraint => sub { ref($_) eq 'ARRAY' },
 137             optimized =>
 138                 \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef,
 139             constraint_generator => sub {
 140                 my $type_parameter = shift;
 141                 my $check = $type_parameter->_compiled_type_constraint;
 142                 return sub {
 143                     foreach my $x (@$_) {
 144                         ( $check->($x) ) || return;
 145                     }
 146                     1;
 147                     }
 148             }
 149         )
 150     );
 151
 152     $registry->add_type_constraint(
 153         Moose::Meta::TypeConstraint::Parameterizable->new(
 154             name               => 'HashRef',
 155             package_defined_in => __PACKAGE__,
 156             parent =>
 157                 Moose::Util::TypeConstraints::find_type_constraint('Ref'),
 158             constraint => sub { ref($_) eq 'HASH' },
 159             optimized =>
 160                 \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef,
 161             constraint_generator => sub {
 162                 my $type_parameter = shift;
 163                 my $check = $type_parameter->_compiled_type_constraint;
 164                 return sub {
 165                     foreach my $x ( values %$_ ) {
 166                         ( $check->($x) ) || return;
 167                     }
 168                     1;
 169                     }
 170             }
 171         )
 172     );
 173
 174     $registry->add_type_constraint(
 175         Moose::Meta::TypeConstraint::Parameterizable->new(
 176             name               => 'Maybe',
 177             package_defined_in => __PACKAGE__,
 178             parent =>
 179                 Moose::Util::TypeConstraints::find_type_constraint('Item'),
 180             constraint           => sub {1},
 181             constraint_generator => sub {
 182                 my $type_parameter = shift;
 183                 my $check = $type_parameter->_compiled_type_constraint;
 184                 return sub {
 185                     return 1 if not( defined($_) ) || $check->($_);
 186                     return;
 187                     }
 188             }
 189         )
 190     );
 191 }
 192
 193 1;