1 package DBIx::Class::Version::Table;
2 use base 'DBIx::Class';
6 __PACKAGE__->load_components(qw/ Core/);
7 __PACKAGE__->table('SchemaVersions');
9 __PACKAGE__->add_columns
11 'data_type' => 'VARCHAR',
12 'is_auto_increment' => 0,
13 'default_value' => undef,
14 'is_foreign_key' => 0,
20 'data_type' => 'VARCHAR',
21 'is_auto_increment' => 0,
22 'default_value' => undef,
23 'is_foreign_key' => 0,
24 'name' => 'Installed',
29 __PACKAGE__->set_primary_key('Version');
31 package DBIx::Class::Version;
32 use base 'DBIx::Class::Schema';
36 __PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table');
39 # ---------------------------------------------------------------------------
43 DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
47 package Library::Schema;
48 use base qw/DBIx::Class::Schema/;
49 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
50 __PACKAGE__->load_classes(qw/CD Book DVD/);
52 __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
53 __PACKAGE__->upgrade_directory('/path/to/upgrades/');
54 __PACKAGE__->backup_directory('/path/to/backups/');
59 This module is a component designed to extend L<DBIx::Class::Schema>
60 classes, to enable them to upgrade to newer schema layouts. To use this
61 module, you need to have called C<create_ddl_dir> on your Schema to
62 create your upgrade files to include with your delivery.
64 A table called I<SchemaVersions> is created and maintained by the
65 module. This contains two fields, 'Version' and 'Installed', which
66 contain each VERSION of your Schema, and the date+time it was installed.
68 The actual upgrade is called manually by calling C<upgrade> on your
69 schema object. Code is run at connect time to determine whether an
70 upgrade is needed, if so, a warning "Versions out of sync" is
73 So you'll probably want to write a script which generates your DDLs and diffs
74 and another which executes the upgrade.
76 NB: At the moment, only SQLite and MySQL are supported. This is due to
77 spotty behaviour in the SQL::Translator producers, please help us by
82 =head2 upgrade_directory
84 Use this to set the directory your upgrade files are stored in.
86 =head2 backup_directory
88 Use this to set the directory you want your backups stored in.
92 package DBIx::Class::Schema::Versioned;
96 use base 'DBIx::Class';
100 __PACKAGE__->mk_classdata('_filedata');
101 __PACKAGE__->mk_classdata('upgrade_directory');
102 __PACKAGE__->mk_classdata('backup_directory');
103 __PACKAGE__->mk_classdata('do_backup');
104 __PACKAGE__->mk_classdata('do_diff_on_init');
106 =head2 schema_version
108 Returns the current schema class' $VERSION; does -not- use $schema->VERSION
109 since that varies in results depending on if version.pm is installed, and if
110 so the perl or XS versions. If you want this to change, bug the version.pm
111 author to make vpp and vxs behave the same.
117 my $class = ref($self)||$self;
121 $version = ${"${class}::VERSION"};
126 =head2 get_db_version
128 Returns the version that your database is currently at. This is determined by the values in the
129 SchemaVersions table that $self->upgrade writes to.
135 my ($self, $rs) = @_;
137 my $vtable = $self->{vschema}->resultset('Table');
138 return 0 unless ($self->_source_exists($vtable));
140 my $psearch = $vtable->search(undef,
142 { 'max' => 'Installed' },
144 as => ['maxinstall'],
146 my $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'),
148 $pversion = $pversion->Version if($pversion);
154 my ($self, $rs) = @_;
157 $rs->search({ 1, 0 })->count;
159 return 0 if $@ || !defined $c;
166 This is an overwritable method which is called just before the upgrade, to
167 allow you to make a backup of the database. Per default this method attempts
168 to call C<< $self->storage->backup >>, to run the standard backup on each
171 This method should return the name of the backup file, if appropriate..
178 ## Make each ::DBI::Foo do this
179 $self->storage->backup($self->backup_directory());
182 # is this just a waste of time? if not then merge with DBI.pm
183 sub _create_db_to_schema_diff {
186 my %driver_to_db_map = (
190 my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
192 print "Sorry, this is an unsupported DB\n";
196 eval 'require SQL::Translator "0.09"';
198 $self->throw_exception("SQL::Translator 0.09 required");
201 my $db_tr = SQL::Translator->new({
204 parser_args => { dbh => $self->storage->dbh }
207 $db_tr->producer($db);
208 my $dbic_tr = SQL::Translator->new;
209 $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
210 $dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db);
211 $dbic_tr->data($self);
212 $dbic_tr->producer($db);
214 $db_tr->schema->name('db_schema');
215 $dbic_tr->schema->name('dbic_schema');
217 # is this really necessary?
218 foreach my $tr ($db_tr, $dbic_tr) {
219 my $data = $tr->data;
220 $tr->parser->($tr, $$data);
223 my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
224 $dbic_tr->schema, $db,
225 { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
227 my $filename = $self->ddl_filename(
229 $self->upgrade_directory,
230 $self->schema_version,
234 if(!open($file, ">$filename"))
236 $self->throw_exception("Can't open $filename for writing ($!)");
242 print "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";
247 Call this to attempt to upgrade your database from the version it is at to the version
248 this DBIC schema is at.
250 It requires an SQL diff file to exist in $schema->upgrade_directory, normally you will
251 have created this using $schema->create_ddl_dir.
258 my $db_version = $self->get_db_version();
261 unless ($db_version) {
262 # set version in SchemaVersions table, can't actually upgrade as we don 't know what version the DB is at
263 $self->_create_db_to_schema_diff() if ($self->do_diff_on_init);
265 # create versions table and version row
266 $self->{vschema}->deploy;
267 $self->_set_db_version;
271 # db and schema at same version. do nothing
272 if ($db_version eq $self->schema_version) {
273 print "Upgrade not necessary\n";
277 my $upgrade_file = $self->ddl_filename(
278 $self->storage->sqlt_type,
279 $self->upgrade_directory,
280 $self->schema_version,
284 unless (-f $upgrade_file) {
285 warn "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
289 # backup if necessary then apply upgrade
290 $self->_filedata($self->_read_sql_file($upgrade_file));
291 $self->backup() if($self->do_backup);
292 $self->txn_do(sub { $self->do_upgrade() });
294 # set row in SchemaVersions table
295 $self->_set_db_version;
298 sub _set_db_version {
301 my $vtable = $self->{vschema}->resultset('Table');
302 $vtable->create({ Version => $self->schema_version,
303 Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
310 my $file = shift || return;
313 open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
314 my @data = split(/\n/, join('', <$fh>));
315 @data = grep(!/^--/, @data);
316 @data = split(/;/, join('', @data));
318 @data = grep { $_ && $_ !~ /^-- / } @data;
319 @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
325 This is an overwritable method used to run your upgrade. The freeform method
326 allows you to run your upgrade any way you please, you can call C<run_upgrade>
327 any number of times to run the actual SQL commands, and in between you can
328 sandwich your data upgrading. For example, first run all the B<CREATE>
329 commands, then migrate your data from old to new tables/formats, then
330 issue the DROP commands when you are finished.
332 Will run the whole file as it is by default.
340 ## overridable sub, per default just run all the commands.
341 $self->run_upgrade(qr/create/i);
342 $self->run_upgrade(qr/alter table .*? add/i);
343 $self->run_upgrade(qr/alter table .*? (?!drop)/i);
344 $self->run_upgrade(qr/alter table .*? drop/i);
345 $self->run_upgrade(qr/drop/i);
350 $self->run_upgrade(qr/create/i);
352 Runs a set of SQL statements matching a passed in regular expression. The
353 idea is that this method can be called any number of times from your
354 C<upgrade> method, running whichever commands you specify via the
355 regex in the parameter. Probably won't work unless called from the overridable
362 my ($self, $stm) = @_;
364 return unless ($self->_filedata);
365 my @statements = grep { $_ =~ $stm } @{$self->_filedata};
366 $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
370 $self->storage->debugobj->query_start($_) if $self->storage->debug;
371 $self->storage->dbh->do($_) or warn "SQL was:\n $_";
372 $self->storage->debugobj->query_end($_) if $self->storage->debug;
380 $self->next::method(@_);
388 $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
390 my $pversion = $self->get_db_version();
392 if($pversion eq $self->schema_version)
394 warn "This version is already installed\n";
400 warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
404 warn "Versions out of sync. This is " . $self->schema_version .
405 ", your database contains version $pversion, please call upgrade on your Schema.\n";
413 Jess Robinson <castaway@desert-island.demon.co.uk>
414 Luke Saunders <luke@shadowcatsystems.co.uk>
418 You may distribute this code under the same terms as Perl itself.