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   401 use 5.010001;
  1         3  
4 1     1   4 use strict;
  1         2  
  1         14  
5 1     1   3 use warnings;
  1         1  
  1         26  
6              
7 1     1   5 use Role::Tiny;
  1         1  
  1         5  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2022-02-20'; # DATE
11             our $DIST = 'TableDataRoles-Standard'; # DIST
12             our $VERSION = '0.014'; # VERSION
13              
14             with 'TableDataRole::Spec::Basic';
15              
16             sub new {
17 1     1 1 63296 my ($class, %args) = @_;
18              
19 1         4 my $dsn = delete $args{dsn};
20 1         3 my $user = delete $args{user};
21 1         1 my $password = delete $args{password};
22 1         2 my $dbh = delete $args{dbh};
23 1 50       5 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         1 my $sth = delete $args{sth};
30 1         2 my $sth_bind_params = delete $args{sth_bind_params};
31 1         2 my $query = delete $args{query};
32 1         2 my $table = delete $args{table};
33 1 50       4 if (defined $sth) {
34             } else {
35 1 50       4 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       4 if (defined $query) {
    50          
39             } elsif (defined $table) {
40 1         3 $query = "SELECT * FROM $table";
41             } else {
42 0         0 die "Please specify 'sth', 'query', or 'table' argument";
43             }
44 1         9 $sth = $dbh->prepare($query);
45 1   50     166 $sth->execute(@{ $sth_bind_params // [] }); # to check query syntax
  1         59  
46             }
47              
48 1         4 my $row_count_sth = delete $args{row_count_sth};
49 1         2 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       5 if (defined $row_count_sth) {
52             } else {
53 1 50       3 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       15 if (defined $row_count_query) {
    50          
57             } elsif (defined $table) {
58 1         3 $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         6 $row_count_sth = $dbh->prepare($row_count_query);
64 1   50     52 $sth->execute(@{ $row_count_sth_bind_params // [] }); # to check query syntax
  1         42  
65             }
66              
67 1 50       6 die "Unknown argument(s): ". join(", ", sort keys %args)
68             if keys %args;
69              
70 1         8 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   6 my $self = shift;
84 6 100       11 if ($self->{buffer}) {
85 3         4 my $row = delete $self->{buffer};
86 3 50 33     7 if (!ref($row) && $row == -1) {
87 0         0 return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
88             } else {
89 3         5 return $row;
90             }
91             } else {
92 3         40 my $row = $self->{sth}->fetchrow_hashref;
93 3 50       10 return undef unless $row; ## no critic: Subroutines::ProhibitExplicitReturnUndef
94 3         7 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   5 my $self = shift;
102 4 50       6 unless ($self->{buffer}) {
103 4   100     66 $self->{buffer} = $self->{sth}->fetchrow_hashref // -1;
104             }
105 4 100 66     17 if (!ref($self->{buffer}) && $self->{buffer} == -1) {
106 1         3 return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
107             } else {
108 3         10 return $self->{buffer};
109             }
110             }
111              
112             sub get_column_count {
113 1     1 0 2 my $self = shift;
114 1         10 $self->{sth}{NUM_OF_FIELDS};
115             }
116              
117             sub get_column_names {
118 7     7 0 10 my $self = shift;
119 7 100       61 wantarray ? @{ $self->{sth}{NAME_lc} } : $self->{sth}{NAME_lc};
  2         38  
120             }
121              
122             sub has_next_item {
123 4     4 0 21 my $self = shift;
124 4 100       9 $self->_peek_row ? 1:0;
125             }
126              
127             sub get_next_item {
128 5     5 0 12 my $self = shift;
129 5         12 my $row_hashref = $self->_get_row;
130 5 50       8 die "StopIteration" unless $row_hashref;
131 5         7 $self->{pos}++;
132 5         6 my $row_aryref = [];
133 5         7 my $column_names = $self->get_column_names;
134 5         11 for (0..$#{$column_names}) {
  5         12  
135 10         19 $row_aryref->[$_] = $row_hashref->{ $column_names->[$_] };
136             }
137 5         16 $row_aryref;
138             }
139              
140             sub get_next_row_hashref {
141 1     1 0 3 my $self = shift;
142 1         3 my $row = $self->_get_row;
143 1 50       3 die "StopIteration" unless $row;
144 1         2 $self->{pos}++;
145 1         4 $row;
146             }
147              
148             sub get_row_count {
149 1     1 0 2 my $self = shift;
150 1   50     2 $self->{row_count_sth}->execute(@{ $self->{row_count_sth_bind_params} // [] });
  1         16  
151 1         8 my ($row_count) = $self->{row_count_sth}->fetchrow_array;
152 1         3 $row_count;
153             }
154              
155             sub reset_iterator {
156 3     3 0 5 my $self = shift;
157 3   50     6 $self->{sth}->execute(@{ $self->{sth_bind_params} // [] });
  3         147  
158 3         10 delete $self->{buffer};
159 3         7 $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__