File Coverage

blib/lib/DBIx/Class/CDBICompat/Retrieve.pm
Criterion Covered Total %
statement 6 45 13.3
branch 0 16 0.0
condition n/a
subroutine 2 11 18.1
pod 0 8 0.0
total 8 80 10.0


line stmt bran cond sub pod time code
1             package # hide from PAUSE
2             DBIx::Class::CDBICompat::Retrieve;
3              
4 2     2   2279 use strict;
  2         4  
  2         55  
5              
6             # even though fatalization has been proven over and over to be a universally
7             # bad idea, this line has been part of the code from the beginning
8             # leaving the compat layer as-is, something may in fact depend on that
9 2     2   9 use warnings FATAL => 'all';
  2         4  
  2         988  
10              
11             sub retrieve {
12 0     0 0   my $self = shift;
13 0 0         die "No args to retrieve" unless @_ > 0;
14              
15 0           my @cols = $self->primary_columns;
16              
17 0           my $query;
18 0 0         if (ref $_[0] eq 'HASH') {
    0          
19 0           $query = { %{$_[0]} };
  0            
20             }
21             elsif (@_ == @cols) {
22 0           $query = {};
23 0           @{$query}{@cols} = @_;
  0            
24             }
25             else {
26 0           $query = {@_};
27             }
28              
29 0           $query = $self->_build_query($query);
30 0           $self->find($query);
31             }
32              
33             sub find_or_create {
34 0     0 0   my $self = shift;
35 0 0         my $query = ref $_[0] eq 'HASH' ? shift : {@_};
36              
37 0           $query = $self->_build_query($query);
38 0           $self->next::method($query);
39             }
40              
41             # _build_query
42             #
43             # Build a query hash. Defaults to a no-op; ColumnCase overrides.
44              
45             sub _build_query {
46 0     0     my ($self, $query) = @_;
47              
48 0           return $query;
49             }
50              
51             sub retrieve_from_sql {
52 0     0 0   my ($class, $cond, @rest) = @_;
53              
54 0           $cond =~ s/^\s*WHERE//i;
55              
56             # Need to parse the SQL clauses after WHERE in reverse
57             # order of appearance.
58              
59 0           my %attrs;
60              
61 0 0         if( $cond =~ s/\bLIMIT\s+(\d+)\s*$//i ) {
62 0           $attrs{rows} = $1;
63             }
64              
65 0 0         if ( $cond =~ s/\bORDER\s+BY\s+(.*)\s*$//i ) {
66 0           $attrs{order_by} = $1;
67             }
68              
69 0 0         if( $cond =~ s/\bGROUP\s+BY\s+(.*)\s*$//i ) {
70 0           $attrs{group_by} = $1;
71             }
72              
73 0 0         return $class->search_literal($cond, @rest, ( %attrs ? \%attrs : () ) );
74             }
75              
76             sub construct {
77 0     0 0   my $class = shift;
78 0           my $obj = $class->resultset_instance->new_result(@_);
79 0           $obj->in_storage(1);
80              
81 0           return $obj;
82             }
83              
84 0     0 0   sub retrieve_all { shift->search }
85 0     0 0   sub count_all { shift->count }
86              
87             sub maximum_value_of {
88 0     0 0   my($class, $col) = @_;
89 0           return $class->resultset_instance->get_column($col)->max;
90             }
91              
92             sub minimum_value_of {
93 0     0 0   my($class, $col) = @_;
94 0           return $class->resultset_instance->get_column($col)->min;
95             }
96              
97             1;