X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FAttributeHelpers%2FMethodProvider%2FHash.pm;h=5b61617fea485d3c27c3ff6eb971f38d270372c0;hb=1ccccb1f899425f1da631506c0a8370df9419e5c;hp=986c0855985c6ef0f73973062aa29e986cca7d60;hpb=5431dff2bf81c8286d40150d9f87a42a2a3e994c;p=gitmo%2FMooseX-AttributeHelpers.git diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm index 986c085..5b61617 100644 --- a/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm +++ b/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm @@ -1,54 +1,65 @@ package MooseX::AttributeHelpers::MethodProvider::Hash; use Moose::Role; -sub exists : method { - my ($attr) = @_; - return sub { exists $attr->get_value($_[0])->{$_[1]} ? 1 : 0 }; -} +our $VERSION = '0.11'; +our $AUTHORITY = 'cpan:STEVAN'; -sub get : method { - my ($attr) = @_; - return sub { $attr->get_value($_[0])->{$_[1]} }; -} +with 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash'; sub set : method { - my ($attr) = @_; - if ($attr->has_container_type) { - my $container_type_constraint = $attr->container_type_constraint; + 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 { - ($container_type_constraint->check($_[2])) - || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint"; - $attr->get_value($_[0])->{$_[1]} = $_[2] + my ( $self, @kvp ) = @_; + + my ( @keys, @values ); + + while ( @kvp ) { + my ( $key, $value ) = ( shift(@kvp), shift(@kvp) ); + ($container_type_constraint->check($value)) + || confess "Value " . ($value||'undef') . " did not pass container type constraint"; + push @keys, $key; + push @values, $value; + } + + if ( @values > 1 ) { + @{ $reader->($self) }{@keys} = @values; + } else { + $reader->($self)->{$keys[0]} = $values[0]; + } }; } else { - return sub { $attr->get_value($_[0])->{$_[1]} = $_[2] }; + return sub { + if ( @_ == 3 ) { + $reader->($_[0])->{$_[1]} = $_[2] + } else { + my ( $self, @kvp ) = @_; + my ( @keys, @values ); + + while ( @kvp ) { + push @keys, shift @kvp; + push @values, shift @kvp; + } + + @{ $reader->($_[0]) }{@keys} = @values; + } + }; } } -sub keys : method { - my ($attr) = @_; - return sub { keys %{$attr->get_value($_[0])} }; -} - -sub values : method { - my ($attr) = @_; - return sub { values %{$attr->get_value($_[0])} }; -} - -sub count : method { - my ($attr) = @_; - return sub { scalar keys %{$attr->get_value($_[0])} }; -} - -sub empty : method { - my ($attr) = @_; - return sub { scalar keys %{$attr->get_value($_[0])} ? 1 : 0 }; +sub clear : method { + my ($attr, $reader, $writer) = @_; + return sub { %{$reader->($_[0])} = () }; } sub delete : method { - my ($attr) = @_; - return sub { delete $attr->get_value($_[0])->{$_[1]} }; + my ($attr, $reader, $writer) = @_; + return sub { + my $hashref = $reader->(shift); + CORE::delete @{$hashref}{@_}; + }; } 1; @@ -66,6 +77,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 @@ -84,6 +98,8 @@ L. =item B +=item B + =item B =item B @@ -94,6 +110,8 @@ L. =item B +=item B + =back =head1 BUGS @@ -108,7 +126,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L