File | /usr/local/lib/perl5/site_perl/5.10.1/MooseX/AttributeHelpers/MethodProvider/List.pm |
Statements Executed | 7 |
Statement Execution Time | 588µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 14µs | 1.41ms | BEGIN@2 | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:12] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:19] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:30] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:38] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:54] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:62] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:70] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:78] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:85] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:92] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:99] | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | count | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | elements | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | empty | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | find | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | first | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | get | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | grep | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | join | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | last | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | map | MooseX::AttributeHelpers::MethodProvider::List::
0 | 0 | 0 | 0s | 0s | sort | MooseX::AttributeHelpers::MethodProvider::List::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package MooseX::AttributeHelpers::MethodProvider::List; | ||||
2 | 3 | 563µs | 2 | 2.81ms | # spent 1.41ms (14µs+1.40) within MooseX::AttributeHelpers::MethodProvider::List::BEGIN@2 which was called
# once (14µs+1.40ms) by MooseX::AttributeHelpers::Trait::Collection::List::BEGIN@9 at line 2 # spent 1.41ms making 1 call to MooseX::AttributeHelpers::MethodProvider::List::BEGIN@2
# spent 1.40ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:389] |
3 | |||||
4 | 1 | 700ns | our $VERSION = '0.23'; | ||
5 | 1 | 15µs | $VERSION = eval $VERSION; | ||
6 | 1 | 300ns | our $AUTHORITY = 'cpan:STEVAN'; | ||
7 | |||||
8 | sub count : method { | ||||
9 | my ($attr, $reader, $writer) = @_; | ||||
10 | return sub { | ||||
11 | scalar @{$reader->($_[0])} | ||||
12 | }; | ||||
13 | } | ||||
14 | |||||
15 | sub empty : method { | ||||
16 | my ($attr, $reader, $writer) = @_; | ||||
17 | return sub { | ||||
18 | scalar @{$reader->($_[0])} ? 1 : 0 | ||||
19 | }; | ||||
20 | } | ||||
21 | |||||
22 | sub find : method { | ||||
23 | my ($attr, $reader, $writer) = @_; | ||||
24 | return sub { | ||||
25 | my ($instance, $predicate) = @_; | ||||
26 | foreach my $val (@{$reader->($instance)}) { | ||||
27 | return $val if $predicate->($val); | ||||
28 | } | ||||
29 | return; | ||||
30 | }; | ||||
31 | } | ||||
32 | |||||
33 | sub map : method { | ||||
34 | my ($attr, $reader, $writer) = @_; | ||||
35 | return sub { | ||||
36 | my ($instance, $f) = @_; | ||||
37 | CORE::map { $f->($_) } @{$reader->($instance)} | ||||
38 | }; | ||||
39 | } | ||||
40 | |||||
41 | sub sort : method { | ||||
42 | my ($attr, $reader, $writer) = @_; | ||||
43 | return sub { | ||||
44 | my ($instance, $predicate) = @_; | ||||
45 | die "Argument must be a code reference" | ||||
46 | if $predicate && ref $predicate ne 'CODE'; | ||||
47 | |||||
48 | if ($predicate) { | ||||
49 | CORE::sort { $predicate->($a, $b) } @{$reader->($instance)}; | ||||
50 | } | ||||
51 | else { | ||||
52 | CORE::sort @{$reader->($instance)}; | ||||
53 | } | ||||
54 | }; | ||||
55 | } | ||||
56 | |||||
57 | sub grep : method { | ||||
58 | my ($attr, $reader, $writer) = @_; | ||||
59 | return sub { | ||||
60 | my ($instance, $predicate) = @_; | ||||
61 | CORE::grep { $predicate->($_) } @{$reader->($instance)} | ||||
62 | }; | ||||
63 | } | ||||
64 | |||||
65 | sub elements : method { | ||||
66 | my ($attr, $reader, $writer) = @_; | ||||
67 | return sub { | ||||
68 | my ($instance) = @_; | ||||
69 | @{$reader->($instance)} | ||||
70 | }; | ||||
71 | } | ||||
72 | |||||
73 | sub join : method { | ||||
74 | my ($attr, $reader, $writer) = @_; | ||||
75 | return sub { | ||||
76 | my ($instance, $separator) = @_; | ||||
77 | join $separator, @{$reader->($instance)} | ||||
78 | }; | ||||
79 | } | ||||
80 | |||||
81 | sub get : method { | ||||
82 | my ($attr, $reader, $writer) = @_; | ||||
83 | return sub { | ||||
84 | $reader->($_[0])->[$_[1]] | ||||
85 | }; | ||||
86 | } | ||||
87 | |||||
88 | sub first : method { | ||||
89 | my ($attr, $reader, $writer) = @_; | ||||
90 | return sub { | ||||
91 | $reader->($_[0])->[0] | ||||
92 | }; | ||||
93 | } | ||||
94 | |||||
95 | sub last : method { | ||||
96 | my ($attr, $reader, $writer) = @_; | ||||
97 | return sub { | ||||
98 | $reader->($_[0])->[-1] | ||||
99 | }; | ||||
100 | } | ||||
101 | |||||
102 | 1 | 9µs | 1; | ||
103 | |||||
104 | __END__ | ||||
105 | |||||
106 | =pod | ||||
107 | |||||
108 | =head1 NAME | ||||
109 | |||||
110 | MooseX::AttributeHelpers::MethodProvider::List | ||||
111 | |||||
112 | =head1 SYNOPSIS | ||||
113 | |||||
114 | package Stuff; | ||||
115 | use Moose; | ||||
116 | use MooseX::AttributeHelpers; | ||||
117 | |||||
118 | has 'options' => ( | ||||
119 | metaclass => 'Collection::List', | ||||
120 | is => 'rw', | ||||
121 | isa => 'ArrayRef[Str]', | ||||
122 | default => sub { [] }, | ||||
123 | auto_deref => 1, | ||||
124 | provides => { | ||||
125 | elements => 'all_options', | ||||
126 | map => 'map_options', | ||||
127 | grep => 'filter_options', | ||||
128 | find => 'find_option', | ||||
129 | first => 'first_option', | ||||
130 | last => 'last_option', | ||||
131 | get => 'get_option', | ||||
132 | join => 'join_options', | ||||
133 | count => 'count_options', | ||||
134 | empty => 'do_i_have_options', | ||||
135 | sort => 'sorted_options', | ||||
136 | } | ||||
137 | ); | ||||
138 | |||||
139 | no Moose; | ||||
140 | 1; | ||||
141 | |||||
142 | =head1 DESCRIPTION | ||||
143 | |||||
144 | This is a role which provides the method generators for | ||||
145 | L<MooseX::AttributeHelpers::Collection::List>. | ||||
146 | |||||
147 | =head1 METHODS | ||||
148 | |||||
149 | =over 4 | ||||
150 | |||||
151 | =item B<meta> | ||||
152 | |||||
153 | =back | ||||
154 | |||||
155 | =head1 PROVIDED METHODS | ||||
156 | |||||
157 | =over 4 | ||||
158 | |||||
159 | =item B<count> | ||||
160 | |||||
161 | Returns the number of elements in the list. | ||||
162 | |||||
163 | $stuff = Stuff->new; | ||||
164 | $stuff->options(["foo", "bar", "baz", "boo"]); | ||||
165 | |||||
166 | my $count = $stuff->count_options; | ||||
167 | print "$count\n"; # prints 4 | ||||
168 | |||||
169 | =item B<empty> | ||||
170 | |||||
171 | If the list is populated, returns true. Otherwise, returns false. | ||||
172 | |||||
173 | $stuff->do_i_have_options ? print "Good boy.\n" : die "No options!\n" ; | ||||
174 | |||||
175 | =item B<find> | ||||
176 | |||||
177 | This method accepts a subroutine reference as its argument. That sub | ||||
178 | will receive each element of the list in turn. If it returns true for | ||||
179 | an element, that element will be returned by the C<find> method. | ||||
180 | |||||
181 | my $found = $stuff->find_option( sub { $_[0] =~ /^b/ } ); | ||||
182 | print "$found\n"; # prints "bar" | ||||
183 | |||||
184 | =item B<grep> | ||||
185 | |||||
186 | This method accepts a subroutine reference as its argument. This | ||||
187 | method returns every element for which that subroutine reference | ||||
188 | returns a true value. | ||||
189 | |||||
190 | my @found = $stuff->filter_options( sub { $_[0] =~ /^b/ } ); | ||||
191 | print "@found\n"; # prints "bar baz boo" | ||||
192 | |||||
193 | =item B<map> | ||||
194 | |||||
195 | This method accepts a subroutine reference as its argument. The | ||||
196 | subroutine will be executed for each element of the list. It is | ||||
197 | expected to return a modified version of that element. The return | ||||
198 | value of the method is a list of the modified options. | ||||
199 | |||||
200 | my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } ); | ||||
201 | print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag" | ||||
202 | |||||
203 | =item B<sort> | ||||
204 | |||||
205 | Sorts and returns the elements of the list. | ||||
206 | |||||
207 | You can provide an optional subroutine reference to sort with (as you | ||||
208 | can with the core C<sort> function). However, instead of using C<$a> | ||||
209 | and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead. | ||||
210 | |||||
211 | # ascending ASCIIbetical | ||||
212 | my @sorted = $stuff->sort_options(); | ||||
213 | |||||
214 | # Descending alphabetical order | ||||
215 | my @sorted_options = $stuff->sort_options( sub { lc $_[1] cmp lc $_[0] } ); | ||||
216 | print "@sorted_options\n"; # prints "foo boo baz bar" | ||||
217 | |||||
218 | =item B<elements> | ||||
219 | |||||
220 | Returns all of the elements of the list | ||||
221 | |||||
222 | my @option = $stuff->all_options; | ||||
223 | print "@options\n"; # prints "foo bar baz boo" | ||||
224 | |||||
225 | =item B<join> | ||||
226 | |||||
227 | Joins every element of the list using the separator given as argument. | ||||
228 | |||||
229 | my $joined = $stuff->join_options( ':' ); | ||||
230 | print "$joined\n"; # prints "foo:bar:baz:boo" | ||||
231 | |||||
232 | =item B<get> | ||||
233 | |||||
234 | Returns an element of the list by its index. | ||||
235 | |||||
236 | my $option = $stuff->get_option(1); | ||||
237 | print "$option\n"; # prints "bar" | ||||
238 | |||||
239 | =item B<first> | ||||
240 | |||||
241 | Returns the first element of the list. | ||||
242 | |||||
243 | my $first = $stuff->first_option; | ||||
244 | print "$first\n"; # prints "foo" | ||||
245 | |||||
246 | =item B<last> | ||||
247 | |||||
248 | Returns the last element of the list. | ||||
249 | |||||
250 | my $last = $stuff->last_option; | ||||
251 | print "$last\n"; # prints "boo" | ||||
252 | |||||
253 | =back | ||||
254 | |||||
255 | =head1 BUGS | ||||
256 | |||||
257 | All complex software has bugs lurking in it, and this module is no | ||||
258 | exception. If you find a bug please either email me, or add the bug | ||||
259 | to cpan-RT. | ||||
260 | |||||
261 | =head1 AUTHOR | ||||
262 | |||||
263 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | ||||
264 | |||||
265 | =head1 COPYRIGHT AND LICENSE | ||||
266 | |||||
267 | Copyright 2007-2009 by Infinity Interactive, Inc. | ||||
268 | |||||
269 | L<http://www.iinteractive.com> | ||||
270 | |||||
271 | This library is free software; you can redistribute it and/or modify | ||||
272 | it under the same terms as Perl itself. | ||||
273 | |||||
274 | =cut |