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__ |