Commit | Line | Data |
a89c6fc0 |
1 | package # Hide from PAUSE |
2 | DBIx::Class::Version::Table; |
d88ecca6 |
3 | use base 'DBIx::Class::Core'; |
c9d2e0a2 |
4 | use strict; |
5 | use warnings; |
6 | |
b4b1e91c |
7 | __PACKAGE__->table('dbix_class_schema_versions'); |
c9d2e0a2 |
8 | |
ad1446da |
9 | __PACKAGE__->add_columns |
732dc718 |
10 | ( 'version' => { |
ad1446da |
11 | 'data_type' => 'VARCHAR', |
12 | 'is_auto_increment' => 0, |
13 | 'default_value' => undef, |
14 | 'is_foreign_key' => 0, |
732dc718 |
15 | 'name' => 'version', |
ad1446da |
16 | 'is_nullable' => 0, |
17 | 'size' => '10' |
18 | }, |
732dc718 |
19 | 'installed' => { |
c9d2e0a2 |
20 | 'data_type' => 'VARCHAR', |
21 | 'is_auto_increment' => 0, |
22 | 'default_value' => undef, |
23 | 'is_foreign_key' => 0, |
732dc718 |
24 | 'name' => 'installed', |
c9d2e0a2 |
25 | 'is_nullable' => 0, |
26 | 'size' => '20' |
ad1446da |
27 | }, |
28 | ); |
e5053694 |
29 | __PACKAGE__->result_source_instance->set_primary_key('version'); |
c9d2e0a2 |
30 | |
a89c6fc0 |
31 | package # Hide from PAUSE |
32 | DBIx::Class::Version::TableCompat; |
d88ecca6 |
33 | use base 'DBIx::Class::Core'; |
b4b1e91c |
34 | __PACKAGE__->table('SchemaVersions'); |
35 | |
732dc718 |
36 | __PACKAGE__->add_columns |
37 | ( 'Version' => { |
38 | 'data_type' => 'VARCHAR', |
39 | }, |
40 | 'Installed' => { |
41 | 'data_type' => 'VARCHAR', |
42 | }, |
43 | ); |
e5053694 |
44 | __PACKAGE__->result_source_instance->set_primary_key('Version'); |
732dc718 |
45 | |
a89c6fc0 |
46 | package # Hide from PAUSE |
47 | DBIx::Class::Version; |
c9d2e0a2 |
48 | use base 'DBIx::Class::Schema'; |
49 | use strict; |
50 | use warnings; |
51 | |
52 | __PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table'); |
53 | |
a89c6fc0 |
54 | package # Hide from PAUSE |
55 | DBIx::Class::VersionCompat; |
b4b1e91c |
56 | use base 'DBIx::Class::Schema'; |
57 | use strict; |
58 | use warnings; |
59 | |
60 | __PACKAGE__->register_class('TableCompat', 'DBIx::Class::Version::TableCompat'); |
61 | |
c9d2e0a2 |
62 | |
63 | # --------------------------------------------------------------------------- |
8424c090 |
64 | |
65 | =head1 NAME |
66 | |
67 | DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades |
68 | |
69 | =head1 SYNOPSIS |
70 | |
6c2b68ed |
71 | package MyApp::Schema; |
e84a43c1 |
72 | use base qw/DBIx::Class::Schema/; |
73 | |
74 | our $VERSION = 0.001; |
75 | |
6c2b68ed |
76 | # load MyApp::Schema::CD, MyApp::Schema::Book, MyApp::Schema::DVD |
8424c090 |
77 | __PACKAGE__->load_classes(qw/CD Book DVD/); |
78 | |
e84a43c1 |
79 | __PACKAGE__->load_components(qw/Schema::Versioned/); |
8424c090 |
80 | __PACKAGE__->upgrade_directory('/path/to/upgrades/'); |
8424c090 |
81 | |
82 | |
83 | =head1 DESCRIPTION |
84 | |
e84a43c1 |
85 | This module provides methods to apply DDL changes to your database using SQL |
86 | diff files. Normally these diff files would be created using |
87 | L<DBIx::Class::Schema/create_ddl_dir>. |
8424c090 |
88 | |
b4b1e91c |
89 | A table called I<dbix_class_schema_versions> is created and maintained by the |
e84a43c1 |
90 | module. This is used to determine which version your database is currently at. |
91 | Similarly the $VERSION in your DBIC schema class is used to determine the |
92 | current DBIC schema version. |
8424c090 |
93 | |
e84a43c1 |
94 | The upgrade is initiated manually by calling C<upgrade> on your schema object, |
95 | this will attempt to upgrade the database from its current version to the current |
96 | schema version using a diff from your I<upgrade_directory>. If a suitable diff is |
97 | not found then no upgrade is possible. |
8424c090 |
98 | |
da0dd7dc |
99 | =head1 SEE ALSO |
100 | |
101 | L<DBIx::Class::DeploymentHandler> is a much more powerful alternative to this |
102 | module. Examples of things it can do that this module cannot do include |
103 | |
104 | =over |
105 | |
106 | =item * |
107 | |
108 | Downgrades in addition to upgrades |
109 | |
110 | =item * |
111 | |
4a0eed52 |
112 | Multiple sql files per upgrade/downgrade/install |
da0dd7dc |
113 | |
114 | =item * |
115 | |
116 | Perl scripts allowed for upgrade/downgrade/install |
117 | |
118 | =item * |
119 | |
120 | Just one set of files needed for upgrade, unlike this module where one might |
121 | need to generate C<factorial(scalar @versions)> |
122 | |
123 | =back |
124 | |
93e4d41a |
125 | =head1 GETTING STARTED |
126 | |
e84a43c1 |
127 | Firstly you need to setup your schema class as per the L</SYNOPSIS>, make sure |
128 | you have specified an upgrade_directory and an initial $VERSION. |
93e4d41a |
129 | |
e84a43c1 |
130 | Then you'll need two scripts, one to create DDL files and diffs and another to perform |
131 | upgrades. Your creation script might look like a bit like this: |
93e4d41a |
132 | |
e84a43c1 |
133 | use strict; |
134 | use Pod::Usage; |
135 | use Getopt::Long; |
136 | use MyApp::Schema; |
8424c090 |
137 | |
56988b6c |
138 | my ( $preversion, $help ); |
e84a43c1 |
139 | GetOptions( |
140 | 'p|preversion:s' => \$preversion, |
141 | ) or die pod2usage; |
8424c090 |
142 | |
e84a43c1 |
143 | my $schema = MyApp::Schema->connect( |
144 | $dsn, |
145 | $user, |
146 | $password, |
147 | ); |
148 | my $sql_dir = './sql'; |
149 | my $version = $schema->schema_version(); |
150 | $schema->create_ddl_dir( 'MySQL', $version, $sql_dir, $preversion ); |
8424c090 |
151 | |
e84a43c1 |
152 | Then your upgrade script might look like so: |
153 | |
154 | use strict; |
155 | use MyApp::Schema; |
156 | |
157 | my $schema = MyApp::Schema->connect( |
158 | $dsn, |
159 | $user, |
160 | $password, |
161 | ); |
8424c090 |
162 | |
e84a43c1 |
163 | if (!$schema->get_db_version()) { |
164 | # schema is unversioned |
165 | $schema->deploy(); |
166 | } else { |
167 | $schema->upgrade(); |
168 | } |
169 | |
170 | The script above assumes that if the database is unversioned then it is empty |
171 | and we can safely deploy the DDL to it. However things are not always so simple. |
172 | |
173 | if you want to initialise a pre-existing database where the DDL is not the same |
82625f90 |
174 | as the DDL for your current schema version then you will need a diff which |
e84a43c1 |
175 | converts the database's DDL to the current DDL. The best way to do this is |
176 | to get a dump of the database schema (without data) and save that in your |
177 | SQL directory as version 0.000 (the filename must be as with |
82625f90 |
178 | L<DBIx::Class::Schema/ddl_filename>) then create a diff using your create DDL |
e84a43c1 |
179 | script given above from version 0.000 to the current version. Then hand check |
82625f90 |
180 | and if necessary edit the resulting diff to ensure that it will apply. Once you have |
e84a43c1 |
181 | done all that you can do this: |
182 | |
183 | if (!$schema->get_db_version()) { |
184 | # schema is unversioned |
185 | $schema->install("0.000"); |
186 | } |
187 | |
188 | # this will now apply the 0.000 to current version diff |
189 | $schema->upgrade(); |
190 | |
191 | In the case of an unversioned database the above code will create the |
82625f90 |
192 | dbix_class_schema_versions table and write version 0.000 to it, then |
e84a43c1 |
193 | upgrade will then apply the diff we talked about creating in the previous paragraph |
194 | and then you're good to go. |
8424c090 |
195 | |
196 | =cut |
197 | |
c9d2e0a2 |
198 | package DBIx::Class::Schema::Versioned; |
199 | |
200 | use strict; |
201 | use warnings; |
d88ecca6 |
202 | use base 'DBIx::Class::Schema'; |
341d5ede |
203 | |
70c28808 |
204 | use DBIx::Class::Carp; |
ddcc02d1 |
205 | use DBIx::Class::_Util 'dbic_internal_try'; |
81023d83 |
206 | use Scalar::Util 'weaken'; |
fd323bf1 |
207 | use namespace::clean; |
c9d2e0a2 |
208 | |
e5053694 |
209 | __PACKAGE__->mk_group_accessors( inherited => qw( |
210 | _filedata |
211 | upgrade_directory |
212 | backup_directory |
213 | do_backup |
214 | do_diff_on_init |
215 | ) ); |
8424c090 |
216 | |
e84a43c1 |
217 | |
218 | =head1 METHODS |
219 | |
220 | =head2 upgrade_directory |
221 | |
222 | Use this to set the directory your upgrade files are stored in. |
223 | |
224 | =head2 backup_directory |
225 | |
226 | Use this to set the directory you want your backups stored in (note that backups |
227 | are disabled by default). |
228 | |
229 | =cut |
230 | |
93e4d41a |
231 | =head2 install |
c9d2e0a2 |
232 | |
93e4d41a |
233 | =over 4 |
c9d2e0a2 |
234 | |
93e4d41a |
235 | =item Arguments: $db_version |
e6129e56 |
236 | |
93e4d41a |
237 | =back |
8424c090 |
238 | |
93e4d41a |
239 | Call this to initialise a previously unversioned database. The table 'dbix_class_schema_versions' will be created which will be used to store the database version. |
8424c090 |
240 | |
93e4d41a |
241 | Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>. |
8424c090 |
242 | |
5529838f |
243 | See L</GETTING STARTED> for more details. |
f81b9157 |
244 | |
8424c090 |
245 | =cut |
246 | |
93e4d41a |
247 | sub install |
c9d2e0a2 |
248 | { |
93e4d41a |
249 | my ($self, $new_version) = @_; |
c9d2e0a2 |
250 | |
93e4d41a |
251 | # must be called on a fresh database |
252 | if ($self->get_db_version()) { |
a03b396b |
253 | $self->throw_exception("A versioned schema has already been deployed, try upgrade instead.\n"); |
8424c090 |
254 | } |
c9d2e0a2 |
255 | |
93e4d41a |
256 | # default to current version if none passed |
257 | $new_version ||= $self->schema_version(); |
8424c090 |
258 | |
e84a43c1 |
259 | if ($new_version) { |
93e4d41a |
260 | # create versions table and version row |
261 | $self->{vschema}->deploy; |
a354b842 |
262 | $self->_set_db_version({ version => $new_version }); |
8424c090 |
263 | } |
c9d2e0a2 |
264 | } |
265 | |
e84a43c1 |
266 | =head2 deploy |
267 | |
268 | Same as L<DBIx::Class::Schema/deploy> but also calls C<install>. |
269 | |
270 | =cut |
271 | |
272 | sub deploy { |
273 | my $self = shift; |
274 | $self->next::method(@_); |
275 | $self->install(); |
276 | } |
277 | |
a354b842 |
278 | =head2 create_upgrade_path |
279 | |
280 | =over 4 |
281 | |
282 | =item Arguments: { upgrade_file => $file } |
283 | |
284 | =back |
285 | |
c1300297 |
286 | Virtual method that should be overridden to create an upgrade file. |
56988b6c |
287 | This is useful in the case of upgrading across multiple versions |
a354b842 |
288 | to concatenate several files to create one upgrade file. |
289 | |
4a743a00 |
290 | You'll probably want the db_version retrieved via $self->get_db_version |
56988b6c |
291 | and the schema_version which is retrieved via $self->schema_version |
4a743a00 |
292 | |
a354b842 |
293 | =cut |
294 | |
295 | sub create_upgrade_path { |
d7a58a29 |
296 | ## override this method |
a354b842 |
297 | } |
298 | |
d2bc7045 |
299 | =head2 ordered_schema_versions |
300 | |
301 | =over 4 |
302 | |
fb13a49f |
303 | =item Return Value: a list of version numbers, ordered from lowest to highest |
d2bc7045 |
304 | |
305 | =back |
306 | |
c1300297 |
307 | Virtual method that should be overridden to return an ordered list |
d2bc7045 |
308 | of schema versions. This is then used to produce a set of steps to |
309 | upgrade through to achieve the required schema version. |
310 | |
311 | You may want the db_version retrieved via $self->get_db_version |
56988b6c |
312 | and the schema_version which is retrieved via $self->schema_version |
d2bc7045 |
313 | |
314 | =cut |
315 | |
316 | sub ordered_schema_versions { |
56988b6c |
317 | ## override this method |
d2bc7045 |
318 | } |
319 | |
8424c090 |
320 | =head2 upgrade |
e2c0df8e |
321 | |
d2bc7045 |
322 | Call this to attempt to upgrade your database from the version it |
323 | is at to the version this DBIC schema is at. If they are the same |
324 | it does nothing. |
e84a43c1 |
325 | |
d2bc7045 |
326 | It will call L</ordered_schema_versions> to retrieve an ordered |
327 | list of schema versions (if ordered_schema_versions returns nothing |
328 | then it is assumed you can do the upgrade as a single step). It |
329 | then iterates through the list of versions between the current db |
330 | version and the schema version applying one update at a time until |
48580715 |
331 | all relevant updates are applied. |
c9d2e0a2 |
332 | |
d2bc7045 |
333 | The individual update steps are performed by using |
334 | L</upgrade_single_step>, which will apply the update and also |
335 | update the dbix_class_schema_versions table. |
c9d2e0a2 |
336 | |
8424c090 |
337 | =cut |
c9d2e0a2 |
338 | |
d2bc7045 |
339 | sub upgrade { |
340 | my ($self) = @_; |
341 | my $db_version = $self->get_db_version(); |
c9d2e0a2 |
342 | |
d2bc7045 |
343 | # db unversioned |
344 | unless ($db_version) { |
345 | carp 'Upgrade not possible as database is unversioned. Please call install first.'; |
346 | return; |
347 | } |
348 | |
349 | # db and schema at same version. do nothing |
350 | if ( $db_version eq $self->schema_version ) { |
70c28808 |
351 | carp 'Upgrade not necessary'; |
d2bc7045 |
352 | return; |
353 | } |
354 | |
355 | my @version_list = $self->ordered_schema_versions; |
356 | |
357 | # if nothing returned then we preload with min/max |
358 | @version_list = ( $db_version, $self->schema_version ) |
359 | unless ( scalar(@version_list) ); |
360 | |
361 | # catch the case of someone returning an arrayref |
362 | @version_list = @{ $version_list[0] } |
363 | if ( ref( $version_list[0] ) eq 'ARRAY' ); |
364 | |
365 | # remove all versions in list above the required version |
366 | while ( scalar(@version_list) |
367 | && ( $version_list[-1] ne $self->schema_version ) ) |
368 | { |
369 | pop @version_list; |
370 | } |
371 | |
372 | # remove all versions in list below the current version |
373 | while ( scalar(@version_list) && ( $version_list[0] ne $db_version ) ) { |
374 | shift @version_list; |
375 | } |
376 | |
377 | # check we have an appropriate list of versions |
378 | if ( scalar(@version_list) < 2 ) { |
379 | die; |
380 | } |
381 | |
382 | # do sets of upgrade |
383 | while ( scalar(@version_list) >= 2 ) { |
384 | $self->upgrade_single_step( $version_list[0], $version_list[1] ); |
385 | shift @version_list; |
386 | } |
387 | } |
388 | |
389 | =head2 upgrade_single_step |
390 | |
391 | =over 4 |
392 | |
393 | =item Arguments: db_version - the version currently within the db |
394 | |
395 | =item Arguments: target_version - the version to upgrade to |
396 | |
397 | =back |
398 | |
399 | Call this to attempt to upgrade your database from the |
400 | I<db_version> to the I<target_version>. If they are the same it |
401 | does nothing. |
402 | |
403 | It requires an SQL diff file to exist in your I<upgrade_directory>, |
404 | normally you will have created this using L<DBIx::Class::Schema/create_ddl_dir>. |
405 | |
406 | If successful the dbix_class_schema_versions table is updated with |
407 | the I<target_version>. |
408 | |
409 | This method may be called repeatedly by the upgrade method to |
410 | upgrade through a series of updates. |
411 | |
412 | =cut |
413 | |
414 | sub upgrade_single_step |
415 | { |
416 | my ($self, |
417 | $db_version, |
418 | $target_version) = @_; |
c9d2e0a2 |
419 | |
8424c090 |
420 | # db and schema at same version. do nothing |
d2bc7045 |
421 | if ($db_version eq $target_version) { |
70c28808 |
422 | carp 'Upgrade not necessary'; |
8424c090 |
423 | return; |
c9d2e0a2 |
424 | } |
425 | |
37fcb5b5 |
426 | # strangely the first time this is called can |
82625f90 |
427 | # differ to subsequent times. so we call it |
37fcb5b5 |
428 | # here to be sure. |
429 | # XXX - just fix it |
430 | $self->storage->sqlt_type; |
d4daee7b |
431 | |
8424c090 |
432 | my $upgrade_file = $self->ddl_filename( |
433 | $self->storage->sqlt_type, |
d2bc7045 |
434 | $target_version, |
99a74c4a |
435 | $self->upgrade_directory, |
8424c090 |
436 | $db_version, |
437 | ); |
c9d2e0a2 |
438 | |
a354b842 |
439 | $self->create_upgrade_path({ upgrade_file => $upgrade_file }); |
440 | |
8424c090 |
441 | unless (-f $upgrade_file) { |
70c28808 |
442 | carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one"; |
8424c090 |
443 | return; |
444 | } |
c9d2e0a2 |
445 | |
d7a58a29 |
446 | carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n"; |
a354b842 |
447 | |
8424c090 |
448 | # backup if necessary then apply upgrade |
449 | $self->_filedata($self->_read_sql_file($upgrade_file)); |
450 | $self->backup() if($self->do_backup); |
451 | $self->txn_do(sub { $self->do_upgrade() }); |
c9d2e0a2 |
452 | |
b4b1e91c |
453 | # set row in dbix_class_schema_versions table |
d2bc7045 |
454 | $self->_set_db_version({version => $target_version}); |
8424c090 |
455 | } |
c9d2e0a2 |
456 | |
e6129e56 |
457 | =head2 do_upgrade |
458 | |
c9d2e0a2 |
459 | This is an overwritable method used to run your upgrade. The freeform method |
460 | allows you to run your upgrade any way you please, you can call C<run_upgrade> |
461 | any number of times to run the actual SQL commands, and in between you can |
462 | sandwich your data upgrading. For example, first run all the B<CREATE> |
82625f90 |
463 | commands, then migrate your data from old to new tables/formats, then |
e7b14c5b |
464 | issue the DROP commands when you are finished. Will run the whole file as it is by default. |
8424c090 |
465 | |
466 | =cut |
467 | |
468 | sub do_upgrade |
469 | { |
e7b14c5b |
470 | my ($self) = @_; |
8424c090 |
471 | |
56988b6c |
472 | # just run all the commands (including inserts) in order |
e7b14c5b |
473 | $self->run_upgrade(qr/.*?/); |
8424c090 |
474 | } |
475 | |
c9d2e0a2 |
476 | =head2 run_upgrade |
477 | |
478 | $self->run_upgrade(qr/create/i); |
479 | |
480 | Runs a set of SQL statements matching a passed in regular expression. The |
481 | idea is that this method can be called any number of times from your |
e84a43c1 |
482 | C<do_upgrade> method, running whichever commands you specify via the |
8424c090 |
483 | regex in the parameter. Probably won't work unless called from the overridable |
484 | do_upgrade method. |
c9d2e0a2 |
485 | |
8424c090 |
486 | =cut |
8795fefb |
487 | |
8424c090 |
488 | sub run_upgrade |
489 | { |
490 | my ($self, $stm) = @_; |
8795fefb |
491 | |
8424c090 |
492 | return unless ($self->_filedata); |
493 | my @statements = grep { $_ =~ $stm } @{$self->_filedata}; |
494 | $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]); |
8795fefb |
495 | |
8424c090 |
496 | for (@statements) |
82625f90 |
497 | { |
8424c090 |
498 | $self->storage->debugobj->query_start($_) if $self->storage->debug; |
abc8f12a |
499 | $self->apply_statement($_); |
8424c090 |
500 | $self->storage->debugobj->query_end($_) if $self->storage->debug; |
501 | } |
8795fefb |
502 | |
8424c090 |
503 | return 1; |
504 | } |
42416a0b |
505 | |
abc8f12a |
506 | =head2 apply_statement |
507 | |
508 | Takes an SQL statement and runs it. Override this if you want to handle errors |
509 | differently. |
510 | |
511 | =cut |
512 | |
513 | sub apply_statement { |
514 | my ($self, $statement) = @_; |
515 | |
d7a58a29 |
516 | $self->storage->dbh->do($_) or carp "SQL was: $_"; |
abc8f12a |
517 | } |
518 | |
93e4d41a |
519 | =head2 get_db_version |
520 | |
521 | Returns the version that your database is currently at. This is determined by the values in the |
e84a43c1 |
522 | dbix_class_schema_versions table that C<upgrade> and C<install> write to. |
93e4d41a |
523 | |
524 | =cut |
525 | |
526 | sub get_db_version |
527 | { |
528 | my ($self, $rs) = @_; |
529 | |
530 | my $vtable = $self->{vschema}->resultset('Table'); |
ddcc02d1 |
531 | my $version = dbic_internal_try { |
56988b6c |
532 | $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } ) |
533 | ->get_column ('version') |
534 | ->next; |
93e4d41a |
535 | }; |
56988b6c |
536 | return $version || 0; |
93e4d41a |
537 | } |
538 | |
539 | =head2 schema_version |
540 | |
541 | Returns the current schema class' $VERSION |
542 | |
543 | =cut |
544 | |
545 | =head2 backup |
546 | |
547 | This is an overwritable method which is called just before the upgrade, to |
548 | allow you to make a backup of the database. Per default this method attempts |
549 | to call C<< $self->storage->backup >>, to run the standard backup on each |
56988b6c |
550 | database type. |
93e4d41a |
551 | |
552 | This method should return the name of the backup file, if appropriate.. |
553 | |
554 | This method is disabled by default. Set $schema->do_backup(1) to enable it. |
555 | |
556 | =cut |
557 | |
558 | sub backup |
559 | { |
560 | my ($self) = @_; |
561 | ## Make each ::DBI::Foo do this |
562 | $self->storage->backup($self->backup_directory()); |
563 | } |
564 | |
ecea7937 |
565 | =head2 connection |
566 | |
567 | Overloaded method. This checks the DBIC schema version against the DB version and |
568 | warns if they are not the same or if the DB is unversioned. It also provides |
569 | compatibility between the old versions table (SchemaVersions) and the new one |
570 | (dbix_class_schema_versions). |
571 | |
48580715 |
572 | To avoid the checks on connect, set the environment var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth argument like so: |
f81b9157 |
573 | |
574 | my $schema = MyApp::Schema->connect( |
575 | $dsn, |
576 | $user, |
577 | $password, |
578 | { ignore_version => 1 }, |
579 | ); |
ecea7937 |
580 | |
581 | =cut |
582 | |
8424c090 |
583 | sub connection { |
584 | my $self = shift; |
585 | $self->next::method(@_); |
8012b15c |
586 | $self->_on_connect(); |
8424c090 |
587 | return $self; |
588 | } |
589 | |
590 | sub _on_connect |
591 | { |
8012b15c |
592 | my ($self) = @_; |
f81b9157 |
593 | |
f03d3e5d |
594 | weaken (my $w_storage = $self->storage ); |
81023d83 |
595 | |
e5053694 |
596 | $self->{vschema} = DBIx::Class::Version->clone->connection( |
e7dcdf69 |
597 | sub { $w_storage->dbh }, |
598 | |
599 | # proxy some flags from the main storage |
600 | { map { $_ => $w_storage->$_ } qw( unsafe ) }, |
601 | ); |
f03d3e5d |
602 | my $conn_attrs = $w_storage->_dbic_connect_attributes || {}; |
06f10f6f |
603 | |
b4b1e91c |
604 | my $vtable = $self->{vschema}->resultset('Table'); |
605 | |
c99c4801 |
606 | # useful when connecting from scripts etc |
f76f761c |
607 | return if ($conn_attrs->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $conn_attrs->{ignore_version})); |
c99c4801 |
608 | |
b4b1e91c |
609 | # check for legacy versions table and move to new if exists |
b4b1e91c |
610 | unless ($self->_source_exists($vtable)) { |
e5053694 |
611 | my $vtable_compat = DBIx::Class::VersionCompat->clone->connection(sub { $w_storage->dbh })->resultset('TableCompat'); |
b4b1e91c |
612 | if ($self->_source_exists($vtable_compat)) { |
613 | $self->{vschema}->deploy; |
77c3a5dc |
614 | map { $vtable->new_result({ installed => $_->Installed, version => $_->Version })->insert } $vtable_compat->all; |
f03d3e5d |
615 | $w_storage->_get_dbh->do("DROP TABLE " . $vtable_compat->result_source->from); |
b4b1e91c |
616 | } |
617 | } |
f81b9157 |
618 | |
8424c090 |
619 | my $pversion = $self->get_db_version(); |
620 | |
621 | if($pversion eq $self->schema_version) |
622 | { |
70c28808 |
623 | #carp "This version is already installed"; |
8424c090 |
624 | return 1; |
625 | } |
42416a0b |
626 | |
8424c090 |
627 | if(!$pversion) |
628 | { |
70c28808 |
629 | carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB."; |
8424c090 |
630 | return 1; |
631 | } |
632 | |
d7a58a29 |
633 | carp "Versions out of sync. This is " . $self->schema_version . |
70c28808 |
634 | ", your database contains version $pversion, please call upgrade on your Schema."; |
8424c090 |
635 | } |
636 | |
93e4d41a |
637 | # is this just a waste of time? if not then merge with DBI.pm |
638 | sub _create_db_to_schema_diff { |
639 | my $self = shift; |
640 | |
641 | my %driver_to_db_map = ( |
642 | 'mysql' => 'MySQL' |
643 | ); |
644 | |
645 | my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}}; |
646 | unless ($db) { |
647 | print "Sorry, this is an unsupported DB\n"; |
648 | return; |
649 | } |
650 | |
18a2903b |
651 | require DBIx::Class::Optional::Dependencies; |
c96bf2bc |
652 | if ( my $missing = DBIx::Class::Optional::Dependencies->req_missing_for('deploy') ) { |
653 | $self->throw_exception("Unable to proceed without $missing"); |
2527233b |
654 | } |
93e4d41a |
655 | |
b2b2e7fd |
656 | my $db_tr = SQL::Translator->new({ |
657 | add_drop_table => 1, |
93e4d41a |
658 | parser => 'DBI', |
659 | parser_args => { dbh => $self->storage->dbh } |
660 | }); |
661 | |
662 | $db_tr->producer($db); |
663 | my $dbic_tr = SQL::Translator->new; |
664 | $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class'); |
93e4d41a |
665 | $dbic_tr->data($self); |
666 | $dbic_tr->producer($db); |
667 | |
668 | $db_tr->schema->name('db_schema'); |
669 | $dbic_tr->schema->name('dbic_schema'); |
670 | |
671 | # is this really necessary? |
672 | foreach my $tr ($db_tr, $dbic_tr) { |
673 | my $data = $tr->data; |
674 | $tr->parser->($tr, $$data); |
675 | } |
676 | |
82625f90 |
677 | my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db, |
93e4d41a |
678 | $dbic_tr->schema, $db, |
679 | { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 }); |
680 | |
681 | my $filename = $self->ddl_filename( |
682 | $db, |
683 | $self->schema_version, |
684 | $self->upgrade_directory, |
685 | 'PRE', |
686 | ); |
687 | my $file; |
688 | if(!open($file, ">$filename")) |
689 | { |
690 | $self->throw_exception("Can't open $filename for writing ($!)"); |
691 | next; |
692 | } |
693 | print $file $diff; |
694 | close($file); |
695 | |
70c28808 |
696 | 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."; |
93e4d41a |
697 | } |
698 | |
699 | |
700 | sub _set_db_version { |
701 | my $self = shift; |
a354b842 |
702 | my ($params) = @_; |
703 | $params ||= {}; |
93e4d41a |
704 | |
a354b842 |
705 | my $version = $params->{version} ? $params->{version} : $self->schema_version; |
93e4d41a |
706 | my $vtable = $self->{vschema}->resultset('Table'); |
93e4d41a |
707 | |
d2bc7045 |
708 | ############################################################################## |
709 | # !!! NOTE !!! |
710 | ############################################################################## |
711 | # |
712 | # The travesty below replaces the old nice timestamp format of %Y-%m-%d %H:%M:%S |
713 | # This is necessary since there are legitimate cases when upgrades can happen |
714 | # back to back within the same second. This breaks things since we relay on the |
715 | # ability to sort by the 'installed' value. The logical choice of an autoinc |
a03b396b |
716 | # is not possible, as it will break multiple legacy installations. Also it is |
d2bc7045 |
717 | # not possible to format the string sanely, as the column is a varchar(20). |
718 | # The 'v' character is added to the front of the string, so that any version |
719 | # formatted by this new function will sort _after_ any existing 200... strings. |
5a8d5308 |
720 | require Time::HiRes; |
721 | my @tm = Time::HiRes::gettimeofday(); |
d2bc7045 |
722 | my @dt = gmtime ($tm[0]); |
77c3a5dc |
723 | my $o = $vtable->new_result({ |
d2bc7045 |
724 | version => $version, |
725 | installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f", |
726 | $dt[5] + 1900, |
727 | $dt[4] + 1, |
728 | $dt[3], |
729 | $dt[2], |
730 | $dt[1], |
731 | $dt[0], |
701c9693 |
732 | int($tm[1] / 1000), # convert to millisecs |
d2bc7045 |
733 | ), |
77c3a5dc |
734 | })->insert; |
93e4d41a |
735 | } |
736 | |
737 | sub _read_sql_file { |
738 | my $self = shift; |
739 | my $file = shift || return; |
740 | |
82625f90 |
741 | open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)"); |
742 | my @data = split /\n/, join '', <$fh>; |
743 | close $fh; |
744 | |
b703fec7 |
745 | @data = split /;/, |
746 | join '', |
747 | grep { $_ && |
748 | !/^--/ && |
749 | !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/mi } |
750 | @data; |
82625f90 |
751 | |
93e4d41a |
752 | return \@data; |
753 | } |
754 | |
755 | sub _source_exists |
756 | { |
ddcc02d1 |
757 | my ($self, $rs) = @_; |
758 | |
759 | ( dbic_internal_try { |
760 | $rs->search(\'1=0')->cursor->next; |
761 | 1; |
762 | } ) |
763 | ? 1 |
764 | : 0 |
765 | ; |
93e4d41a |
766 | } |
767 | |
a2bd3796 |
768 | =head1 FURTHER QUESTIONS? |
8424c090 |
769 | |
a2bd3796 |
770 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
8424c090 |
771 | |
a2bd3796 |
772 | =head1 COPYRIGHT AND LICENSE |
c9d2e0a2 |
773 | |
a2bd3796 |
774 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
775 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
776 | redistribute it and/or modify it under the same terms as the |
777 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |
8424c090 |
778 | |
a2bd3796 |
779 | =cut |
8424c090 |
780 | |
a2bd3796 |
781 | 1; |