1 package DBIx::Class::DeploymentHandler;
4 use Method::Signatures::Simple;
5 require DBIx::Class::Schema; # loaded for type constraint
6 require DBIx::Class::Storage; # loaded for type constraint
10 isa => 'DBIx::Class::Schema',
15 has upgrade_directory => (
22 has backup_directory => (
28 isa => 'DBIx::Class::Storage',
43 has do_diff_on_init => (
49 method _build_storage {
50 return $self->schema->storage;
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';
59 # default to current version if none passed
60 $new_version ||= $self->schema_version();
63 # create versions table and version row
64 $self->{vschema}->deploy;
65 $self->_set_db_version({ version => $new_version });
70 $self->next::method(@_);
74 sub create_upgrade_path {
75 ## override this method
78 sub ordered_schema_versions {
79 ## override this method
83 my $db_version = $self->get_db_version();
86 unless ($db_version) {
87 carp 'Upgrade not possible as database is unversioned. Please call install first.';
91 # db and schema at same version. do nothing
92 if ( $db_version eq $self->schema_version ) {
93 carp "Upgrade not necessary\n";
97 my @version_list = $self->ordered_schema_versions;
99 # if nothing returned then we preload with min/max
100 @version_list = ( $db_version, $self->schema_version )
101 unless ( scalar(@version_list) );
103 # catch the case of someone returning an arrayref
104 @version_list = @{ $version_list[0] }
105 if ( ref( $version_list[0] ) eq 'ARRAY' );
107 # remove all versions in list above the required version
108 while ( scalar(@version_list)
109 && ( $version_list[-1] ne $self->schema_version ) )
114 # remove all versions in list below the current version
115 while ( scalar(@version_list) && ( $version_list[0] ne $db_version ) ) {
119 # check we have an appropriate list of versions
120 if ( scalar(@version_list) < 2 ) {
125 while ( scalar(@version_list) >= 2 ) {
126 $self->upgrade_single_step( $version_list[0], $version_list[1] );
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";
138 # strangely the first time this is called can
139 # differ to subsequent times. so we call it
142 $self->storage->sqlt_type;
144 my $upgrade_file = $self->ddl_filename(
145 $self->storage->sqlt_type,
147 $self->upgrade_directory,
151 $self->create_upgrade_path({ upgrade_file => $upgrade_file });
153 unless (-f $upgrade_file) {
154 carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
158 carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
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() });
165 # set row in dbix_class_schema_versions table
166 $self->_set_db_version({version => $target_version});
170 # just run all the commands (including inserts) in order
171 $self->run_upgrade(qr/.*?/);
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} ]);
180 $self->storage->debugobj->query_start($_) if $self->storage->debug;
181 $self->apply_statement($_);
182 $self->storage->debugobj->query_end($_) if $self->storage->debug;
188 method apply_statement($statement) {
189 $self->storage->dbh->do($_) or carp "SQL was: $_";
192 method get_db_version($rs) {
193 my $vtable = $self->{vschema}->resultset('Table');
195 $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
196 ->get_column ('version')
199 return $version || 0;
202 method schema_version {}
205 ## Make each ::DBI::Foo do this
206 $self->storage->backup($self->backup_directory());
210 $self->next::method(@_);
211 $self->_on_connect($_[3]);
217 my ($self, $args) = @_;
219 $args = {} unless $args;
221 $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
222 my $vtable = $self->{vschema}->resultset('Table');
224 # useful when connecting from scripts etc
225 return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
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);
238 my $pversion = $self->get_db_version();
240 if($pversion eq $self->schema_version)
242 # carp "This version is already installed\n";
248 carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
252 carp "Versions out of sync. This is " . $self->schema_version .
253 ", your database contains version $pversion, please call upgrade on your Schema.\n";
256 sub _create_db_to_schema_diff {
259 my %driver_to_db_map = (
263 my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
265 print "Sorry, this is an unsupported DB\n";
269 $self->throw_exception($self->storage->_sqlt_version_error)
270 if (not $self->storage->_sqlt_version_ok);
272 my $db_tr = SQL::Translator->new({
275 parser_args => { dbh => $self->storage->dbh }
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);
284 $db_tr->schema->name('db_schema');
285 $dbic_tr->schema->name('dbic_schema');
287 # is this really necessary?
288 foreach my $tr ($db_tr, $dbic_tr) {
289 my $data = $tr->data;
290 $tr->parser->($tr, $$data);
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 });
297 my $filename = $self->ddl_filename(
299 $self->schema_version,
300 $self->upgrade_directory,
304 if(!open($file, ">$filename"))
306 $self->throw_exception("Can't open $filename for writing ($!)");
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";
316 sub _set_db_version {
321 my $version = $params->{version} ? $params->{version} : $self->schema_version;
322 my $vtable = $self->{vschema}->resultset('Table');
324 ##############################################################################
326 ##############################################################################
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({
340 installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f",
347 $tm[1] / 1000, # convert to millisecs, format as up/down rounded int above
354 my $file = shift || return;
356 open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)");
357 my @data = split /\n/, join '', <$fh>;
363 !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/m
372 my ($self, $rs) = @_;
375 $rs->search({ 1, 0 })->count;
377 return 0 if $@ || !defined $c;