=head1 SYNOPSIS
- package Library::Schema;
- use base qw/DBIx::Class::Schema/;
- # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
+ package MyApp::Schema;
+ use base qw/DBIx::Class::Schema/;
+
+ our $VERSION = 0.001;
+
+ # load MyApp::Schema::CD, MyApp::Schema::Book, MyApp::Schema::DVD
__PACKAGE__->load_classes(qw/CD Book DVD/);
- __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
+ __PACKAGE__->load_components(qw/Schema::Versioned/);
__PACKAGE__->upgrade_directory('/path/to/upgrades/');
- __PACKAGE__->backup_directory('/path/to/backups/');
=head1 DESCRIPTION
-This module is a component designed to extend L<DBIx::Class::Schema>
-classes, to enable them to upgrade to newer schema layouts. To use this
-module, you need to have called C<create_ddl_dir> on your Schema to
-create your upgrade files to include with your delivery.
+This module provides methods to apply DDL changes to your database using SQL
+diff files. Normally these diff files would be created using
+L<DBIx::Class::Schema/create_ddl_dir>.
A table called I<dbix_class_schema_versions> is created and maintained by the
-module. This contains two fields, 'Version' and 'Installed', which
-contain each VERSION of your Schema, and the date+time it was installed.
-
-The actual upgrade is called manually by calling C<upgrade> on your
-schema object. Code is run at connect time to determine whether an
-upgrade is needed, if so, a warning "Versions out of sync" is
-produced.
+module. This is used to determine which version your database is currently at.
+Similarly the $VERSION in your DBIC schema class is used to determine the
+current DBIC schema version.
-So you'll probably want to write a script which generates your DDLs and diffs
-and another which executes the upgrade.
+The upgrade is initiated manually by calling C<upgrade> on your schema object,
+this will attempt to upgrade the database from its current version to the current
+schema version using a diff from your I<upgrade_directory>. If a suitable diff is
+not found then no upgrade is possible.
NB: At the moment, only SQLite and MySQL are supported. This is due to
spotty behaviour in the SQL::Translator producers, please help us by
-them.
-
+enhancing them. Ask on the mailing list or IRC channel for details (community details
+in L<DBIx::Class>).
=head1 GETTING STARTED
+Firstly you need to setup your schema class as per the L</SYNOPSIS>, make sure
+you have specified an upgrade_directory and an initial $VERSION.
-=cut
+Then you'll need two scripts, one to create DDL files and diffs and another to perform
+upgrades. Your creation script might look like a bit like this:
-=head1 METHODS
+ use strict;
+ use Pod::Usage;
+ use Getopt::Long;
+ use MyApp::Schema;
-=head2 upgrade_directory
+ my ( $preversion, $help );
+ GetOptions(
+ 'p|preversion:s' => \$preversion,
+ ) or die pod2usage;
-Use this to set the directory your upgrade files are stored in.
+ my $schema = MyApp::Schema->connect(
+ $dsn,
+ $user,
+ $password,
+ );
+ my $sql_dir = './sql';
+ my $version = $schema->schema_version();
+ $schema->create_ddl_dir( 'MySQL', $version, $sql_dir, $preversion );
-=head2 backup_directory
+Then your upgrade script might look like so:
+
+ use strict;
+ use MyApp::Schema;
-Use this to set the directory you want your backups stored in.
+ my $schema = MyApp::Schema->connect(
+ $dsn,
+ $user,
+ $password,
+ );
+
+ if (!$schema->get_db_version()) {
+ # schema is unversioned
+ $schema->deploy();
+ } else {
+ $schema->upgrade();
+ }
+
+The script above assumes that if the database is unversioned then it is empty
+and we can safely deploy the DDL to it. However things are not always so simple.
+
+if you want to initialise a pre-existing database where the DDL is not the same
+as the DDL for your current schema version then you will need a diff which
+converts the database's DDL to the current DDL. The best way to do this is
+to get a dump of the database schema (without data) and save that in your
+SQL directory as version 0.000 (the filename must be as with
+L<DBIx::Class::Schema/ddl_filename>) then create a diff using your create DDL
+script given above from version 0.000 to the current version. Then hand check
+and if necessary edit the resulting diff to ensure that it will apply. Once you have
+done all that you can do this:
+
+ if (!$schema->get_db_version()) {
+ # schema is unversioned
+ $schema->install("0.000");
+ }
+
+ # this will now apply the 0.000 to current version diff
+ $schema->upgrade();
+
+In the case of an unversioned database the above code will create the
+dbix_class_schema_versions table and write version 0.000 to it, then
+upgrade will then apply the diff we talked about creating in the previous paragraph
+and then you're good to go.
=cut
use strict;
use warnings;
use base 'DBIx::Class';
+
+use Carp::Clan qw/^DBIx::Class/;
use POSIX 'strftime';
-use Data::Dumper;
__PACKAGE__->mk_classdata('_filedata');
__PACKAGE__->mk_classdata('upgrade_directory');
__PACKAGE__->mk_classdata('do_backup');
__PACKAGE__->mk_classdata('do_diff_on_init');
+
+=head1 METHODS
+
+=head2 upgrade_directory
+
+Use this to set the directory your upgrade files are stored in.
+
+=head2 backup_directory
+
+Use this to set the directory you want your backups stored in (note that backups
+are disabled by default).
+
+=cut
+
=head2 install
=over 4
# must be called on a fresh database
if ($self->get_db_version()) {
- warn 'Install not possible as versions table already exists in database';
+ carp 'Install not possible as versions table already exists in database';
}
# default to current version if none passed
$new_version ||= $self->schema_version();
- unless ($new_version) {
+ if ($new_version) {
# create versions table and version row
$self->{vschema}->deploy;
- $self->_set_db_version;
+ $self->_set_db_version({ version => $new_version });
}
}
+=head2 deploy
+
+Same as L<DBIx::Class::Schema/deploy> but also calls C<install>.
+
+=cut
+
+sub deploy {
+ my $self = shift;
+ $self->next::method(@_);
+ $self->install();
+}
+
+=head2 create_upgrade_path
+
+=over 4
+
+=item Arguments: { upgrade_file => $file }
+
+=back
+
+Virtual method that should be overriden to create an upgrade file.
+This is useful in the case of upgrading across multiple versions
+to concatenate several files to create one upgrade file.
+
+You'll probably want the db_version retrieved via $self->get_db_version
+and the schema_version which is retrieved via $self->schema_version
+
+=cut
+
+sub create_upgrade_path {
+ ## override this method
+}
+
=head2 upgrade
Call this to attempt to upgrade your database from the version it is at to the version
-this DBIC schema is at.
+this DBIC schema is at. If they are the same it does nothing.
+
+It requires an SQL diff file to exist in you I<upgrade_directory>, normally you will
+have created this using L<DBIx::Class::Schema/create_ddl_dir>.
-It requires an SQL diff file to exist in $schema->upgrade_directory, normally you will
-have created this using $schema->create_ddl_dir.
+If successful the dbix_class_schema_versions table is updated with the current
+DBIC schema version.
=cut
# db unversioned
unless ($db_version) {
- warn 'Upgrade not possible as database is unversioned. Please call install first.';
+ carp 'Upgrade not possible as database is unversioned. Please call install first.';
return;
}
# db and schema at same version. do nothing
if ($db_version eq $self->schema_version) {
- print "Upgrade not necessary\n";
+ carp "Upgrade not necessary\n";
return;
}
# here to be sure.
# XXX - just fix it
$self->storage->sqlt_type;
-
+
my $upgrade_file = $self->ddl_filename(
$self->storage->sqlt_type,
$self->schema_version,
$db_version,
);
+ $self->create_upgrade_path({ upgrade_file => $upgrade_file });
+
unless (-f $upgrade_file) {
- warn "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
+ carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
return;
}
+ carp "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
+
# backup if necessary then apply upgrade
$self->_filedata($self->_read_sql_file($upgrade_file));
$self->backup() if($self->do_backup);
Runs a set of SQL statements matching a passed in regular expression. The
idea is that this method can be called any number of times from your
-C<upgrade> method, running whichever commands you specify via the
+C<do_upgrade> method, running whichever commands you specify via the
regex in the parameter. Probably won't work unless called from the overridable
do_upgrade method.
for (@statements)
{
$self->storage->debugobj->query_start($_) if $self->storage->debug;
- $self->storage->dbh->do($_) or warn "SQL was:\n $_";
+ $self->apply_statement($_);
$self->storage->debugobj->query_end($_) if $self->storage->debug;
}
return 1;
}
+=head2 apply_statement
+
+Takes an SQL statement and runs it. Override this if you want to handle errors
+differently.
+
+=cut
+
+sub apply_statement {
+ my ($self, $statement) = @_;
+
+ $self->storage->dbh->do($_) or carp "SQL was:\n $_";
+}
+
=head2 get_db_version
Returns the version that your database is currently at. This is determined by the values in the
-dbix_class_schema_versions table that $self->upgrade writes to.
+dbix_class_schema_versions table that C<upgrade> and C<install> write to.
=cut
compatibility between the old versions table (SchemaVersions) and the new one
(dbix_class_schema_versions).
-To avoid the checks on connect, set the env var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth arg like so:
+To avoid the checks on connect, set the env var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth argument like so:
my $schema = MyApp::Schema->connect(
$dsn,
my ($self, $args) = @_;
$args = {} unless $args;
+
+ # useful when connecting from scripts etc
+ return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
+
$self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
my $vtable = $self->{vschema}->resultset('Table');
}
}
- # useful when connecting from scripts etc
- return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
my $pversion = $self->get_db_version();
if($pversion eq $self->schema_version)
{
-# warn "This version is already installed\n";
+# carp "This version is already installed\n";
return 1;
}
if(!$pversion)
{
- warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
+ carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
return 1;
}
- warn "Versions out of sync. This is " . $self->schema_version .
+ carp "Versions out of sync. This is " . $self->schema_version .
", your database contains version $pversion, please call upgrade on your Schema.\n";
}
return;
}
- eval 'require SQL::Translator "0.09"';
- if ($@) {
- $self->throw_exception("SQL::Translator 0.09 required");
- }
+ $self->throw_exception($self->storage->_sqlt_version_error)
+ if (not $self->storage->_sqlt_version_ok);
- my $db_tr = SQL::Translator->new({
- add_drop_table => 1,
+ my $db_tr = SQL::Translator->new({
+ add_drop_table => 1,
parser => 'DBI',
parser_args => { dbh => $self->storage->dbh }
});
$db_tr->producer($db);
my $dbic_tr = SQL::Translator->new;
$dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
- $dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db);
$dbic_tr->data($self);
$dbic_tr->producer($db);
print $file $diff;
close($file);
- 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";
+ 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";
}
sub _set_db_version {
my $self = shift;
+ my ($params) = @_;
+ $params ||= {};
+ my $version = $params->{version} ? $params->{version} : $self->schema_version;
my $vtable = $self->{vschema}->resultset('Table');
- $vtable->create({ version => $self->schema_version,
+ $vtable->create({ version => $version,
installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
});
my $file = shift || return;
my $fh;
- open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
+ open $fh, "<$file" or carp("Can't open upgrade file, $file ($!)");
my @data = split(/\n/, join('', <$fh>));
@data = grep(!/^--/, @data);
@data = split(/;/, join('', @data));
=head1 AUTHORS
-Jess Robinson <castaway@desert-island.demon.co.uk>
+Jess Robinson <castaway@desert-island.me.uk>
Luke Saunders <luke@shadowcatsystems.co.uk>
=head1 LICENSE