use Carp 'confess';
use Scalar::Util 'blessed', 'reftype';
-use B 'svref_2object';
use Sub::Exporter;
-our $VERSION = '0.16';
+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 $keyword = \&{$class . '::' . $name};
# make sure it is from Moose
- my $pkg_name = eval { svref_2object($keyword)->GV->STASH->NAME };
+ my ($pkg_name) = Class::MOP::get_code_info($keyword);
next if $@;
next if $pkg_name ne 'Moose::Util::TypeConstraints';
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);
sub _create_type_constraint ($$$;$$) {
my $name = shift;
my $parent = shift;
- my $check = shift || sub { 1 };
+ my $check = shift;
my ($message, $optimized);
for (@_) {
}
$parent = find_or_create_type_constraint($parent) if defined $parent;
-
+
my $constraint = Moose::Meta::TypeConstraint->new(
name => $name || '__ANON__',
package_defined_in => $pkg_defined_in,
($message ? (message => $message) : ()),
($optimized ? (optimized => $optimized) : ()),
);
+
+ # NOTE:
+ # if we have a type constraint union, and no
+ # type check, this means we are just aliasing
+ # the union constraint, which means we need to
+ # handle this differently.
+ # - SL
+ if (not(defined $check)
+ && $parent->isa('Moose::Meta::TypeConstraint::Union')
+ && $parent->has_coercion
+ ){
+ $constraint->coercion(Moose::Meta::TypeCoercion::Union->new(
+ type_constraint => $parent
+ ));
+ }
$REGISTRY->add_type_constraint($constraint)
if defined $name;
sub _install_type_coercions ($$) {
my ($type_name, $coercion_map) = @_;
my $type = $REGISTRY->get_type_constraint($type_name);
- (!$type->has_coercion)
- || confess "The type coercion for '$type_name' has already been registered";
- my $type_coercion = Moose::Meta::TypeCoercion->new(
- type_coercion_map => $coercion_map,
- type_constraint => $type
- );
- $type->coercion($type_coercion);
+ (defined $type)
+ || confess "Cannot find type '$type_name', perhaps you forgot to load it.";
+ if ($type->has_coercion) {
+ $type->coercion->add_type_coercions(@$coercion_map);
+ }
+ else {
+ my $type_coercion = Moose::Meta::TypeCoercion->new(
+ type_coercion_map => $coercion_map,
+ type_constraint => $type
+ );
+ $type->coercion($type_coercion);
+ }
}
## --------------------------------------------------------
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>
projects / gitmo/Moose.git / blobdiff