File Coverage

blib/lib/CPAN/SQLite/DBI/Index.pm
Criterion Covered Total %
statement 109 159 68.5
branch 13 40 32.5
condition 1 3 33.3
subroutine 22 25 88.0
pod 5 9 55.5
total 150 236 63.5


line stmt bran cond sub pod time code
1             # $Id: Index.pm 84 2020-05-31 06:29:34Z stro $
2              
3             package CPAN::SQLite::DBI::Index;
4 4     4   33 use strict;
  4         11  
  4         137  
5 4     4   22 use warnings;
  4         8  
  4         335  
6              
7             BEGIN {
8 4     4   17 our $VERSION = '0.219';
9 4         18 $CPAN::SQLite::DBI::Index::info::VERSION = $VERSION;
10 4         9 $CPAN::SQLite::DBI::Index::mods::VERSION = $VERSION;
11 4         8 $CPAN::SQLite::DBI::Index::dists::VERSION = $VERSION;
12 4         96 $CPAN::SQLite::DBI::Index::auths::VERSION = $VERSION;
13             }
14              
15 4     4   22 use CPAN::SQLite::DBI qw($dbh);
  4         11  
  4         321  
16 4     4   28 use parent 'CPAN::SQLite::DBI';
  4         8  
  4         21  
17              
18             package CPAN::SQLite::DBI::Index::info;
19 4     4   285 use parent 'CPAN::SQLite::DBI::Index';
  4         11  
  4         16  
20 4     4   242 use CPAN::SQLite::DBI qw($dbh);
  4         8  
  4         350  
21              
22             package CPAN::SQLite::DBI::Index::mods;
23 4     4   26 use parent 'CPAN::SQLite::DBI::Index';
  4         8  
  4         19  
24 4     4   268 use CPAN::SQLite::DBI qw($dbh);
  4         8  
  4         360  
25              
26             package CPAN::SQLite::DBI::Index::dists;
27 4     4   38 use parent 'CPAN::SQLite::DBI::Index';
  4         9  
  4         54  
28 4     4   253 use CPAN::SQLite::DBI qw($dbh);
  4         10  
  4         1029  
29              
30             sub fetch_ids {
31 0     0   0 my $self = shift;
32 0         0 my $sql = sprintf(qq{SELECT %s,%s,%s FROM %s}, $self->{id}, $self->{name}, 'dist_vers', $self->{table});
33 0 0       0 my $sth = $dbh->prepare($sql) or do {
34 0         0 $self->db_error();
35 0         0 return;
36             };
37 0 0       0 $sth->execute() or do {
38 0         0 $self->db_error($sth);
39 0         0 return;
40             };
41 0         0 my ($ids, $versions);
42 0         0 while (my ($id, $key, $vers) = $sth->fetchrow_array()) {
43 0         0 $ids->{$key} = $id;
44 0         0 $versions->{$key} = $vers;
45             }
46 0         0 $sth->finish;
47 0         0 undef $sth;
48 0         0 return ($ids, $versions);
49             }
50              
51             package CPAN::SQLite::DBI::Index::auths;
52 4     4   31 use parent 'CPAN::SQLite::DBI::Index';
  4         10  
  4         17  
53 4     4   260 use CPAN::SQLite::DBI qw($dbh);
  4         8  
  4         418  
54              
55             package CPAN::SQLite::DBI::Index;
56 4     4   31 use CPAN::SQLite::DBI qw($tables);
  4         6  
  4         297  
57 4     4   27 use CPAN::SQLite::DBI qw($dbh);
  4         8  
  4         4885  
58              
59             sub fetch_ids {
60 0     0 0 0 my $self = shift;
61 0         0 my $sql = sprintf(qq{SELECT %s,%s from %s}, $self->{id}, $self->{name}, $self->{table});
62 0 0       0 my $sth = $dbh->prepare($sql) or do {
63 0         0 $self->db_error();
64 0         0 return;
65             };
66 0 0       0 $sth->execute() or do {
67 0         0 $self->db_error($sth);
68 0         0 return;
69             };
70 0         0 my $ids;
71 0         0 while (my ($id, $key) = $sth->fetchrow_array()) {
72 0         0 $ids->{$key} = $id;
73             }
74 0         0 $sth->finish;
75 0         0 undef $sth;
76 0         0 return $ids;
77             }
78              
79             sub schema {
80 4     4 0 11 my ($self, $data) = @_;
81 4         9 my $schema = '';
82 4         16 foreach my $type (qw(primary other)) {
83 8         13 foreach my $column (keys %{ $data->{$type} }) {
  8         23  
84 16         50 $schema .= $column . ' ' . $data->{$type}->{$column} . ", ";
85             }
86             }
87 4         27 $schema =~ s{, $}{};
88 4         15 return $schema;
89             }
90              
91             sub create_index {
92 4     4 0 12 my ($self, $data) = @_;
93 4         10 my $key = $data->{key};
94 4         9 my $table = $self->{table};
95 4 50 33     23 return 1 unless (defined $key and ref($key) eq 'ARRAY');
96 4         12 foreach my $index (@$key) {
97 5         15 my $id_name = 'ix_' . $table . '_' . $index;
98 5         16 $id_name =~ s/\(\s*\d+\s*\)//;
99 5         14 my $sql = 'CREATE INDEX ' . $id_name . ' ON ' . $table . '( ' . $index . ' )';
100 5         35 my $sth = $dbh->prepare($sql);
101 5 50       669 $sth->execute() or do {
102 0         0 $self->db_error($sth);
103 0         0 return;
104             };
105 5         31 $sth->finish;
106 5         53 undef $sth;
107             }
108 4         19 return 1;
109             }
110              
111             sub drop_table {
112 4     4 1 7 my $self = shift;
113 4         19 my $table = $self->{table};
114 4         10 my $sql = qq{SELECT name FROM sqlite_master } . qq{ WHERE type='table' AND name=?};
115 4         22 my $sth = $dbh->prepare($sql);
116 4         611 $sth->execute($table);
117 4 50       29 if (defined $sth->fetchrow_array) {
118 0 0       0 $dbh->do(qq{drop table $table}) or do {
119 0         0 $self->db_error($sth);
120 0         0 return;
121             };
122             }
123 4         14 $sth->finish;
124 4         47 undef $sth;
125 4         13 return 1;
126             }
127              
128             sub create_table {
129 4     4 0 12 my ($self, $schema) = @_;
130 4 50       23 return unless $schema;
131 4         22 my $sql = sprintf(qq{CREATE TABLE %s (%s)}, $self->{table}, $schema);
132 4         19 my $sth = $dbh->prepare($sql);
133 4 50       785 $sth->execute() or do {
134 0         0 $self->db_error($sth);
135 0         0 return;
136             };
137 4         27 $sth->finish;
138 4         38 undef $sth;
139 4         22 return 1;
140             }
141              
142             sub create_tables {
143 1     1 1 5 my ($self, %args) = @_;
144 1 50       5 return unless $args{setup};
145 1         7 my $objs = $self->{objs};
146 1         4 foreach my $table (keys %$objs) {
147 4 50       15 next unless my $schema = $self->schema($tables->{$table});
148 4         9 my $obj = $objs->{$table};
149 4 50       24 $obj->drop_table or return;
150 4 50       32 $obj->create_table($schema) or return;
151 4 50       34 $obj->create_index($tables->{$table}) or return;
152             }
153 1         8 return 1;
154             }
155              
156             sub sth_insert {
157 4     4 1 57 my ($self, $fields) = @_;
158 4         12 my $flds = join ',', @{$fields};
  4         23  
159 4         13 my $vals = join ',', map { '?' } @{$fields};
  13         46  
  4         16  
160 4         41 my $sql = sprintf(qq{INSERT INTO %s (%s) VALUES (%s)}, $self->{table}, $flds, $vals);
161              
162 4 50       75 my $sth = $dbh->prepare($sql) or do {
163 0         0 $self->db_error();
164 0         0 return;
165             };
166 4         504 return $sth;
167             }
168              
169             sub sth_update {
170 0     0 1 0 my ($self, $fields, $id, $rep_id) = @_;
171 0         0 my $set = join ',', map { "$_=?" } @{$fields};
  0         0  
  0         0  
172 0         0 my $sql = sprintf(qq{UPDATE %s SET %s WHERE %s = %s}, $self->{table}, $set, $self->{id}, $id);
173 0 0       0 $sql .= qq { AND rep_id = $rep_id } if ($rep_id);
174 0 0       0 my $sth = $dbh->prepare($sql) or do {
175 0         0 $self->db_error();
176 0         0 return;
177             };
178 0         0 return $sth;
179             }
180              
181             sub sth_delete {
182 1     1 1 4 my ($self, $table_id, $rep_id) = @_;
183 1         15 my $sql = sprintf(qq{DELETE FROM %s where %s = ?}, $self->{table}, $table_id);
184 1 50       6 $sql .= qq { AND rep_id = $rep_id } if ($rep_id);
185 1 50       7 my $sth = $dbh->prepare($sql) or do {
186 0         0 $self->db_error();
187 0         0 return;
188             };
189 1         64 return $sth;
190             }
191              
192             1;
193              
194             =head1 NAME
195              
196             CPAN::SQLite::DBI::Index - DBI information for indexing the CPAN::SQLite database
197              
198             =head1 VERSION
199              
200             version 0.219
201              
202             =head1 DESCRIPTION
203              
204             This module provides various methods for L in
205             indexing and populating the database from the index files.
206              
207             =over
208              
209             =item C
210              
211             This creates the database tables.
212              
213             =item C
214              
215             This drops a table.
216              
217             =item C
218              
219             This returns an C<$sth> statement handle for inserting
220             values into a table.
221              
222             =item C
223              
224             This returns an C<$sth> statement handle for updating
225             values into a table.
226              
227             =item C
228              
229             This returns an C<$sth> statement handle for deleting
230             values from a table.
231              
232             =back
233              
234             =head1 SEE ALSO
235              
236             L
237              
238             =cut