Profile of /project/perl/lib/Class/DBI/Plugin/AbstractCount.pm

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
1	1	1	42µs	469µs	Class::DBI::Plugin::AbstractCount::init
0	0	0	0s	0s	Class::DBI::Plugin::AbstractCount::BEGIN
0	0	0	0s	0s	Class::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
1					package Class::DBI::Plugin::AbstractCount;
2					# vim:set tabstop=2 shiftwidth=2 expandtab:
3
4	3	94µs	1	25µs	use strict; # spent 25µs making 1 call to strict::import
5	3	111µs	1	0s	use base 'Class::DBI::Plugin'; # spent 12.2ms making 1 call to base::import, recursion: max depth 1, time 12.2ms
6	3	862µs			use SQL::Abstract;
7
8	1	6µs			our $VERSION = '0.07';
9
10					sub 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 {
12	1	6µs			my $class = shift;
13	1	37µs	1	427µ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
20					sub count_search_where : Plugged
21	1	24µs	1	324µ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 );
88	2	113µs			}
89
90	1	13µs			1;
91					__END__
92
93					=head1 NAME
94
95					Class::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
110					This Class::DBI plugin combines the functionality from
111					Class::DBI::Plugin::CountSearch (counting objects without having to use an
112					array or an iterator), and Class::DBI::AbstractSearch, which allows complex
113					where-clauses a la SQL::Abstract.
114
115					=head1 METHODS
116
117					=head2 count_search_where
118
119					Takes a hashref with the abstract where-clause. An additional attribute hashref
120					can be passed to influence the default behaviour: arrayrefs are OR'ed, hashrefs
121					are AND'ed.
122
123					=head1 TODO
124
125					More 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
141					Jean-Christophe Zeus, E<lt>mail@jczeus.comE<gt> with some help from
142					Tatsuhiko Myagawa and Todd Holbrook.
143
144					=head1 COPYRIGHT AND LICENSE
145
146					Copyright (C) 2004 by Jean-Christophe Zeus
147
148					This library is free software; you can redistribute it and/or modify
149					it under the same terms as Perl itself.
150
151					=cut