← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:57:03 2010

File /project/perl/lib/Class/DBI/Plugin/AbstractCount.pm
Statements Executed 16
Statement Execution Time 1.27ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11142µs469µsClass::DBI::Plugin::AbstractCount::::initClass::DBI::Plugin::AbstractCount::init
0000s0sClass::DBI::Plugin::AbstractCount::::BEGINClass::DBI::Plugin::AbstractCount::BEGIN
0000s0sClass::DBI::Plugin::AbstractCount::::count_search_whereClass::DBI::Plugin::AbstractCount::count_search_where
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Class::DBI::Plugin::AbstractCount;
2# vim:set tabstop=2 shiftwidth=2 expandtab:
3
4394µs125µsuse strict;
# spent 25µs making 1 call to strict::import
53111µs10suse base 'Class::DBI::Plugin';
# spent 12.2ms making 1 call to base::import, recursion: max depth 1, time 12.2ms
63862µsuse SQL::Abstract;
7
816µsour $VERSION = '0.07';
9
10sub init
11
# spent 469µs (42+427) within Class::DBI::Plugin::AbstractCount::init which was called # once (42µs+427µs) by Class::DBI::Plugin::import at line 22 of Class/DBI/Plugin.pm
{
1216µs my $class = shift;
13137µs1427µs $class->set_sql( count_search_where => qq{
# spent 427µs making 1 call to Class::DBI::set_sql
14 SELECT COUNT(*)
15 FROM __TABLE__
16 %s
17 } );
18}
19
20sub count_search_where : Plugged
21124µs1324µs{
# spent 324µs making 1 call to attributes::import
22 my $class = shift;
23 my %where = ();
24 my $rh_attr = {};
25 if ( ref $_[0] ) {
26 $class->_croak( "where-clause must be a hashref it it's a reference" )
27 unless ref( $_[0] ) eq 'HASH';
28 %where = %{ $_[0] };
29 $rh_attr = $_[1];
30 }
31 else {
32 $rh_attr = pop if @_ % 2;
33 %where = @_;
34 }
35 delete $rh_attr->{order_by};
36
37 $class->can( 'retrieve_from_sql' )
38 or $class->_croak( "$class should inherit from Class::DBI >= 0.95" );
39
40 my ( %columns, %accessors ) = ();
41 for my $column ( $class->columns ) {
42 ++$columns{ $column };
43 $accessors{ $column->accessor } = $column;
44 }
45
46 COLUMN: for my $column ( keys %where ) {
47 # Column names are (of course) OK
48 next COLUMN if exists $columns{ $column };
49
50 # Accessor names are OK, but replace them with corresponding column name
51 $where{ $accessors{ $column }} = delete $where{ $column }, next COLUMN
52 if exists $accessors{ $column };
53
54 # SQL::Abstract keywords are OK
55 next COLUMN
56 if $column =~ /^-(?:and|or|nest|(?:(not_)?(?:like|between)))$/;
57
58 # Check for functions
59 if ( index( $column, '(' ) > 0
60 && index( $column, ')' ) > 1 )
61 {
62 my @tokens = ( $column =~ /(-?\w+(?:\s*\(\s*)?|\W+)/g );
63 TOKEN: for my $token ( @tokens ) {
64 if ( $token !~ /\W/ ) { # must be column or accessor name
65 next TOKEN if exists $columns{ $token };
66 $token = $accessors{ $token }, next TOKEN
67 if exists $accessors{ $token };
68 $class->_croak(
69 qq{"$token" is not a column/accessor of class "$class"} );
70 }
71 }
72
73 my $normalized = join "", @tokens;
74 $where{ $normalized } = delete $where{ $column }
75 if $normalized ne $column;
76 next COLUMN;
77 }
78
79 $class->_croak( qq{"$column" is not a column/accessor of class "$class"} );
80 }
81
82 my ( $phrase, @bind ) = SQL::Abstract
83 -> new( %$rh_attr )
84 -> where( \%where );
85 $class
86 -> sql_count_search_where( $phrase )
87 -> select_val( @bind );
882113µs}
89
90113µs1;
91__END__
92
93=head1 NAME
94
95Class::DBI::Plugin::AbstractCount - get COUNT(*) results with abstract SQL
96
97=head1 SYNOPSIS
98
99 use base 'Class::DBI';
100 use Class::DBI::Plugin::AbstractCount;
101
102 my $count = Music::Vinyl->count_search_where(
103 { artist => 'Frank Zappa'
104 , title => { like => '%Shut Up 'n Play Yer Guitar%' }
105 , released => { between => [ 1980, 1982 ] }
106 });
107
108=head1 DESCRIPTION
109
110This Class::DBI plugin combines the functionality from
111Class::DBI::Plugin::CountSearch (counting objects without having to use an
112array or an iterator), and Class::DBI::AbstractSearch, which allows complex
113where-clauses a la SQL::Abstract.
114
115=head1 METHODS
116
117=head2 count_search_where
118
119Takes a hashref with the abstract where-clause. An additional attribute hashref
120can be passed to influence the default behaviour: arrayrefs are OR'ed, hashrefs
121are AND'ed.
122
123=head1 TODO
124
125More tests, more doc.
126
127=head1 SEE ALSO
128
129=over
130
131=item SQL::Abstract for details about the where-clause and the attributes.
132
133=item Class::DBI::AbstractSearch
134
135=item Class::DBI::Plugin::CountSearch
136
137=back
138
139=head1 AUTHOR
140
141Jean-Christophe Zeus, E<lt>mail@jczeus.comE<gt> with some help from
142Tatsuhiko Myagawa and Todd Holbrook.
143
144=head1 COPYRIGHT AND LICENSE
145
146Copyright (C) 2004 by Jean-Christophe Zeus
147
148This library is free software; you can redistribute it and/or modify
149it under the same terms as Perl itself.
150
151=cut