use warnings;
use Carp 'confess';
+use Scalar::Util 'blessed';
sub new {
my $class = shift;
sub name { $_[0]->{name} }
sub class { $_[0]->{class} }
+sub _is_metadata { $_[0]->{is} }
+sub is_required { $_[0]->{required} }
sub default { $_[0]->{default} }
+sub is_lazy { $_[0]->{lazy} }
sub predicate { $_[0]->{predicate} }
sub clearer { $_[0]->{clearer} }
sub handles { $_[0]->{handles} }
sub weak_ref { $_[0]->{weak_ref} }
sub init_arg { $_[0]->{init_arg} }
sub type_constraint { $_[0]->{type_constraint} }
+sub trigger { $_[0]->{trigger} }
+sub builder { $_[0]->{builder} }
+
+sub has_default { exists $_[0]->{default} }
+sub has_predicate { exists $_[0]->{predicate} }
+sub has_clearer { exists $_[0]->{clearer} }
+sub has_handles { exists $_[0]->{handles} }
+sub has_type_constraint { exists $_[0]->{type_constraint} }
+sub has_trigger { exists $_[0]->{trigger} }
+sub has_builder { exists $_[0]->{builder} }
sub generate_accessor {
my $attribute = shift;
- my $name = $attribute->{name};
- my $key = $attribute->{init_arg};
- my $default = $attribute->{default};
- my $trigger = $attribute->{trigger};
- my $type = $attribute->{type_constraint};
-
- my $constraint = sub {
- return unless $type;
-
- my $checker = Mouse::TypeRegistry->optimized_constraints->{$type};
- return $checker if $checker;
-
- confess "Unable to parse type constraint '$type'";
- }->();
+ my $name = $attribute->name;
+ my $key = $attribute->init_arg;
+ my $default = $attribute->default;
+ my $trigger = $attribute->trigger;
+ my $type = $attribute->type_constraint;
+ my $constraint = $attribute->find_type_constraint;
my $accessor = 'sub {
my $self = shift;';
- if ($attribute->{is} eq 'rw') {
+ if ($attribute->_is_metadata eq 'rw') {
$accessor .= 'if (@_) {
local $_ = $_[0];';
if ($constraint) {
- $accessor .= 'Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $_") unless $constraint->();'
+ $accessor .= 'do {
+ my $display = defined($_) ? $_ : "undef";
+ Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display") unless $constraint->();
+ };'
}
$accessor .= '$self->{$key} = $_;';
- if ($attribute->{weak_ref}) {
+ if ($attribute->weak_ref) {
$accessor .= 'Scalar::Util::weaken($self->{$key});';
}
else {
}
- if ($attribute->{lazy}) {
+ if ($attribute->is_lazy) {
$accessor .= '$self->{$key} = ';
- $accessor .= ref($attribute->{default}) eq 'CODE'
+ $accessor .= ref($default) eq 'CODE'
? '$default->($self)'
: '$default';
$accessor .= ' if !exists($self->{$key});';
sub generate_predicate {
my $attribute = shift;
- my $key = $attribute->{init_arg};
+ my $key = $attribute->init_arg;
my $predicate = 'sub { exists($_[0]->{$key}) }';
sub generate_clearer {
my $attribute = shift;
- my $key = $attribute->{init_arg};
+ my $key = $attribute->init_arg;
my $predicate = 'sub { delete($_[0]->{$key}) }';
sub generate_handles {
my $attribute = shift;
- my $reader = $attribute->{name};
+ my $reader = $attribute->name;
my %method_map;
- for my $local_method (keys %{ $attribute->{handles} }) {
- my $remote_method = $attribute->{handles}{$local_method};
+ for my $local_method (keys %{ $attribute->handles }) {
+ my $remote_method = $attribute->handles->{$local_method};
my $method = 'sub {
my $self = shift;
if ref($args{default})
&& ref($args{default}) ne 'CODE';
- $args{handles} = { map { $_ => $_ } @{ $args{handles} } }
- if $args{handles}
- && ref($args{handles}) eq 'ARRAY';
-
- confess "You must pass a HASH or ARRAY to handles"
- if exists($args{handles})
- && ref($args{handles}) ne 'HASH';
+ $args{handles} = { $self->_canonicalize_handles($args{handles}) }
+ if $args{handles};
$args{type_constraint} = delete $args{isa};
$meta->add_attribute($attribute);
# install an accessor
- if ($attribute->{is} eq 'rw' || $attribute->{is} eq 'ro') {
+ if ($attribute->_is_metadata eq 'rw' || $attribute->_is_metadata eq 'ro') {
my $accessor = $attribute->generate_accessor;
no strict 'refs';
*{ $class . '::' . $name } = $accessor;
}
for my $method (qw/predicate clearer/) {
- if (exists $attribute->{$method}) {
+ my $predicate = "has_$method";
+ if ($attribute->$predicate) {
my $generator = "generate_$method";
my $coderef = $attribute->$generator;
no strict 'refs';
- *{ $class . '::' . $attribute->{$method} } = $coderef;
+ *{ $class . '::' . $attribute->$method } = $coderef;
}
}
- if ($attribute->{handles}) {
+ if ($attribute->has_handles) {
my $method_map = $attribute->generate_handles;
for my $method_name (keys %$method_map) {
no strict 'refs';
return $attribute;
}
+sub find_type_constraint {
+ my $self = shift;
+ my $type = $self->type_constraint;
+
+ return unless $type;
+
+ my $checker = Mouse::TypeRegistry->optimized_constraints->{$type};
+ return $checker if $checker;
+
+ return sub { blessed($_) && blessed($_) eq $type };
+}
+
+sub verify_type_constraint {
+ my $self = shift;
+ local $_ = shift;
+
+ my $type = $self->type_constraint
+ or return 1;
+ my $constraint = $self->find_type_constraint;
+
+ return 1 if $constraint->($_);
+
+ my $name = $self->name;
+ local $_ = "undef" unless defined($_);
+ Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $_");
+}
+
+sub _canonicalize_handles {
+ my $self = shift;
+ my $handles = shift;
+
+ if (ref($handles) eq 'HASH') {
+ return %$handles;
+ }
+ elsif (ref($handles) eq 'ARRAY') {
+ return map { $_ => $_ } @$handles;
+ }
+ else {
+ confess "Unable to canonicalize the 'handles' option with $handles";
+ }
+}
+
1;
__END__
=head2 class -> OwnerClass
-=head2 default -> Value
+=head2 is_required -> Bool
+
+=head2 default -> Item
+
+=head2 has_default -> Bool
+
+=head2 is_lazy -> Bool
+
+=head2 predicate -> MethodName | Undef
-=head2 predicate -> MethodName
+=head2 has_predicate -> Bool
-=head2 clearer -> MethodName
+=head2 clearer -> MethodName | Undef
+
+=head2 has_clearer -> Bool
=head2 handles -> { LocalName => RemoteName }
+=head2 has_handles -> Bool
+
=head2 weak_ref -> Bool
=head2 init_arg -> Str
+=head2 type_constraint -> Str
+
+=head2 has_type_constraint -> Bool
+
+=head2 trigger => CODE | Undef
+
+=head2 has_trigger -> Bool
+
+=head2 builder => MethodName | Undef
+
+=head2 has_builder -> Bool
+
Informational methods.
=head2 generate_accessor -> CODE
projects / gitmo/Mouse.git / blobdiff