From: Stevan Little Date: Fri, 23 Nov 2007 20:37:06 +0000 (+0000) Subject: adding in the new junk to this X-Git-Tag: 0.18_01~56 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9a9764976656e1a089735d0cb1f1affd06f4d7e4;p=gitmo%2FMooseX-AttributeHelpers.git adding in the new junk to this --- diff --git a/Build.PL b/Build.PL index f595d06..f49b1c7 100644 --- a/Build.PL +++ b/Build.PL @@ -6,7 +6,8 @@ my $build = Module::Build->new( module_name => 'MooseX::AttributeHelpers', license => 'perl', requires => { - 'Moose' => '0.24', + 'Class::MOP' => '0.46', + 'Moose' => '0.30', }, optional => { }, diff --git a/ChangeLog b/ChangeLog index 690f5cf..726b03f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,30 @@ Revision history for Perl extension MooseX-AttributeHelpers -0.03 +0.04 + * MooseX::AttributeHelpers::Base + - changing this to use the new Class::MOP::Attribute + reader and write method ref stuff. + - fixed this to use find_or_create_type_constraint + instead of trying to parse stuff on our own. + + * MooseX::AttributeHelpers::Collection + - this is pretty much empty subclass now cause of + the find_or_create_type_constraint fix above + + + MooseX::AttributeHelpers::Collection::ImmutableHash + + MooseX::AttributeHelpers::Collection::Bag + - added these two new collection types + - added method provider roles for them + - added tests for them + + * MooseX::AttributeHelpers::MethodProvider::Hash + - this is now composed from the ImmutableHash + method provider + + * t/ + - fixed the plans on all the tests + +0.03 Mon. Sept. 17, 2007 ~~ more misc. doc updates ~~ * MooseX::AttributeHelpers::Counter diff --git a/MANIFEST b/MANIFEST index a68ebcf..69b57e3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,22 +1,25 @@ Build.PL ChangeLog -META.yml -Makefile.PL MANIFEST -MANIFEST.SKIP README +META.yml +Makefile.PL lib/MooseX/AttributeHelpers.pm lib/MooseX/AttributeHelpers/Base.pm lib/MooseX/AttributeHelpers/Collection.pm lib/MooseX/AttributeHelpers/Counter.pm lib/MooseX/AttributeHelpers/Number.pm lib/MooseX/AttributeHelpers/Collection/Array.pm +lib/MooseX/AttributeHelpers/Collection/Bag.pm lib/MooseX/AttributeHelpers/Collection/Hash.pm +lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm lib/MooseX/AttributeHelpers/Collection/List.pm lib/MooseX/AttributeHelpers/Meta/Method/Provided.pm lib/MooseX/AttributeHelpers/MethodProvider/Array.pm +lib/MooseX/AttributeHelpers/MethodProvider/Bag.pm lib/MooseX/AttributeHelpers/MethodProvider/Counter.pm lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm +lib/MooseX/AttributeHelpers/MethodProvider/ImmutableHash.pm lib/MooseX/AttributeHelpers/MethodProvider/List.pm t/000_load.t t/001_basic_counter.t @@ -24,7 +27,9 @@ t/002_basic_array.t t/003_basic_hash.t t/004_basic_number.t t/005_basic_list.t +t/006_basic_bag.t t/010_array_from_role.t +t/011_counter_with_defaults.t t/100_collection_with_roles.t t/pod.t t/pod_coverage.t diff --git a/README b/README index d6c08d3..133b3b8 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -MooseX::AttributeHelpers version 0.03 +MooseX::AttributeHelpers version 0.04 =========================== See the individual module documentation for more information diff --git a/lib/MooseX/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm index d1e6d47..15cac8e 100644 --- a/lib/MooseX/AttributeHelpers.pm +++ b/lib/MooseX/AttributeHelpers.pm @@ -1,7 +1,7 @@ package MooseX::AttributeHelpers; -our $VERSION = '0.03'; +our $VERSION = '0.04'; our $AUTHORITY = 'cpan:STEVAN'; use MooseX::AttributeHelpers::Meta::Method::Provided; @@ -11,6 +11,8 @@ use MooseX::AttributeHelpers::Number; use MooseX::AttributeHelpers::Collection::List; use MooseX::AttributeHelpers::Collection::Array; use MooseX::AttributeHelpers::Collection::Hash; +use MooseX::AttributeHelpers::Collection::ImmutableHash; +use MooseX::AttributeHelpers::Collection::Bag; 1; diff --git a/lib/MooseX/AttributeHelpers/Base.pm b/lib/MooseX/AttributeHelpers/Base.pm index 00c3004..2c403a9 100644 --- a/lib/MooseX/AttributeHelpers/Base.pm +++ b/lib/MooseX/AttributeHelpers/Base.pm @@ -3,7 +3,7 @@ package MooseX::AttributeHelpers::Base; use Moose; use Moose::Util::TypeConstraints; -our $VERSION = '0.02'; +our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; extends 'Moose::Meta::Attribute'; @@ -66,7 +66,7 @@ sub process_options_for_provides { my $isa = $options->{isa}; unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) { - $isa = find_type_constraint($isa); + $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint($isa); } ($isa->is_a_type_of($type)) @@ -101,20 +101,9 @@ after 'install_accessors' => sub { # grab the reader and writer methods # as well, this will be useful for # our method provider constructors - my ($attr_reader, $attr_writer); - if (my $reader = $attr->get_read_method) { - $attr_reader = $class->get_method($reader); - } - else { - $attr_reader = sub { $attr->get_value(@_) }; - } - - if (my $writer = $attr->get_write_method) { - $attr_writer = $class->get_method($writer); - } - else { - $attr_writer = sub { $attr->set_value(@_) }; - } + my $attr_reader = $attr->get_read_method_ref; + my $attr_writer = $attr->get_write_method_ref; + # before we install them, lets # make sure they are valid @@ -125,16 +114,17 @@ after 'install_accessors' => sub { foreach my $key (keys %{$attr->provides}) { my $method_name = $attr->provides->{$key}; + + if ($class->has_method($method_name)) { + confess "The method ($method_name) already exists in class (" . $class->name . ")"; + } + my $method_body = $method_constructors->{$key}->( $attr, $attr_reader, $attr_writer, ); - if ($class->has_method($method_name)) { - confess "The method ($method_name) already exists in class (" . $class->name . ")"; - } - $class->add_method($method_name => MooseX::AttributeHelpers::Meta::Method::Provided->wrap( $method_body, diff --git a/lib/MooseX/AttributeHelpers/Collection.pm b/lib/MooseX/AttributeHelpers/Collection.pm index 4623d67..6b4514b 100644 --- a/lib/MooseX/AttributeHelpers/Collection.pm +++ b/lib/MooseX/AttributeHelpers/Collection.pm @@ -1,73 +1,13 @@ package MooseX::AttributeHelpers::Collection; use Moose; -use Moose::Util::TypeConstraints; -our $VERSION = '0.01'; +our $VERSION = '0.03'; 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', -); - -before 'process_options_for_provides' => sub { - my ($self, $options) = @_; - - if (exists $options->{isa}) { - my $type = $options->{isa}; - - # ... we should check if the type exists already - # and then we should use it,.. however, this means - # we need to extract the container type constraint - # as well, which is a little trickier - - if ($type =~ /^(.*)\[(.*)\]$/) { - my $core_type = $1; - my $container_type = $2; - - $options->{container_type} = $container_type; - - my $container_type_constraint = find_type_constraint($container_type); - - # NOTE: - # I am not sure DWIM-ery is a good thing - # here, so i am going to err on the side - # of caution, and blow up if you have - # not made a type constraint for this yet. - # - SL - (defined $container_type_constraint) - || confess "You must predefine the '$container_type' constraint before you can use it as a container type"; - - $options->{container_type_constraint} = $container_type_constraint; - - if ($core_type eq 'ArrayRef') { - $options->{isa} = subtype('ArrayRef' => where { - foreach my $x (@$_) { ($container_type_constraint->check($x)) || return } 1; - }); - } - elsif ($core_type eq 'HashRef') { - $options->{isa} = subtype('HashRef' => where { - foreach my $x (values %$_) { ($container_type_constraint->check($x)) || return } 1; - }); - } - else { - confess "Your isa must be either ArrayRef or HashRef (sorry no subtype support yet)"; - } - } - } -}; - no Moose; -no Moose::Util::TypeConstraints; 1; diff --git a/lib/MooseX/AttributeHelpers/Collection/Bag.pm b/lib/MooseX/AttributeHelpers/Collection/Bag.pm new file mode 100644 index 0000000..3b1afd9 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Collection/Bag.pm @@ -0,0 +1,109 @@ + +package MooseX::AttributeHelpers::Collection::Bag; +use Moose; +use Moose::Util::TypeConstraints; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::Bag; + +extends 'MooseX::AttributeHelpers::Collection'; + +has '+method_provider' => ( + default => 'MooseX::AttributeHelpers::MethodProvider::Bag' +); + +subtype 'Bag' => as 'HashRef[Int]'; + +sub helper_type { 'Bag' } + +before 'process_options_for_provides' => sub { + my ($self, $options, $name) = @_; + + # Set some default attribute options here unless already defined + if ((my $type = $self->helper_type) && !exists $options->{isa}){ + $options->{isa} = $type; + } + + $options->{default} = sub { +{} } unless exists $options->{default}; +}; + +no Moose; +no Moose::Util::TypeConstraints; + +# register the alias ... +package Moose::Meta::Attribute::Custom::Collection::Bag; +sub register_implementation { 'MooseX::AttributeHelpers::Collection::Bag' } + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Collection::Bag + +=head1 SYNOPSIS + + package Stuff; + use Moose; + use MooseX::AttributeHelpers; + + has 'word_histogram' => ( + metaclass => 'Collection::Bag', + is => 'ro', + isa => 'Bag', # optional ... as is defalt + provides => { + 'add' => 'add_word', + 'get' => 'get_count_for', + 'empty' => 'has_any_words', + 'count' => 'num_words', + 'delete' => 'delete_word', + } + ); + +=head1 DESCRIPTION + +This module provides a Bag attribute which provides a number of +bag-like operations. See L +for more details. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=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 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 \ No newline at end of file diff --git a/lib/MooseX/AttributeHelpers/Collection/Hash.pm b/lib/MooseX/AttributeHelpers/Collection/Hash.pm index b23130d..6715a7d 100644 --- a/lib/MooseX/AttributeHelpers/Collection/Hash.pm +++ b/lib/MooseX/AttributeHelpers/Collection/Hash.pm @@ -2,7 +2,7 @@ package MooseX::AttributeHelpers::Collection::Hash; use Moose; -our $VERSION = '0.01'; +our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; use MooseX::AttributeHelpers::MethodProvider::Hash; @@ -54,8 +54,8 @@ MooseX::AttributeHelpers::Collection::Hash =head1 DESCRIPTION -This module provides an Array attribute which provides a number of -array operations. See L +This module provides an Hash attribute which provides a number of +hash-like operations. See L for more details. =head1 METHODS diff --git a/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm b/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm new file mode 100644 index 0000000..32a02af --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Collection/ImmutableHash.pm @@ -0,0 +1,92 @@ + +package MooseX::AttributeHelpers::Collection::ImmutableHash; +use Moose; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use MooseX::AttributeHelpers::MethodProvider::ImmutableHash; + +extends 'MooseX::AttributeHelpers::Collection'; + +has '+method_provider' => ( + default => 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash' +); + +sub helper_type { 'HashRef' } + +no Moose; + +# register the alias ... +package Moose::Meta::Attribute::Custom::Collection::ImmutableHash; +sub register_implementation { 'MooseX::AttributeHelpers::Collection::ImmutableHash' } + + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Collection::ImmutableHash + +=head1 SYNOPSIS + + package Stuff; + use Moose; + use MooseX::AttributeHelpers; + + has 'options' => ( + metaclass => 'Collection::ImmutableHash', + is => 'ro', + isa => 'HashRef[Str]', + default => sub { {} }, + provides => { + 'get' => 'get_option', + 'empty' => 'has_options', + 'keys' => 'get_option_list', + } + ); + +=head1 DESCRIPTION + +This module provides a immutable HashRef attribute which provides a number of +hash-line operations. See L +for more details. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=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 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 \ No newline at end of file diff --git a/lib/MooseX/AttributeHelpers/Counter.pm b/lib/MooseX/AttributeHelpers/Counter.pm index 31da9ff..48b0e21 100644 --- a/lib/MooseX/AttributeHelpers/Counter.pm +++ b/lib/MooseX/AttributeHelpers/Counter.pm @@ -2,7 +2,7 @@ package MooseX::AttributeHelpers::Counter; use Moose; -our $VERSION = '0.02'; +our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; use MooseX::AttributeHelpers::MethodProvider::Counter; @@ -19,8 +19,8 @@ before 'process_options_for_provides' => sub { my ($self, $options, $name) = @_; # Set some default attribute options here unless already defined - if (my $type = $self->helper_type && !exists $options->{isa}){ - $options->{isa} = $self->helper_type; + if ((my $type = $self->helper_type) && !exists $options->{isa}){ + $options->{isa} = $type; } $options->{is} = 'ro' unless exists $options->{is}; diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm index 5336366..07c341b 100644 --- a/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm +++ b/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm @@ -1,7 +1,7 @@ package MooseX::AttributeHelpers::MethodProvider::Array; use Moose::Role; -our $VERSION = '0.03'; +our $VERSION = '0.05'; our $AUTHORITY = 'cpan:STEVAN'; with 'MooseX::AttributeHelpers::MethodProvider::List'; @@ -9,8 +9,8 @@ with 'MooseX::AttributeHelpers::MethodProvider::List'; sub push : method { my ($attr, $reader, $writer) = @_; - if ($attr->has_container_type) { - my $container_type_constraint = $attr->container_type_constraint; + if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) { + my $container_type_constraint = $attr->type_constraint->type_parameter; return sub { my $instance = CORE::shift; $container_type_constraint->check($_) @@ -36,8 +36,8 @@ sub pop : method { sub unshift : method { my ($attr, $reader, $writer) = @_; - if ($attr->has_container_type) { - my $container_type_constraint = $attr->container_type_constraint; + if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) { + my $container_type_constraint = $attr->type_constraint->type_parameter; return sub { my $instance = CORE::shift; $container_type_constraint->check($_) @@ -70,8 +70,8 @@ sub get : method { sub set : method { my ($attr, $reader, $writer) = @_; - if ($attr->has_container_type) { - my $container_type_constraint = $attr->container_type_constraint; + if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) { + my $container_type_constraint = $attr->type_constraint->type_parameter; return sub { ($container_type_constraint->check($_[2])) || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint"; @@ -101,17 +101,17 @@ sub delete : method { sub insert : method { my ($attr, $reader, $writer) = @_; - if ($attr->has_container_type) { - my $container_type_constraint = $attr->container_type_constraint; + if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) { + my $container_type_constraint = $attr->type_constraint->type_parameter; return sub { ($container_type_constraint->check($_[2])) || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint"; - splice @{$reader->($_[0])}, $_[1], 0, $_[2]; + CORE::splice @{$reader->($_[0])}, $_[1], 0, $_[2]; }; } else { return sub { - splice @{$reader->($_[0])}, $_[1], 0, $_[2]; + CORE::splice @{$reader->($_[0])}, $_[1], 0, $_[2]; }; } } diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/Bag.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Bag.pm new file mode 100644 index 0000000..e59e016 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/MethodProvider/Bag.pm @@ -0,0 +1,96 @@ +package MooseX::AttributeHelpers::MethodProvider::Bag; +use Moose::Role; + +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; + +with 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash'; + +sub add : method { + my ($attr, $reader, $writer) = @_; + return sub { $reader->($_[0])->{$_[1]}++ }; +} + +sub delete : method { + my ($attr, $reader, $writer) = @_; + return sub { CORE::delete $reader->($_[0])->{$_[1]} }; +} + +sub reset : method { + my ($attr, $reader, $writer) = @_; + return sub { $reader->($_[0])->{$_[1]} = 0 }; +} + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::MethodProvider::Bag + +=head1 DESCRIPTION + +This is a role which provides the method generators for +L. + +This role is composed from the +L role. + +=head1 METHODS + +=over 4 + +=item B + +=back + +=head1 PROVIDED METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=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 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/MethodProvider/Hash.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm index 5f2cde3..f70c5ef 100644 --- a/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm +++ b/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm @@ -1,23 +1,15 @@ package MooseX::AttributeHelpers::MethodProvider::Hash; use Moose::Role; -our $VERSION = '0.01'; +our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; -sub exists : method { - my ($attr, $reader, $writer) = @_; - return sub { exists $reader->($_[0])->{$_[1]} ? 1 : 0 }; -} - -sub get : method { - my ($attr, $reader, $writer) = @_; - return sub { $reader->($_[0])->{$_[1]} }; -} +with 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash'; sub set : method { my ($attr, $reader, $writer) = @_; - if ($attr->has_container_type) { - my $container_type_constraint = $attr->container_type_constraint; + if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) { + my $container_type_constraint = $attr->type_constraint->type_parameter; return sub { ($container_type_constraint->check($_[2])) || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint"; @@ -29,26 +21,6 @@ sub set : method { } } -sub keys : method { - my ($attr, $reader, $writer) = @_; - return sub { keys %{$reader->($_[0])} }; -} - -sub values : method { - my ($attr, $reader, $writer) = @_; - return sub { values %{$reader->($_[0])} }; -} - -sub count : method { - my ($attr, $reader, $writer) = @_; - return sub { scalar keys %{$reader->($_[0])} }; -} - -sub empty : method { - my ($attr, $reader, $writer) = @_; - return sub { scalar keys %{$reader->($_[0])} ? 1 : 0 }; -} - sub clear : method { my ($attr, $reader, $writer) = @_; return sub { %{$reader->($_[0])} = () }; @@ -56,7 +28,7 @@ sub clear : method { sub delete : method { my ($attr, $reader, $writer) = @_; - return sub { delete $reader->($_[0])->{$_[1]} }; + return sub { CORE::delete $reader->($_[0])->{$_[1]} }; } 1; @@ -74,6 +46,9 @@ MooseX::AttributeHelpers::MethodProvider::Hash This is a role which provides the method generators for L. +This role is composed from the +L role. + =head1 METHODS =over 4 @@ -104,6 +79,8 @@ L. =item B +=item B + =back =head1 BUGS diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/ImmutableHash.pm b/lib/MooseX/AttributeHelpers/MethodProvider/ImmutableHash.pm new file mode 100644 index 0000000..ea96a19 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/MethodProvider/ImmutableHash.pm @@ -0,0 +1,110 @@ +package MooseX::AttributeHelpers::MethodProvider::ImmutableHash; +use Moose::Role; + +our $VERSION = '0.03'; +our $AUTHORITY = 'cpan:STEVAN'; + +sub exists : method { + my ($attr, $reader, $writer) = @_; + return sub { CORE::exists $reader->($_[0])->{$_[1]} ? 1 : 0 }; +} + +sub get : method { + my ($attr, $reader, $writer) = @_; + return sub { $reader->($_[0])->{$_[1]} }; +} + +sub keys : method { + my ($attr, $reader, $writer) = @_; + return sub { CORE::keys %{$reader->($_[0])} }; +} + +sub values : method { + my ($attr, $reader, $writer) = @_; + return sub { CORE::values %{$reader->($_[0])} }; +} + +sub kv : method { + my ($attr, $reader, $writer) = @_; + return sub { + my $h = $reader->($_[0]); + map { + [ $_, $h->{$_} ] + } CORE::keys %{$h} + }; +} + +sub count : method { + my ($attr, $reader, $writer) = @_; + return sub { scalar CORE::keys %{$reader->($_[0])} }; +} + +sub empty : method { + my ($attr, $reader, $writer) = @_; + return sub { scalar CORE::keys %{$reader->($_[0])} ? 1 : 0 }; +} + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::MethodProvider::ImmutableHash + +=head1 DESCRIPTION + +This is a role which provides the method generators for +L. + +=head1 METHODS + +=over 4 + +=item B + +=back + +=head1 PROVIDED METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=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 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/t/000_load.t b/t/000_load.t index e62e167..30cd112 100644 --- a/t/000_load.t +++ b/t/000_load.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 1; BEGIN { use_ok('MooseX::AttributeHelpers'); diff --git a/t/001_basic_counter.t b/t/001_basic_counter.t index ff63f2c..1f7d760 100644 --- a/t/001_basic_counter.t +++ b/t/001_basic_counter.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 14; BEGIN { use_ok('MooseX::AttributeHelpers'); diff --git a/t/002_basic_array.t b/t/002_basic_array.t index 4cc3404..27520ee 100644 --- a/t/002_basic_array.t +++ b/t/002_basic_array.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 51; use Test::Exception; BEGIN { @@ -147,4 +147,4 @@ is_deeply($options->provides, { 'clear' => 'clear_options', }, '... got the right provies mapping'); -is($options->container_type, 'Int', '... got the right container type'); +is($options->type_constraint->type_parameter, 'Int', '... got the right container type'); diff --git a/t/003_basic_hash.t b/t/003_basic_hash.t index 8888f4b..c0b3a2a 100644 --- a/t/003_basic_hash.t +++ b/t/003_basic_hash.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 26; use Test::Exception; BEGIN { diff --git a/t/004_basic_number.t b/t/004_basic_number.t index 519b9f6..0ca838e 100644 --- a/t/004_basic_number.t +++ b/t/004_basic_number.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 18; BEGIN { use_ok('MooseX::AttributeHelpers'); diff --git a/t/005_basic_list.t b/t/005_basic_list.t index 83e6324..bb8d10f 100644 --- a/t/005_basic_list.t +++ b/t/005_basic_list.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 16; use Test::Exception; BEGIN { @@ -72,4 +72,4 @@ is_deeply($options->provides, { 'empty' => 'has_options', }, '... got the right provies mapping'); -is($options->container_type, 'Int', '... got the right container type'); +is($options->type_constraint->type_parameter, 'Int', '... got the right container type'); diff --git a/t/006_basic_bag.t b/t/006_basic_bag.t new file mode 100644 index 0000000..a90bbc9 --- /dev/null +++ b/t/006_basic_bag.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 18; +use Test::Exception; + +BEGIN { + use_ok('MooseX::AttributeHelpers'); +} + +{ + package Stuff; + use Moose; + use MooseX::AttributeHelpers; + + has 'word_histogram' => ( + metaclass => 'Collection::Bag', + is => 'ro', + provides => { + 'add' => 'add_word', + 'get' => 'get_count_for', + 'empty' => 'has_any_words', + 'count' => 'num_words', + 'delete' => 'delete_word', + } + ); +} + +my $stuff = Stuff->new(); +isa_ok($stuff, 'Stuff'); + +can_ok($stuff, $_) for qw[ + add_word + get_count_for + has_any_words + num_words + delete_word +]; + +ok(!$stuff->has_any_words, '... we have no words'); +is($stuff->num_words, 0, '... we have no words'); + +lives_ok { + $stuff->add_word('bar'); +} '... set the words okay'; + +ok($stuff->has_any_words, '... we have words'); +is($stuff->num_words, 1, '... we have 1 word(s)'); +is($stuff->get_count_for('bar'), 1, '... got words now'); + +lives_ok { + $stuff->add_word('foo'); + $stuff->add_word('bar') for 0 .. 3; + $stuff->add_word('baz') for 0 .. 10; +} '... set the words okay'; + +is($stuff->num_words, 3, '... we still have 1 word(s)'); +is($stuff->get_count_for('foo'), 1, '... got words now'); +is($stuff->get_count_for('bar'), 5, '... got words now'); +is($stuff->get_count_for('baz'), 11, '... got words now'); + + + diff --git a/t/010_array_from_role.t b/t/010_array_from_role.t index c28a0f7..60bc06c 100644 --- a/t/010_array_from_role.t +++ b/t/010_array_from_role.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 3; use Test::Exception; BEGIN { diff --git a/t/011_counter_with_defaults.t b/t/011_counter_with_defaults.t index 5a5e74d..37ed3bc 100644 --- a/t/011_counter_with_defaults.t +++ b/t/011_counter_with_defaults.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 14; BEGIN { use_ok('MooseX::AttributeHelpers'); diff --git a/t/100_collection_with_roles.t b/t/100_collection_with_roles.t index a2c8a31..164665d 100644 --- a/t/100_collection_with_roles.t +++ b/t/100_collection_with_roles.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 29; BEGIN { use_ok('MooseX::AttributeHelpers');