File Coverage

blib/lib/DBIx/DataModel/Schema/ResultAs/Categorize.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	4	6	66.6
condition	4	5	80.0
subroutine	10	10	100.0
pod	1	2	50.0
total	56	60	93.3

#----------------------------------------------------------------------
package DBIx::DataModel::Schema::ResultAs::Categorize;
#----------------------------------------------------------------------
use warnings;
use strict;
use Carp::Clan              qw[^(DBIx::DataModel::|SQL::Abstract)];
use List::Categorize 0.04   qw/categorize/;

use parent 'DBIx::DataModel::Schema::ResultAs';

use namespace::clean;

sub new {
  my $class = shift;

  @_ or croak "-result_as => [categorize => ...] ... need field names or sub{} ";

  my $self;

  if ((ref $_[0] || '') eq 'CODE') {
    $self = {make_key => shift};
    !@_ or croak "-result_as => [categorize => sub {...}] : improper other args after sub{}";
  }
  else {
    $self = {cols => \@_};
  }

  return bless $self, $class;
}

sub get_result {
  my ($self, $statement) = @_;


  my $make_key = $self->{make_key} || do {
    my @cols = @{$self->{cols}};
    sub {my $row = shift; @{$row}{@cols}};
  };


  $statement->execute;
  my $rows = $statement->all;
  my %result = categorize {$make_key->($_)} @$rows;
  $statement->finish;

  return \%result;
}


1;


__END__