package Class::DBI::Plugin::AbstractCount; # vim:set tabstop=2 shiftwidth=2 expandtab: use strict; use base 'Class::DBI::Plugin'; use SQL::Abstract; our $VERSION = '0.07'; sub init { my $class = shift; $class->set_sql( count_search_where => qq{ SELECT COUNT(*) FROM __TABLE__ %s } ); } sub count_search_where : Plugged { my $class = shift; my %where = (); my $rh_attr = {}; if ( ref $_[0] ) { $class->_croak( "where-clause must be a hashref it it's a reference" ) unless ref( $_[0] ) eq 'HASH'; %where = %{ $_[0] }; $rh_attr = $_[1]; } else { $rh_attr = pop if @_ % 2; %where = @_; } delete $rh_attr->{order_by}; $class->can( 'retrieve_from_sql' ) or $class->_croak( "$class should inherit from Class::DBI >= 0.95" ); my ( %columns, %accessors ) = (); for my $column ( $class->columns ) { ++$columns{ $column }; $accessors{ $column->accessor } = $column; } COLUMN: for my $column ( keys %where ) { # Column names are (of course) OK next COLUMN if exists $columns{ $column }; # Accessor names are OK, but replace them with corresponding column name $where{ $accessors{ $column }} = delete $where{ $column }, next COLUMN if exists $accessors{ $column }; # SQL::Abstract keywords are OK next COLUMN if $column =~ /^-(?:and|or|nest|(?:(not_)?(?:like|between)))$/; # Check for functions if ( index( $column, '(' ) > 0 && index( $column, ')' ) > 1 ) { my @tokens = ( $column =~ /(-?\w+(?:\s*\(\s*)?|\W+)/g ); TOKEN: for my $token ( @tokens ) { if ( $token !~ /\W/ ) { # must be column or accessor name next TOKEN if exists $columns{ $token }; $token = $accessors{ $token }, next TOKEN if exists $accessors{ $token }; $class->_croak( qq{"$token" is not a column/accessor of class "$class"} ); } } my $normalized = join "", @tokens; $where{ $normalized } = delete $where{ $column } if $normalized ne $column; next COLUMN; } $class->_croak( qq{"$column" is not a column/accessor of class "$class"} ); } my ( $phrase, @bind ) = SQL::Abstract -> new( %$rh_attr ) -> where( \%where ); $class -> sql_count_search_where( $phrase ) -> select_val( @bind ); } 1; __END__ =head1 NAME Class::DBI::Plugin::AbstractCount - get COUNT(*) results with abstract SQL =head1 SYNOPSIS use base 'Class::DBI'; use Class::DBI::Plugin::AbstractCount; my $count = Music::Vinyl->count_search_where( { artist => 'Frank Zappa' , title => { like => '%Shut Up 'n Play Yer Guitar%' } , released => { between => [ 1980, 1982 ] } }); =head1 DESCRIPTION This Class::DBI plugin combines the functionality from Class::DBI::Plugin::CountSearch (counting objects without having to use an array or an iterator), and Class::DBI::AbstractSearch, which allows complex where-clauses a la SQL::Abstract. =head1 METHODS =head2 count_search_where Takes a hashref with the abstract where-clause. An additional attribute hashref can be passed to influence the default behaviour: arrayrefs are OR'ed, hashrefs are AND'ed. =head1 TODO More tests, more doc. =head1 SEE ALSO =over =item SQL::Abstract for details about the where-clause and the attributes. =item Class::DBI::AbstractSearch =item Class::DBI::Plugin::CountSearch =back =head1 AUTHOR Jean-Christophe Zeus, Email@jczeus.comE with some help from Tatsuhiko Myagawa and Todd Holbrook. =head1 COPYRIGHT AND LICENSE Copyright (C) 2004 by Jean-Christophe Zeus This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut