Commit | Line | Data |
e3c07b19 |
1 | package Moose::AttributeHelpers::MethodProvider::Hash; |
2 | use Moose::Role; |
3 | |
dbd46676 |
4 | our $VERSION = '0.83'; |
e3c07b19 |
5 | $VERSION = eval $VERSION; |
6 | our $AUTHORITY = 'cpan:STEVAN'; |
7 | |
8 | with 'Moose::AttributeHelpers::MethodProvider::ImmutableHash'; |
9 | |
10 | sub set : method { |
11 | my ($attr, $reader, $writer) = @_; |
12 | if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) { |
13 | my $container_type_constraint = $attr->type_constraint->type_parameter; |
14 | return sub { |
15 | my ( $self, @kvp ) = @_; |
16 | |
17 | my ( @keys, @values ); |
18 | |
19 | while ( @kvp ) { |
20 | my ( $key, $value ) = ( shift(@kvp), shift(@kvp) ); |
21 | ($container_type_constraint->check($value)) |
22 | || confess "Value " . ($value||'undef') . " did not pass container type constraint '$container_type_constraint'"; |
23 | push @keys, $key; |
24 | push @values, $value; |
25 | } |
26 | |
27 | if ( @values > 1 ) { |
28 | @{ $reader->($self) }{@keys} = @values; |
29 | } else { |
30 | $reader->($self)->{$keys[0]} = $values[0]; |
31 | } |
32 | }; |
33 | } |
34 | else { |
35 | return sub { |
36 | if ( @_ == 3 ) { |
37 | $reader->($_[0])->{$_[1]} = $_[2] |
38 | } else { |
39 | my ( $self, @kvp ) = @_; |
40 | my ( @keys, @values ); |
41 | |
42 | while ( @kvp ) { |
43 | push @keys, shift @kvp; |
44 | push @values, shift @kvp; |
45 | } |
46 | |
47 | @{ $reader->($_[0]) }{@keys} = @values; |
48 | } |
49 | }; |
50 | } |
51 | } |
52 | |
53 | sub accessor : method { |
54 | my ($attr, $reader, $writer) = @_; |
55 | |
56 | if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) { |
57 | my $container_type_constraint = $attr->type_constraint->type_parameter; |
58 | return sub { |
59 | my $self = shift; |
60 | |
61 | if (@_ == 1) { # reader |
62 | return $reader->($self)->{$_[0]}; |
63 | } |
64 | elsif (@_ == 2) { # writer |
65 | ($container_type_constraint->check($_[1])) |
66 | || confess "Value " . ($_[1]||'undef') . " did not pass container type constraint '$container_type_constraint'"; |
67 | $reader->($self)->{$_[0]} = $_[1]; |
68 | } |
69 | else { |
70 | confess "One or two arguments expected, not " . @_; |
71 | } |
72 | }; |
73 | } |
74 | else { |
75 | return sub { |
76 | my $self = shift; |
77 | |
78 | if (@_ == 1) { # reader |
79 | return $reader->($self)->{$_[0]}; |
80 | } |
81 | elsif (@_ == 2) { # writer |
82 | $reader->($self)->{$_[0]} = $_[1]; |
83 | } |
84 | else { |
85 | confess "One or two arguments expected, not " . @_; |
86 | } |
87 | }; |
88 | } |
89 | } |
90 | |
91 | sub clear : method { |
92 | my ($attr, $reader, $writer) = @_; |
93 | return sub { %{$reader->($_[0])} = () }; |
94 | } |
95 | |
96 | sub delete : method { |
97 | my ($attr, $reader, $writer) = @_; |
98 | return sub { |
99 | my $hashref = $reader->(shift); |
100 | CORE::delete @{$hashref}{@_}; |
101 | }; |
102 | } |
103 | |
104 | 1; |
105 | |
106 | __END__ |
107 | |
108 | =pod |
109 | |
110 | =head1 NAME |
111 | |
112 | Moose::AttributeHelpers::MethodProvider::Hash |
113 | |
114 | =head1 DESCRIPTION |
115 | |
116 | This is a role which provides the method generators for |
117 | L<Moose::AttributeHelpers::Collection::Hash>. |
118 | |
119 | This role is composed from the |
120 | L<Moose::AttributeHelpers::Collection::ImmutableHash> role. |
121 | |
122 | =head1 METHODS |
123 | |
124 | =over 4 |
125 | |
126 | =item B<meta> |
127 | |
128 | =back |
129 | |
130 | =head1 PROVIDED METHODS |
131 | |
132 | =over 4 |
133 | |
134 | =item B<count> |
135 | |
136 | Returns the number of elements in the hash. |
137 | |
138 | =item B<delete> |
139 | |
140 | Removes the element with the given key |
141 | |
142 | =item B<defined> |
143 | |
144 | Returns true if the value of a given key is defined |
145 | |
146 | =item B<empty> |
147 | |
148 | If the list is populated, returns true. Otherwise, returns false. |
149 | |
150 | =item B<clear> |
151 | |
152 | Unsets the hash entirely. |
153 | |
154 | =item B<exists> |
155 | |
156 | Returns true if the given key is present in the hash |
157 | |
158 | =item B<get> |
159 | |
160 | Returns an element of the hash by its key. |
161 | |
162 | =item B<keys> |
163 | |
164 | Returns the list of keys in the hash. |
165 | |
166 | =item B<set> |
167 | |
168 | Sets the element in the hash at the given key to the given value. |
169 | |
170 | =item B<values> |
171 | |
172 | Returns the list of values in the hash. |
173 | |
174 | =item B<kv> |
175 | |
176 | Returns the key, value pairs in the hash |
177 | |
178 | =item B<accessor> |
179 | |
180 | If passed one argument, returns the value of the requested key. If passed two |
181 | arguments, sets the value of the requested key. |
182 | |
183 | =back |
184 | |
185 | =head1 BUGS |
186 | |
187 | All complex software has bugs lurking in it, and this module is no |
188 | exception. If you find a bug please either email me, or add the bug |
189 | to cpan-RT. |
190 | |
191 | =head1 AUTHOR |
192 | |
193 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
194 | |
195 | =head1 COPYRIGHT AND LICENSE |
196 | |
197 | Copyright 2007-2009 by Infinity Interactive, Inc. |
198 | |
199 | L<http://www.iinteractive.com> |
200 | |
201 | This library is free software; you can redistribute it and/or modify |
202 | it under the same terms as Perl itself. |
203 | |
204 | =cut |
205 | |