File Coverage

blib/lib/Class/DBI/Plugin/AbstractCount.pm
Criterion Covered Total %
statement 45 47 95.7
branch 19 24 79.1
condition 1 3 33.3
subroutine 6 6 100.0
pod 1 2 50.0
total 72 82 87.8


line stmt bran cond sub pod time code
1             package Class::DBI::Plugin::AbstractCount;
2             # vim:set tabstop=2 shiftwidth=2 expandtab:
3              
4 3     3   46537 use strict;
  3         13  
  3         126  
5 3     3   20 use base 'Class::DBI::Plugin';
  3         6  
  3         3266  
6 3     3   13678 use SQL::Abstract;
  3         34321  
  3         1947  
7              
8             our $VERSION = '0.08';
9              
10             sub init
11             {
12 3     3 0 165 my $class = shift;
13 3         26 $class->set_sql( count_search_where => qq{
14             SELECT COUNT(*)
15             FROM __TABLE__
16             %s
17             } );
18             }
19              
20             sub count_search_where : Plugged
21             {
22 10     10 1 69277 my $class = shift;
23 10         28 my %where = ();
24 10         24 my $rh_attr = {};
25 10 100       46 if ( ref $_[0] ) {
26 9 50       56 $class->_croak( "where-clause must be a hashref it it's a reference" )
27             unless ref( $_[0] ) eq 'HASH';
28 9         17 %where = %{ $_[0] };
  9         47  
29 9         20 $rh_attr = $_[1];
30             }
31             else {
32 1 50       9 $rh_attr = pop if @_ % 2;
33 1         5 %where = @_;
34             }
35 10         23 delete $rh_attr->{order_by};
36              
37 10 50       88 $class->can( 'retrieve_from_sql' )
38             or $class->_croak( "$class should inherit from Class::DBI >= 0.95" );
39            
40 10         31 my ( %columns, %accessors ) = ();
41 10         47 for my $column ( $class->columns ) {
42 40         217 ++$columns{ $column };
43 40         169 $accessors{ $column->accessor } = $column;
44             }
45              
46 10         79 COLUMN: for my $column ( keys %where ) {
47             # Column names are (of course) OK
48 20 100       59 next COLUMN if exists $columns{ $column };
49              
50             # Accessor names are OK, but replace them with corresponding column name
51 12 100       52 $where{ $accessors{ $column }} = delete $where{ $column }, next COLUMN
52             if exists $accessors{ $column };
53              
54             # SQL::Abstract keywords are OK
55             next COLUMN
56 7 100       39 if $column =~ /^-(?:and|or|nest|(?:(not_)?(?:like|between)))$/;
57              
58             # Check for functions
59 6 50 33     58 if ( index( $column, '(' ) > 0
60             && index( $column, ')' ) > 1 )
61             {
62 6         84 my @tokens = ( $column =~ /(-?\w+(?:\s*\(\s*)?|\W+)/g );
63 6         14 TOKEN: for my $token ( @tokens ) {
64 30 100       108 if ( $token !~ /\W/ ) { # must be column or accessor name
65 8 100       27 next TOKEN if exists $columns{ $token };
66 3 50       15 $token = $accessors{ $token }, next TOKEN
67             if exists $accessors{ $token };
68 0         0 $class->_croak(
69             qq{"$token" is not a column/accessor of class "$class"} );
70             }
71             }
72              
73 6         18 my $normalized = join "", @tokens;
74 6 100       25 $where{ $normalized } = delete $where{ $column }
75             if $normalized ne $column;
76 6         21 next COLUMN;
77             }
78              
79 0         0 $class->_croak( qq{"$column" is not a column/accessor of class "$class"} );
80             }
81              
82 10         80 my ( $phrase, @bind ) = SQL::Abstract
83             -> new( %$rh_attr )
84             -> where( \%where );
85 10         6809 $class
86             -> sql_count_search_where( $phrase )
87             -> select_val( @bind );
88 3     3   41 }
  3         5  
  3         29  
89              
90             1;
91             __END__