File Coverage

blib/lib/DBIx/ThinSQL/Deploy.pm
Criterion Covered Total %
statement 156 183 85.2
branch 38 64 59.3
condition 9 21 42.8
subroutine 17 19 89.4
pod 10 10 100.0
total 230 297 77.4


line stmt bran cond sub pod time code
1             package DBIx::ThinSQL::Deploy;
2 2     2   517 use strict;
  2         4  
  2         51  
3 2     2   8 use warnings;
  2         4  
  2         46  
4 2     2   8 use Log::Any qw/$log/;
  2         4  
  2         10  
5 2     2   386 use Carp qw/croak carp confess/;
  2         3  
  2         163  
6 2     2   651 use Path::Tiny;
  2         9313  
  2         3726  
7              
8             our $VERSION = '0.0.49_2';
9              
10             sub _split_sql {
11 41     41   7803 my $input = shift;
12 41         76 my $end = '';
13 41         70 my $item = '';
14 41         64 my @items;
15              
16 41         148 $input =~ s/^\s*--.*\n//gm;
17 41         107 $input =~ s!/\*.*?\*/!!gsm;
18              
19 41         269 while ( $input =~ s/(.*\n)// ) {
20 325         655 my $try = $1;
21              
22 325 100       831 if ($end) {
    100          
    50          
    100          
23 60 100       296 if ( $try =~ m/$end/ ) {
24 6         11 $item .= $try;
25              
26 6 50       24 if ( $try =~ m/;/ ) {
27 6         45 $item =~ s/(^[\s\n]+)|(\s\n]+$)//;
28 6         18 push( @items, { sql => $item } );
29 6         10 $item = '';
30             }
31              
32 6         19 $end = '';
33             }
34             else {
35 54         203 $item .= $try;
36             }
37              
38             }
39             elsif ( $try =~ m/;/ ) {
40 107         153 $item .= $try;
41 107         654 $item =~ s/(^[\s\n]+)|(\s\n]+$)//;
42 107         276 push( @items, { sql => $item } );
43 107         473 $item = '';
44             }
45             elsif ( $try =~ m/^\s*CREATE( OR REPLACE)? FUNCTION.*AS (\S*)/i ) {
46 0         0 $end = $2;
47 0         0 $end =~ s/\$/\\\$/g;
48 0         0 $item .= $try;
49             }
50             elsif ( $try =~ m/^\s*CREATE TRIGGER/i ) {
51 6         52 $end = qr/(EXECUTE PROCEDURE)|(^END)/i;
52 6         36 $item .= $try;
53             }
54             else {
55 152         640 $item .= $try;
56             }
57             }
58              
59 41         80 foreach my $item (@items) {
60 113         537 $item->{sql} =~ s/;[\s\n]*$//;
61             }
62 41         174 return \@items;
63             }
64              
65             sub _load_file {
66 46     46   112 my $file = path(shift);
67 46         595 my $type = lc $file;
68              
69 46         236 $log->debug( '_load_file(' . $file . ')' );
70              
71 46 50       520 confess "fatal: missing extension/type: $file\n"
72             unless $type =~ s/.*\.(.+)$/$1/;
73              
74 46 100       174 if ( $type eq 'sql' ) {
    50          
75              
76             # TODO add file name to hashrefs
77 41         150 return _split_sql( $file->slurp_utf8 );
78             }
79             elsif ( $type eq 'pl' ) {
80 5         13 return [ { $type => $file->slurp_utf8 } ];
81             }
82              
83 0         0 die "Cannot load file of type '$type': $file";
84             }
85              
86             sub run_arrayref {
87 34     34 1 53 my $self = shift;
88 34         44 my $ref = shift;
89              
90 34         347 local $self->{ShowErrorStatement} = 1;
91 34         500 local $self->{RaiseError} = 1;
92              
93 34         411 $log->debug( 'running ' . scalar @$ref . ' statements' );
94 34         108 my $i = 1;
95              
96 34         75 foreach my $cmd (@$ref) {
97 100 50       275 if ( exists $cmd->{sql} ) {
    0          
98 100         446 $self->do( $cmd->{sql} );
99             }
100             elsif ( exists $cmd->{pl} ) {
101 0         0 $log->debug( "-- _run_cmd\n" . $cmd->{pl} );
102 0         0 my $tmp = Path::Tiny->tempfile;
103 0         0 print $tmp $cmd->{pl};
104 0 0       0 system( $^X, $tmp->filename ) == 0 or die "system failed";
105             }
106             else {
107 0         0 confess "Missing 'sql' or 'pl' key";
108             }
109              
110 100         225985 $i++;
111             }
112              
113 34         406 return scalar @$ref;
114             }
115              
116             sub run_sql {
117 0     0 1 0 my $self = shift;
118 0         0 my $sql = shift;
119              
120 0         0 $log->debug("run_sql");
121 0         0 $self->run_arrayref( _split_sql($sql) );
122             }
123              
124             sub run_file {
125 34     34 1 697 my $self = shift;
126 34         76 my $file = shift;
127              
128 34         119 $log->debug("run_file($file)");
129 34         266 my $result = eval { $self->run_arrayref( _load_file($file) ) };
  34         97  
130 34 50       144 if ($@) {
131 0         0 die "$file\n" . $@;
132             }
133 34         236 return $result;
134             }
135              
136             sub run_dir {
137 6     6 1 480 my $self = shift;
138 6   33     13 my $dir = path(shift) || confess 'deploy_dir($dir)';
139              
140 6 50       78 confess "directory not found: $dir" unless -d $dir;
141 6         132 $log->debug("run_dir($dir)");
142              
143 6         40 my @files;
144 6         21 my $iter = $dir->iterator;
145 6         205 while ( my $file = $iter->() ) {
146 6 50 33     752 push( @files, $file )
147             if $file =~ m/.+\.((sql)|(pl))$/ and -f $file;
148             }
149              
150 6         368 $self->run_file($_) for sort { $a->stringify cmp $b->stringify } @files;
  0         0  
151             }
152              
153             sub _setup_deploy {
154 6     6   16 my $self = shift;
155 6         78 my $driver = $self->{Driver}->{Name};
156              
157 6         26 $log->debug("_setup_deploy");
158              
159 6 50       31 if ( defined &static::find ) {
160 0         0 my $src = 'auto/share/dist/DBIx-ThinSQL/Deploy/' . $driver . '.sql';
161 0 0       0 my $sql = static::find($src)
162             or croak 'Driver not supported for deploy: ' . $driver;
163 0         0 return $self->run_sql($sql);
164             }
165              
166 6         28 return $self->run_dir( $self->share_dir->child( 'Deploy', $driver ) );
167             }
168              
169             sub last_deploy_id {
170 12     12 1 3159 my $self = shift;
171 12   100     54 my $app = shift || 'default';
172              
173 12         98 my $sth = $self->table_info( '%', '%', '_deploy' );
174 12 100       4138 return 0 unless ( @{ $sth->fetchall_arrayref } );
  12         309  
175              
176 10         103 return $self->selectrow_array(
177             'SELECT COALESCE(MAX(seq),0) FROM _deploy WHERE app=?',
178             undef, $app );
179             }
180              
181             sub deploy_arrayref {
182 6     6 1 13 my $self = shift;
183 6         10 my $ref = shift;
184 6   50     21 my $app = shift || 'default';
185              
186 6 50       17 confess 'deploy(ARRAYREF)' unless ref $ref eq 'ARRAY';
187 6         43 local $self->{ShowErrorStatement} = 1;
188 6         94 local $self->{RaiseError} = 1;
189              
190 6         99 my @current =
191             $self->selectrow_array( 'SELECT COUNT(app) from _deploy WHERE app=?',
192             undef, $app );
193              
194 6 100       786 unless ( $current[0] ) {
195 2         12 $self->do( '
196             INSERT INTO _deploy(app)
197             VALUES(?)
198             ', undef, $app );
199             }
200              
201 6         16470 my $latest_change_id = $self->last_deploy_id($app);
202 6         778 $log->debug( 'Current Change ID:', $latest_change_id );
203 6         33 $log->debug( 'Requested Change ID:', scalar @$ref );
204              
205 6 50       30 die "Requested Change ID("
206             . ( scalar @$ref )
207             . ") is less than current: $latest_change_id"
208             if @$ref < $latest_change_id;
209              
210 6         11 my $count = 0;
211 6         18 foreach my $cmd (@$ref) {
212 18         26 $count++;
213 18 100       35 next unless ( $count > $latest_change_id );
214              
215             exists $cmd->{sql}
216             || exists $cmd->{pl}
217 8 50 66     35 || confess "Missing 'sql' or 'pl' key for id " . $count;
218              
219 8 100       16 if ( exists $cmd->{sql} ) {
220 5         25 $log->debug("-- change #$count\n");
221 5         16 eval { $self->do( $cmd->{sql} ); };
  5         24  
222 5 50       42943 die $cmd->{sql} . $@ if $@;
223             $self->do( "
224             UPDATE
225             _deploy
226             SET
227             type = ?,
228             data = ?
229             WHERE
230             app = ?
231             ",
232 5         42 undef, 'sql', $cmd->{sql}, $app );
233             }
234              
235 8 100       42456 if ( exists $cmd->{pl} ) {
236 3         25 $log->debug( "# change #$count\n" . $cmd->{pl} );
237 3         26 my $tmp = Path::Tiny->tempfile;
238 3         2210 $tmp->spew_utf8( $cmd->{pl} );
239              
240             # TODO stop and restart the transaction (if any) around
241             # this
242 3 50       25379 system( $^X, $tmp ) == 0 or die "system failed";
243             $self->do( "
244             UPDATE
245             _deploy
246             SET
247             type = ?,
248             data = ?
249             WHERE
250             app = ?
251             ",
252 3         206 undef, 'pl', $cmd->{pl}, $app );
253             }
254             }
255 6         27217 $log->debug( 'Deployed to Change ID:', $count );
256 6         302 return ( $latest_change_id, $count );
257             }
258              
259             sub deploy_sql {
260 0     0 1 0 my $self = shift;
261 0         0 my $sql = shift;
262 0   0     0 my $app = shift || 'default';
263              
264 0         0 $log->debug("deploy_sql($app)");
265 0         0 $self->_setup_deploy;
266 0         0 $self->deploy_arrayref( _split_sql($sql), $app );
267             }
268              
269             sub deploy_file {
270 2     2 1 2149 my $self = shift;
271 2         4 my $file = shift;
272 2         3 my $app = shift;
273 2         11 $log->debug("deploy_file($file)");
274 2         20 $self->_setup_deploy;
275 2         8 $self->deploy_arrayref( _load_file($file), $app );
276             }
277              
278             sub deploy_dir {
279 4     4 1 2555 my $self = shift;
280 4   33     26 my $dir = path(shift) || confess 'deploy_dir($dir)';
281 4         109 my $app = shift;
282              
283 4 50       15 confess "directory not found: $dir" unless -d $dir;
284 4         87 $log->debug("deploy_dir($dir)");
285 4         45 $self->_setup_deploy;
286              
287 4         10 my @files;
288 4         15 my $iter = $dir->iterator;
289 4         92 while ( my $file = $iter->() ) {
290 10 50 33     754 if ( $file =~ m/.+\.((sql)|(pl))$/ and -f $file ) {
291 10         273 push( @files, $file );
292             }
293             else {
294 0         0 warn "Cannot deploy file: $file";
295             }
296             }
297              
298 10         178 my @items = map { @{ _load_file($_) } }
  10         19  
299 4         155 sort { $a->stringify cmp $b->stringify } @files;
  7         33  
300              
301 4         569 $self->deploy_arrayref( \@items, $app );
302             }
303              
304             sub deployed_table_info {
305 1     1 1 1230 my $self = shift;
306 1         7 my $dbschema = shift;
307 1         23 my $driver = $self->{Driver}->{Name};
308              
309 1 50       17 if ( !$dbschema ) {
310 1 50       13 if ( $driver eq 'SQLite' ) {
    0          
311 1         6 $dbschema = 'main';
312             }
313             elsif ( $driver eq 'Pg' ) {
314 0         0 $dbschema = 'public';
315             }
316             else {
317 0         0 $dbschema = '%';
318             }
319             }
320              
321 1         18 my $sth = $self->table_info( '%', $dbschema, '%',
322             "'TABLE','VIEW','GLOBAL TEMPORARY','LOCAL TEMPORARY'" );
323              
324 1         993 my %tables;
325              
326 1         65 while ( my $table = $sth->fetchrow_arrayref ) {
327 4         394 my $sth2 = $self->column_info( '%', '%', $table->[2], '%' );
328 4         5826 $tables{ $table->[2] } = $sth2->fetchall_arrayref;
329             }
330              
331 1         95 return \%tables;
332             }
333              
334             {
335 2     2   14 no strict 'refs';
  2         4  
  2         307  
336             *{'DBIx::ThinSQL::db::last_deploy_id'} = \&last_deploy_id;
337             *{'DBIx::ThinSQL::db::_split_sql'} = \&_split_sql;
338             *{'DBIx::ThinSQL::db::_load_file'} = \&_load_file;
339             *{'DBIx::ThinSQL::db::run_sql'} = \&run_sql;
340             *{'DBIx::ThinSQL::db::run_arrayref'} = \&run_arrayref;
341             *{'DBIx::ThinSQL::db::run_file'} = \&run_file;
342             *{'DBIx::ThinSQL::db::run_dir'} = \&run_dir;
343             *{'DBIx::ThinSQL::db::_setup_deploy'} = \&_setup_deploy;
344             *{'DBIx::ThinSQL::db::deploy_arrayref'} = \&deploy_arrayref;
345             *{'DBIx::ThinSQL::db::deploy_sql'} = \&deploy_sql;
346             *{'DBIx::ThinSQL::db::deploy_file'} = \&deploy_file;
347             *{'DBIx::ThinSQL::db::deploy_dir'} = \&deploy_dir;
348             *{'DBIx::ThinSQL::db::deployed_table_info'} = \&deployed_table_info;
349             }
350              
351             1;
352              
353             __END__