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