← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:59 2010

File /usr/local/lib/perl5/site_perl/5.10.1/MooseX/AttributeHelpers/MethodProvider/List.pm
Statements Executed 7
Statement Execution Time 588µs
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11114µs1.41msMooseX::AttributeHelpers::MethodProvider::List::::BEGIN@2MooseX::AttributeHelpers::MethodProvider::List::BEGIN@2
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:12]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:12]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:19]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:19]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:30]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:30]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:38]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:38]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:54]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:54]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:62]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:62]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:70]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:70]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:78]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:78]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:85]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:85]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:92]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:92]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::__ANON__[:99]MooseX::AttributeHelpers::MethodProvider::List::__ANON__[:99]
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::countMooseX::AttributeHelpers::MethodProvider::List::count
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::elementsMooseX::AttributeHelpers::MethodProvider::List::elements
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::emptyMooseX::AttributeHelpers::MethodProvider::List::empty
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::findMooseX::AttributeHelpers::MethodProvider::List::find
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::firstMooseX::AttributeHelpers::MethodProvider::List::first
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::getMooseX::AttributeHelpers::MethodProvider::List::get
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::grepMooseX::AttributeHelpers::MethodProvider::List::grep
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::joinMooseX::AttributeHelpers::MethodProvider::List::join
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::lastMooseX::AttributeHelpers::MethodProvider::List::last
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::mapMooseX::AttributeHelpers::MethodProvider::List::map
0000s0sMooseX::AttributeHelpers::MethodProvider::List::::sortMooseX::AttributeHelpers::MethodProvider::List::sort
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package MooseX::AttributeHelpers::MethodProvider::List;
23563µs22.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
use Moose::Role;
3
41700nsour $VERSION = '0.23';
5115µs$VERSION = eval $VERSION;
61300nsour $AUTHORITY = 'cpan:STEVAN';
7
8sub count : method {
9 my ($attr, $reader, $writer) = @_;
10 return sub {
11 scalar @{$reader->($_[0])}
12 };
13}
14
15sub empty : method {
16 my ($attr, $reader, $writer) = @_;
17 return sub {
18 scalar @{$reader->($_[0])} ? 1 : 0
19 };
20}
21
22sub 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
33sub map : method {
34 my ($attr, $reader, $writer) = @_;
35 return sub {
36 my ($instance, $f) = @_;
37 CORE::map { $f->($_) } @{$reader->($instance)}
38 };
39}
40
41sub 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
57sub grep : method {
58 my ($attr, $reader, $writer) = @_;
59 return sub {
60 my ($instance, $predicate) = @_;
61 CORE::grep { $predicate->($_) } @{$reader->($instance)}
62 };
63}
64
65sub elements : method {
66 my ($attr, $reader, $writer) = @_;
67 return sub {
68 my ($instance) = @_;
69 @{$reader->($instance)}
70 };
71}
72
73sub join : method {
74 my ($attr, $reader, $writer) = @_;
75 return sub {
76 my ($instance, $separator) = @_;
77 join $separator, @{$reader->($instance)}
78 };
79}
80
81sub get : method {
82 my ($attr, $reader, $writer) = @_;
83 return sub {
84 $reader->($_[0])->[$_[1]]
85 };
86}
87
88sub first : method {
89 my ($attr, $reader, $writer) = @_;
90 return sub {
91 $reader->($_[0])->[0]
92 };
93}
94
95sub last : method {
96 my ($attr, $reader, $writer) = @_;
97 return sub {
98 $reader->($_[0])->[-1]
99 };
100}
101
10219µs1;
103
104__END__
105
106=pod
107
108=head1 NAME
109
110MooseX::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
144This is a role which provides the method generators for
145L<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
161Returns 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
171If 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
177This method accepts a subroutine reference as its argument. That sub
178will receive each element of the list in turn. If it returns true for
179an 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
186This method accepts a subroutine reference as its argument. This
187method returns every element for which that subroutine reference
188returns 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
195This method accepts a subroutine reference as its argument. The
196subroutine will be executed for each element of the list. It is
197expected to return a modified version of that element. The return
198value 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
205Sorts and returns the elements of the list.
206
207You can provide an optional subroutine reference to sort with (as you
208can with the core C<sort> function). However, instead of using C<$a>
209and 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
220Returns 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
227Joins 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
234Returns 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
241Returns 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
248Returns 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
257All complex software has bugs lurking in it, and this module is no
258exception. If you find a bug please either email me, or add the bug
259to cpan-RT.
260
261=head1 AUTHOR
262
263Stevan Little E<lt>stevan@iinteractive.comE<gt>
264
265=head1 COPYRIGHT AND LICENSE
266
267Copyright 2007-2009 by Infinity Interactive, Inc.
268
269L<http://www.iinteractive.com>
270
271This library is free software; you can redistribute it and/or modify
272it under the same terms as Perl itself.
273
274=cut