File Coverage: lib/DBIx/SchemaChecksum/App/ApplyChanges.pm

# File Coverage

File: | lib/DBIx/SchemaChecksum/App/ApplyChanges.pm
Coverage: | 74.1%

line | stmt | bran | cond | sub | time | code
--- | --- | --- | --- | --- | --- | ---
1 |  |  |  |  |  | package DBIx::SchemaChecksum::App::ApplyChanges;
2 | 3 3 3 |  |  | 3 | 114872 6 100 | use 5.010;
3 | 3 3 3 |  |  | 3 | 433 999407 39 | use MooseX::App::Command;
4 |  |  |  |  |  | extends qw(DBIx::SchemaChecksum::App);
5 | 3 3 3 |  |  | 3 | 3616809 932 121 | use IO::Prompt::Tiny qw(prompt);
6 | 3 3 3 |  |  | 3 | 9 3 1222 | use Try::Tiny;
7 |
8 |  |  |  |  |  | option '+sqlsnippetdir' => ( required => 1);
9 |  |  |  |  |  | has 'no_prompt' => ( is => 'rw', isa => 'Bool', default => 0, documentation=>'Do not prompt, just use defaults');
10 |
11 |  |  |  |  |  | sub run {
12 | 1 |  |  | 1 | 2072 | my $self = shift;
13 |
14 | 1 |  |  |  | 12 | $self->apply_sql_snippets($self->checksum);
15 |  |  |  |  |  | }
16 |
17 - 25 |  |
    =head3 apply_sql_snippets

        $self->apply_sql_snippets( $starting_checksum );

    Applies SQL snippets in the correct order to the DB. Checks if the
    checksum after applying the snippets is correct. If it isn't correct
    rolls back the last change (if your DB supports transactions...)

    =cut
26 |
27 |  |  |  |  |  | sub apply_sql_snippets {
28 | 8 |  |  | 8 | 1878 | my ($self, $this_checksum ) = @_;
29 | 8 |  |  |  | 512 | my $update_path = $self->_update_path;
30 |
31 | 8 | 100 |  |  | 43 | my $update = $update_path->{$this_checksum}
32 |  |  |  |  |  | if ( exists $update_path->{$this_checksum} );
33 |
34 | 8 | 100 |  |  | 17 | unless ($update) {
35 | 2 |  |  |  | 47 | say "No update found that's based on $this_checksum.";
36 | 2 |  |  |  | 49 | exit;
37 |  |  |  |  |  | }
38 |
39 | 6 | 100 |  |  | 92 | if ( $update->[0] eq 'SAME_CHECKSUM' ) {
40 | 2 | 50 |  |  | 33 | return unless $update->[1];
41 | 2 |  |  |  | 30 | my ( $file, $expected_post_checksum ) = splice( @$update, 1, 2 );
42 |
43 | 2 |  |  |  | 12 | $self->apply_file( $file, $expected_post_checksum );
44 |  |  |  |  |  | }
45 |  |  |  |  |  | else {
46 | 4 |  |  |  | 662 | $self->apply_file( @$update );
47 |  |  |  |  |  | }
48 |  |  |  |  |  | }
49 |
50 |  |  |  |  |  | sub apply_file {
51 | 6 |  |  | 6 | 23 | my ( $self, $file, $expected_post_checksum ) = @_;
52 | 6 |  |  |  | 224 | my $filename = $file->relative($self->sqlsnippetdir);
53 |
54 | 6 | 100 |  |  | 2154 | my $no_checksum_change = $self->checksum eq $expected_post_checksum ? 1 : 0;
55 |
56 | 6 |  |  |  | 10 | my $answer;
57 | 6 | 100 |  |  | 12 | if ($no_checksum_change) {
58 | 1 |  |  |  | 11 | $answer = prompt("Apply $filename (won't change checksum)? [y/n/s]",'y');
59 |  |  |  |  |  | }
60 |  |  |  |  |  | else {
61 | 5 |  |  |  | 91 | $answer = prompt("Apply $filename? [y/n]",'y');
62 |  |  |  |  |  | }
63 |
64 | 6 | 50 0 |  |  | 604 | if ($answer eq 'y') {
65 | 6 | 50 |  |  | 203 | say "Starting to apply $filename" if $self->verbose;
66 |
67 | 6 |  |  |  | 98 | my $content = $file->slurp;
68 |
69 | 6 |  |  |  | 3421 | my $dbh = $self->dbh;
70 | 6 |  |  |  | 177 | $dbh->begin_work;
71 |
72 | 6 |  |  |  | 263 | my $split_regex = qr/(?!:[\\]);/;
73 |
74 | 6 | 50 |  |  | 23 | if ($content =~ m/--\s*split-at:\s*(\S+)\n/s) {
75 | 0 |  |  |  | 0 | say "Splitting $filename commands at >$1<";
76 | 0 |  |  |  | 0 | $split_regex = qr/$1/;
77 |  |  |  |  |  | }
78 |
79 | 6 |  |  |  | 41 | $content =~ s/^\s*--.+$//gm;
80 | 6 |  |  |  | 59 | foreach my $command ( split( $split_regex , $content ) ) {
81 | 11 |  |  |  | 30 | $command =~ s/\A\s+//;
82 | 11 |  |  |  | 20 | $command =~ s/\s+\Z//;
83 |
84 | 11 | 100 |  |  | 32 | next unless $command;
85 | 5 | 50 |  |  | 155 | say "Executing SQL statement: $command" if $self->verbose;
86 |  |  |  |  |  | try {
87 | 5 |  |  | 5 | 355 | $dbh->do($command)
88 |  |  |  |  |  | } catch {
89 | 0 |  |  | 0 | 0 | $dbh->rollback;
90 | 0 |  |  |  | 0 | say "SQL error: $_";
91 | 0 |  |  |  | 0 | say "ABORTING!";
92 | 0 |  |  |  | 0 | exit 1;
93 | 5 |  |  |  | 117 | };
94 | 5 | 50 |  |  | 2488 | say "Successful!" if $self->verbose;
95 |  |  |  |  |  | }
96 |
97 | 6 | 50 |  |  | 198 | if ( $self->dry_run ) {
98 | 0 |  |  |  | 0 | $dbh->rollback;
99 | 0 |  |  |  | 0 | say "dry run, so checksums cannot match. We proceed anyway...";
100 | 0 |  |  |  | 0 | return $self->apply_sql_snippets($expected_post_checksum);
101 |  |  |  |  |  | }
102 |
103 |  |  |  |  |  | # new checksum
104 | 6 |  |  |  | 236 | $self->reset_checksum;
105 | 6 |  |  |  | 105 | my $post_checksum = $self->checksum;
106 |
107 | 6 | 50 |  |  | 14 | if ( $post_checksum eq $expected_post_checksum ) {
108 | 6 |  |  |  | 100 | say "post checksum OK";
109 | 6 |  |  |  | 549588 | $dbh->commit;
110 | 6 |  |  |  | 105 | return $self->apply_sql_snippets($post_checksum);
111 |  |  |  |  |  | }
112 |  |  |  |  |  | else {
113 | 0 |  |  |  |  | say "post checksum mismatch!";
114 | 0 |  |  |  |  | say " expected $expected_post_checksum";
115 | 0 |  |  |  |  | say " got $post_checksum";
116 | 0 |  |  |  |  | $dbh->rollback;
117 | 0 |  |  |  |  | say "ABORTING!";
118 | 0 |  |  |  |  | exit 1;
119 |  |  |  |  |  | }
120 |  |  |  |  |  | }
121 |  |  |  |  |  | elsif ($answer eq 's') {
122 | 0 |  |  |  |  | return $self->apply_sql_snippets($expected_post_checksum);
123 |  |  |  |  |  | }
124 |  |  |  |  |  | else {
125 | 0 |  |  |  |  | say "Not applying $filename, so we stop.";
126 | 0 |  |  |  |  | exit;
127 |  |  |  |  |  | }
128 |  |  |  |  |  | }
129 |
130 |
131 |  |  |  |  |  | 1;