ec8dac5ee33a64fd52d79a0b074141fb516d62a3
[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider / Hash.pm
1 package MooseX::AttributeHelpers::MethodProvider::Hash;
2 use Moose::Role;
3
4 our $VERSION   = '0.04';
5 our $AUTHORITY = 'cpan:STEVAN';
6
7 with 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash';
8
9 sub set : method {
10     my ($attr, $reader, $writer) = @_;
11     if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
12         my $container_type_constraint = $attr->type_constraint->type_parameter;
13         return sub { 
14             my ( $self, @kvp ) = @_;
15            
16             my ( @keys, @values );
17
18             while ( @kvp ) {
19                 my ( $key, $value ) = ( shift(@kvp), shift(@kvp) );
20                 ($container_type_constraint->check($value)) 
21                     || confess "Value " . ($value||'undef') . " did not pass container type constraint";
22                 push @keys, $key;
23                 push @values, $value;
24             }
25
26             if ( @values > 1 ) {
27                 @{ $reader->($self) }{@keys} = @values;
28             } else {
29                 $reader->($self)->{$keys[0]} = $values[0];
30             }
31         };
32     }
33     else {
34         return sub {
35             if ( @_ == 3 ) {
36                 $reader->($_[0])->{$_[1]} = $_[2]
37             } else {
38                 my ( $self, @kvp ) = @_;
39                 my ( @keys, @values );
40
41                 while ( @kvp ) {
42                     push @keys, shift @kvp;
43                     push @values, shift @kvp;
44                 }
45
46                 @{ $reader->($_[0]) }{@keys} = @values;
47             }
48         };
49     }
50 }
51
52 sub clear : method {
53     my ($attr, $reader, $writer) = @_;
54     return sub { %{$reader->($_[0])} = () };
55 }
56
57 sub delete : method {
58     my ($attr, $reader, $writer) = @_;
59     return sub { CORE::delete $reader->($_[0])->{$_[1]} };
60 }
61
62 1;
63
64 __END__
65
66 =pod
67
68 =head1 NAME
69
70 MooseX::AttributeHelpers::MethodProvider::Hash
71   
72 =head1 DESCRIPTION
73
74 This is a role which provides the method generators for 
75 L<MooseX::AttributeHelpers::Collection::Hash>.
76
77 This role is composed from the 
78 L<MooseX::AttributeHelpers::Collection::ImmutableHash> role.
79
80 =head1 METHODS
81
82 =over 4
83
84 =item B<meta>
85
86 =back
87
88 =head1 PROVIDED METHODS
89
90 =over 4
91
92 =item B<count>
93
94 =item B<delete>
95
96 =item B<empty>
97
98 =item B<clear>
99
100 =item B<exists>
101
102 =item B<get>
103
104 =item B<keys>
105
106 =item B<set>
107
108 =item B<values>
109
110 =item B<kv>
111
112 =back
113
114 =head1 BUGS
115
116 All complex software has bugs lurking in it, and this module is no 
117 exception. If you find a bug please either email me, or add the bug
118 to cpan-RT.
119
120 =head1 AUTHOR
121
122 Stevan Little E<lt>stevan@iinteractive.comE<gt>
123
124 =head1 COPYRIGHT AND LICENSE
125
126 Copyright 2007-2008 by Infinity Interactive, Inc.
127
128 L<http://www.iinteractive.com>
129
130 This library is free software; you can redistribute it and/or modify
131 it under the same terms as Perl itself.
132
133 =cut
134