File Coverage

blib/lib/CPAN/SQLite/Populate.pm
Criterion Covered Total %
statement 216 469 46.0
branch 59 188 31.3
condition 12 57 21.0
subroutine 33 41 80.4
pod 0 5 0.0
total 320 760 42.1


line stmt bran cond sub pod time code
1             # $Id: Populate.pm 82 2020-05-30 06:14:27Z stro $
2              
3             package CPAN::SQLite::Populate;
4 4     4   723 use strict;
  4         9  
  4         123  
5 4     4   20 use warnings;
  4         22  
  4         108  
6 4     4   24 no warnings qw(redefine);
  4         8  
  4         179  
7              
8             our $VERSION = '0.218';
9              
10 4     4   22 use English qw/-no_match_vars/;
  4         7  
  4         21  
11              
12 4     4   1312 use CPAN::SQLite::Util qw($table_id has_hash_data print_debug);
  4         8  
  4         422  
13 4     4   521 use CPAN::SQLite::DBI::Index;
  4         8  
  4         171  
14 4     4   26 use CPAN::SQLite::DBI qw($dbh);
  4         18  
  4         356  
15 4     4   35 use File::Find;
  4         9  
  4         283  
16 4     4   27 use File::Basename;
  4         11  
  4         282  
17 4     4   26 use File::Spec::Functions;
  4         10  
  4         444  
18 4     4   35 use File::Path;
  4         15  
  4         353  
19 4     4   27 use Scalar::Util 'weaken';
  4         7  
  4         3967  
20              
21             our $dbh = $CPAN::SQLite::DBI::dbh;
22             my ($setup);
23              
24             my %tbl2obj;
25             $tbl2obj{$_} = __PACKAGE__ . '::' . $_ foreach (qw(dists mods auths info));
26             my %obj2tbl = reverse %tbl2obj;
27              
28             sub new {
29 1     1 0 533 my ($class, %args) = @_;
30              
31 1         4 $setup = $args{setup};
32              
33 1         3 my $index = $args{index};
34 1         5 my @tables = qw(dists mods auths info);
35 1         2 foreach my $table (@tables) {
36 4         8 my $obj = $index->{$table};
37 4 50 33     21 die "Please supply a CPAN::SQLite::Index::$table object"
38             unless ($obj and ref($obj) eq "CPAN::SQLite::Index::$table");
39             }
40 1         3 my $state = $args{state};
41 1 50       2 unless ($setup) {
42 0 0 0     0 die "Please supply a CPAN::SQLite::State object"
43             unless ($state and ref($state) eq 'CPAN::SQLite::State');
44             }
45 1         6 my $cdbi = CPAN::SQLite::DBI::Index->new(%args);
46              
47             my $self = {
48             index => $index,
49             state => $state,
50             obj => {},
51             cdbi => $cdbi,
52             db_name => $args{db_name},
53 1         19 };
54 1         8 return bless $self, $class;
55             }
56              
57             sub populate {
58 1     1 0 398 my $self = shift;
59              
60 1 50       5 if ($setup) {
61 1 50       11 unless ($self->{cdbi}->create_tables(setup => $setup)) {
62 0         0 warn "Creating tables failed";
63 0         0 return;
64             }
65             }
66 1 50       5 unless ($self->create_objs()) {
67 0         0 warn "Cannot create objects";
68 0         0 return;
69             }
70 1 50       6 unless ($self->populate_tables()) {
71 0         0 warn "Populating tables failed";
72 0         0 return;
73             }
74 1         8 return 1;
75             }
76              
77             sub create_objs {
78 1     1 0 4 my $self = shift;
79 1         4 my @tables = qw(dists auths mods info);
80              
81 1         4 foreach my $table (@tables) {
82 4         7 my $obj;
83 4         12 my $pack = $tbl2obj{$table};
84 4         6 my $index = $self->{index}->{$table};
85 4 50 33     26 if ($index and ref($index) eq "CPAN::SQLite::Index::$table") {
86 4         9 my $info = $index->{info};
87 4 100       10 if ($table ne 'info') {
88 3 50       22 return unless has_hash_data($info);
89             }
90             $obj = $pack->new(
91             info => $info,
92 4         54 cdbi => $self->{cdbi}->{objs}->{$table});
93             } else {
94 0         0 $obj = $pack->new(cdbi => $self->{cdbi}->{objs}->{$table});
95             }
96 4         14 $self->{obj}->{$table} = $obj;
97             }
98              
99 1         3 foreach my $table (@tables) {
100 4         6 my $obj = $self->{obj}->{$table};
101 4         7 foreach (@tables) {
102 16 100       37 next if ref($obj) eq $tbl2obj{$_};
103 12         37 $obj->{obj}->{$_} = $self->{obj}->{$_};
104 12         28 weaken $obj->{obj}->{$_};
105             }
106             }
107              
108 1 50       13 unless ($setup) {
109 0         0 my $state = $self->{state};
110 0         0 my @tables = qw(auths dists mods);
111 0         0 my @data = qw(ids insert update delete);
112              
113 0         0 foreach my $table (@tables) {
114 0         0 my $state_obj = $state->{obj}->{$table};
115 0         0 my $pop_obj = $self->{obj}->{$table};
116 0         0 $pop_obj->{$_} = $state_obj->{$_} for (@data);
117             }
118             }
119 1         5 return 1;
120             }
121              
122             sub populate_tables {
123 1     1 0 2 my $self = shift;
124 1 50       5 my @methods = $setup ? qw(insert) : qw(insert update delete);
125              
126             # Reset status
127 1         3 my $info_obj = $self->{'obj'}->{'info'};
128 1 50       6 unless ($info_obj->delete) {
129 0         0 print_debug('Fatal error from ', ref($info_obj), ':', $info_obj->{'error_msg'});
130 0         0 return;
131             }
132              
133 1         20 my @tables = qw(auths dists mods);
134 1         5 for my $method (@methods) {
135 1         4 for my $table (@tables) {
136 3         19 my $obj = $self->{obj}->{$table};
137 3 50       34 unless ($obj->$method()) {
138 0 0       0 if (my $error = $obj->{error_msg}) {
139 0         0 print_debug("Fatal error from ", ref($obj), ": ", $error, $/);
140 0         0 return;
141             } else {
142 0         0 my $info = $obj->{info_msg};
143 0         0 print_debug("Info from ", ref($obj), ": ", $info, $/);
144             }
145             }
146             }
147             }
148              
149             # Update status
150 1 50       10 unless ($info_obj->insert) {
151 0         0 print_debug('Fatal error from ', ref($info_obj), ':', $info_obj->{'error_msg'});
152 0         0 return;
153             }
154              
155 1         13 return 1;
156             }
157              
158             package CPAN::SQLite::Populate::auths;
159 4     4   33 use parent 'CPAN::SQLite::Populate';
  4         8  
  4         21  
160 4     4   286 use CPAN::SQLite::Util qw(has_hash_data print_debug);
  4         9  
  4         3111  
161              
162             sub new {
163 1     1   5 my ($class, %args) = @_;
164 1         3 my $info = $args{info};
165 1 50       3 die "No author info available" unless has_hash_data($info);
166 1         3 my $cdbi = $args{cdbi};
167 1 50 33     6 die "No dbi object available"
168             unless ($cdbi and ref($cdbi) eq 'CPAN::SQLite::DBI::Index::auths');
169 1         70 my $self = {
170             info => $info,
171             insert => {},
172             update => {},
173             delete => {},
174             ids => {},
175             obj => {},
176             cdbi => $cdbi,
177             error_msg => '',
178             info_msg => '',
179             };
180 1         43 return bless $self, $class;
181             }
182              
183             sub insert {
184 1     1   4 my $self = shift;
185 1 50       5 unless ($dbh) {
186 0         0 $self->{error_msg} = q{No db handle available};
187 0         0 return;
188             }
189 1         4 my $info = $self->{info};
190 1         3 my $cdbi = $self->{cdbi};
191 1 50       6 my $data = $setup ? $info : $self->{insert};
192 1 50       8 unless (has_hash_data($data)) {
193 0         0 $self->{info_msg} = q{No author data to insert};
194 0         0 return;
195             }
196 1         7 my $auth_ids = $self->{ids};
197 1         5 my @fields = qw(cpanid email fullname);
198 1 50       28 my $sth = $cdbi->sth_insert(\@fields) or do {
199 0         0 $self->{error_msg} = $cdbi->{error_msg};
200 0         0 return;
201             };
202 1         12 foreach my $cpanid (keys %$data) {
203 4         13 my $values = $info->{$cpanid};
204 4 50 33     23 next unless ($values and $cpanid);
205 4         28 print_debug("Inserting author $cpanid\n");
206             $sth->execute($cpanid, $values->{email}, $values->{fullname})
207 4 50       411 or do {
208 0         0 $cdbi->db_error($sth);
209 0         0 $self->{error_msg} = $cdbi->{error_msg};
210 0         0 return;
211             };
212 4 50       54 $auth_ids->{$cpanid} = $dbh->func('last_insert_rowid') or do {
213 0         0 $cdbi->db_error($sth);
214 0         0 $self->{error_msg} = $cdbi->{error_msg};
215 0         0 return;
216             };
217             }
218 1         8 $sth->finish();
219 1         18 undef $sth;
220 1 50       11687 $dbh->commit() or do {
221 0         0 $cdbi->db_error();
222 0         0 $self->{error_msg} = $cdbi->{error_msg};
223 0         0 return;
224             };
225 1         17 return 1;
226             }
227              
228             sub update {
229 0     0   0 my $self = shift;
230 0 0       0 unless ($dbh) {
231 0         0 $self->{error_msg} = q{No db handle available};
232 0         0 return;
233             }
234 0         0 my $data = $self->{update};
235 0         0 my $cdbi = $self->{cdbi};
236 0 0       0 unless (has_hash_data($data)) {
237 0         0 $self->{info_msg} = q{No author data to update};
238 0         0 return;
239             }
240              
241 0         0 my $info = $self->{info};
242 0         0 my @fields = qw(cpanid email fullname);
243 0         0 foreach my $cpanid (keys %$data) {
244 0         0 print_debug("Updating author $cpanid\n");
245 0 0       0 next unless $data->{$cpanid};
246 0         0 my $sth = $cdbi->sth_update(\@fields, $data->{$cpanid});
247 0         0 my $values = $info->{$cpanid};
248 0 0 0     0 next unless ($cpanid and $values);
249             $sth->execute($cpanid, $values->{email}, $values->{fullname})
250 0 0       0 or do {
251 0         0 $cdbi->db_error($sth);
252 0         0 $self->{error_msg} = $cdbi->{error_msg};
253 0         0 return;
254             };
255 0         0 $sth->finish();
256 0         0 undef $sth;
257             }
258 0 0       0 $dbh->commit() or do {
259 0         0 $cdbi->db_error();
260 0         0 $self->{error_msg} = $cdbi->{error_msg};
261 0         0 return;
262             };
263 0         0 return 1;
264             }
265              
266             sub delete {
267 0     0   0 my $self = shift;
268 0         0 $self->{info_msg} = q{No author data to delete};
269 0         0 return;
270             }
271              
272             package CPAN::SQLite::Populate::dists;
273 4     4   33 use parent 'CPAN::SQLite::Populate';
  4         9  
  4         17  
274 4     4   278 use CPAN::SQLite::Util qw(has_hash_data print_debug);
  4         17  
  4         4405  
275              
276             sub new {
277 1     1   5 my ($class, %args) = @_;
278 1         4 my $info = $args{info};
279 1 50       4 die "No dist info available" unless has_hash_data($info);
280 1         3 my $cdbi = $args{cdbi};
281 1 50 33     8 die "No dbi object available"
282             unless ($cdbi and ref($cdbi) eq 'CPAN::SQLite::DBI::Index::dists');
283 1         21 my $self = {
284             info => $info,
285             insert => {},
286             update => {},
287             delete => {},
288             ids => {},
289             obj => {},
290             cdbi => $cdbi,
291             error_msg => '',
292             info_msg => '',
293             };
294 1         6 return bless $self, $class;
295             }
296              
297             sub insert {
298 1     1   4 my $self = shift;
299 1 50       7 unless ($dbh) {
300 0         0 $self->{error_msg} = q{No db handle available};
301 0         0 return;
302             }
303 1 50       8 return unless my $auth_obj = $self->{obj}->{auths};
304 1         5 my $cdbi = $self->{cdbi};
305 1         4 my $auth_ids = $auth_obj->{ids};
306 1         3 my $dists = $self->{info};
307 1 50       26 my $data = $setup ? $dists : $self->{insert};
308 1 50       15 unless (has_hash_data($data)) {
309 0         0 $self->{info_msg} = q{No dist data to insert};
310 0         0 return;
311             }
312 1 50 33     13 unless ($dists and $auth_ids) {
313 0         0 $self->{error_msg}->{index} = q{No dist index data available};
314 0         0 return;
315             }
316              
317 1         5 my $dist_ids = $self->{ids};
318 1         11 my @fields = qw(auth_id dist_name dist_file dist_vers dist_abs);
319 1 50       18 my $sth = $cdbi->sth_insert(\@fields) or do {
320 0         0 $self->{error_msg} = $cdbi->{error_msg};
321 0         0 return;
322             };
323 1         50 foreach my $distname (keys %$data) {
324 92         308 my $values = $dists->{$distname};
325 92         329 my $cpanid = $values->{cpanid};
326 92 50 33     574 next unless ($values and $cpanid and $auth_ids->{$cpanid});
      33        
327 92         508 print_debug("Inserting $distname of $cpanid\n");
328             $sth->execute($auth_ids->{ $values->{cpanid} }, $distname, $values->{dist_file}, $values->{dist_vers}, $values->{dist_abs})
329 92 50       2323 or do {
330 0         0 $cdbi->db_error($sth);
331 0         0 $self->{error_msg} = $cdbi->{error_msg};
332 0         0 return;
333             };
334 92 50       937 $dist_ids->{$distname} = $dbh->func('last_insert_rowid') or do {
335 0         0 $cdbi->db_error($sth);
336 0         0 $self->{error_msg} = $cdbi->{error_msg};
337 0         0 return;
338             };
339             }
340 1         15 $sth->finish();
341 1         23 undef $sth;
342 1 50       13848 $dbh->commit() or do {
343 0         0 $cdbi->db_error();
344 0         0 $self->{error_msg} = $cdbi->{error_msg};
345 0         0 return;
346             };
347 1         19 return 1;
348             }
349              
350             sub update {
351 0     0   0 my $self = shift;
352 0 0       0 unless ($dbh) {
353 0         0 $self->{error_msg} = q{No db handle available};
354 0         0 return;
355             }
356 0         0 my $cdbi = $self->{cdbi};
357 0         0 my $data = $self->{update};
358 0 0       0 unless (has_hash_data($data)) {
359 0         0 $self->{info_msg} = q{No dist data to update};
360 0         0 return;
361             }
362 0 0       0 return unless my $auth_obj = $self->{obj}->{auths};
363 0         0 my $auth_ids = $auth_obj->{ids};
364 0         0 my $dists = $self->{info};
365 0 0 0     0 unless ($dists and $auth_ids) {
366 0         0 $self->{error_msg} = q{No dist index data available};
367 0         0 return;
368             }
369              
370 0         0 my @fields = qw(auth_id dist_name dist_file dist_vers dist_abs);
371 0         0 foreach my $distname (keys %$data) {
372 0 0       0 next unless $data->{$distname};
373 0         0 my $sth = $cdbi->sth_update(\@fields, $data->{$distname});
374 0         0 my $values = $dists->{$distname};
375 0         0 my $cpanid = $values->{cpanid};
376 0 0 0     0 next unless ($values and $cpanid and $auth_ids->{$cpanid});
      0        
377 0         0 print_debug("Updating $distname of $cpanid\n");
378             $sth->execute($auth_ids->{ $values->{cpanid} }, $distname, $values->{dist_file}, $values->{dist_vers}, $values->{dist_abs})
379 0 0       0 or do {
380 0         0 $cdbi->db_error($sth);
381 0         0 $self->{error_msg} = $cdbi->{error_msg};
382 0         0 return;
383             };
384 0         0 $sth->finish();
385 0         0 undef $sth;
386             }
387 0 0       0 $dbh->commit() or do {
388 0         0 $cdbi->db_error();
389 0         0 $self->{error_msg} = $cdbi->{error_msg};
390 0         0 return;
391             };
392 0         0 return 1;
393             }
394              
395             sub delete {
396 0     0   0 my $self = shift;
397 0 0       0 unless ($dbh) {
398 0         0 $self->{error_msg} = q{No db handle available};
399 0         0 return;
400             }
401 0         0 my $cdbi = $self->{cdbi};
402 0         0 my $data = $self->{delete};
403 0 0       0 unless (has_hash_data($data)) {
404 0         0 $self->{info_msg} = q{No dist data to delete};
405 0         0 return;
406             }
407              
408 0         0 my $sth = $cdbi->sth_delete('dist_id');
409 0         0 foreach my $distname (keys %$data) {
410 0         0 print_debug("Deleting $distname\n");
411 0 0       0 $sth->execute($data->{$distname}) or do {
412 0         0 $cdbi->db_error($sth);
413 0         0 $self->{error_msg} = $cdbi->{error_msg};
414 0         0 return;
415             };
416             }
417 0         0 $sth->finish();
418 0         0 undef $sth;
419 0 0       0 $dbh->commit() or do {
420 0         0 $cdbi->db_error();
421 0         0 $self->{error_msg} = $cdbi->{error_msg};
422 0         0 return;
423             };
424 0         0 return 1;
425             }
426              
427             package CPAN::SQLite::Populate::mods;
428 4     4   40 use parent 'CPAN::SQLite::Populate';
  4         10  
  4         21  
429 4     4   287 use CPAN::SQLite::Util qw(has_hash_data print_debug);
  4         8  
  4         4662  
430              
431             sub new {
432 1     1   4 my ($class, %args) = @_;
433 1         5 my $info = $args{info};
434 1 50       4 die "No module info available" unless has_hash_data($info);
435 1         3 my $cdbi = $args{cdbi};
436 1 50 33     13 die "No dbi object available"
437             unless ($cdbi and ref($cdbi) eq 'CPAN::SQLite::DBI::Index::mods');
438 1         8 my $self = {
439             info => $info,
440             insert => {},
441             update => {},
442             delete => {},
443             ids => {},
444             obj => {},
445             cdbi => $cdbi,
446             error_msg => '',
447             info_msg => '',
448             };
449 1         4 return bless $self, $class;
450             }
451              
452             sub insert {
453 1     1   6 my $self = shift;
454 1 50       7 unless ($dbh) {
455 0         0 $self->{error_msg} = q{No db handle available};
456 0         0 return;
457             }
458 1 50       7 return unless my $dist_obj = $self->{obj}->{dists};
459 1         5 my $cdbi = $self->{cdbi};
460 1         4 my $dist_ids = $dist_obj->{ids};
461 1         5 my $mods = $self->{info};
462 1 50       7 my $data = $setup ? $mods : $self->{insert};
463 1 50       9 unless (has_hash_data($data)) {
464 0         0 $self->{info_msg} = q{No module data to insert};
465 0         0 return;
466             }
467 1 50 33     13 unless ($mods and $dist_ids) {
468 0         0 $self->{error_msg} = q{No module index data available};
469 0         0 return;
470             }
471              
472 1         8 my $mod_ids = $self->{ids};
473 1         8 my @fields = qw(dist_id mod_name mod_abs
474             mod_vers);
475              
476 1 50       17 my $sth = $cdbi->sth_insert(\@fields) or do {
477 0         0 $self->{error_msg} = $cdbi->{error_msg};
478 0         0 return;
479             };
480 1         256 foreach my $modname (keys %$data) {
481 544         1410 my $values = $mods->{$modname};
482 544 50 33     2482 next unless ($values and $dist_ids->{ $values->{dist_name} });
483             $sth->execute($dist_ids->{ $values->{dist_name} }, $modname, $values->{mod_abs}, $values->{mod_vers})
484 544 50       8452 or do {
485 0         0 $cdbi->db_error($sth);
486 0         0 $self->{error_msg} = $cdbi->{error_msg};
487 0         0 return;
488             };
489 544 50       3662 $mod_ids->{$modname} = $dbh->func('last_insert_rowid') or do {
490 0         0 $cdbi->db_error($sth);
491 0         0 $self->{error_msg} = $cdbi->{error_msg};
492 0         0 return;
493             };
494             }
495 1         30 $sth->finish();
496 1         14 undef $sth;
497 1 50       13703 $dbh->commit() or do {
498 0         0 $cdbi->db_error();
499 0         0 $self->{error_msg} = $cdbi->{error_msg};
500 0         0 return;
501             };
502 1         16 return 1;
503             }
504              
505             sub update {
506 0     0   0 my $self = shift;
507 0 0       0 unless ($dbh) {
508 0         0 $self->{error_msg} = q{No db handle available};
509 0         0 return;
510             }
511 0         0 my $cdbi = $self->{cdbi};
512 0         0 my $data = $self->{update};
513 0 0       0 unless (has_hash_data($data)) {
514 0         0 $self->{info_msg} = q{No module data to update};
515 0         0 return;
516             }
517 0 0       0 return unless my $dist_obj = $self->{obj}->{dists};
518 0         0 my $dist_ids = $dist_obj->{ids};
519 0         0 my $mods = $self->{info};
520 0 0 0     0 unless ($dist_ids and $mods) {
521 0         0 $self->{error_msg} = q{No module index data available};
522 0         0 return;
523             }
524              
525 0         0 my @fields = qw(dist_id mod_name mod_abs
526             mod_vers);
527              
528 0         0 foreach my $modname (keys %$data) {
529 0 0       0 next unless $data->{$modname};
530 0         0 print_debug("Updating $modname\n");
531 0         0 my $sth = $cdbi->sth_update(\@fields, $data->{$modname});
532 0         0 my $values = $mods->{$modname};
533 0 0 0     0 next unless ($values and $dist_ids->{ $values->{dist_name} });
534             $sth->execute($dist_ids->{ $values->{dist_name} }, $modname, $values->{mod_abs}, $values->{mod_vers})
535 0 0       0 or do {
536 0         0 $cdbi->db_error($sth);
537 0         0 $self->{error_msg} = $cdbi->{error_msg};
538 0         0 return;
539             };
540 0         0 $sth->finish();
541 0         0 undef $sth;
542             }
543 0 0       0 $dbh->commit() or do {
544 0         0 $cdbi->db_error();
545 0         0 $self->{error_msg} = $cdbi->{error_msg};
546 0         0 return;
547             };
548 0         0 return 1;
549             }
550              
551             sub delete {
552 0     0   0 my $self = shift;
553 0 0       0 unless ($dbh) {
554 0         0 $self->{error_msg} = q{No db handle available};
555 0         0 return;
556             }
557 0 0       0 return unless my $dist_obj = $self->{obj}->{dists};
558 0         0 my $cdbi = $self->{cdbi};
559 0         0 my $data = $dist_obj->{delete};
560 0 0       0 if (has_hash_data($data)) {
561 0         0 my $sth = $cdbi->sth_delete('dist_id');
562 0         0 foreach my $distname (keys %$data) {
563 0 0       0 $sth->execute($data->{$distname}) or do {
564 0         0 $cdbi->db_error($sth);
565 0         0 $self->{error_msg} = $cdbi->{error_msg};
566 0         0 return;
567             };
568             }
569 0         0 $sth->finish();
570 0         0 undef $sth;
571             }
572              
573 0         0 $data = $self->{delete};
574 0 0       0 if (has_hash_data($data)) {
575 0         0 my $sth = $cdbi->sth_delete('mod_id');
576 0         0 foreach my $modname (keys %$data) {
577 0 0       0 $sth->execute($data->{$modname}) or do {
578 0         0 $cdbi->db_error($sth);
579 0         0 $self->{error_msg} = $cdbi->{error_msg};
580 0         0 return;
581             };
582 0         0 print_debug("Deleting $modname\n");
583             }
584 0         0 $sth->finish;
585 0         0 undef $sth;
586             }
587 0 0       0 $dbh->commit() or do {
588 0         0 $cdbi->db_error();
589 0         0 $self->{error_msg} = $cdbi->{error_msg};
590 0         0 return;
591             };
592 0         0 return 1;
593             }
594              
595             package CPAN::SQLite::Populate::info;
596 4     4   82 use parent 'CPAN::SQLite::Populate';
  4         9  
  4         19  
597 4     4   337 use CPAN::SQLite::Util qw(has_hash_data print_debug);
  4         18  
  4         2373  
598              
599             sub new {
600 1     1   4 my ($class, %args) = @_;
601 1         4 my $cdbi = $args{cdbi};
602 1 50 33     9 die "No dbi object available"
603             unless ($cdbi and ref($cdbi) eq 'CPAN::SQLite::DBI::Index::info');
604 1         17 my $self = {
605             obj => {},
606             cdbi => $cdbi,
607             error_msg => '',
608             info_msg => '',
609             };
610 1         4 return bless $self, $class;
611             }
612              
613             sub insert {
614 1     1   5 my $self = shift;
615 1 50       20 unless ($dbh) {
616 0         0 $self->{error_msg} = q{No db handle available};
617 0         0 return;
618             }
619 1         5 my $cdbi = $self->{cdbi};
620              
621 1 50       15 my $sth = $cdbi->sth_insert(['status']) or do {
622 0         0 $self->{error_msg} = $cdbi->{error_msg};
623 0         0 return;
624             };
625             $sth->execute(1)
626 1 50       274 or do {
627 0         0 $cdbi->db_error($sth);
628 0         0 $self->{error_msg} = $cdbi->{error_msg};
629 0         0 return;
630             };
631 1         14 $sth->finish();
632 1         20 undef $sth;
633 1 50       11059 $dbh->commit() or do {
634 0         0 $cdbi->db_error();
635 0         0 $self->{error_msg} = $cdbi->{error_msg};
636 0         0 return;
637             };
638 1         15 return 1;
639             }
640              
641             sub update {
642 0     0   0 my $self = shift;
643 0         0 $self->{'error_msg'} = 'update is not a valid call';
644 0         0 return;
645             }
646              
647             sub delete {
648 1     1   2 my $self = shift;
649 1 50       3 unless ($dbh) {
650 0         0 $self->{error_msg} = q{No db handle available};
651 0         0 return;
652             }
653 1         2 my $cdbi = $self->{cdbi};
654              
655 1         12 my $sth = $cdbi->sth_delete('status');
656 1 50       21 $sth->execute(1) or do {
657 0         0 $cdbi->db_error($sth);
658 0         0 $self->{error_msg} = $cdbi->{error_msg};
659 0         0 return;
660             };
661 1         5 $sth->finish();
662 1         11 undef $sth;
663 1 50       13976 $dbh->commit() or do {
664 0         0 $cdbi->db_error();
665 0         0 $self->{error_msg} = $cdbi->{error_msg};
666 0         0 return;
667             };
668 1         13 return 1;
669             }
670              
671             package CPAN::SQLite::Populate;
672              
673             sub db_error {
674 0     0 0   my ($obj, $sth) = @_;
675 0 0         return unless $dbh;
676 0 0         if ($sth) {
677 0           $sth->finish;
678 0           undef $sth;
679             }
680 0           return $obj->{error_msg} = q{Database error: } . $dbh->errstr;
681             }
682              
683             1;
684              
685             =head1 NAME
686              
687             CPAN::SQLite::Populate - create and populate database tables
688              
689             =head1 VERSION
690              
691             version 0.218
692              
693             =head1 DESCRIPTION
694              
695             This module is responsible for creating the tables
696             (if C is passed as an option) and then for
697             inserting, updating, or deleting (as appropriate) the
698             relevant information from the indices of
699             I and the
700             state information from I. It does
701             this through the C, C, and C
702             methods associated with each table.
703              
704             Note that the tables are created with the C argument
705             passed into the C method when creating the
706             C object; existing tables will be
707             dropped.
708              
709             =head1 TABLES
710              
711             The tables used are described below - the data types correspond
712             to mysql tables, with the corresponding adjustments made if
713             the SQLite database is used.
714              
715             =head2 mods
716              
717             This table contains module information, and is created as
718              
719             mod_id INTEGER NOT NULL PRIMARY KEY
720             mod_name VARCHAR(100) NOT NULL
721             dist_id INTEGER NOT NULL
722             mod_abs TEXT
723             mod_vers VARCHAR(10)
724              
725             =over 3
726              
727             =item * mod_id
728              
729             This is the primary (unique) key of the table.
730              
731             =item * dist_id
732              
733             This key corresponds to the id of the associated distribution
734             in the C table.
735              
736             =item * mod_name
737              
738             This is the module's name.
739              
740             =item * mod_abs
741              
742             This is a description, if available, of the module.
743              
744             =item * mod_vers
745              
746             This value, if present, gives the version of the module.
747              
748             =back
749              
750             =head2 dists
751              
752             This table contains distribution information, and is created as
753              
754             dist_id INTEGER NOT NULL PRIMARY KEY
755             dist_name VARCHAR(90) NOT NULL
756             auth_id INTEGER NOT NULL
757             dist_file VARCHAR(110) NOT NULL
758             dist_vers VARCHAR(20)
759             dist_abs TEXT
760              
761             =over 3
762              
763             =item * dist_id
764              
765             This is the primary (unique) key of the table.
766              
767             =item * auth_id
768              
769             This corresponds to the CPAN author id of the distribution
770             in the C table.
771              
772             =item * dist_name
773              
774             This corresponds to the distribution name (eg, for
775             F, C will be C).
776              
777             =item * dist_file
778              
779             This corresponds to the CPAN file name.
780              
781             =item * dist_vers
782              
783             This is the version of the CPAN file (eg, for
784             F, C will be C<0.22>).
785              
786             =item * dist_abs
787              
788             This is a description of the distribution. If not directly
789             supplied, the description for, eg, C, if present, will
790             be used for the C distribution.
791              
792             =back
793              
794             =head2 auths
795              
796             This table contains CPAN author information, and is created as
797              
798             auth_id INTEGER NOT NULL PRIMARY KEY
799             cpanid VARCHAR(20) NOT NULL
800             fullname VARCHAR(40) NOT NULL
801             email TEXT
802              
803             =over 3
804              
805             =item * auth_id
806              
807             This is the primary (unique) key of the table.
808              
809             =item * cpanid
810              
811             This gives the CPAN author id.
812              
813             =item * fullname
814              
815             This is the full name of the author.
816              
817             =item * email
818              
819             This is the supplied email address of the author.
820              
821             =back
822              
823             =head1 SEE ALSO
824              
825             L
826              
827             =cut