use strict;
use warnings;
-use Carp 'confess';
+use Carp ();
use Scalar::Util 'blessed';
-use Sub::Exporter;
+use Moose::Exporter;
-our $VERSION = '0.50';
+our $VERSION = '0.57';
+$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
## --------------------------------------------------------
use Moose::Meta::TypeConstraint::Registry;
use Moose::Util::TypeConstraints::OptimizedConstraints;
-my @exports = qw/
- type subtype class_type role_type as where message optimize_as
- coerce from via
- enum
- find_type_constraint
- register_type_constraint
-/;
-
-Sub::Exporter::setup_exporter({
- exports => \@exports,
- groups => { default => [':all'] }
-});
-
-sub unimport {
- no strict 'refs';
- my $class = caller();
- # loop through the exports ...
- foreach my $name (@exports) {
- # if we find one ...
- if (defined &{$class . '::' . $name}) {
- my $keyword = \&{$class . '::' . $name};
-
- # make sure it is from Moose
- my ($pkg_name) = Class::MOP::get_code_info($keyword);
- next if $@;
- next if $pkg_name ne 'Moose::Util::TypeConstraints';
-
- # and if it is from Moose then undef the slot
- delete ${$class . '::'}{$name};
- }
- }
-}
+Moose::Exporter->setup_import_methods(
+ as_is => [
+ qw(
+ type subtype class_type role_type as where message optimize_as
+ coerce from via
+ enum
+ find_type_constraint
+ register_type_constraint )
+ ],
+ _export_to_main => 1,
+);
## --------------------------------------------------------
## type registry and some useful functions for it
}
(scalar @type_constraint_names >= 2)
- || confess "You must pass in at least 2 type names to make a union";
+ || Moose::throw_error("You must pass in at least 2 type names to make a union");
($REGISTRY->has_type_constraint($_))
- || confess "Could not locate type constraint ($_) for the union"
+ || Moose::throw_error("Could not locate type constraint ($_) for the union")
foreach @type_constraint_names;
return Moose::Meta::TypeConstraint::Union->new(
my ($base_type, $type_parameter) = _parse_parameterized_type_constraint($type_constraint_name);
(defined $base_type && defined $type_parameter)
- || confess "Could not parse type name ($type_constraint_name) correctly";
+ || Moose::throw_error("Could not parse type name ($type_constraint_name) correctly");
($REGISTRY->has_type_constraint($base_type))
- || confess "Could not locate the base type ($base_type)";
+ || Moose::throw_error("Could not locate the base type ($base_type)");
return Moose::Meta::TypeConstraint::Parameterized->new(
name => $type_constraint_name,
# 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::throw_error("Can't create a class type constraint because '$class' is not a class name");
my %options = (
class => $class,
# 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::throw_error("Can't create a class type constraint because '$class' is not a class name");
my %options = (
role => $role,
sub find_or_parse_type_constraint ($) {
my $type_constraint_name = shift;
-
- return $REGISTRY->get_type_constraint($type_constraint_name)
- if $REGISTRY->has_type_constraint($type_constraint_name);
-
my $constraint;
-
- if (_detect_type_constraint_union($type_constraint_name)) {
+
+ if ($constraint = find_type_constraint($type_constraint_name)) {
+ return $constraint;
+ } elsif (_detect_type_constraint_union($type_constraint_name)) {
$constraint = create_type_constraint_union($type_constraint_name);
- }
- elsif (_detect_parameterized_type_constraint($type_constraint_name)) {
+ } elsif (_detect_parameterized_type_constraint($type_constraint_name)) {
$constraint = create_parameterized_type_constraint($type_constraint_name);
} else {
return;
}
-
+
$REGISTRY->add_type_constraint($constraint);
return $constraint;
}
if ( blessed $type and $type->isa("Moose::Meta::TypeConstraint") ) {
return $type;
- } else {
+ }
+ else {
+ return unless $REGISTRY->has_type_constraint($type);
return $REGISTRY->get_type_constraint($type);
}
}
sub register_type_constraint ($) {
my $constraint = shift;
- confess "can't register an unnamed type constraint" unless defined $constraint->name;
+ Moose::throw_error("can't register an unnamed type constraint") unless defined $constraint->name;
$REGISTRY->add_type_constraint($constraint);
return $constraint;
}
$type_name = undef;
}
(scalar @values >= 2)
- || confess "You must have at least two values to enumerate through";
+ || Moose::throw_error("You must have at least two values to enumerate through");
my %valid = map { $_ => 1 } @values;
register_type_constraint(
sub create_enum_type_constraint ($$) {
my ( $type_name, $values ) = @_;
-
+
Moose::Meta::TypeConstraint::Enum->new(
name => $type_name || '__ANON__',
values => $values,
# FIXME should probably not be a special case
if ( defined $parent and $parent = find_or_parse_type_constraint($parent) ) {
- $class = "Moose::Meta::TypeConstraint::Parameterizable"
+ $class = "Moose::Meta::TypeConstraint::Parameterizable"
if $parent->isa("Moose::Meta::TypeConstraint::Parameterizable");
}
sub _install_type_coercions ($$) {
my ($type_name, $coercion_map) = @_;
- my $type = $REGISTRY->get_type_constraint($type_name);
+ my $type = find_type_constraint($type_name);
(defined $type)
- || confess "Cannot find type '$type_name', perhaps you forgot to load it.";
+ || Moose::throw_error("Cannot find type '$type_name', perhaps you forgot to load it.");
if ($type->has_coercion) {
$type->coercion->add_type_coercions(@$coercion_map);
}
push @rv => $1;
}
(pos($given) eq length($given))
- || confess "'$given' didn't parse (parse-pos="
+ || Moose::throw_error("'$given' didn't parse (parse-pos="
. pos($given)
. " and str-length="
. length($given)
- . ")";
+ . ")");
@rv;
}
sub add_parameterizable_type {
my $type = shift;
(blessed $type && $type->isa('Moose::Meta::TypeConstraint::Parameterizable'))
- || confess "Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type";
+ || Moose::throw_error("Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type");
push @PARAMETERIZABLE_TYPES => $type;
}
type 'Num' => where { Scalar::Util::looks_like_number($_) };
subtype 'Natural'
- => as 'Num'
+ => as 'Int'
=> where { $_ > 0 };
subtype 'NaturalLessThanTen'
inference is performed, expression are not typed, etc. etc. etc.
This is simply a means of creating small constraint functions which
-can be used to simplify your own type-checking code, with the added
+can be used to simplify your own type-checking code, with the added
side benefit of making your intentions clearer through self-documentation.
=head2 Slightly Less Important Caveat
=head2 Default Type Constraints
-This module also provides a simple hierarchy for Perl 5 types, here is
+This module also provides a simple hierarchy for Perl 5 types, here is
that hierarchy represented visually.
Any
HashRef[CodeRef] # a hash of str to CODE ref mappings
Maybe[Str] # value may be a string, may be undefined
+B<NOTE:> Unless you parameterize a type, then it is invalid to
+include the square brackets. I.e. C<ArrayRef[]> will be
+literally interpreted as a type name.
+
B<NOTE:> The C<Undef> type constraint for the most part works
correctly now, but edge cases may still exist, please use it
sparringly.
this type constraint to pass. I know this is not ideal for all,
but it is a saner restriction than most others.
-=head2 Type Constraint Naming
+=head2 Type Constraint Naming
-Since the types created by this module are global, it is suggested
-that you namespace your types just as you would namespace your
+Since the types created by this module are global, it is suggested
+that you namespace your types just as you would namespace your
modules. So instead of creating a I<Color> type for your B<My::Graphics>
module, you would call the type I<My::Graphics::Color> instead.
-keys => HasLength,
-values => IsArrayRef( IsObject ));
-For more examples see the F<t/200_examples/204_example_w_DCS.t>
+For more examples see the F<t/200_examples/204_example_w_DCS.t>
test file.
Here is an example of using L<Test::Deep> and it's non-test
})))
};
-For a complete example see the
+For a complete example see the
F<t/200_examples/205_example_w_TestDeep.t> test file.
=head1 FUNCTIONS
This is just sugar for the type constraint construction syntax.
+Takes a block/code ref as an argument. When the type constraint is
+tested, the supplied code is run with the value to be tested in
+$_. This block should return true or false to indicate whether or not
+the constraint check passed.
+
=item B<message>
This is just sugar for the type constraint construction syntax.
+Takes a block/code ref as an argument. When the type constraint fails,
+then the code block is run (with the value provided in $_). This code
+ref should return a string, which will be used in the text of the
+exception thrown.
+
=item B<optimize_as>
This can be used to define a "hand optimized" version of your
=back
+=head1 Error Management
+
+=over 4
+
+=item B<confess>
+
+If the caller is a Moose metaclass, use its L<Moose::Meta::Class/throw_error>
+routine, otherwise use L<Carp/confess>.
+
+=back
+
=head2 Namespace Management
=over 4
projects / gitmo/Moose.git / blobdiff