use Scalar::Util 'blessed', 'reftype';
use Sub::Exporter;
-our $VERSION = '0.17';
+our $VERSION = '0.20';
our $AUTHORITY = 'cpan:STEVAN';
## --------------------------------------------------------
# creation and location
sub find_type_constraint ($);
+sub register_type_constraint ($);
sub find_or_create_type_constraint ($;$);
sub create_type_constraint_union (@);
sub create_parameterized_type_constraint ($);
+sub create_class_type_constraint ($);
# dah sugah!
sub type ($$;$$);
sub subtype ($$;$$$);
+sub class_type ($);
sub coerce ($@);
sub as ($);
sub from ($);
use Moose::Meta::TypeCoercion;
use Moose::Meta::TypeCoercion::Union;
use Moose::Meta::TypeConstraint::Registry;
+use Moose::Util::TypeConstraints::OptimizedConstraints;
my @exports = qw/
- type subtype as where message optimize_as
+ type subtype class_type as where message optimize_as
coerce from via
enum
find_type_constraint
+ register_type_constraint
/;
Sub::Exporter::setup_exporter({
my $pkg = caller();
no strict 'refs';
foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
- *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint)
- ->_compiled_type_constraint;
+ my $tc = $REGISTRY->get_type_constraint($constraint)->_compiled_type_constraint;
+ *{"${pkg}::${constraint}"} = sub { $tc->($_[0]) ? 1 : undef };
}
}
);
}
+sub create_class_type_constraint ($) {
+ my $class = shift;
+
+ # too early for this check
+ #find_type_constraint("ClassName")->check($class)
+ # || confess "Can't create a class type constraint because '$class' is not a class name";
+
+ Moose::Meta::TypeConstraint::Class->new( name => $class );
+}
+
sub find_or_create_type_constraint ($;$) {
my ($type_constraint_name, $options_for_anon_type) = @_;
sub find_type_constraint ($) { $REGISTRY->get_type_constraint(@_) }
+sub register_type_constraint ($) {
+ my $constraint = shift;
+ confess "can't register an unnamed type constraint" unless defined $constraint->name;
+ $REGISTRY->add_type_constraint($constraint);
+}
+
# type constructors
sub type ($$;$$) {
goto &_create_type_constraint;
}
+sub class_type ($) {
+ register_type_constraint( create_class_type_constraint(shift) );
+}
+
sub coerce ($@) {
my ($type_name, @coercion_map) = @_;
_install_type_coercions($type_name, \@coercion_map);
subtype 'Value'
=> as 'Defined'
=> where { !ref($_) }
- => optimize_as { defined($_[0]) && !ref($_[0]) };
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value;
subtype 'Ref'
=> as 'Defined'
=> where { ref($_) }
- => optimize_as { ref($_[0]) };
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
subtype 'Str'
=> as 'Value'
=> where { 1 }
- => optimize_as { defined($_[0]) && !ref($_[0]) };
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
subtype 'Num'
=> as 'Value'
=> where { Scalar::Util::looks_like_number($_) }
- => optimize_as { !ref($_[0]) && Scalar::Util::looks_like_number($_[0]) };
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num;
subtype 'Int'
=> as 'Num'
=> where { "$_" =~ /^-?[0-9]+$/ }
- => optimize_as { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ };
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int;
-subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } => optimize_as { ref($_[0]) eq 'SCALAR' };
-subtype 'ArrayRef' => as 'Ref' => where { ref($_) eq 'ARRAY' } => optimize_as { ref($_[0]) eq 'ARRAY' };
-subtype 'HashRef' => as 'Ref' => where { ref($_) eq 'HASH' } => optimize_as { ref($_[0]) eq 'HASH' };
-subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as { ref($_[0]) eq 'CODE' };
-subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => optimize_as { ref($_[0]) eq 'Regexp' };
-subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => optimize_as { ref($_[0]) eq 'GLOB' };
+subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef;
+subtype 'ArrayRef' => as 'Ref' => where { ref($_) eq 'ARRAY' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef;
+subtype 'HashRef' => as 'Ref' => where { ref($_) eq 'HASH' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef;
+subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef;
+subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef;
+subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef;
# NOTE:
# scalar filehandles are GLOB refs,
subtype 'FileHandle'
=> as 'GlobRef'
=> where { Scalar::Util::openhandle($_) }
- => optimize_as { ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]) };
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle;
# NOTE:
# blessed(qr/.../) returns true,.. how odd
subtype 'Object'
=> as 'Ref'
=> where { blessed($_) && blessed($_) ne 'Regexp' }
- => optimize_as { blessed($_[0]) && blessed($_[0]) ne 'Regexp' };
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object;
subtype 'Role'
=> as 'Object'
=> where { $_->can('does') }
- => optimize_as { blessed($_[0]) && $_[0]->can('does') };
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
my $_class_name_checker = sub {
return if ref($_[0]);
this will extract the base type and container type and build an instance of
L<Moose::Meta::TypeConstraint::Parameterized> for it.
+=item B<create_class_type_constraint ($class)>
+
+Given a class name it will create a new L<Moose::Meta::TypeConstraint::Class>
+object for that class name.
+
=item B<find_or_create_type_constraint ($type_name, ?$options_for_anon_type)>
This will attempt to find or create a type constraint given the a C<$type_name>.
meta-object, of the class L<Moose::Meta::TypeConstraint> or a
derivative. What you do with it from there is up to you :)
+=item B<register_type_constraint ($type_object)>
+
+This function will register a named type constraint with the type registry.
+
=item B<get_type_constraint_registry>
Fetch the L<Moose::Meta::TypeConstraint::Registry> object which
constraint meta-object, which will be an instance of
L<Moose::Meta::TypeConstraint>.
+=item B<class_type ($class)>
+
+Creates a type constraint with the name C<$class> and the metaclass
+L<Moose::Meta::TypeConstraint::Class>.
+
=item B<enum ($name, @values)>
This will create a basic subtype for a given set of strings.
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>