- added all the meta classes to the immutable list and
set it to inline the accessors
+ * Moose::Util::TypeConstraint
+ - no longer uses package variable to keep track of
+ the type constraints, now uses the an instance of
+ Moose::Meta::TypeConstraint::Registry to do it
+
* Moose::Meta::TypeConstraint
- some minor adjustments to make subclassing easier
+ - added the package_defined_in attribute so that we
+ can track where the type constraints are created
* Moose::Meta::TypeConstraint::Union
- this is not a subclass of Moose::Meta::TypeConstraint
to help construct nested collection types
- added tests for this
+ * Moose::Meta::TypeConstraint::Registry
+ - added this class to keep track of type constraints
+
* Moose::Meta::Attribute
Moose::Meta::Method::Constructor
Moose::Meta::Method::Accessor
the checks to be turned off would be helpful for deploying into performance
intensive systems. Perhaps this can actually be done as an option to make_immutable?
+- add support for locally scoped TC
+
+This would borrow from MooseX::TypeLibrary to prefix the TC with the name
+of the package. It would then be accesible from the outside as the fully
+scoped name, but the local attributes would use it first. (this would need support
+in the registry for this).
+
+- look into sugar extensions
+
+Use roles as sugar layer function providers (ala MooseX::AttributeHelpers). This
+would allow custom metaclasses to provide roles to extend the sugar syntax with.
+
+(NOTE: Talk to phaylon a bit more on this)
+
- misc. minor bits
* make the errors for TCs use ->message
* look into localizing the messages too
* make ANON TCs be lazy, so they can possibly be subsituted for the real thing later
* make ANON TCs more introspectable
+* add this ...
+
+#
+# Type Definition
+#
+subtype 'Username',
+ from 'Str',
+ where { (/[a-z][a-z0-9]+/i or fail('Invalid character(s)'))
+ and (length($_) >= 5 or fail('Too short (less than 5 chars)'))
+ }
+on_fail { MyException->throw(value => $_[0], message => $_[1]) };
+
+# fail() will just return false unless the call is made via
+$tc->check_or_fail($value);
+
+* and then something like this:
+
+subtype Foo => as Bar => where { ... } => scoped => -global;
+subtype Foo => as Bar => where { ... } => scoped => -local;
+
+# or
+
+subtype Foo => as Bar => where { ... } => in __PACKAGE__ ;
+
+# or (not sure if it would be possible)
+
+my $Foo = subtype Bar => where { ... };
-----------------------------------------------------------
--- /dev/null
+
+package Moose::Meta::TypeConstraint::Registry;
+
+use strict;
+use warnings;
+use metaclass;
+
+use Scalar::Util 'blessed';
+use Carp 'confess';
+
+our $VERSION = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Class::MOP::Object';
+
+__PACKAGE__->meta->add_attribute('type_constraints' => (
+ reader => 'type_constraints',
+ default => sub { {} }
+));
+
+sub new {
+ my $class = shift;
+ my $self = $class->meta->new_object(@_);
+ return $self;
+}
+
+sub has_type_constraint {
+ my ($self, $type_name) = @_;
+ exists $self->type_constraints->{$type_name} ? 1 : 0
+}
+
+sub get_type_constraint {
+ my ($self, $type_name) = @_;
+ $self->type_constraints->{$type_name}
+}
+
+sub add_type_constraint {
+ my ($self, $type) = @_;
+ $self->type_constraints->{$type->name} = $type;
+}
+
+1;
+
+__END__
+
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::TypeConstraint::Registry
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<new>
+
+=item B<type_constraints>
+
+=item B<has_type_constraint>
+
+=item B<get_type_constraint>
+
+=item B<add_type_constraint>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006, 2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
use B 'svref_2object';
use Sub::Exporter;
-our $VERSION = '0.13';
+our $VERSION = '0.14';
our $AUTHORITY = 'cpan:STEVAN';
# Prototyped subs must be predeclared because we have a circular dependency
use Moose::Meta::TypeConstraint;
use Moose::Meta::TypeCoercion;
+use Moose::Meta::TypeConstraint::Registry;
my @exports = qw/
type subtype as where message optimize_as
}
}
-{
- my %TYPES;
- sub find_type_constraint ($) {
- return $TYPES{$_[0]}->[1]
- if exists $TYPES{$_[0]};
- return;
- }
-
- sub _dump_type_constraints {
- require Data::Dumper;
- Data::Dumper::Dumper(\%TYPES);
- }
-
- sub _create_type_constraint ($$$;$$) {
- my $name = shift;
- my $parent = shift;
- my $check = shift || sub { 1 };
-
- my ($message, $optimized);
- for (@_) {
- $message = $_->{message} if exists $_->{message};
- $optimized = $_->{optimized} if exists $_->{optimized};
- }
+my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new;
- my $pkg_defined_in = scalar(caller(0));
-
- ($TYPES{$name}->[0] eq $pkg_defined_in)
- || confess ("The type constraint '$name' has already been created in "
- . $TYPES{$name}->[0] . " and cannot be created again in "
- . $pkg_defined_in)
- if defined $name && exists $TYPES{$name};
-
- $parent = find_type_constraint($parent) if defined $parent;
- my $constraint = Moose::Meta::TypeConstraint->new(
- name => $name || '__ANON__',
- parent => $parent,
- constraint => $check,
- message => $message,
- optimized => $optimized,
- );
- $TYPES{$name} = [ $pkg_defined_in, $constraint ] if defined $name;
- return $constraint;
- }
+sub _get_type_constraint_registry { $REGISTRY }
+sub _dump_type_constraints { $REGISTRY->dump }
- sub _install_type_coercions ($$) {
- my ($type_name, $coercion_map) = @_;
- my $type = find_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);
- }
-
- sub create_type_constraint_union (@) {
- my (@type_constraint_names) = @_;
- return Moose::Meta::TypeConstraint->union(
- map {
- find_type_constraint($_)
- } @type_constraint_names
- );
- }
+sub _create_type_constraint ($$$;$$) {
+ my $name = shift;
+ my $parent = shift;
+ my $check = shift || sub { 1 };
- sub export_type_constraints_as_functions {
- my $pkg = caller();
- no strict 'refs';
- foreach my $constraint (keys %TYPES) {
- *{"${pkg}::${constraint}"} = find_type_constraint($constraint)->_compiled_type_constraint;
- }
+ my ($message, $optimized);
+ for (@_) {
+ $message = $_->{message} if exists $_->{message};
+ $optimized = $_->{optimized} if exists $_->{optimized};
}
+
+ my $pkg_defined_in = scalar(caller(0));
- *Moose::Util::TypeConstraints::export_type_contstraints_as_functions = \&export_type_constraints_as_functions;
+ if (defined $name) {
+ my $type = $REGISTRY->get_type_constraint($name);
- sub list_all_type_constraints { keys %TYPES }
+ ($type->_package_defined_in eq $pkg_defined_in)
+ || confess ("The type constraint '$name' has already been created in "
+ . $type->_package_defined_in . " and cannot be created again in "
+ . $pkg_defined_in)
+ if defined $type;
+ }
+
+ $parent = $REGISTRY->get_type_constraint($parent) if defined $parent;
+ my $constraint = Moose::Meta::TypeConstraint->new(
+ name => $name || '__ANON__',
+ parent => $parent,
+ constraint => $check,
+ message => $message,
+ optimized => $optimized,
+ package_defined_in => $pkg_defined_in,
+ );
+
+ $REGISTRY->add_type_constraint($constraint)
+ if defined $name;
+
+ return $constraint;
+}
+
+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);
+}
+
+sub create_type_constraint_union (@) {
+ my (@type_constraint_names) = @_;
+ return Moose::Meta::TypeConstraint->union(
+ map {
+ $REGISTRY->get_type_constraint($_)
+ } @type_constraint_names
+ );
}
+sub export_type_constraints_as_functions {
+ my $pkg = caller();
+ no strict 'refs';
+ foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
+ *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint)
+ ->_compiled_type_constraint;
+ }
+}
+
+*Moose::Util::TypeConstraints::export_type_contstraints_as_functions = \&export_type_constraints_as_functions;
+
+sub list_all_type_constraints { keys %{$REGISTRY->type_constraints} }
+
+## --------------------------------------------------------
+## exported functions ...
+## --------------------------------------------------------
+
+sub find_type_constraint ($) { $REGISTRY->get_type_constraint(@_) }
+
# type constructors
sub type ($$;$$) {
projects / gitmo/Moose.git / commitdiff