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 4     4   442690 use 5.010001;
  4         25  
4 4     4   653 use Role::Tiny;
  4         8079  
  4         34  
5 4     4   1585 use Role::Tiny::With;
  4         317  
  4         5122  
6             with 'HashDataRole::Spec::Basic';
7              
8             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
9             our $DATE = '2024-11-04'; # DATE
10             our $DIST = 'HashDataRoles-Standard'; # DIST
11             our $VERSION = '0.005'; # VERSION
12              
13             sub new {
14 1     1 1 500763 my ($class, %args) = @_;
15              
16 1         6 my $dsn = delete $args{dsn};
17 1         4 my $user = delete $args{user};
18 1         5 my $password = delete $args{password};
19 1         4 my $dbh = delete $args{dbh};
20 1 50       27 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         5 my $table = delete $args{table}; # XXX quote
27 1         4 my $key_column = delete $args{key_column}; # XXX quote
28 1         3 my $val_column = delete $args{val_column}; # XXX quote
29              
30 1         3 my $iterate_sth = delete $args{iterate_sth};
31 1 50       7 unless (defined $iterate_sth) {
32 1 50 33     18 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         21 my $query = "SELECT $key_column,$val_column FROM $table";
37 1         29 $iterate_sth = $dbh->prepare($query);
38             }
39              
40 1         220 my $get_by_key_sth = delete $args{get_by_key_sth};
41 1 50       20 unless (defined $get_by_key_sth) {
42 1 50 33     14 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         21 my $query = "SELECT $val_column FROM $table WHERE $key_column=?";
47 1         8 $get_by_key_sth = $dbh->prepare($query);
48             }
49              
50 1         93 my $row_count_sth = delete $args{row_count_sth};
51 1 50       7 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         3 my $query = "SELECT COUNT(*) FROM $table";
57 1         6 $row_count_sth = $dbh->prepare($query);
58             }
59              
60 1 50       75 die "Unknown argument(s): ". join(", ", sort keys %args)
61             if keys %args;
62              
63 1         12 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 15 my $self = shift;
75 6 50       20 $self->reset_iterator unless defined $self->{pos};
76              
77 6 100       31 if (exists $self->{buf}) {
78 3         8 $self->{pos}++;
79 3         9 return delete $self->{buf};
80             } else {
81 3         41 my $row = $self->{iterate_sth}->fetchrow_arrayref;
82 3 50       9 die "StopIteration" unless $row;
83 3         15 $self->{pos}++;
84 3         33 [$row->[0], $row->[1]];
85             }
86             }
87              
88             sub has_next_item {
89 5     5 0 12 my $self = shift;
90 5 50       17 $self->reset_iterator unless defined $self->{pos};
91              
92 5 50       14 if (exists $self->{buf}) {
93 0         0 return 1;
94             }
95 5         81 my $row = $self->{iterate_sth}->fetchrow_arrayref;
96 5 100       42 return 0 unless $row;
97 3         13 $self->{buf} = [$row->[0], $row->[1]];
98 3         11 1;
99             }
100              
101             sub get_item_count {
102 1     1 0 3 my $self = shift;
103 1         24 $self->{row_count_sth}->execute;
104 1         17 my ($row_count) = $self->{row_count_sth}->fetchrow_array;
105 1         8 $row_count;
106             }
107              
108             sub reset_iterator {
109 3     3 0 13 my $self = shift;
110 3         361 $self->{iterate_sth}->execute;
111 3         19 $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 2060 my ($self, $pos) = @_;
121 2 100       17 $self->reset_iterator if $self->{pos} > $pos;
122 2         4 while (1) {
123 2 100       12 die "Out of range" unless $self->has_next_item;
124 1         5 my $item = $self->get_next_item;
125 1 50       12 return $item if $self->{pos} > $pos;
126             }
127             }
128              
129             sub has_item_at_pos {
130 2     2 0 8 my ($self, $pos) = @_;
131 2 100       15 return 1 if $self->{pos} > $pos;
132 1         4 while (1) {
133 3 100       9 return 0 unless $self->has_next_item;
134 2         13 $self->get_next_item;
135 2 50       8 return 1 if $self->{pos} > $pos;
136             }
137             }
138              
139             sub get_item_at_key {
140 2     2 0 65 my ($self, $key) = @_;
141 2         48 $self->{get_by_key_sth}->execute($key);
142 2         19 my $row = $self->{get_by_key_sth}->fetchrow_arrayref;
143 2 100       25 die "No such key '$key'" unless $row;
144 1         9 $row->[0];
145             }
146              
147             sub has_item_at_key {
148 2     2 0 594 my ($self, $key) = @_;
149 2         62 $self->{get_by_key_sth}->execute($key);
150 2         20 my $row = $self->{get_by_key_sth}->fetchrow_arrayref;
151 2 100       22 $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__