* Moose::Meta::Attribute
- if your attribute 'isa' ArrayRef of HashRef, and you have
not explicitly set a default, then make the default DWIM.
+ This will also work for subtypes of ArrayRef and HashRef
+ as well.
+ - you can now auto-deref subtypes of ArrayRef or HashRef too.
+ - new test added for this (thanks to ashley)
* Moose::Meta::Role
- added basic support for runtime role composition
if (exists $options->{auto_deref} && $options->{auto_deref}) {
(exists $options->{type_constraint})
|| confess "You cannot auto-dereference without specifying a type constraint";
- ($options->{type_constraint}->name =~ /^ArrayRef|HashRef$/)
+ ($options->{type_constraint}->is_a_type_of('ArrayRef') ||
+ $options->{type_constraint}->is_a_type_of('HashRef'))
|| confess "You cannot auto-dereference anything other than a ArrayRef or HashRef";
}
- if (exists $options->{type_constraint} && $options->{type_constraint}->name =~ /^ArrayRef|HashRef$/) {
+ if (exists $options->{type_constraint} &&
+ ($options->{type_constraint}->is_a_type_of('ArrayRef') ||
+ $options->{type_constraint}->is_a_type_of('HashRef') )) {
unless (exists $options->{default}) {
$options->{default} = sub { [] } if $options->{type_constraint}->name eq 'ArrayRef';
$options->{default} = sub { {} } if $options->{type_constraint}->name eq 'HashRef';
return $ref_value unless $self->should_auto_deref;
- my $type = $self->type_constraint->name;
+ my $type_constraint = $self->type_constraint;
my $sigil;
- if ($type eq "ArrayRef") {
+ if ($type_constraint->is_a_type_of('ArrayRef')) {
$sigil = '@';
}
- elsif ($type eq 'HashRef') {
+ elsif ($type_constraint->is_a_type_of('HashRef')) {
$sigil = '%';
}
else {
- confess "Can not auto de-reference the type constraint '$type'";
+ confess "Can not auto de-reference the type constraint '" . $type_constraint->name . "'";
}
"(wantarray() ? $sigil\{ ( $ref_value ) || return } : ( $ref_value ) )";
return ($message . ' in (' . $self->name . ')') ;
}
+sub is_a_type_of {
+ my ($self, $type_name) = @_;
+ foreach my $type (@{$self->type_constraints}) {
+ return 1 if $type->is_a_type_of($type_name);
+ }
+ return 0;
+}
+
+sub is_subtype_of {
+ my ($self, $type_name) = @_;
+ foreach my $type (@{$self->type_constraints}) {
+ return 1 if $type->is_subtype_of($type_name);
+ }
+ return 0;
+}
+
1;
__END__
use strict;
use warnings;
-use Test::More tests => 28;
+use Test::More tests => 29;
use Test::Exception;
BEGIN {
+ use_ok('Moose');
use_ok('Moose::Meta::Role');
}
}
my $SCALAR_REF = \(my $var);
+
+no warnings 'once'; # << I *hates* that warning ...
my $GLOB_REF = \*GLOB_REF;
Moose::Util::TypeConstraints->export_type_contstraints_as_functions();
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+__END__
+
+package Email::Moose;
+
+use warnings;
+use strict;
+
+use Moose;
+use Moose::Util::TypeConstraints;
+
+use IO::String;
+
+=head1 NAME
+
+Email::Moose - Email::Simple on Moose steroids
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+=head1 METHODS
+
+=head2 raw_body
+
+=cut
+
+subtype q{IO::String}
+ => as q{Object}
+ => where { $_->isa(q{IO::String}) };
+
+coerce q{IO::String}
+ => from q{Str}
+ => via { IO::String->new($_) },
+ => from q{ScalarRef},
+ => via { IO::String->new($_) };
+
+type q{FileHandle}
+ => where { Scalar::Util::openhandle($_) };
+
+subtype q{IO::File}
+ => as q{Object}
+ => where { $_->isa(q{IO::File}) };
+
+coerce q{IO::File}
+ => from q{FileHandle}
+ => via { bless $_, q{IO::File} };
+
+subtype q{IO::Socket}
+ => as q{Object}
+ => where { $_->isa(q{IO::Socket}) };
+
+coerce q{IO::Socket}
+ => from q{CodeRef} # no test sample yet
+ => via { IO::Socket->new($_) };
+=cut
+
+has q{raw_body} => (
+ is => q{rw},
+ isa => q{IO::String | IO::File | IO::Socket},
+ coerce => 1,
+ default => sub { IO::String->new() },
+);
+
+=head2 as_string
+
+=cut
+
+sub as_string {
+ my ($self) = @_;
+ my $fh = $self->raw_body();
+ return do { local $/; <$fh> };
+}
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+## Roles
+
+{
+ package Test::TheDefaultFor::ArrayRef::and::HashRef;
+ use Moose;
+
+ has 'array_ref' => (is => 'rw', isa => 'ArrayRef');
+ has 'hash_ref' => (is => 'rw', isa => 'HashRef');
+
+}
+
+my $test = Test::TheDefaultFor::ArrayRef::and::HashRef->new;
+isa_ok($test, 'Test::TheDefaultFor::ArrayRef::and::HashRef');
+
+is_deeply($test->array_ref, [], '.... got the right default value');
+is_deeply($test->hash_ref, {}, '.... got the right default value');
+
+my $test2 = Test::TheDefaultFor::ArrayRef::and::HashRef->new(
+ array_ref => [ 1, 2, [] ],
+ hash_ref => { one => 1, two => 2, three => {} },
+);
+isa_ok($test2, 'Test::TheDefaultFor::ArrayRef::and::HashRef');
+
+is_deeply($test2->array_ref, [ 1, 2, [] ], '.... got the right default value');
+is_deeply($test2->hash_ref, { one => 1, two => 2, three => {} }, '.... got the right default value');
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+{
+ package Customer;
+ use Moose;
+
+ package Firm;
+ use Moose;
+ use Moose::Util::TypeConstraints;
+
+ ::lives_ok {
+ has 'customers' => (
+ is => 'ro',
+ isa => subtype('ArrayRef' => where {
+ (blessed($_) && $_->isa('Customer') || return) for @$_; 1 }),
+ auto_deref => 1,
+ );
+ } '... successfully created attr';
+}
+
+{
+ my $customer = Customer->new;
+ isa_ok($customer, 'Customer');
+
+ my $firm = Firm->new(customers => [ $customer ]);
+ isa_ok($firm, 'Firm');
+
+ can_ok($firm, 'customers');
+
+ is_deeply(
+ [ $firm->customers ],
+ [ $customer ],
+ '... got the right dereferenced value'
+ );
+}
+
+{
+ my $firm = Firm->new();
+ isa_ok($firm, 'Firm');
+
+ can_ok($firm, 'customers');
+
+ is_deeply(
+ [ $firm->customers ],
+ [],
+ '... got the right dereferenced value'
+ );
+}
\ No newline at end of file
projects / gitmo/Moose.git / commitdiff