| 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 | MooseX::AttributeHelpers::MethodProvider::List::BEGIN@2 |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:12] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:19] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:30] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:38] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:54] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:62] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:70] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:78] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:85] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:92] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:99] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::count |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::elements |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::empty |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::find |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::first |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::get |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::grep |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::join |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::last |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::map |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::MethodProvider::List::sort |
| 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 |