Composite now implemented.

[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider / Hash.pm

diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm
index bca2cd3..2ab57a4 100644 (file)
--- a/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm
+++ b/lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm
@@ -1,56 +1,103 @@
 package MooseX::AttributeHelpers::MethodProvider::Hash;
 use Moose::Role;
+use MooseX::AttributeHelpers::Collection::TypeCheck;
 
-sub exists : method {
-    my ($attr) = @_;    
-    return sub { exists $attr->get_value($_[0])->{$_[1]} ? 1 : 0 };
-}   
+our $VERSION   = '0.04';
+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;
-        return sub { 
-            ($container_type_constraint->check($_[2])) 
-                || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";                        
-            $attr->get_value($_[0])->{$_[1]} = $_[2] 
-        };
-    }
-    else {
-        return sub { $attr->get_value($_[0])->{$_[1]} = $_[2] };
-    }
+    my ($attr, $reader, $writer) = @_;
+    type_check(
+        $attr, 
+        sub {
+            my ($self, %pairs) = @_;
+            return (values %pairs);
+        },
+        sub {
+            my ($self, @pairs) = @_;
+            my $hash = $reader->($self);
+            while (@pairs) {
+                my $key = shift(@pairs);
+                my $value = shift(@pairs);
+                $hash->{$key} = $value;
+            }
+        },
+    );
 }
 
-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;
 
-__END__
\ No newline at end of file
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::AttributeHelpers::MethodProvider::Hash
+  
+=head1 DESCRIPTION
+
+This is a role which provides the method generators for 
+L<MooseX::AttributeHelpers::Collection::Hash>.  It consumes 
+L<MooseX::AttributeHelpers::MethodProvider::ImmutableHash>, and thus 
+provides all its methods as wel.
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item B<count>
+
+Returns the number of items in the hash.
+
+=item B<delete(@keys)>
+
+Deletes the specified keys from the hash.
+
+=item B<clear>
+
+Deletes all keys from the hash.
+
+=item B<set>
+
+Sets the specified keys to the specified values.  You can specify several of
+these at once, in key => value order.
+
+=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 E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+