From: Shawn M Moore Date: Thu, 14 May 2009 04:41:57 +0000 (-0400) Subject: Add accessor to Collection::Hash X-Git-Tag: 0.18_01~8^2~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=671d0d24bba344c05d06cc0950a73b4e46fc668c;hp=de9d98c6a3686c5cc696602da01905fedc7e7548;p=gitmo%2FMooseX-AttributeHelpers.git Add accessor to Collection::Hash --- diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm index b6e9103..e3f03f9 100644 --- a/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm +++ b/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm @@ -50,6 +50,44 @@ sub set : method { } } +sub accessor : method { + my ($attr, $reader, $writer) = @_; + + 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 $self = shift; + + if (@_ == 1) { # reader + return $reader->($self)->{$_[0]}; + } + elsif (@_ == 2) { # writer + ($container_type_constraint->check($_[1])) + || confess "Value " . ($_[1]||'undef') . " did not pass container type constraint"; + $reader->($self)->{$_[0]} = $_[1]; + } + else { + confess "One or two arguments expected, not " . @_; + } + }; + } + else { + return sub { + my $self = shift; + + if (@_ == 1) { # reader + return $reader->($self)->{$_[0]}; + } + elsif (@_ == 2) { # writer + $reader->($self)->{$_[0]} = $_[1]; + } + else { + confess "One or two arguments expected, not " . @_; + } + }; + } +} + sub clear : method { my ($attr, $reader, $writer) = @_; return sub { %{$reader->($_[0])} = () }; @@ -137,6 +175,11 @@ Returns the list of values in the hash. Returns the key, value pairs in the hash +=item B + +If passed one argument, returns the value of the requested key. If passed two +arguments, sets the value of the requested key. + =back =head1 BUGS diff --git a/t/003_basic_hash.t b/t/003_basic_hash.t index e32c830..79ca4cd 100644 --- a/t/003_basic_hash.t +++ b/t/003_basic_hash.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 42; +use Test::More tests => 45; use Test::Exception; BEGIN { @@ -21,18 +21,19 @@ BEGIN { isa => 'HashRef[Str]', default => sub { {} }, provides => { - 'set' => 'set_option', - 'get' => 'get_option', - 'empty' => 'has_options', - 'count' => 'num_options', - 'clear' => 'clear_options', - 'delete' => 'delete_option', - 'exists' => 'has_option', - 'defined'=> 'is_defined', + 'set' => 'set_option', + 'get' => 'get_option', + 'empty' => 'has_options', + 'count' => 'num_options', + 'clear' => 'clear_options', + 'delete' => 'delete_option', + 'exists' => 'has_option', + 'defined' => 'is_defined', + 'accessor' => 'option_accessor', }, curries => { - 'set' => { - set_quantity => ['quantity'] + 'accessor' => { + quantity => ['quantity'], }, } ); @@ -50,6 +51,8 @@ can_ok($stuff, $_) for qw[ clear_options is_defined has_option + quantity + option_accessor ]; ok(!$stuff->has_options, '... we have no options'); @@ -107,9 +110,11 @@ $stuff->clear_options; is_deeply($stuff->options, { }, "... cleared options" ); lives_ok { - $stuff->set_quantity(4); + $stuff->quantity(4); } '... options added okay with defaults'; +is($stuff->quantity, 4, 'reader part of curried accessor works'); + is_deeply($stuff->options, {quantity => 4}, '... returns what we expect'); lives_ok { @@ -132,14 +137,15 @@ my $options = $stuff->meta->get_attribute('options'); isa_ok($options, 'MooseX::AttributeHelpers::Collection::Hash'); is_deeply($options->provides, { - 'set' => 'set_option', - 'get' => 'get_option', - 'empty' => 'has_options', - 'count' => 'num_options', - 'clear' => 'clear_options', - 'delete' => 'delete_option', - 'defined' => 'is_defined', - 'exists' => 'has_option', -}, '... got the right provies mapping'); + 'set' => 'set_option', + 'get' => 'get_option', + 'empty' => 'has_options', + 'count' => 'num_options', + 'clear' => 'clear_options', + 'delete' => 'delete_option', + 'defined' => 'is_defined', + 'exists' => 'has_option', + 'accessor' => 'option_accessor', +}, '... got the right provides mapping'); is($options->type_constraint->type_parameter, 'Str', '... got the right container type');