From: Stevan Little Date: Tue, 22 May 2007 03:54:37 +0000 (+0000) Subject: * added typed-ness to collections X-Git-Tag: 0.18_01~82 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8c651099f4d73825057940d246f69f2eb63e1e7c;p=gitmo%2FMooseX-AttributeHelpers.git * added typed-ness to collections * more tests --- diff --git a/lib/MooseX/AttributeHelpers/Base.pm b/lib/MooseX/AttributeHelpers/Base.pm index 3d13d16..9e6113b 100644 --- a/lib/MooseX/AttributeHelpers/Base.pm +++ b/lib/MooseX/AttributeHelpers/Base.pm @@ -36,7 +36,7 @@ sub process_options_for_provides { (exists $options->{isa}) || confess "You must define a type with the $type metaclass"; - my $isa = $options->{isa}; + my $isa = $options->{isa}; unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) { $isa = find_type_constraint($isa); @@ -45,9 +45,6 @@ sub process_options_for_provides { ($isa->is_a_type_of($type)) || confess "The type constraint for a $type ($options->{isa}) must be a subtype of $type"; } - - # this can be augmented by subclasses .. - inner(); } before '_process_options' => sub { diff --git a/lib/MooseX/AttributeHelpers/Collection.pm b/lib/MooseX/AttributeHelpers/Collection.pm new file mode 100644 index 0000000..f27a1ad --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Collection.pm @@ -0,0 +1,85 @@ + +package MooseX::AttributeHelpers::Collection; +use Moose; +use Moose::Util::TypeConstraints; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +extends 'MooseX::AttributeHelpers::Base'; + +has 'container_type' => ( + is => 'ro', + isa => 'Str', + predicate => 'has_container_type', +); + +has 'container_type_constraint' => ( + is => 'rw', + isa => 'Moose::Meta::TypeConstraint', + lazy => 1, + default => sub { + my $self = shift; + ($self->has_container_type) + || confess "You cannot create a container_type_constraint if you dont have a container type"; + + my $container_type = $self->container_type; + my $constraint = find_type_constraint($container_type); + + $constraint = subtype('Object', where { $_->isa($container_type) }) + unless $constraint; + + return $constraint; + } +); + +before 'process_options_for_provides' => sub { + my ($self, $options) = @_; + + if (exists $options->{isa}) { + my $type = $options->{isa}; + if ($type =~ /^(.*)\[(.*)\]$/) { + my $core_type = $1; + my $container_type = $2; + $options->{isa} = $core_type; + $options->{container_type} = $container_type; + } + } +}; + +no Moose; + +1; + +__END__ + +=pod + +=head1 NAME + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/AttributeHelpers/Collection/Array.pm b/lib/MooseX/AttributeHelpers/Collection/Array.pm index e9e9491..387e453 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Array.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Array.pm @@ -1,11 +1,12 @@ package MooseX::AttributeHelpers::Collection::Array; use Moose; +use Moose::Util::TypeConstraints; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; -extends 'MooseX::AttributeHelpers::Base'; +extends 'MooseX::AttributeHelpers::Collection'; sub helper_type { 'ArrayRef' } @@ -14,10 +15,22 @@ has '+method_constructors' => ( return +{ 'push' => sub { my $attr = shift; - return sub { - my $instance = shift; - push @{$attr->get_value($instance)} => @_; - }; + if ($attr->has_container_type) { + my $container_type_constraint = $attr->container_type_constraint; + return sub { + my $instance = shift; + $container_type_constraint->check($_) + || confess "Value $_ did not pass container type constraint" + foreach @_; + push @{$attr->get_value($instance)} => @_; + }; + } + else { + return sub { + my $instance = shift; + push @{$attr->get_value($instance)} => @_; + }; + } }, 'pop' => sub { my $attr = shift; @@ -25,10 +38,22 @@ has '+method_constructors' => ( }, 'unshift' => sub { my $attr = shift; - return sub { - my $instance = shift; - unshift @{$attr->get_value($instance)} => @_; - }; + if ($attr->has_container_type) { + my $container_type_constraint = $attr->container_type_constraint; + return sub { + my $instance = shift; + $container_type_constraint->check($_) + || confess "Value $_ did not pass container type constraint" + foreach @_; + unshift @{$attr->get_value($instance)} => @_; + }; + } + else { + return sub { + my $instance = shift; + unshift @{$attr->get_value($instance)} => @_; + }; + } }, 'shift' => sub { my $attr = shift; @@ -40,7 +65,17 @@ has '+method_constructors' => ( }, 'set' => sub { my $attr = shift; - return sub { $attr->get_value($_[0])->[$_[1]] = $_[2] }; + if ($attr->has_container_type) { + my $container_type_constraint = $attr->container_type_constraint; + return sub { + ($container_type_constraint->check($_[2])) + || confess "Value $_[2] did not pass container type constraint"; + $attr->get_value($_[0])->[$_[1]] = $_[2] + }; + } + else { + return sub { $attr->get_value($_[0])->[$_[1]] = $_[2] }; + } }, 'count' => sub { my $attr = shift; @@ -77,7 +112,7 @@ __END__ has 'options' => ( metaclass => 'Collection', is => 'ro', - isa => 'ArrayRef', + isa => 'ArrayRef[Int]', default => sub { [] }, provides => { 'push' => 'add_options', diff --git a/lib/MooseX/AttributeHelpers/Collection/Hash.pm b/lib/MooseX/AttributeHelpers/Collection/Hash.pm index c0a165f..fc07031 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Hash.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Hash.pm @@ -5,7 +5,7 @@ use Moose; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; -extends 'MooseX::AttributeHelpers::Base'; +extends 'MooseX::AttributeHelpers::Collection'; sub helper_type { 'HashRef' } @@ -18,8 +18,26 @@ has '+method_constructors' => ( }, 'set' => sub { my $attr = shift; - return sub { $attr->get_value($_[0])->{$_[1]} = $_[2] }; + if ($attr->has_container_type) { + my $container_type_constraint = $attr->container_type_constraint; + return sub { + ($container_type_constraint->check($_[2])) + || confess "Value $_[2] did not pass container type constraint"; + $attr->get_value($_[0])->{$_[1]} = $_[2] + }; + } + else { + return sub { $attr->get_value($_[0])->{$_[1]} = $_[2] }; + } }, + 'keys' => sub { + my $attr = shift; + return sub { keys %{$attr->get_value($_[0])} }; + }, + 'values' => sub { + my $attr = shift; + return sub { values %{$attr->get_value($_[0])} }; + }, 'count' => sub { my $attr = shift; return sub { scalar keys %{$attr->get_value($_[0])} }; diff --git a/lib/MooseX/AttributeHelpers/Counter.pm b/lib/MooseX/AttributeHelpers/Counter.pm index 0e8fb70..0ab0d71 100644 --- a/lib/MooseX/AttributeHelpers/Counter.pm +++ b/lib/MooseX/AttributeHelpers/Counter.pm @@ -1,7 +1,6 @@ package MooseX::AttributeHelpers::Counter; use Moose; -use Moose::Util::TypeConstraints; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; @@ -26,7 +25,6 @@ has '+method_constructors' => ( ); no Moose; -no Moose::Util::TypeConstraints; # register the alias ... package Moose::Meta::Attribute::Custom::Counter; diff --git a/lib/MooseX/AttributeHelpers/Number.pm b/lib/MooseX/AttributeHelpers/Number.pm index eb03977..ee1ebbb 100644 --- a/lib/MooseX/AttributeHelpers/Number.pm +++ b/lib/MooseX/AttributeHelpers/Number.pm @@ -1,6 +1,5 @@ package MooseX::AttributeHelpers::Number; use Moose; -use Moose::Util::TypeConstraints; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; @@ -45,7 +44,6 @@ has '+method_constructors' => ( ); no Moose; -no Moose::Util::TypeConstraints; # register the alias ... package Moose::Meta::Attribute::Custom::Number; @@ -96,7 +94,7 @@ to cpan-RT. =head1 AUTHOR -Stevan Little Estevan@iinteractive.comE +Robert Boone =head1 COPYRIGHT AND LICENSE diff --git a/t/001_basic_counter.t b/t/001_basic_counter.t index 107314f..64cc641 100644 --- a/t/001_basic_counter.t +++ b/t/001_basic_counter.t @@ -28,6 +28,9 @@ BEGIN { my $page = MyHomePage->new(); isa_ok($page, 'MyHomePage'); +can_ok($page, 'inc_counter'); +can_ok($page, 'dec_counter'); + is($page->counter, 0, '... got the default value'); $page->inc_counter; @@ -39,5 +42,17 @@ is($page->counter, 2, '... got the incremented value (again)'); $page->dec_counter; is($page->counter, 1, '... got the decremented value'); +# check the meta .. + +my $counter = $page->meta->get_attribute('counter'); +isa_ok($counter, 'MooseX::AttributeHelpers::Counter'); + +is($counter->helper_type, 'Num', '... got the expected helper type'); + +is($counter->type_constraint->name, 'Int', '... got the expected type constraint'); +is_deeply($counter->provides, { + inc => 'inc_counter', + dec => 'dec_counter', +}, '... got the right provides methods'); diff --git a/t/002_basic_collection.t b/t/002_basic_collection.t index f0ebb98..4b3eddd 100644 --- a/t/002_basic_collection.t +++ b/t/002_basic_collection.t @@ -16,11 +16,17 @@ BEGIN { has 'options' => ( metaclass => 'Collection::Array', is => 'ro', - isa => 'ArrayRef', + isa => 'ArrayRef[Int]', default => sub { [] }, provides => { - 'push' => 'add_options', - 'pop' => 'remove_last_option', + 'push' => 'add_options', + 'pop' => 'remove_last_option', + 'shift' => 'remove_first_option', + 'unshift' => 'insert_options', + 'get' => 'get_option_at', + 'set' => 'set_option_at', + 'count' => 'num_options', + 'empty' => 'has_options', } ); } @@ -28,17 +34,74 @@ BEGIN { my $stuff = Stuff->new(); isa_ok($stuff, 'Stuff'); +can_ok($stuff, $_) for qw[ + add_options + remove_last_option + remove_first_option + insert_options + get_option_at + set_option_at + num_options + has_options +]; + is_deeply($stuff->options, [], '... no options yet'); +ok(!$stuff->has_options, '... no options'); +is($stuff->num_options, 0, '... got no options'); + $stuff->add_options(1, 2, 3); is_deeply($stuff->options, [1, 2, 3], '... got options now'); +ok($stuff->has_options, '... no options'); +is($stuff->num_options, 3, '... got 3 options'); + +is($stuff->get_option_at(0), 1, '... get option at index 0'); +is($stuff->get_option_at(1), 2, '... get option at index 1'); +is($stuff->get_option_at(2), 3, '... get option at index 2'); + +$stuff->set_option_at(1, 100); + +is($stuff->get_option_at(1), 100, '... get option at index 1'); + $stuff->add_options(10, 15); -is_deeply($stuff->options, [1, 2, 3, 10, 15], '... got more options now'); +is_deeply($stuff->options, [1, 100, 3, 10, 15], '... got more options now'); + +is($stuff->num_options, 5, '... got 5 options'); is($stuff->remove_last_option, 15, '... removed the last option'); -is_deeply($stuff->options, [1, 2, 3, 10], '... got diff options now'); +is($stuff->num_options, 4, '... got 4 options'); +is_deeply($stuff->options, [1, 100, 3, 10], '... got diff options now'); + +$stuff->insert_options(10, 20); + +is($stuff->num_options, 6, '... got 6 options'); +is_deeply($stuff->options, [10, 20, 1, 100, 3, 10], '... got diff options now'); + +is($stuff->get_option_at(0), 10, '... get option at index 0'); +is($stuff->get_option_at(1), 20, '... get option at index 1'); +is($stuff->get_option_at(3), 100, '... get option at index 3'); + +is($stuff->remove_first_option, 10, '... getting the first option'); + +is($stuff->num_options, 5, '... got 5 options'); +is($stuff->get_option_at(0), 20, '... get option at index 0'); + +## test the meta + +my $options = $stuff->meta->get_attribute('options'); +isa_ok($options, 'MooseX::AttributeHelpers::Collection::Array'); +is_deeply($options->provides, { + 'push' => 'add_options', + 'pop' => 'remove_last_option', + 'shift' => 'remove_first_option', + 'unshift' => 'insert_options', + 'get' => 'get_option_at', + 'set' => 'set_option_at', + 'count' => 'num_options', + 'empty' => 'has_options', +}, '... got the right provies mapping');