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
-enhancing them. Ask on the mailing list or IRC channel for details (community details
-in L<DBIx::Class>).
+=head1 SEE ALSO
+
+L<DBIx::Class::DeploymentHandler> is a much more powerful alternative to this
+module. Examples of things it can do that this module cannot do include
+
+=over
+
+=item *
+
+Downgrades in addition to upgrades
+
+=item *
+
+Multiple sql files files per upgrade/downgrade/install
+
+=item *
+
+Perl scripts allowed for upgrade/downgrade/install
+
+=item *
+
+Just one set of files needed for upgrade, unlike this module where one might
+need to generate C<factorial(scalar @versions)>
+
+=back
=head1 GETTING STARTED
use Getopt::Long;
use MyApp::Schema;
- my ( $preversion, $help );
+ my ( $preversion, $help );
GetOptions(
'p|preversion:s' => \$preversion,
) or die pod2usage;
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
+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
+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
+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->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
+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.
use warnings;
use base 'DBIx::Class::Schema';
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
use Time::HiRes qw/gettimeofday/;
+use Try::Tiny;
+use namespace::clean;
__PACKAGE__->mk_classdata('_filedata');
__PACKAGE__->mk_classdata('upgrade_directory');
# must be called on a fresh database
if ($self->get_db_version()) {
- carp 'Install not possible as versions table already exists in database';
+ $self->throw_exception("A versioned schema has already been deployed, try upgrade instead.\n");
}
# default to current version if none passed
=back
-Virtual method that should be overriden to create an upgrade file.
-This is useful in the case of upgrading across multiple versions
+Virtual method that should be overridden 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
+and the schema_version which is retrieved via $self->schema_version
=cut
sub create_upgrade_path {
- ## override this method
+ ## override this method
}
=head2 ordered_schema_versions
=back
-Virtual method that should be overriden to return an ordered list
+Virtual method that should be overridden to return an ordered list
of schema versions. This is then used to produce a set of steps to
upgrade through to achieve the required schema version.
You may want the db_version retrieved via $self->get_db_version
-and the schema_version which is retrieved via $self->schema_version
+and the schema_version which is retrieved via $self->schema_version
=cut
sub ordered_schema_versions {
- ## override this method
+ ## override this method
}
=head2 upgrade
then it is assumed you can do the upgrade as a single step). It
then iterates through the list of versions between the current db
version and the schema version applying one update at a time until
-all relvant updates are applied.
+all relevant updates are applied.
The individual update steps are performed by using
L</upgrade_single_step>, which will apply the update and also
# db and schema at same version. do nothing
if ( $db_version eq $self->schema_version ) {
- carp "Upgrade not necessary\n";
+ carp 'Upgrade not necessary';
return;
}
# db and schema at same version. do nothing
if ($db_version eq $target_version) {
- carp "Upgrade not necessary\n";
+ carp 'Upgrade not necessary';
return;
}
# strangely the first time this is called can
- # differ to subsequent times. so we call it
+ # differ to subsequent times. so we call it
# here to be sure.
# XXX - just fix it
$self->storage->sqlt_type;
$self->create_upgrade_path({ upgrade_file => $upgrade_file });
unless (-f $upgrade_file) {
- carp "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";
return;
}
- carp "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
+ carp "DB 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));
allows you to run your upgrade any way you please, you can call C<run_upgrade>
any number of times to run the actual SQL commands, and in between you can
sandwich your data upgrading. For example, first run all the B<CREATE>
-commands, then migrate your data from old to new tables/formats, then
+commands, then migrate your data from old to new tables/formats, then
issue the DROP commands when you are finished. Will run the whole file as it is by default.
=cut
{
my ($self) = @_;
- # just run all the commands (including inserts) in order
+ # just run all the commands (including inserts) in order
$self->run_upgrade(qr/.*?/);
}
$self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
for (@statements)
- {
+ {
$self->storage->debugobj->query_start($_) if $self->storage->debug;
$self->apply_statement($_);
$self->storage->debugobj->query_end($_) if $self->storage->debug;
sub apply_statement {
my ($self, $statement) = @_;
- $self->storage->dbh->do($_) or carp "SQL was:\n $_";
+ $self->storage->dbh->do($_) or carp "SQL was: $_";
}
=head2 get_db_version
my ($self, $rs) = @_;
my $vtable = $self->{vschema}->resultset('Table');
- my $version = 0;
- eval {
- my $stamp = $vtable->get_column('installed')->max;
- $version = $vtable->search({ installed => $stamp })->first->version;
+ my $version = try {
+ $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
+ ->get_column ('version')
+ ->next;
};
- return $version;
+ return $version || 0;
}
=head2 schema_version
This is an overwritable method which is called just before the upgrade, to
allow you to make a backup of the database. Per default this method attempts
to call C<< $self->storage->backup >>, to run the standard backup on each
-database type.
+database type.
This method should return the name of the backup file, if appropriate..
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 argument like so:
+To avoid the checks on connect, set the environment 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,
sub connection {
my $self = shift;
$self->next::method(@_);
- $self->_on_connect($_[3]);
+ $self->_on_connect();
return $self;
}
sub _on_connect
{
- my ($self, $args) = @_;
+ my ($self) = @_;
- $args = {} unless $args;
+ my $conn_info = $self->storage->connect_info;
+ $self->{vschema} = DBIx::Class::Version->connect(@$conn_info);
+ my $conn_attrs = $self->{vschema}->storage->_dbic_connect_attributes || {};
- $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}));
+ return if ($conn_attrs->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $conn_attrs->{ignore_version}));
# check for legacy versions table and move to new if exists
- my $vschema_compat = DBIx::Class::VersionCompat->connect(@{$self->storage->connect_info()});
unless ($self->_source_exists($vtable)) {
- my $vtable_compat = $vschema_compat->resultset('TableCompat');
+ my $vtable_compat = DBIx::Class::VersionCompat->connect(@$conn_info)->resultset('TableCompat');
if ($self->_source_exists($vtable_compat)) {
$self->{vschema}->deploy;
map { $vtable->create({ installed => $_->Installed, version => $_->Version }) } $vtable_compat->all;
- $self->storage->dbh->do("DROP TABLE " . $vtable_compat->result_source->from);
+ $self->storage->_get_dbh->do("DROP TABLE " . $vtable_compat->result_source->from);
}
}
if($pversion eq $self->schema_version)
{
-# carp "This version is already installed\n";
+ #carp "This version is already installed";
return 1;
}
if(!$pversion)
{
- carp "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.";
return 1;
}
- carp "Versions out of sync. This is " . $self->schema_version .
- ", your database contains version $pversion, please call upgrade on your Schema.\n";
+ carp "Versions out of sync. This is " . $self->schema_version .
+ ", your database contains version $pversion, please call upgrade on your Schema.";
}
# is this just a waste of time? if not then merge with DBI.pm
return;
}
- $self->throw_exception($self->storage->_sqlt_version_error)
- if (not $self->storage->_sqlt_version_ok);
+ unless (DBIx::Class::Optional::Dependencies->req_ok_for ('deploy')) {
+ $self->throw_exception("Unable to proceed without " . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') );
+ }
my $db_tr = SQL::Translator->new({
add_drop_table => 1,
$tr->parser->($tr, $$data);
}
- my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
+ my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
$dbic_tr->schema, $db,
{ ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
print $file $diff;
close($file);
- 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";
+ 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.";
}
# This is necessary since there are legitimate cases when upgrades can happen
# back to back within the same second. This breaks things since we relay on the
# ability to sort by the 'installed' value. The logical choice of an autoinc
- # is not possible, as it will break multiple legacy installations. Also it is
+ # is not possible, as it will break multiple legacy installations. Also it is
# not possible to format the string sanely, as the column is a varchar(20).
# The 'v' character is added to the front of the string, so that any version
# formatted by this new function will sort _after_ any existing 200... strings.
my @tm = gettimeofday();
my @dt = gmtime ($tm[0]);
- my $o = $vtable->create({
+ my $o = $vtable->create({
version => $version,
installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f",
$dt[5] + 1900,
$dt[2],
$dt[1],
$dt[0],
- $tm[1] / 1000, # convert to millisecs, format as up/down rounded int above
+ int($tm[1] / 1000), # convert to millisecs
),
});
}
my $self = shift;
my $file = shift || return;
- my $fh;
- open $fh, "<$file" or carp("Can't open upgrade file, $file ($!)");
- my @data = split(/\n/, join('', <$fh>));
- @data = grep(!/^--/, @data);
- @data = split(/;/, join('', @data));
- close($fh);
- @data = grep { $_ && $_ !~ /^-- / } @data;
- @data = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @data;
+ open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)");
+ my @data = split /\n/, join '', <$fh>;
+ close $fh;
+
+ @data = split /;/,
+ join '',
+ grep { $_ &&
+ !/^--/ &&
+ !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/mi }
+ @data;
+
return \@data;
}
{
my ($self, $rs) = @_;
- my $c = eval {
- $rs->search({ 1, 0 })->count;
+ return try {
+ $rs->search(\'1=0')->cursor->next;
+ 1;
+ } catch {
+ 0;
};
- return 0 if $@ || !defined $c;
-
- return 1;
}
1;
-=head1 AUTHORS
+=head1 AUTHOR AND CONTRIBUTORS
-Jess Robinson <castaway@desert-island.me.uk>
-Luke Saunders <luke@shadowcatsystems.co.uk>
+See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
=head1 LICENSE
projects / dbsrgits/DBIx-Class.git / blobdiff