| 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 | Class::DBI::Plugin::RetrieveAll::__ANON__[:77] |
| 1 | 1 | 1 | 163µs | 826µs | Class::DBI::Plugin::RetrieveAll::import |
| 1 | 1 | 1 | 91µs | 868ms | Class::DBI::Plugin::RetrieveAll::__ANON__[:93] |
| 1 | 1 | 1 | 56µs | 216µs | Class::DBI::Plugin::RetrieveAll::__ANON__[:84] |
| 0 | 0 | 0 | 0s | 0s | Class::DBI::Plugin::RetrieveAll::BEGIN |
| 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 | 1 | 7µ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 | 1 | 32µs | 1 | 593µs | $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 | 1 | 7µs | my ($class, $order_by) = @_; | ||
| 76 | 1 | 95µs | 2 | 868ms | 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 | 1 | 10µs | }; | ||
| 78 | |||||
| 79 | 1 | 30µs | 1 | 56µs | $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 | 1 | 7µs | my ($class, $field) = @_; | ||
| 83 | 1 | 35µs | 1 | 160µs | $class->__plugin_retall_sortfield($field); # spent 160µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23] |
| 84 | 1 | 10µs | }; | ||
| 85 | |||||
| 86 | # I hate that SUPER means *my* SUPER *now* - not $class->SUPER then | ||||
| 87 | 1 | 54µs | 1 | 14µs | 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 | 1 | 6µs | my $class = shift; | ||
| 90 | 1 | 19µs | 1 | 29µs | 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 | 1 | 43µs | 1 | 868ms | 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 | 1 | 39µs | }; | ||
| 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 |