File Coverage

blib/lib/HashDataRole/Source/DBI.pm
Criterion Covered Total %
statement 78 90 86.6
branch 30 46 65.2
condition 7 21 33.3
subroutine 12 14 85.7
pod 1 11 9.0
total 128 182 70.3


line stmt bran cond sub pod time code
1             package HashDataRole::Source::DBI;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-05-21'; # DATE
5             our $DIST = 'HashDataRoles-Standard'; # DIST
6             our $VERSION = '0.001'; # VERSION
7              
8 1     1   534 use 5.010001;
  1         4  
9 1     1   6 use Role::Tiny;
  1         3  
  1         6  
10 1     1   162 use Role::Tiny::With;
  1         2  
  1         1147  
11             with 'HashDataRole::Spec::Basic';
12              
13             sub new {
14 1     1 1 70060 my ($class, %args) = @_;
15              
16 1         6 my $dsn = delete $args{dsn};
17 1         3 my $user = delete $args{user};
18 1         3 my $password = delete $args{password};
19 1         4 my $dbh = delete $args{dbh};
20 1 50       10 if (defined $dbh) {
    0          
21             } elsif (defined $dsn) {
22 0         0 require DBI;
23 0         0 $dbh = DBI->connect($dsn, $user, $password, {RaiseError=>1});
24             }
25              
26 1         24 my $table = delete $args{table}; # XXX quote
27 1         21 my $key_column = delete $args{key_column}; # XXX quote
28 1         6 my $val_column = delete $args{val_column}; # XXX quote
29              
30 1         3 my $iterate_sth = delete $args{iterate_sth};
31 1 50       5 unless (defined $iterate_sth) {
32 1 50 33     17 die "You don't specify 'iterate_sth', so you must specify ".
      33        
      33        
33             "dbh/dsn+user+password & table & key_column & val_column, ".
34             "so I can create a statement handle"
35             unless $dbh && defined($table) && defined($key_column) && defined($val_column);
36 1         6 my $query = "SELECT $key_column,$val_column FROM $table";
37 1         16 $iterate_sth = $dbh->prepare($query);
38             }
39              
40 1         136 my $get_by_key_sth = delete $args{get_by_key_sth};
41 1 50       6 unless (defined $get_by_key_sth) {
42 1 50 33     35 die "You don't specify 'iterate_sth', so you must specify ".
      33        
      33        
43             "dbh/dsn+user+password & table & key_column & val_column, ".
44             "so I can create a statement handle"
45             unless $dbh && defined($table) && defined($key_column) && defined($val_column);
46 1         8 my $query = "SELECT $val_column FROM $table WHERE $key_column=?";
47 1         8 $get_by_key_sth = $dbh->prepare($query);
48             }
49              
50 1         76 my $row_count_sth = delete $args{row_count_sth};
51 1 50       5 unless (defined $row_count_sth) {
52 1 50 33     8 die "You don't specify 'iterate_sth', so you must specify ".
53             "dbh/dsn+user+password & table, ".
54             "so I can create a statement handle"
55             unless $dbh && defined($table);
56 1         5 my $query = "SELECT COUNT(*) FROM $table";
57 1         6 $row_count_sth = $dbh->prepare($query);
58             }
59              
60 1 50       74 die "Unknown argument(s): ". join(", ", sort keys %args)
61             if keys %args;
62              
63 1         10 bless {
64             #dbh => $dbh,
65             iterate_sth => $iterate_sth,
66             get_by_key_sth => $get_by_key_sth,
67             row_count_sth => $row_count_sth,
68             pos => undef, # iterator pos
69             #buf => '', # exists when there is a buffer
70             }, $class;
71             }
72              
73             sub get_next_item {
74 6     6 0 17 my $self = shift;
75 6 50       16 $self->reset_iterator unless defined $self->{pos};
76              
77 6 100       18 if (exists $self->{buf}) {
78 3         4 $self->{pos}++;
79 3         11 return delete $self->{buf};
80             } else {
81 3         41 my $row = $self->{iterate_sth}->fetchrow_arrayref;
82 3 50       12 die "StopIteration" unless $row;
83 3         6 $self->{pos}++;
84 3         27 [$row->[0], $row->[1]];
85             }
86             }
87              
88             sub has_next_item {
89 5     5 0 9 my $self = shift;
90 5 50       12 $self->reset_iterator unless defined $self->{pos};
91              
92 5 50       11 if (exists $self->{buf}) {
93 0         0 return 1;
94             }
95 5         42 my $row = $self->{iterate_sth}->fetchrow_arrayref;
96 5 100       37 return 0 unless $row;
97 3         13 $self->{buf} = [$row->[0], $row->[1]];
98 3         13 1;
99             }
100              
101             sub get_item_count {
102 1     1 0 3 my $self = shift;
103 1         15 $self->{row_count_sth}->execute;
104 1         11 my ($row_count) = $self->{row_count_sth}->fetchrow_array;
105 1         6 $row_count;
106             }
107              
108             sub reset_iterator {
109 3     3 0 12 my $self = shift;
110 3         213 $self->{iterate_sth}->execute;
111 3         17 $self->{pos} = 0;
112             }
113              
114             sub get_iterator_pos {
115 0     0 0 0 my $self = shift;
116 0         0 $self->{pos};
117             }
118              
119             sub get_item_at_pos {
120 2     2 0 36 my ($self, $pos) = @_;
121 2 100       9 $self->reset_iterator if $self->{pos} > $pos;
122 2         4 while (1) {
123 2 100       7 die "Out of range" unless $self->has_next_item;
124 1         7 my $item = $self->get_next_item;
125 1 50       8 return $item if $self->{pos} > $pos;
126             }
127             }
128              
129             sub has_item_at_pos {
130 2     2 0 6 my ($self, $pos) = @_;
131 2 100       11 return 1 if $self->{pos} > $pos;
132 1         2 while (1) {
133 3 100       8 return 0 unless $self->has_next_item;
134 2         6 $self->get_next_item;
135 2 50       5 return 1 if $self->{pos} > $pos;
136             }
137             }
138              
139             sub get_item_at_key {
140 2     2 0 53 my ($self, $key) = @_;
141 2         33 $self->{get_by_key_sth}->execute($key);
142 2         11 my $row = $self->{get_by_key_sth}->fetchrow_arrayref;
143 2 100       17 die "No such key '$key'" unless $row;
144 1         6 $row->[0];
145             }
146              
147             sub has_item_at_key {
148 2     2 0 8 my ($self, $key) = @_;
149 2         41 $self->{get_by_key_sth}->execute($key);
150 2         12 my $row = $self->{get_by_key_sth}->fetchrow_arrayref;
151 2 100       16 $row ? 1:0;
152             }
153              
154             sub get_all_keys {
155 0     0 0   my $self = shift;
156 0           my @keys;
157 0           $self->reset_iterator;
158 0           while ($self->has_next_item) {
159 0           my $item = $self->get_next_item;
160 0           push @keys, $item->[0];
161             }
162 0           @keys;
163             }
164              
165             1;
166             # ABSTRACT: Role to access elements from DBI
167              
168             __END__