Commit | Line | Data |
b974984a |
1 | package DBIx::Class::DeploymentHandler; |
2 | |
3 | use Moose; |
4 | use Method::Signatures::Simple; |
5 | require DBIx::Class::Schema; # loaded for type constraint |
6 | require DBIx::Class::Storage; # loaded for type constraint |
7 | use Carp 'carp'; |
8 | |
9 | has schema => ( |
10 | isa => 'DBIx::Class::Schema', |
11 | is => 'ro', |
12 | required => 1, |
13 | ); |
14 | |
15 | has upgrade_directory => ( |
16 | isa => 'Str', |
17 | is => 'ro', |
18 | required => 1, |
19 | default => 'sql', |
20 | ); |
21 | |
22 | has backup_directory => ( |
23 | isa => 'Str', |
24 | is => 'ro', |
25 | ); |
26 | |
27 | has storage => ( |
28 | isa => 'DBIx::Class::Storage', |
29 | is => 'ro', |
30 | lazy_build => 1, |
31 | ); |
32 | |
33 | has _filedata => ( |
34 | is => 'ro', |
35 | ); |
36 | |
37 | has do_backup => ( |
38 | isa => 'Bool', |
39 | is => 'ro', |
40 | default => undef, |
41 | ); |
42 | |
43 | has do_diff_on_init => ( |
44 | isa => 'Bool', |
45 | is => 'ro', |
46 | default => undef, |
47 | ); |
48 | |
49 | method _build_storage { |
50 | return $self->schema->storage; |
51 | } |
52 | |
53 | method install($new_version) { |
54 | # must be called on a fresh database |
55 | if ($self->get_db_version) { |
56 | carp 'Install not possible as versions table already exists in database'; |
57 | } |
58 | |
59 | # default to current version if none passed |
60 | $new_version ||= $self->schema_version(); |
61 | |
62 | if ($new_version) { |
63 | # create versions table and version row |
64 | $self->{vschema}->deploy; |
65 | $self->_set_db_version({ version => $new_version }); |
66 | } |
67 | } |
68 | |
69 | method deploy { |
70 | $self->next::method(@_); |
71 | $self->install(); |
72 | } |
73 | |
74 | sub create_upgrade_path { |
75 | ## override this method |
76 | } |
77 | |
78 | sub ordered_schema_versions { |
79 | ## override this method |
80 | } |
81 | |
82 | method upgrade { |
83 | my $db_version = $self->get_db_version(); |
84 | |
85 | # db unversioned |
86 | unless ($db_version) { |
87 | carp 'Upgrade not possible as database is unversioned. Please call install first.'; |
88 | return; |
89 | } |
90 | |
91 | # db and schema at same version. do nothing |
92 | if ( $db_version eq $self->schema_version ) { |
93 | carp "Upgrade not necessary\n"; |
94 | return; |
95 | } |
96 | |
97 | my @version_list = $self->ordered_schema_versions; |
98 | |
99 | # if nothing returned then we preload with min/max |
100 | @version_list = ( $db_version, $self->schema_version ) |
101 | unless ( scalar(@version_list) ); |
102 | |
103 | # catch the case of someone returning an arrayref |
104 | @version_list = @{ $version_list[0] } |
105 | if ( ref( $version_list[0] ) eq 'ARRAY' ); |
106 | |
107 | # remove all versions in list above the required version |
108 | while ( scalar(@version_list) |
109 | && ( $version_list[-1] ne $self->schema_version ) ) |
110 | { |
111 | pop @version_list; |
112 | } |
113 | |
114 | # remove all versions in list below the current version |
115 | while ( scalar(@version_list) && ( $version_list[0] ne $db_version ) ) { |
116 | shift @version_list; |
117 | } |
118 | |
119 | # check we have an appropriate list of versions |
120 | if ( scalar(@version_list) < 2 ) { |
121 | die; |
122 | } |
123 | |
124 | # do sets of upgrade |
125 | while ( scalar(@version_list) >= 2 ) { |
126 | $self->upgrade_single_step( $version_list[0], $version_list[1] ); |
127 | shift @version_list; |
128 | } |
129 | } |
130 | |
131 | method upgrade_single_step($db_version, $target_version) { |
132 | # db and schema at same version. do nothing |
133 | if ($db_version eq $target_version) { |
134 | carp "Upgrade not necessary\n"; |
135 | return; |
136 | } |
137 | |
138 | # strangely the first time this is called can |
139 | # differ to subsequent times. so we call it |
140 | # here to be sure. |
141 | # XXX - just fix it |
142 | $self->storage->sqlt_type; |
143 | |
144 | my $upgrade_file = $self->ddl_filename( |
145 | $self->storage->sqlt_type, |
146 | $target_version, |
147 | $self->upgrade_directory, |
148 | $db_version, |
149 | ); |
150 | |
151 | $self->create_upgrade_path({ upgrade_file => $upgrade_file }); |
152 | |
153 | unless (-f $upgrade_file) { |
154 | carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n"; |
155 | return; |
156 | } |
157 | |
158 | carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n"; |
159 | |
160 | # backup if necessary then apply upgrade |
161 | $self->_filedata($self->_read_sql_file($upgrade_file)); |
162 | $self->backup() if($self->do_backup); |
163 | $self->txn_do(sub { $self->do_upgrade() }); |
164 | |
165 | # set row in dbix_class_schema_versions table |
166 | $self->_set_db_version({version => $target_version}); |
167 | } |
168 | |
169 | method do_upgrade { |
170 | # just run all the commands (including inserts) in order |
171 | $self->run_upgrade(qr/.*?/); |
172 | } |
173 | |
174 | method run_upgrade($stm) { |
175 | return unless ($self->_filedata); |
176 | my @statements = grep { $_ =~ $stm } @{$self->_filedata}; |
177 | $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]); |
178 | |
179 | for (@statements) { |
180 | $self->storage->debugobj->query_start($_) if $self->storage->debug; |
181 | $self->apply_statement($_); |
182 | $self->storage->debugobj->query_end($_) if $self->storage->debug; |
183 | } |
184 | |
185 | return 1; |
186 | } |
187 | |
188 | method apply_statement($statement) { |
189 | $self->storage->dbh->do($_) or carp "SQL was: $_"; |
190 | } |
191 | |
192 | method get_db_version($rs) { |
193 | my $vtable = $self->{vschema}->resultset('Table'); |
194 | my $version = eval { |
195 | $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } ) |
196 | ->get_column ('version') |
197 | ->next; |
198 | }; |
199 | return $version || 0; |
200 | } |
201 | |
202 | method schema_version {} |
203 | |
204 | method backup { |
205 | ## Make each ::DBI::Foo do this |
206 | $self->storage->backup($self->backup_directory()); |
207 | } |
208 | |
209 | method connection { |
210 | $self->next::method(@_); |
211 | $self->_on_connect($_[3]); |
212 | return $self; |
213 | } |
214 | |
215 | sub _on_connect |
216 | { |
217 | my ($self, $args) = @_; |
218 | |
219 | $args = {} unless $args; |
220 | |
221 | $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); |
222 | my $vtable = $self->{vschema}->resultset('Table'); |
223 | |
224 | # useful when connecting from scripts etc |
225 | return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version})); |
226 | |
227 | # check for legacy versions table and move to new if exists |
228 | my $vschema_compat = DBIx::Class::VersionCompat->connect(@{$self->storage->connect_info()}); |
229 | unless ($self->_source_exists($vtable)) { |
230 | my $vtable_compat = $vschema_compat->resultset('TableCompat'); |
231 | if ($self->_source_exists($vtable_compat)) { |
232 | $self->{vschema}->deploy; |
233 | map { $vtable->create({ installed => $_->Installed, version => $_->Version }) } $vtable_compat->all; |
234 | $self->storage->dbh->do("DROP TABLE " . $vtable_compat->result_source->from); |
235 | } |
236 | } |
237 | |
238 | my $pversion = $self->get_db_version(); |
239 | |
240 | if($pversion eq $self->schema_version) |
241 | { |
242 | # carp "This version is already installed\n"; |
243 | return 1; |
244 | } |
245 | |
246 | if(!$pversion) |
247 | { |
248 | carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n"; |
249 | return 1; |
250 | } |
251 | |
252 | carp "Versions out of sync. This is " . $self->schema_version . |
253 | ", your database contains version $pversion, please call upgrade on your Schema.\n"; |
254 | } |
255 | |
256 | sub _create_db_to_schema_diff { |
257 | my $self = shift; |
258 | |
259 | my %driver_to_db_map = ( |
260 | 'mysql' => 'MySQL' |
261 | ); |
262 | |
263 | my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}}; |
264 | unless ($db) { |
265 | print "Sorry, this is an unsupported DB\n"; |
266 | return; |
267 | } |
268 | |
269 | $self->throw_exception($self->storage->_sqlt_version_error) |
270 | if (not $self->storage->_sqlt_version_ok); |
271 | |
272 | my $db_tr = SQL::Translator->new({ |
273 | add_drop_table => 1, |
274 | parser => 'DBI', |
275 | parser_args => { dbh => $self->storage->dbh } |
276 | }); |
277 | |
278 | $db_tr->producer($db); |
279 | my $dbic_tr = SQL::Translator->new; |
280 | $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class'); |
281 | $dbic_tr->data($self); |
282 | $dbic_tr->producer($db); |
283 | |
284 | $db_tr->schema->name('db_schema'); |
285 | $dbic_tr->schema->name('dbic_schema'); |
286 | |
287 | # is this really necessary? |
288 | foreach my $tr ($db_tr, $dbic_tr) { |
289 | my $data = $tr->data; |
290 | $tr->parser->($tr, $$data); |
291 | } |
292 | |
293 | my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db, |
294 | $dbic_tr->schema, $db, |
295 | { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 }); |
296 | |
297 | my $filename = $self->ddl_filename( |
298 | $db, |
299 | $self->schema_version, |
300 | $self->upgrade_directory, |
301 | 'PRE', |
302 | ); |
303 | my $file; |
304 | if(!open($file, ">$filename")) |
305 | { |
306 | $self->throw_exception("Can't open $filename for writing ($!)"); |
307 | next; |
308 | } |
309 | print $file $diff; |
310 | close($file); |
311 | |
312 | carp "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n"; |
313 | } |
314 | |
315 | |
316 | sub _set_db_version { |
317 | my $self = shift; |
318 | my ($params) = @_; |
319 | $params ||= {}; |
320 | |
321 | my $version = $params->{version} ? $params->{version} : $self->schema_version; |
322 | my $vtable = $self->{vschema}->resultset('Table'); |
323 | |
324 | ############################################################################## |
325 | # !!! NOTE !!! |
326 | ############################################################################## |
327 | # |
328 | # The travesty below replaces the old nice timestamp format of %Y-%m-%d %H:%M:%S |
329 | # This is necessary since there are legitimate cases when upgrades can happen |
330 | # back to back within the same second. This breaks things since we relay on the |
331 | # ability to sort by the 'installed' value. The logical choice of an autoinc |
332 | # is not possible, as it will break multiple legacy installations. Also it is |
333 | # not possible to format the string sanely, as the column is a varchar(20). |
334 | # The 'v' character is added to the front of the string, so that any version |
335 | # formatted by this new function will sort _after_ any existing 200... strings. |
336 | my @tm = gettimeofday(); |
337 | my @dt = gmtime ($tm[0]); |
338 | my $o = $vtable->create({ |
339 | version => $version, |
340 | installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f", |
341 | $dt[5] + 1900, |
342 | $dt[4] + 1, |
343 | $dt[3], |
344 | $dt[2], |
345 | $dt[1], |
346 | $dt[0], |
347 | $tm[1] / 1000, # convert to millisecs, format as up/down rounded int above |
348 | ), |
349 | }); |
350 | } |
351 | |
352 | sub _read_sql_file { |
353 | my $self = shift; |
354 | my $file = shift || return; |
355 | |
356 | open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)"); |
357 | my @data = split /\n/, join '', <$fh>; |
358 | close $fh; |
359 | |
360 | @data = grep { |
361 | $_ && |
362 | !/^--/ && |
363 | !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/m |
364 | } split /;/, |
365 | join '', @data; |
366 | |
367 | return \@data; |
368 | } |
369 | |
370 | sub _source_exists |
371 | { |
372 | my ($self, $rs) = @_; |
373 | |
374 | my $c = eval { |
375 | $rs->search({ 1, 0 })->count; |
376 | }; |
377 | return 0 if $@ || !defined $c; |
378 | |
379 | return 1; |
380 | } |
381 | |
382 | 1; |