File Coverage

blib/lib/Module/Build/Database.pm
Criterion Covered Total %
statement 28 226 12.3
branch 0 82 0.0
condition 0 14 0.0
subroutine 10 22 45.4
pod 0 9 0.0
total 38 353 10.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Module::Build::Database - Manage database patches in the style of Module::Build.
4              
5             =head1 SYNOPSIS
6              
7             perl Build.PL
8             ./Build dbtest
9             ./Build dbdist
10             ./Build dbfakeinstall
11             ./Build dbinstall
12              
13             In more detail :
14              
15             # In Build.PL :
16              
17             use Module::Build::Database;
18              
19             my $builder = Module::Build::Database->new(
20             database_type => "PostgreSQL",
21             ...other module build options..
22             );
23              
24             $builder->create_build_script();
25              
26             # Put database patches into db/patches/*.sql.
27             # A schema will be autogenerated in db/dist/base.sql.
28             # Any data generated by the patches will be put into db/dist/base_data.sql.
29             # Documentation will be autogenerated in db/doc/.
30              
31             # That is, first do this :
32             perl Build.PL
33              
34             # Then, test that patches in db/patches/ will apply successfully to
35             # the schema in db/dist/ :
36             ./Build dbtest
37              
38             # The, update the db information in db/dist/ by applying any
39             # unapplied patches in db/patches/ to the schema in db/dist/ :
40             ./Build dbdist
41              
42             # Update the docs in db/docs using the schema in db/dist :
43             ./Build dbdocs
44              
45             # Install a new database or upgrade an existing one :
46             ./Build dbfakeinstall
47             ./Build dbinstall
48              
49             Additionally, when doing
50              
51             ./Build install
52              
53             The content of the C directory will be installed into your distributions
54             share directory so that it can be retrieved using L. For example,
55             assuming your MBD dist is called C, to find the C file from perl:
56              
57             use File::ShareDir qw( dist_dir );
58             my $base = dist_dir('MyDist') . '/dist/base.sql';
59              
60             =head1 DESCRIPTION
61              
62             This is a subclass of Module::Build for modules which depend on a database,
63             which adds functionality for testing and distributing changes to the database.
64              
65             Changes are represented as sql files ("patches") which will be fed into a
66             command line client for the database.
67              
68             A complete schema is regenerated whenever
69             L is run.
70              
71             A list of the patches which have been applied is stored in two places :
72              
73             =over
74              
75             =item 1.
76              
77             the file C
78              
79             =item 2.
80              
81             the table C within the target database.
82              
83             =back
84              
85             When the L action is
86             invoked, any patches in (1) but not in (2) are applied. In order to
87             determine whether they will apply successfully,
88             L may be run, which
89             does the following :
90              
91             =over
92              
93             =item 1.
94              
95             Dumps the schema for an existing instance.
96              
97             =item 2.
98              
99             Applies any patches not found in the C table.
100              
101             =item 3.
102              
103             Dumps the resulting schema and compares it to the schema in C.
104              
105             =back
106              
107             If the comparison in step 3 is the same, then one may conclude that applying
108             the missing patches will produce the desired schema.
109              
110             =head1 ACTIONS
111              
112             =head2 dbdist
113              
114             This (re-)generates the files C, C,
115             and C.
116              
117             It does this by reading patches from C,
118             applying the ones that are not listed in C,
119             and then dumping out a new C and C.
120              
121             In other words :
122              
123             =over 4
124              
125             =item 1.
126              
127             Start a new empty database instance.
128              
129             =item 2.
130              
131             Populate the schema using C.
132              
133             =item 3.
134              
135             Import any data in C.
136              
137             =item 4.
138              
139             For every patch in C :
140              
141             Is the patch is listed in C?
142              
143             =over 4
144              
145             =item Yes?
146              
147             Skip it.
148              
149             =item No?
150              
151             Apply it, and add it to C.
152              
153             =back
154              
155             =item 5.
156              
157             Dump the new schema out to C
158              
159             =item 6.
160              
161             Dump any data out into C
162              
163             =item 7.
164              
165             Stop the database.
166              
167             =back
168              
169             =head2 dbtest
170              
171             =over 4
172              
173             =item 1.
174              
175             Start a new empty database instance.
176              
177             =item 2.
178              
179             Apply C.
180              
181             =item 3.
182              
183             Apply C.
184              
185             =item 4.
186              
187             Apply any patches in C that are
188             not in C.
189             For each of the above, the tests will fail if any of the
190             patches do not apply cleanly.
191              
192             =item 5.
193              
194             Shut down the database instance.
195              
196             If C<--leave_running=1> is passed, step 4 will not be executed.
197             The "host" for the database can be found in
198              
199             Module::Build::Database->current->notes("dbtest_host");
200              
201             =back
202              
203             =head2 dbclean
204              
205             Stop any test daemons that are running and remove any
206             test databases that have been created.
207              
208             =head2 dbdocs
209              
210             =over 4
211              
212             =item 1.
213              
214             Start a new empty database instance.
215              
216             =item 2.
217              
218             Apply C.
219              
220             =item 3.
221              
222             Dump the new schema docs out to C.
223              
224             =item 4.
225              
226             Stop the database.
227              
228             =back
229              
230             =head2 dbfakeinstall
231              
232             =over 4
233              
234             =item 1.
235              
236             Look for a running database, based on environment variables.
237              
238             =item 2.
239              
240             Display the connection information obtained from the above.
241              
242             =item 3.
243              
244             Dump the schema from the live database to a temporary directory.
245              
246             =item 4.
247              
248             Make a temporary database using the above schema.
249              
250             =item 5.
251              
252             Apply patches listed in C that are not
253             in the C table.
254              
255             =item 6.
256              
257             Dump out the resulting schema, and compare it to C.
258              
259             =back
260              
261             Note that L must be run to update
262             C before doing
263             C or
264             C.
265              
266             =head2 dbinstall
267              
268             =over 4
269              
270             =item 1.
271              
272             Look for a running database, based on environment variables
273              
274             =item 2.
275              
276             Apply any patches in C that are not in the C table.
277              
278             =item 3.
279              
280             Add an entry to the C table for each patch applied.
281              
282             =back
283              
284             =head2 dbplant
285              
286             =over 4
287              
288             =item 1.
289              
290             Starts a test database based on C and any patches (see
291             L)
292              
293             =item 2.
294              
295             Calls C in L. to generate a static object hierarchy.
296              
297             =item 3.
298              
299             Stops the test database.
300              
301             =back
302              
303             The default name of the object class will be formed by appending
304             '::Objects' to the name of the module. This may be overridden
305             by setting the build property C. The directory
306             name will be formed by prepending C and appending
307             C, e.g. C<./lib/MyModule/Objects/autolib>.
308              
309             =head1 NOTES
310              
311             Patches will be applied in lexicographic order, so their names should start
312             with a sequence of digits, e.g. C<0010_something.sql>, C<0020_something_else.sql>, etc.
313              
314             =head1 AUTHOR
315              
316             Brian Duggan
317              
318             Graham Ollis Eplicease@cpan.orgE
319              
320             Curt Tilmes
321              
322             =head1 TODO
323              
324             Allow L to not interfere with
325             other running mbd-test databases. Currently it errs on the side of
326             cleaning up too much.
327              
328             =head1 SEE ALSO
329              
330             L, L, L
331              
332             =cut
333              
334             package Module::Build::Database;
335 6     6   27021 use File::Basename qw/basename/;
  6         8  
  6         973  
336 6     6   22 use File::Path qw/mkpath/;
  6         6  
  6         190  
337 6     6   22 use Digest::MD5;
  6         8  
  6         138  
338 6     6   2515 use List::MoreUtils qw/uniq/;
  6         45052  
  6         38  
339 6     6   4971 use Path::Class qw/file/;
  6         121051  
  6         318  
340 6     6   38 use warnings;
  6         8  
  6         118  
341 6     6   22 use strict;
  6         7  
  6         146  
342              
343 6     6   2644 use Module::Build::Database::Helpers qw/debug info/;
  6         12  
  6         37  
344 6     6   1338 use base 'Module::Build';
  6         15  
  6         273353  
345              
346             our $VERSION = '0.56';
347              
348             __PACKAGE__->add_property(database_object_class => default => "");
349              
350             sub new {
351 0     0 0 0 my $class = shift;
352 0         0 my %args = @_;
353            
354             # add db to the share directory, if it isn't already there
355 0   0     0 my $dirs = $args{share_dir}->{dist} // [];
356 0 0       0 $dirs = [ $dirs ] unless ref($dirs) eq 'ARRAY';
357 0         0 push @$dirs, 'db';
358 0         0 $args{share_dir}->{dist} = $dirs;
359            
360             # recursive constructor, fun
361 0 0       0 my $driver = delete $args{database_type}
362             or return $class->SUPER::new(%args);
363 0         0 my $subclass = "$class\::$driver";
364 0         0 eval "use $subclass";
365 0 0       0 die $@ if $@;
366 0         0 my $self = $subclass->new(%args);
367 0         0 $self->add_to_cleanup(
368             'tmp_db_????.sql',
369             'postmaster.log',
370             );
371 0         0 $self;
372             }
373              
374             # Return an array of patch filenames.
375             # Send (pending => 1) to omit applied patches.
376             sub _find_patch_files {
377 0     0   0 my $self = shift;
378 0         0 my %args = @_;
379 0         0 my $pending = $args{pending};
380              
381 0         0 my @filenames = sort map { basename $_ } glob $self->base_dir.'/db/patches/*.sql';
  0         0  
382 0         0 my @bad = grep { $_ !~ /^\d{4}/ } @filenames;
  0         0  
383 0 0       0 if (@bad) {
384 0         0 die "\nBad patch files : @bad\nAll files must start with at least 4 digits.\n";
385             }
386 0 0       0 return @filenames unless $pending;
387 0         0 my %applied = $self->_read_patches_applied_file();
388 0         0 return grep { !exists( $applied{$_} ) } @filenames;
  0         0  
389             }
390              
391             # Read patches_applied.txt or $args{filename}, return a hash whose
392             # keys are the filenames, and whose values are information about
393             # the patch.
394             sub _read_patches_applied_file {
395 0     0   0 my $self = shift;
396 0         0 my %args = @_;
397 0         0 my %h;
398 0   0     0 my $readme = $args{filename} || join '/', $self->base_dir, qw(db dist patches_applied.txt);
399 0 0       0 return %h unless -e $readme;
400 0         0 my @lines = file($readme)->slurp;
401 0         0 for my $line (@lines) {
402 0         0 my @info = split /\s+/, $line;
403 0         0 $h{$info[0]} = \@info;
404             }
405 0         0 return %h;
406             }
407              
408             sub _diff_files {
409 0     0   0 my $self = shift;
410 0         0 my ($one,$two) = @_;
411 0         0 return system("diff -B $one $two")==0;
412             }
413              
414             sub ACTION_dbtest {
415 0     0 0 0 my $self = shift;
416              
417             # 1. Start a new empty database instance.
418 0         0 warn "# starting test database\n";
419 0 0       0 my $host = $self->_start_new_db() or die "could not start the db";
420 0         0 $self->notes(dbtest_host => $host);
421              
422             # 1a. create postgres language extensions, if appropriate
423 0         0 $self->_create_language_extensions;
424              
425             # 2. Apply db/dist/base.sql.
426 0         0 $self->_apply_base_sql();
427              
428             # 2.1 Apply db/dist/base_data.sql
429 0         0 $self->_apply_base_data();
430              
431             # 3. Apply any patches in db/patches/*.sql that are
432             # not in db/dist/patches_applied.txt.
433             # For each of the above, the tests will fail if any of the
434             # patches do not apply cleanly.
435              
436 0         0 my @todo = $self->_find_patch_files(pending => 1);
437              
438 0 0       0 info "no unapplied patches" unless @todo;
439 0 0 0     0 print "1..".@todo."\n" if (@todo && !$ENV{MBD_QUIET});
440 0         0 my $i = 1;
441 0         0 my $passes = 0;
442 0         0 for my $filename (@todo) {
443 0 0       0 if ($self->_apply_patch($filename)) {
444 0 0       0 print "ok $i - applied $filename\n" unless $ENV{MBD_QUIET};
445 0         0 $passes++;
446             } else {
447 0 0       0 print "not ok $i - applied $filename\n" unless $ENV{MBD_QUIET};
448             }
449 0         0 $i++;
450             }
451              
452 0 0 0     0 return 1 if $self->runtime_params("leave_running") || $self->notes("leave_running");
453              
454             # 4. Shut down the database instance.
455 0         0 $self->_stop_db();
456              
457             # and remove it
458 0         0 $self->_remove_db();
459 0         0 $self->notes(dbtest_host => "");
460              
461 0         0 return $passes==@todo;
462             }
463              
464             sub ACTION_dbclean {
465 0     0 0 0 my $self = shift;
466              
467 0 0       0 if (my $host = $self->notes("dbtest_host")) {
468 0         0 $self->_stop_db($host);
469 0         0 $self->_remove_db($host);
470             }
471              
472             # Remove any test databases created, stop any daemons.
473 0         0 $self->_cleanup_old_dbs; # NB: this may conflict with other running tests
474 0         0 $self->notes(dbtest_host => "");
475 0         0 $self->notes(already_started => 0);
476             }
477              
478             sub ACTION_dbdist {
479 0     0 0 0 my $self = shift;
480 0         0 my $dbdist = $self->base_dir . '/db/dist';
481              
482 0 0 0     0 if (! -e "$dbdist/base.sql" && -e "$dbdist/patches_applied.txt") {
483 0         0 die "No base.sql : remove patches_applied.txt to apply all patches\n";
484             };
485              
486             # 1. Start a new empty database instance.
487 0         0 $self->_start_new_db();
488              
489             # 1a. create postgres language extensions, if appropriate
490 0         0 $self->_create_language_extensions;
491              
492             # 2. Populate the schema using db/dist/base.sql.
493             # If there is no base.sql, we will create it from the patches.
494 0 0       0 if ($self->_apply_base_sql()) {
495 0         0 warn "updating base.sql\n";
496             } else {
497 0         0 warn "creating new base.sql\n";
498             }
499              
500             # 2.1 Apply base data
501 0         0 $self->_apply_base_data();
502              
503             # 3. For every pending patch, apply, and add to patches_applied.txt.
504 0         0 my %applied = $self->_read_patches_applied_file();
505 0         0 my @todo = $self->_find_patch_files( pending => 1 );
506 0 0       0 -d $dbdist or mkpath $dbdist;
507 0         0 my $patches_file = "$dbdist/patches_applied.txt";
508 0 0       0 my $fp = IO::File->new(">>$patches_file") or die "error: $!";
509 0         0 for my $filename (@todo) {
510 0         0 my $hash = Digest::MD5->new()->addfile(
511             IO::File->new( "<" .$self->base_dir . '/db/patches/' . $filename ) )
512             ->hexdigest;
513 0 0       0 $self->_apply_patch($filename) or die "Failed to apply $filename";
514 0         0 print ${fp} (join "\t", $filename, $hash)."\n";
515 0         0 info "Applied patch $filename";
516             }
517 0         0 $fp->close;
518 0 0       0 info "Wrote $patches_file" if @todo;
519              
520             # 4. Dump the new schema out to db/dist/base.sql
521 0         0 $self->_dump_base_sql();
522 0         0 info "Wrote $dbdist/base.sql";
523              
524             # 4.1 Dump any data out to db/dist/base_data.dump
525 0         0 $self->_dump_base_data();
526 0         0 info "Wrote $dbdist/base_data.sql";
527              
528             # 5. Stop the database.
529 0         0 $self->_stop_db();
530              
531             # 6. Wipe it.
532 0         0 $self->_remove_db();
533 0         0 $self->notes(dbtest_host => "");
534             }
535              
536             sub ACTION_dbdocs {
537 0     0 0 0 my $self = shift;
538              
539 0         0 my $docdir = $self->base_dir."/db/dist/docs";
540 0         0 mkpath $docdir;
541 0         0 $self->_generate_docs(dir => $docdir);
542             }
543              
544             sub ACTION_dbfakeinstall {
545 0     0 0 0 my $self = shift;
546              
547 0 0       0 -e $self->base_dir.'/db/dist' or die "no db/dist dir, cannot fakeinstall";
548              
549             # 1. Look for a running database, based on environment variables.
550             # 2. Display the connection information obtained from the above.
551              
552 0         0 $self->_show_live_db();
553              
554             # 3. Dump the schema from the live database to a temporary directory.
555 0         0 my $existing_schema = File::Temp->new(TEMPLATE => "tmp_db_XXXX", SUFFIX => '.sql');
556 0         0 $existing_schema->close;
557 0 0       0 if ($self->_is_fresh_install()) {
558 0         0 info "Ready to create the base database.";
559 0         0 return;
560             } else {
561 0         0 $self->_dump_base_sql(outfile => "$existing_schema");
562             }
563              
564             # 4. Dump the patch table.
565 0         0 my $tmp = File::Temp->new(); $tmp->close;
  0         0  
566 0 0       0 if ($self->_patch_table_exists()) {
567 0         0 $self->_dump_patch_table(outfile => "$tmp");
568             } else {
569 0         0 info "There is no patch table, it will be created.";
570 0 0       0 unlink "$tmp" or die "error unlinking $tmp: $!";
571             }
572              
573             # 4. Apply patches listed in db/dist/patches_applied.txt that are not
574             # in the patches_applied table.
575             # 4a. Determine list of patches to apply.
576 0         0 my %db_patches = $self->_read_patches_applied_file(filename => "$tmp");
577 0         0 my %base_patches = $self->_read_patches_applied_file();
578 0         0 my @todo = grep { !$db_patches{$_} } sort keys %base_patches;
  0         0  
579 0         0 debug "patches todo : @todo";
580 0         0 for my $patch (sort keys %db_patches) {
581 0 0       0 unless (exists $base_patches{$patch}) {
582 0         0 info "WARNING: patch $patch in db is not in patches_applied.txt";
583 0         0 next;
584             }
585 0 0       0 next if "@{ $db_patches{$patch} }" eq "@{ $base_patches{$patch} }";
  0         0  
  0         0  
586 0         0 info "WARNING: @{ $db_patches{$patch} } != @{ $base_patches{$patch} }";
  0         0  
  0         0  
587             }
588 0         0 for my $patch (@todo) {
589 0         0 info "Will apply patch $patch";
590             }
591              
592             # 5a. Start a temporary database, apply the live schema.
593             # 5b. Apply the pending patches to that one.
594             # 5c. Remove the patches_applied table.
595             # 5d. Dump out the resulting schema.
596             # 5e. Compare that to base.sql.
597              
598 0         0 $tmp = File::Temp->new();$tmp->close;
  0         0  
599 0         0 $self->_start_new_db();
600 0         0 $self->_create_language_extensions;
601             $self->_apply_base_sql("$existing_schema") # NB: contains patches_applied table
602 0 0       0 or do { $existing_schema->unlink_on_destroy(0); die "error with existing schema" };
  0         0  
  0         0  
603 0 0       0 do { $self->_apply_patch($_) or die "patch $_ failed" } for @todo;
  0         0  
604 0         0 $self->_remove_patches_applied_table();
605 0         0 $self->_dump_base_sql(outfile => "$tmp");
606 0 0       0 $self->_diff_files("$tmp", $self->base_dir. "/db/dist/base.sql")
607             or warn "Applying patches will not result in a schema identical to base.sql\n";
608             }
609              
610             sub ACTION_dbinstall {
611 0     0 0 0 my $self = shift;
612              
613 0 0       0 -e $self->base_dir.'/db/dist' or die "no db/dist dir, cannot install";
614              
615 0 0       0 if ($self->_is_fresh_install()) {
616 0         0 info "Fresh install.";
617 0 0       0 $self->_create_database() or die "could not create database\n";
618 0         0 $self->_create_language_extensions();
619 0 0       0 $self->_apply_base_sql() or die "could not apply base sql\n";
620 0 0       0 $self->_apply_base_data() or die "could not apply base_data sql\n";
621             } else {
622 0         0 $self->_create_language_extensions();
623             }
624              
625 0         0 my %base_patches = $self->_read_patches_applied_file();
626 0 0       0 unless ($self->_patch_table_exists()) {
627             # add records for all patches which have been applied to the base
628 0         0 info "Creating a new patch table";
629 0 0       0 $self->_create_patch_table() or die "could not create patch table\n";
630 0         0 for my $patch (sort keys %base_patches) {
631 0         0 $self->_insert_patch_record($base_patches{$patch});
632             }
633             }
634             # 1. Look for a running instance, based on environment variables
635             # 2. Apply any patches in db/patches/ that are not in the patches_applied table.
636             # 3. Add an entry to the patches_applied table for each patch applied.
637              
638 0         0 my $outfile = File::Temp->new(); $outfile->close;
  0         0  
639 0         0 $self->_dump_patch_table(outfile => "$outfile");
640 0         0 my %db_patches = $self->_read_patches_applied_file(filename => "$outfile");
641 0         0 for my $patch (sort keys %base_patches) {
642 0 0       0 if (exists($db_patches{$patch})) {
643 0 0       0 next if "@{$base_patches{$patch}}" eq "@{$db_patches{$patch}}";
  0         0  
  0         0  
644 0         0 warn "patch $patch: @{$base_patches{$patch}} != @{$db_patches{$patch}}\n";
  0         0  
  0         0  
645 0         0 next;
646             }
647 0         0 warn "Applying $patch\n";
648 0 0       0 $self->_apply_patch($patch) or die "error applying $patch";
649 0         0 $self->_insert_patch_record($base_patches{$patch});
650             }
651             }
652              
653             sub ACTION_dbplant {
654 0     0 0 0 my $self = shift;
655 0         0 eval {
656 0         0 require Rose::Planter;
657             };
658 0 0       0 if ($@) {
659 0         0 die "Rose::Planter not found, install it to run dbplant";
660             }
661 0         0 $self->notes(leave_running => 1);
662 0         0 $self->depends_on('dbtest'); # run dbtest
663 0         0 my $obj_class = $self->database_object_class;
664 0 0       0 unless ($obj_class) {
665 0         0 $obj_class = join '::', $self->module_name, 'Objects';
666 0         0 info "Using default database_object_class : $obj_class";
667             }
668 0         0 my $autodir = $obj_class;
669 0         0 $autodir =~ s[::][/]g;
670 0         0 $autodir .= '/autolib';
671 0         0 $autodir = './lib/'.$autodir;
672 0         0 info "Writing to $autodir";
673 0         0 unshift @INC, './lib';
674 0         0 $ENV{HARNESS_ACTIVE} = 1;
675 0         0 Rose::Planter->plant($obj_class => $autodir);
676 0         0 $self->depends_on('dbclean');
677             }
678              
679             sub hash_properties {
680 6     6 0 2745 uniq(Module::Build->hash_properties, shift->SUPER::hash_properties);
681             }
682              
683 0     0     sub _create_language_extensions { }
684              
685             1;
686