File | /project/perl/lib/Class/DBI/Plugin/RetrieveAll.pm |
Statements Executed | 25 |
Statement Execution Time | 1.14ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 169µs | 868ms | __ANON__[:77] | Class::DBI::Plugin::RetrieveAll::
1 | 1 | 1 | 163µs | 826µs | import | Class::DBI::Plugin::RetrieveAll::
1 | 1 | 1 | 91µs | 868ms | __ANON__[:93] | Class::DBI::Plugin::RetrieveAll::
1 | 1 | 1 | 56µs | 216µs | __ANON__[:84] | Class::DBI::Plugin::RetrieveAll::
0 | 0 | 0 | 0s | 0s | BEGIN | Class::DBI::Plugin::RetrieveAll::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Class::DBI::Plugin::RetrieveAll; | ||||
2 | |||||
3 | 1 | 6µs | our $VERSION = '1.04'; | ||
4 | |||||
5 | 3 | 91µs | 1 | 27µs | use strict; # spent 27µs making 1 call to strict::import |
6 | 3 | 149µs | 1 | 119µs | use warnings; # spent 119µs making 1 call to warnings::import |
7 | |||||
8 | =head1 NAME | ||||
9 | |||||
10 | Class::DBI::Plugin::RetrieveAll - more complex retrieve_all() for Class::DBI | ||||
11 | |||||
12 | =head1 SYNOPSIS | ||||
13 | |||||
14 | use base 'Class::DBI'; | ||||
15 | use Class::DBI::Plugin::RetrieveAll; | ||||
16 | |||||
17 | my @by_date = My::Class->retrieve_all_sorted_by("date"); | ||||
18 | |||||
19 | # or | ||||
20 | |||||
21 | __PACKAGE__->retrieve_all_sort_field('date'); | ||||
22 | |||||
23 | my @by_date = My::Class->retrieve_all; | ||||
24 | |||||
25 | =head1 DESCRIPTION | ||||
26 | |||||
27 | This is a simple plugin to a Class::DBI subclass that allows for simple | ||||
28 | sorting of the results of a retrieve_all(). | ||||
29 | |||||
30 | There are two main ways to use this. | ||||
31 | |||||
32 | Firstly, we create a new method 'retrieve_all_sorted_by' which takes an | ||||
33 | argument of how to sort. | ||||
34 | |||||
35 | We also add a method for 'retrieve_all_sort_field' that sets a default | ||||
36 | field that any retrieve_all() will use for sorting. | ||||
37 | |||||
38 | =head1 METHODS | ||||
39 | |||||
40 | =head2 retrieve_all_sorted_by | ||||
41 | |||||
42 | my @by_date = My::Class->retrieve_all_sorted_by("date"); | ||||
43 | |||||
44 | This method will be exported into the calling class, and allows for | ||||
45 | retrieving all the objects of the class, sorted by the given column. | ||||
46 | |||||
47 | The argument given will be passed straight through to the database 'as | ||||
48 | is', and is not checked in any way, so an error here will usually | ||||
49 | in an error from the database, rather than Class::DBI itself. | ||||
50 | |||||
51 | This makes it possible to pass more complex ORDER BY clauses through: | ||||
52 | |||||
53 | my @by_date = My::Class->retrieve_all_sorted_by("date DESC, reference_no"); | ||||
54 | |||||
55 | =head2 retrieve_all_sort_field | ||||
56 | |||||
57 | __PACKAGE__->retrieve_all_sort_field('date'); | ||||
58 | |||||
59 | This method changes the default retrieve_all() in the Class to be | ||||
60 | auto-sorted by the field given. Again this will be passed through | ||||
61 | directly, so you can have complex ORDER BY clauses. | ||||
62 | |||||
63 | =cut | ||||
64 | |||||
65 | # spent 826µs (163+663) within Class::DBI::Plugin::RetrieveAll::import which was called
# once (163µs+663µs) by base::import at line 8 of K2/DB2.pm | ||||
66 | 7 | 182µs | my $caller = caller(); | ||
67 | 3 | 485µs | 1 | 94µs | no strict 'refs'; # spent 94µs making 1 call to strict::unimport |
68 | |||||
69 | $caller->set_sql(retrieve_all_sorted => <<''); # spent 593µs making 1 call to Class::DBI::set_sql | ||||
70 | SELECT __ESSENTIAL__ | ||||
71 | FROM __TABLE__ | ||||
72 | ORDER BY %s | ||||
73 | |||||
74 | # spent 868ms (169µs+868) within Class::DBI::Plugin::RetrieveAll::__ANON__[/project/perl/lib/Class/DBI/Plugin/RetrieveAll.pm:77] which was called
# once (169µs+868ms) by Class::DBI::Plugin::RetrieveAll::__ANON__[/project/perl/lib/Class/DBI/Plugin/RetrieveAll.pm:93] at line 92 | ||||
75 | 2 | 102µs | my ($class, $order_by) = @_; | ||
76 | return $class->sth_to_objects($class->sql_retrieve_all_sorted($order_by)); # spent 863ms making 1 call to Class::DBI::sth_to_objects
# spent 4.69ms making 1 call to Ima::DBI::__ANON__[Ima/DBI.pm:384] | ||||
77 | }; | ||||
78 | |||||
79 | $caller->mk_classdata('__plugin_retall_sortfield'); # spent 56µs making 1 call to Class::Data::Inheritable::mk_classdata | ||||
80 | |||||
81 | # spent 216µs (56+160) within Class::DBI::Plugin::RetrieveAll::__ANON__[/project/perl/lib/Class/DBI/Plugin/RetrieveAll.pm:84] which was called
# once (56µs+160µs) by main::BEGIN at line 10 of Wiki/DB/Wiki.pm | ||||
82 | 2 | 42µs | my ($class, $field) = @_; | ||
83 | $class->__plugin_retall_sortfield($field); # spent 160µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23] | ||||
84 | }; | ||||
85 | |||||
86 | # I hate that SUPER means *my* SUPER *now* - not $class->SUPER then | ||||
87 | my $super = $caller->can('retrieve_all'); # spent 14µs making 1 call to UNIVERSAL::can | ||||
88 | # spent 868ms (91µs+868) within Class::DBI::Plugin::RetrieveAll::__ANON__[/project/perl/lib/Class/DBI/Plugin/RetrieveAll.pm:93] which was called
# once (91µs+868ms) by main::RUNTIME at line 7 of ddd2.pl | ||||
89 | 3 | 68µs | my $class = shift; | ||
90 | my $field = $class->__plugin_retall_sortfield # spent 29µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23] | ||||
91 | or return $super->($class); | ||||
92 | return $class->retrieve_all_sorted_by($field); # spent 868ms making 1 call to Class::DBI::Plugin::RetrieveAll::__ANON__[Class/DBI/Plugin/RetrieveAll.pm:77] | ||||
93 | }; | ||||
94 | } | ||||
95 | |||||
96 | =head1 AUTHOR | ||||
97 | |||||
98 | Tony Bowden | ||||
99 | |||||
100 | =head1 BUGS and QUERIES | ||||
101 | |||||
102 | Please direct all correspondence regarding this module to: | ||||
103 | bug-Class-DBI-Plugin-RetrieveAll@rt.cpan.org | ||||
104 | |||||
105 | =head1 COPYRIGHT and LICENSE | ||||
106 | |||||
107 | Copyright (C) 2004-2006 Kasei. All rights reserved. | ||||
108 | |||||
109 | This module is free software; you can redistribute it and/or modify | ||||
110 | it under the same terms as Perl itself. | ||||
111 | |||||
112 | =cut | ||||
113 | |||||
114 | 1 | 14µs | 1; | ||
115 |