File Coverage

blib/lib/DBIx/Class/Helper/SimpleStats.pm
Criterion Covered Total %
statement 50 51 98.0
branch 7 10 70.0
condition 2 3 66.6
subroutine 10 10 100.0
pod 1 1 100.0
total 70 75 93.3


line stmt bran cond sub pod time code
1             package DBIx::Class::Helper::SimpleStats;
2              
3             # ABSTRACT: Simple grouping and aggregate functions for DBIx::Class
4              
5 1     1   164608 use v5.10.1;
  1         6  
6              
7 1     1   6 use strict;
  1         3  
  1         21  
8 1     1   6 use warnings;
  1         2  
  1         27  
9              
10 1     1   6 use base qw( DBIx::Class );
  1         2  
  1         104  
11              
12 1     1   8 use Carp;
  1         3  
  1         82  
13 1     1   8 use List::Util 1.45 qw/ uniqstr /;
  1         24  
  1         73  
14 1     1   17 use Ref::Util qw/ is_plain_hashref is_ref /;
  1         3  
  1         54  
15              
16             # RECOMMEND PREREQ: Ref::Util::XS
17              
18 1     1   502 use namespace::autoclean;
  1         1535  
  1         6  
19              
20             our $VERSION = 'v0.1.1';
21              
22              
23              
24             sub simple_stats {
25 6     6 1 403777 my ( $self, @args ) = @_;
26              
27 6 50       90 croak "No columns" unless @args;
28              
29 6         16 my @cols;
30             my @funcs;
31              
32 6         39 my $me = $self->current_source_alias;
33              
34             my $alias = sub {
35 20     20   34 my $ident = shift;
36 20 50       73 $ident = "$me.$ident" unless $ident =~ /^(\w+)\./;
37 20         71 return $ident;
38 6         71 };
39              
40 6         25 foreach my $arg (@args) {
41              
42 11 100       60 if ( is_ref($arg) ) {
43              
44 7 50       23 if ( is_plain_hashref($arg) ) {
45              
46 7         19 my $as = delete $arg->{'-as'};
47 7         14 my ( $func, $col ) = each %{$arg};
  7         25  
48              
49 7   66     45 $as //= "${col}_${func}";
50              
51 7         18 push @cols, $alias->($col);
52              
53 7         21 push @funcs, { $func => $alias->($col), -as => $as };
54              
55             }
56             else {
57              
58 0         0 croak "Unsupported reference type: " . ref($arg);
59              
60             }
61              
62             }
63             else {
64              
65 4         13 push @cols, $alias->($arg);
66              
67             }
68              
69             }
70              
71 6 100       38 unless (@funcs) {
72              
73 2         8 my $func = "count";
74 2         5 my $col = $cols[0];
75 2         14 $col =~ s/^\w+\.// ;
76              
77 2         8 push @funcs, { $func => $alias->($col), -as => "${col}_${func}" };
78              
79             }
80              
81 6         18 my @names = map { delete $_->{'-as'} } @funcs;
  9         30  
82              
83 6         37 my @group = uniqstr @cols;
84              
85 6         90 return $self->search(
86             undef,
87             {
88             group_by => \@group,
89             select => [ @group, @funcs ],
90             as => [ @group, @names ],
91             order_by => \@group,
92             }
93             );
94              
95             }
96              
97              
98              
99              
100             1;
101              
102             __END__