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 # ---------------------------------------------------------------------------
40 package DBIx::Class::Schema::Versioned;
44 use base 'DBIx::Class';
48 __PACKAGE__->mk_classdata('_filedata');
49 __PACKAGE__->mk_classdata('upgrade_directory');
50 __PACKAGE__->mk_classdata('backup_directory');
51 __PACKAGE__->mk_classdata('do_backup');
55 my $class = ref($self)||$self;
59 $version = ${"${class}::VERSION"};
66 $self->next::method(@_);
74 $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
76 my $pversion = $self->get_db_version();
78 if($pversion eq $self->schema_version)
80 warn "This version is already installed\n";
86 warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
90 my $file = $self->ddl_filename(
91 $self->storage->sqlt_type,
92 $self->upgrade_directory,
97 # No upgrade path between these two versions
102 ## Don't do this yet, do only on command?
103 ## If we do this later, where does the Version table get updated??
104 warn "Versions out of sync. This is " . $self->schema_version .
105 ", your database contains version $pversion, please call upgrade on your Schema.\n";
110 my ($self, $rs) = @_;
112 my $vtable = $self->{vschema}->resultset('Table');
113 return 0 unless ($self->_source_exists($vtable));
115 my $psearch = $vtable->search(undef,
117 { 'max' => 'Installed' },
119 as => ['maxinstall'],
121 my $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'),
123 $pversion = $pversion->Version if($pversion);
129 my ($self, $rs) = @_;
132 $rs->search({ 1, 0 })->count;
134 return 0 if $@ || !defined $c;
142 ## Make each ::DBI::Foo do this
143 $self->storage->backup($self->backup_directory());
148 my ($self, $params) = @_;
150 my $db_version = $self->get_db_version();
152 my %driver_to_db_map = (
156 my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
158 print "Sorry, this is an unsupported DB\n";
162 if ($params->{create_diff}) {
163 require SQL::Translator;
164 require SQL::Translator::Diff;
165 my $db_tr = SQL::Translator->new({
168 parser_args => { dbh => $self->storage->dbh }
171 $db_tr->producer($db);
172 my $dbic_tr = SQL::Translator->new;
173 $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
174 $dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db);
175 $dbic_tr->data($self);
176 $dbic_tr->producer($db);
178 $db_tr->schema->name('db_schema');
179 $dbic_tr->schema->name('dbic_schema');
181 # is this really necessary?
182 foreach my $tr ($db_tr, $dbic_tr) {
183 my $data = $tr->data;
184 $tr->parser->($tr, $$data);
187 my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
188 $dbic_tr->schema, $db,
191 my $filename = $self->ddl_filename(
193 $self->upgrade_directory,
194 $self->schema_version,
198 if(!open($file, ">$filename")) {
199 $self->throw_exception("Can't open $filename for writing ($!)");
205 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";
208 # create versions table
209 $self->{vschema}->deploy;
211 if ($db_version eq $self->schema_version) {
212 print "Upgrade not necessary\n";
216 my $file = $self->ddl_filename(
217 $self->storage->sqlt_type,
218 $self->upgrade_directory,
219 $self->schema_version,
225 warn "Upgrade not possible, no upgrade file found ($file)\n";
230 open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
231 my @data = split(/\n/, join('', <$fh>));
232 @data = grep(!/^--/, @data);
233 @data = split(/;/, join('', @data));
235 @data = grep { $_ && $_ !~ /^-- / } @data;
236 @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
238 $self->_filedata(\@data);
239 $self->backup() if($self->do_backup);
246 my $vtable = $self->{vschema}->resultset('Table');
247 $vtable->create({ Version => $self->schema_version,
248 Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
257 ## overridable sub, per default just run all the commands.
258 $self->run_upgrade(qr/create/i);
259 $self->run_upgrade(qr/alter table .*? add/i);
260 $self->run_upgrade(qr/alter table .*? (?!drop)/i);
261 $self->run_upgrade(qr/alter table .*? drop/i);
262 $self->run_upgrade(qr/drop/i);
267 my ($self, $stm) = @_;
268 # print "Reg: $stm\n";
269 my @statements = grep { $_ =~ $stm } @{$self->_filedata};
270 # print "Statements: ", join("\n", @statements), "\n";
271 $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
275 $self->storage->debugobj->query_start($_) if $self->storage->debug;
276 $self->storage->dbh->do($_) or warn "SQL was:\n $_";
277 $self->storage->debugobj->query_end($_) if $self->storage->debug;
287 DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
291 package Library::Schema;
292 use base qw/DBIx::Class::Schema/;
293 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
294 __PACKAGE__->load_classes(qw/CD Book DVD/);
296 __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
297 __PACKAGE__->upgrade_directory('/path/to/upgrades/');
298 __PACKAGE__->backup_directory('/path/to/backups/');
303 # my special backup process
310 ## overridable sub, per default just runs all the commands.
312 $self->run_upgrade(qr/create/i);
313 $self->run_upgrade(qr/alter table .*? add/i);
314 $self->run_upgrade(qr/alter table .*? (?!drop)/i);
315 $self->run_upgrade(qr/alter table .*? drop/i);
316 $self->run_upgrade(qr/drop/i);
317 $self->run_upgrade(qr//i);
322 This module is a component designed to extend L<DBIx::Class::Schema>
323 classes, to enable them to upgrade to newer schema layouts. To use this
324 module, you need to have called C<create_ddl_dir> on your Schema to
325 create your upgrade files to include with your delivery.
327 A table called I<SchemaVersions> is created and maintained by the
328 module. This contains two fields, 'Version' and 'Installed', which
329 contain each VERSION of your Schema, and the date+time it was installed.
331 If you would like to influence which levels of version change need
332 upgrades in your Schema, you can override the method C<ddl_filename>
333 in L<DBIx::Class::Schema>. Return a false value if there is no upgrade
334 path between the two versions supplied. By default, every change in
335 your VERSION is regarded as needing an upgrade.
337 The actual upgrade is called manually by calling C<upgrade> on your
338 schema object. Code is run at connect time to determine whether an
339 upgrade is needed, if so, a warning "Versions out of sync" is
342 NB: At the moment, SQLite upgrading is rather spotty, as SQL::Translator::Diff
343 returns SQL statements that SQLite does not support.
350 This is an overwritable method which is called just before the upgrade, to
351 allow you to make a backup of the database. Per default this method attempts
352 to call C<< $self->storage->backup >>, to run the standard backup on each
355 This method should return the name of the backup file, if appropriate..
359 This is the main upgrade method which calls the overridable do_upgrade and
360 also handles the backups and updating of the SchemaVersion table.
364 This is an overwritable method used to run your upgrade. The freeform method
365 allows you to run your upgrade any way you please, you can call C<run_upgrade>
366 any number of times to run the actual SQL commands, and in between you can
367 sandwich your data upgrading. For example, first run all the B<CREATE>
368 commands, then migrate your data from old to new tables/formats, then
369 issue the DROP commands when you are finished.
373 $self->run_upgrade(qr/create/i);
375 Runs a set of SQL statements matching a passed in regular expression. The
376 idea is that this method can be called any number of times from your
377 C<upgrade> method, running whichever commands you specify via the
378 regex in the parameter.
380 =head2 upgrade_directory
382 Use this to set the directory your upgrade files are stored in.
384 =head2 backup_directory
386 Use this to set the directory you want your backups stored in.
388 =head2 schema_version
390 Returns the current schema class' $VERSION; does -not- use $schema->VERSION
391 since that varies in results depending on if version.pm is installed, and if
392 so the perl or XS versions. If you want this to change, bug the version.pm
393 author to make vpp and vxs behave the same.
397 Jess Robinson <castaway@desert-island.demon.co.uk>