File Coverage

blib/lib/Class/DBI/Sweet/Pie.pm

Criterion	Covered	Total	%
statement	68	69	98.5
branch	19	24	79.1
condition	8	13	61.5
subroutine	8	8	100.0
pod	0	1	0.0
total	103	115	89.5

package Class::DBI::Sweet::Pie;
use strict;
use vars qw/$VERSION/;
$VERSION = '0.04';

sub import {
    my $class = shift;
    my $pkg = caller(0);

    no strict 'refs';
    *{"$pkg\::mk_aggregate_function"} = \&mk_aggregate_function;
}

sub mk_aggregate_function {
    my $class = shift;
    my ($aggregate_func, $alias) = @_;
    $alias ||= $aggregate_func;

    ## create aggregate function
    my $sql_aggregate = "sql_Join_AggregateFunction_$alias";
    $class->set_sql( "Join_AggregateFunction_$alias" => <<__SQL__ );
  SELECT $aggregate_func( %s )
  FROM   %s
  WHERE  %s
__SQL__

    no strict 'refs';
    *{"$class\::$alias"} = sub {
	my $self = shift;
	my $aggregate_column = shift;
	return $self->_attr( $alias ) unless defined $aggregate_column;

	my $class = ref $self || $self;
	my ($criteria, $attributes) = $class->_search_args(@_);

	$aggregate_column =~ s/^ (distinct) \s+ //ix;
	my $distinct = $1 || '';

	if ($aggregate_column eq "*") {
	    ;
	}
	elsif ($aggregate_column =~ /^(\w+)\.(.+)$/) {
	    my $join = $1;
	    $aggregate_column = "*" if $2 eq '*';

	    if (ref $self) {
	        $attributes->{prefetch} = [ $join ];
	        foreach my $pcol ($self->primary_column) {
	            $criteria->{ $pcol } = $self->$pcol;
	        }
	    }
	    else {
	        $criteria->{ $join } = \"IS NOT NULL"
	        	unless exists $criteria->{ $join };
	    }
	}
	else {
	    $aggregate_column = "me.$aggregate_column";
	}

	$aggregate_column = "$distinct $aggregate_column" if $distinct;

	# make sure we take copy of $attribues since it can be reused
	my $agfunc_attr = { %{$attributes} };

	# no need for LIMIT/OFFSET and ORDER BY in AGGREGATE_FUNC()
	delete @{$agfunc_attr}{qw( rows offset order_by )};

	my ($sql_parts, $classes, $columns, $values) = $class->_search( $criteria, $agfunc_attr );

	my $sth = $class->$sql_aggregate( $aggregate_column, @{$sql_parts}{qw/ from where /} );

	$class->_bind_param( $sth, $columns );
	return $sth->select_val(@$values);
    };

    ## create search with aggregate function
    my $sql_with_aggregate = "sql_Join_Retrieve_$alias";
    $class->set_sql( "Join_Retrieve_$alias" => <<__SQL__ );
  SELECT __ESSENTIAL(me)__, $aggregate_func( %s ) AS $alias
  FROM   %s
  WHERE  %s
  GROUP BY __ESSENTIAL(me)__
  %s %s
__SQL__

    *{"$class\::search_with_$alias"} = sub {
	my $self = shift;
	my $class = ref($self) || $self;
	my $aggregate_column = shift;
	my ($criteria, $attributes) = $class->_search_args(@_);

	$aggregate_column =~ s/^ (distinct) \s+ //ix;
	my $distinct = $1 || '';

	if ($aggregate_column eq "*") {
	    ;
	}
	elsif ($aggregate_column =~ /^(\w+)\.(.+)$/) {
	    my $join = $1;
	    $aggregate_column = "*" if $2 eq '*';

	    $criteria->{ $join } = \"IS NOT NULL"
	    	unless exists $criteria->{ $join };
	}
	else {
	    $aggregate_column = "me.$aggregate_column";
	}

	$aggregate_column = "$distinct $aggregate_column" if $distinct;

	my ($sql_parts, $classes, $columns, $values) = $class->_search( $criteria, $attributes );

	my $sth = $class->$sql_with_aggregate( $aggregate_column, @{$sql_parts}{qw/ from where order_by limit /} );

        $self->sth_to_objects( $sth, $values );
    };
}

1;
__END__