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   165653 use v5.10.1;
  1         6  
6              
7 1     1   7 use strict;
  1         3  
  1         22  
8 1     1   5 use warnings;
  1         3  
  1         27  
9              
10 1     1   5 use base qw( DBIx::Class );
  1         4  
  1         90  
11              
12 1     1   6 use Carp;
  1         2  
  1         85  
13 1     1   7 use List::Util 1.45 qw/ uniqstr /;
  1         21  
  1         71  
14 1     1   15 use Ref::Util qw/ is_plain_hashref is_ref /;
  1         2  
  1         55  
15              
16             # RECOMMEND PREREQ: Ref::Util::XS
17              
18 1     1   482 use namespace::autoclean;
  1         1482  
  1         6  
19              
20             our $VERSION = 'v0.1.0';
21              
22              
23              
24             sub simple_stats {
25 6     6 1 410903 my ( $self, @args ) = @_;
26              
27 6 50       37 croak "No columns" unless @args;
28              
29 6         17 my @cols;
30             my @funcs;
31              
32 6         38 my $me = $self->current_source_alias;
33              
34             my $alias = sub {
35 20     20   36 my $ident = shift;
36 20 50       77 $ident = "$me.$ident" unless $ident =~ /^(\w+)\./;
37 20         92 return $ident;
38 6         69 };
39              
40 6         23 foreach my $arg (@args) {
41              
42 11 100       54 if ( is_ref($arg) ) {
43              
44 7 50       23 if ( is_plain_hashref($arg) ) {
45              
46 7         22 my $as = delete $arg->{'-as'};
47 7         17 my ( $func, $col ) = each %{$arg};
  7         30  
48              
49 7   66     47 $as //= "${col}_${func}";
50              
51 7         19 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         12 push @cols, $alias->($arg);
66              
67             }
68              
69             }
70              
71 6 100       38 unless (@funcs) {
72              
73 2         9 my $func = "count";
74 2         6 my $col = $cols[0];
75 2         14 $col =~ s/^\w+\.// ;
76              
77 2         9 push @funcs, { $func => $alias->($col), -as => "${col}_${func}" };
78              
79             }
80              
81 6         23 my @names = map { delete $_->{'-as'} } @funcs;
  9         31  
82              
83 6         42 my @group = uniqstr @cols;
84              
85 6         74 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__