File Coverage

blib/lib/Catmandu/Store/DBI/Iterator.pm
Criterion Covered Total %
statement 68 72 94.4
branch 12 26 46.1
condition 5 13 38.4
subroutine 13 13 100.0
pod 0 4 0.0
total 98 128 76.5


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 6     6   39 use Catmandu::Util qw(is_value is_string is_array_ref);
  6         10  
  6         35  
4 6     6   924 use Moo;
  6         9  
  6         348  
5 6     6   31 use namespace::clean;
  6         16  
  6         35  
6 6     6   1813  
  6         19  
  6         47  
7             our $VERSION = "0.12";
8              
9             with 'Catmandu::Iterable';
10              
11             has bag => (is => 'ro', required => 1);
12             has where => (is => 'ro');
13             has binds => (is => 'lazy');
14             has total => (is => 'ro');
15             has start => (is => 'lazy');
16             has limit => (is => 'lazy');
17              
18              
19 4     4   60 my ($self) = @_;
20 4     4   113 my $limit = 100;
21             my $total = $self->total;
22             if (defined $total && $total < $limit) {
23 1     1   9 $limit = $total;
24 1         2 }
25 1         3 $limit;
26 1 50 33     7 }
27 1         2  
28             my ($self) = @_;
29 1         3 my $bag = $self->bag;
30             my $store = $self->bag->store_with_table;
31             my $handler = $store->handler;
32             my $binds = $self->binds;
33 1     1 0 52 my $total = $self->total;
34 1         3 my $start = $self->start;
35 1         16 my $limit = $self->limit;
36 1         18 my $where = $self->where;
37 1         18  
38 1         7 sub {
39 1         13 state $rows;
40 1         19  
41 1         4 return if defined $total && $total <= 0;
42              
43             unless (defined $rows && @$rows) {
44 1     1   1 my $dbh = $store->dbh;
45              
46 1 50 33     6 #DO NOT USE prepare_cached as it holds previous data in memory, leading to a memory leak!
47             my $sth
48 1 50 33     5 = $dbh->prepare(
49 1         2 $handler->select_sql($bag, $start, $limit, $where))
50             or Catmandu::Error->throw($dbh->errstr);
51             $sth->execute(@$binds) or Catmandu::Error->throw($sth->errstr);
52 1 50       5 $rows = $sth->fetchall_arrayref({});
53             # less results than requested: the end is near
54             $total = scalar(@$rows) if scalar(@$rows) < $limit;
55             $sth->finish;
56 1 50       197 $start += $limit;
57 1         16 }
58              
59 1 50       103 my $data = $bag->_row_to_data(shift(@$rows) // return);
60 1         4 $total-- if defined $total;
61 1         20 $data;
62             };
63             }
64 1   50     9  
65 1 50       4 my ($self) = @_;
66 1         10 my $bag = $self->bag;
67 1         7 my $binds = $self->binds;
68             my $store = $bag->store_with_table;
69             my $dbh = $store->dbh;
70             my $sth = $dbh->prepare_cached(
71 8     8 0 3792 $store->handler->count_sql(
72 8         33 $bag, $self->start, $self->total, $self->where
73 8         141 )
74 8         148 ) or Catmandu::Error->throw($dbh->errstr);
75 8         83 $sth->execute(@$binds) or Catmandu::Error->throw($sth->errstr);
76 8 50       119 my ($n) = $sth->fetchrow_array;
77             $sth->finish;
78             $n;
79             }
80              
81 8 50       1449 my ($self, $start, $total) = @_;
82 8         135 ref($self)->new(
83 8         42 {
84 8         115 bag => $self->bag,
85             where => $self->where,
86             binds => $self->binds,
87             total => $total,
88 3     3 0 1852 start => $self->start + ($start // 0),
89 3   50     58 }
90             );
91             }
92              
93             around select => sub {
94             my ($orig, $self, $arg1, $arg2) = @_;
95             my $mapping = $self->bag->mapping;
96              
97             if ( is_string($arg1)
98             && $mapping->{$arg1}
99             && (is_value($arg2) || is_array_ref($arg2)))
100             {
101             my $opts = $self->_scope($arg1, $arg2);
102             return ref($self)->new($opts);
103             }
104              
105             $self->$orig($arg1, $arg2);
106             };
107              
108             around detect => sub {
109             my ($orig, $self, $arg1, $arg2) = @_;
110             my $mapping = $self->bag->mapping;
111              
112             if ( is_string($arg1)
113             && $mapping->{$arg1}
114             && (is_value($arg2) || is_array_ref($arg2)))
115             {
116             my $opts = $self->_scope($arg1, $arg2);
117             $opts->{total} = 1;
118             return ref($self)->new($opts)->generator->();
119             }
120              
121             $self->$orig($arg1, $arg2);
122             };
123              
124             my ($self) = @_;
125             ref($self)->new(
126             {
127             bag => $self->bag,
128             where => $self->where,
129             binds => $self->binds,
130             total => 1,
131             start => $self->start,
132 1     1 0 25 }
133 1         19 )->generator->();
134             }
135              
136             my ($self, $arg1, $arg2) = @_;
137             my $binds = [@{$self->binds}];
138             my $where = is_string($self->where) ? '(' . $self->where . ') AND ' : '';
139             my $map = $self->bag->mapping->{$arg1};
140             my $column = $map->{column};
141             my $q_column = $self->bag->_quote_id($column);
142              
143             if ($map->{array}) {
144             push @$binds, is_value($arg2) ? [$arg2] : $arg2;
145 4     4   10 $where .= "($q_column && ?)";
146 4         6 }
  4         55  
147 4 50       28 elsif (is_value($arg2)) {
148 4         10 push @$binds, $arg2;
149 4         8 $where .= "($q_column=?)";
150 4         11 }
151             else {
152 4 50       96 push @$binds, @$arg2;
    50          
153 0 0       0 $where .= "($q_column IN(" . join(',', ('?') x @$arg2) . '))';
154 0         0 }
155              
156             {
157 4         8 bag => $self->bag,
158 4         13 where => $where,
159             binds => $binds,
160             start => $self->start,
161 0         0 };
162 0         0 }
163              
164             1;