File Coverage

blib/lib/TableDataRole/Source/DBI.pm
Criterion Covered Total %
statement 86 93 92.4
branch 23 40 57.5
condition 9 16 56.2
subroutine 14 15 93.3
pod 1 9 11.1
total 133 173 76.8


line stmt bran cond sub pod time code
1             package TableDataRole::Source::DBI;
2              
3 1     1   509 use 5.010001;
  1         3  
4 1     1   5 use strict;
  1         5  
  1         20  
5 1     1   4 use warnings;
  1         2  
  1         37  
6              
7 1     1   5 use Role::Tiny;
  1         2  
  1         10  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2023-02-24'; # DATE
11             our $DIST = 'TableDataRoles-Standard'; # DIST
12             our $VERSION = '0.015'; # VERSION
13              
14             with 'TableDataRole::Spec::Basic';
15              
16             sub new {
17 1     1 1 68928 my ($class, %args) = @_;
18              
19 1         10 my $dsn = delete $args{dsn};
20 1         5 my $user = delete $args{user};
21 1         4 my $password = delete $args{password};
22 1         4 my $dbh = delete $args{dbh};
23 1 50       13 if (defined $dbh) {
    0          
24             } elsif (defined $dsn) {
25 0         0 require DBI;
26 0         0 $dbh = DBI->connect($dsn, $user, $password, {RaiseError=>1});
27             }
28              
29 1         5 my $sth = delete $args{sth};
30 1         4 my $sth_bind_params = delete $args{sth_bind_params};
31 1         4 my $query = delete $args{query};
32 1         3 my $table = delete $args{table};
33 1 50       8 if (defined $sth) {
34             } else {
35 1 50       8 die "You specify 'query' or 'table', but you don't specify ".
36             "dbh/dsn+user+password, so I cannot create a statement handle"
37             unless $dbh;
38 1 50       9 if (defined $query) {
    50          
39             } elsif (defined $table) {
40 1         8 $query = "SELECT * FROM $table";
41             } else {
42 0         0 die "Please specify 'sth', 'query', or 'table' argument";
43             }
44 1         16 $sth = $dbh->prepare($query);
45 1   50     201 $sth->execute(@{ $sth_bind_params // [] }); # to check query syntax
  1         134  
46             }
47              
48 1         17 my $row_count_sth = delete $args{row_count_sth};
49 1         8 my $row_count_sth_bind_params = delete $args{row_count_sth_bind_params};
50 1         2 my $row_count_query = delete $args{row_count_query};
51 1 50       6 if (defined $row_count_sth) {
52             } else {
53 1 50       8 die "You specify 'row_count_query' or 'table', but you don't specify ".
54             "dbh/dsn+user+password, so I cannot create a statement handle"
55             unless $dbh;
56 1 50       7 if (defined $row_count_query) {
    50          
57             } elsif (defined $table) {
58 1         5 $row_count_query = "SELECT COUNT(*) FROM $table";
59             } else {
60 0         0 die "For getting row count, please specify 'row_count_sth', ".
61             "'row_count_query', or 'table' argument";
62             }
63 1         10 $row_count_sth = $dbh->prepare($row_count_query);
64 1   50     105 $sth->execute(@{ $row_count_sth_bind_params // [] }); # to check query syntax
  1         135  
65             }
66              
67 1 50       11 die "Unknown argument(s): ". join(", ", sort keys %args)
68             if keys %args;
69              
70 1         15 bless {
71             #dbh => $dbh,
72             sth => $sth,
73             sth_bind_params => $sth_bind_params,
74             row_count_sth => $row_count_sth,
75             row_count_sth_bind_params => $row_count_sth_bind_params,
76              
77             pos => 0,
78             }, $class;
79             }
80              
81             sub _get_row {
82             # get a hashref row from sth, and empty the buffer
83 6     6   9 my $self = shift;
84 6 100       15 if ($self->{buffer}) {
85 3         19 my $row = delete $self->{buffer};
86 3 50 33     10 if (!ref($row) && $row == -1) {
87 0         0 return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
88             } else {
89 3         7 return $row;
90             }
91             } else {
92 3         51 my $row = $self->{sth}->fetchrow_hashref;
93 3 50       16 return undef unless $row; ## no critic: Subroutines::ProhibitExplicitReturnUndef
94 3         9 return $row;
95             }
96             }
97              
98             sub _peek_row {
99             # get a row from iterator, put it in buffer. will return the existing buffer
100             # content if it exists.
101 4     4   7 my $self = shift;
102 4 50       12 unless ($self->{buffer}) {
103 4   100     105 $self->{buffer} = $self->{sth}->fetchrow_hashref // -1;
104             }
105 4 100 66     27 if (!ref($self->{buffer}) && $self->{buffer} == -1) {
106 1         5 return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
107             } else {
108 3         15 return $self->{buffer};
109             }
110             }
111              
112             sub get_column_count {
113 1     1 0 3 my $self = shift;
114 1         12 $self->{sth}{NUM_OF_FIELDS};
115             }
116              
117             sub get_column_names {
118 7     7 0 28 my $self = shift;
119 7 100       52 wantarray ? @{ $self->{sth}{NAME_lc} } : $self->{sth}{NAME_lc};
  2         57  
120             }
121              
122             sub has_next_item {
123 4     4 0 28 my $self = shift;
124 4 100       13 $self->_peek_row ? 1:0;
125             }
126              
127             sub get_next_item {
128 5     5 0 15 my $self = shift;
129 5         17 my $row_hashref = $self->_get_row;
130 5 50       15 die "StopIteration" unless $row_hashref;
131 5         10 $self->{pos}++;
132 5         9 my $row_aryref = [];
133 5         14 my $column_names = $self->get_column_names;
134 5         12 for (0..$#{$column_names}) {
  5         37  
135 10         25 $row_aryref->[$_] = $row_hashref->{ $column_names->[$_] };
136             }
137 5         23 $row_aryref;
138             }
139              
140             sub get_next_row_hashref {
141 1     1 0 3 my $self = shift;
142 1         4 my $row = $self->_get_row;
143 1 50       5 die "StopIteration" unless $row;
144 1         3 $self->{pos}++;
145 1         5 $row;
146             }
147              
148             sub get_row_count {
149 1     1 0 3 my $self = shift;
150 1   50     3 $self->{row_count_sth}->execute(@{ $self->{row_count_sth_bind_params} // [] });
  1         20  
151 1         10 my ($row_count) = $self->{row_count_sth}->fetchrow_array;
152 1         22 $row_count;
153             }
154              
155             sub reset_iterator {
156 3     3 0 11 my $self = shift;
157 3   50     7 $self->{sth}->execute(@{ $self->{sth_bind_params} // [] });
  3         197  
158 3         22 delete $self->{buffer};
159 3         14 $self->{pos} = 0;
160             }
161              
162             sub get_iterator_pos {
163 0     0 0   my $self = shift;
164 0           $self->{pos};
165             }
166              
167             1;
168             # ABSTRACT: Role to access table data from DBI
169              
170             __END__