X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=0874167b16d7e570c2eb02ed94e1250ed4d42913;hb=d4daee7b54e38e4b3d3d0a77759bddc1a4ede6e5;hp=e264f22de05c0d48c8e345157b00a2715b0a9cd3;hpb=e7b14c5bf2b238d32fc22dbf8450eb4b01ace466;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index e264f22..0874167 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -70,48 +70,109 @@ DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades =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 -classes, to enable them to upgrade to newer schema layouts. To use this -module, you need to have called C 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. A table called I 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 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 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. 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. - -=head1 METHODS +enhancing them. Ask on the mailing list or IRC channel for details (community details +in L). + +=head1 GETTING STARTED + +Firstly you need to setup your schema class as per the L, make sure +you have specified an upgrade_directory and an initial $VERSION. + +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: + + use strict; + use Pod::Usage; + use Getopt::Long; + use MyApp::Schema; + + my ( $preversion, $help ); + GetOptions( + 'p|preversion:s' => \$preversion, + ) or die pod2usage; + + 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 ); + +Then your upgrade script might look like so: + + use strict; + use MyApp::Schema; + + my $schema = MyApp::Schema->connect( + $dsn, + $user, + $password, + ); + + if (!$schema->get_db_version()) { + # schema is unversioned + $schema->deploy(); + } else { + $schema->upgrade(); + } -=head2 upgrade_directory +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) 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"); + } -Use this to set the directory your upgrade files are stored in. + # this will now apply the 0.000 to current version diff + $schema->upgrade(); -=head2 backup_directory - -Use this to set the directory you want your backups stored in. +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 @@ -120,8 +181,9 @@ package DBIx::Class::Schema::Versioned; 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'); @@ -129,146 +191,98 @@ __PACKAGE__->mk_classdata('backup_directory'); __PACKAGE__->mk_classdata('do_backup'); __PACKAGE__->mk_classdata('do_diff_on_init'); -=head2 schema_version -Returns the current schema class' $VERSION; does -not- use $schema->VERSION -since that varies in results depending on if version.pm is installed, and if -so the perl or XS versions. If you want this to change, bug the version.pm -author to make vpp and vxs behave the same. +=head1 METHODS -=cut +=head2 upgrade_directory -sub schema_version { - my ($self) = @_; - my $class = ref($self)||$self; - my $version; - { - no strict 'refs'; - $version = ${"${class}::VERSION"}; - } - return $version; -} +Use this to set the directory your upgrade files are stored in. -=head2 get_db_version +=head2 backup_directory -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. +Use this to set the directory you want your backups stored in (note that backups +are disabled by default). =cut -sub 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; - }; - return $version; -} +=head2 install -sub _source_exists -{ - my ($self, $rs) = @_; +=over 4 - my $c = eval { - $rs->search({ 1, 0 })->count; - }; - return 0 if $@ || !defined $c; +=item Arguments: $db_version - return 1; -} +=back -=head2 backup +Call this to initialise a previously unversioned database. The table 'dbix_class_schema_versions' will be created which will be used to store the database 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. +Takes one argument which should be the version that the database is currently at. Defaults to the return value of L. -This method should return the name of the backup file, if appropriate.. +See L for more details. =cut -sub backup +sub install { - my ($self) = @_; - ## Make each ::DBI::Foo do this - $self->storage->backup($self->backup_directory()); -} + my ($self, $new_version) = @_; -# is this just a waste of time? if not then merge with DBI.pm -sub _create_db_to_schema_diff { - my $self = shift; + # must be called on a fresh database + if ($self->get_db_version()) { + carp 'Install not possible as versions table already exists in database'; + } - my %driver_to_db_map = ( - 'mysql' => 'MySQL' - ); + # default to current version if none passed + $new_version ||= $self->schema_version(); - my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}}; - unless ($db) { - print "Sorry, this is an unsupported DB\n"; - return; + if ($new_version) { + # create versions table and version row + $self->{vschema}->deploy; + $self->_set_db_version({ version => $new_version }); } +} - eval 'require SQL::Translator "0.09"'; - if ($@) { - $self->throw_exception("SQL::Translator 0.09 required"); - } +=head2 deploy - my $db_tr = SQL::Translator->new({ - add_drop_table => 1, - parser => 'DBI', - parser_args => { dbh => $self->storage->dbh } - }); +Same as L but also calls C. - $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); +=cut - $db_tr->schema->name('db_schema'); - $dbic_tr->schema->name('dbic_schema'); +sub deploy { + my $self = shift; + $self->next::method(@_); + $self->install(); +} - # is this really necessary? - foreach my $tr ($db_tr, $dbic_tr) { - my $data = $tr->data; - $tr->parser->($tr, $$data); - } +=head2 create_upgrade_path - 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 }); +=over 4 - my $filename = $self->ddl_filename( - $db, - $self->upgrade_directory, - $self->schema_version, - 'PRE', - ); - my $file; - if(!open($file, ">$filename")) - { - $self->throw_exception("Can't open $filename for writing ($!)"); - next; - } - print $file $diff; - close($file); +=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. - 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"; +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 $schema->upgrade_directory, normally you will -have created this using $schema->create_ddl_dir. +It requires an SQL diff file to exist in you I, normally you will +have created this using L. + +If successful the dbix_class_schema_versions table is updated with the current +DBIC schema version. =cut @@ -279,18 +293,13 @@ sub upgrade # db unversioned unless ($db_version) { - # set version in dbix_class_schema_versions table, can't actually upgrade as we don 't know what version the DB is at - $self->_create_db_to_schema_diff() if ($self->do_diff_on_init); - - # create versions table and version row - $self->{vschema}->deploy; - $self->_set_db_version; + 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; } @@ -299,19 +308,23 @@ sub upgrade # here to be sure. # XXX - just fix it $self->storage->sqlt_type; - + my $upgrade_file = $self->ddl_filename( $self->storage->sqlt_type, - $self->upgrade_directory, $self->schema_version, + $self->upgrade_directory, $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); @@ -321,31 +334,6 @@ sub upgrade $self->_set_db_version; } -sub _set_db_version { - my $self = shift; - - my $vtable = $self->{vschema}->resultset('Table'); - $vtable->create({ version => $self->schema_version, - installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) - }); - -} - -sub _read_sql_file { - my $self = shift; - my $file = shift || return; - - my $fh; - open $fh, "<$file" or warn("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 TRANACTION|COMMIT)/m } @data; - return \@data; -} - =head2 do_upgrade This is an overwritable method used to run your upgrade. The freeform method @@ -371,7 +359,7 @@ sub do_upgrade 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 method, running whichever commands you specify via the +C method, running whichever commands you specify via the regex in the parameter. Probably won't work unless called from the overridable do_upgrade method. @@ -388,13 +376,72 @@ sub run_upgrade 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 C and C write to. + +=cut + +sub 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; + }; + return $version; +} + +=head2 schema_version + +Returns the current schema class' $VERSION + +=cut + +=head2 backup + +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. + +This method should return the name of the backup file, if appropriate.. + +This method is disabled by default. Set $schema->do_backup(1) to enable it. + +=cut + +sub backup +{ + my ($self) = @_; + ## Make each ::DBI::Foo do this + $self->storage->backup($self->backup_directory()); +} + =head2 connection Overloaded method. This checks the DBIC schema version against the DB version and @@ -402,21 +449,29 @@ warns if they are not the same or if the DB is unversioned. It also provides 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. This can be -useful for scripts. +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, + $user, + $password, + { ignore_version => 1 }, + ); =cut sub connection { my $self = shift; $self->next::method(@_); - $self->_on_connect; + $self->_on_connect($_[3]); return $self; } sub _on_connect { - my ($self) = @_; + my ($self, $args) = @_; + + $args = {} unless $args; $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); my $vtable = $self->{vschema}->resultset('Table'); @@ -430,34 +485,136 @@ sub _on_connect $self->storage->dbh->do("DROP TABLE " . $vtable_compat->result_source->from); } } - + # useful when connecting from scripts etc - return if ($ENV{DBIC_NO_VERSION_CHECK}); - + 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"; } +# is this just a waste of time? if not then merge with DBI.pm +sub _create_db_to_schema_diff { + my $self = shift; + + my %driver_to_db_map = ( + 'mysql' => 'MySQL' + ); + + my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}}; + unless ($db) { + print "Sorry, this is an unsupported DB\n"; + return; + } + + eval 'require SQL::Translator "0.09003"'; + if ($@) { + $self->throw_exception("SQL::Translator 0.09003 required"); + } + + 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->data($self); + $dbic_tr->producer($db); + + $db_tr->schema->name('db_schema'); + $dbic_tr->schema->name('dbic_schema'); + + # is this really necessary? + foreach my $tr ($db_tr, $dbic_tr) { + my $data = $tr->data; + $tr->parser->($tr, $$data); + } + + 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 }); + + my $filename = $self->ddl_filename( + $db, + $self->schema_version, + $self->upgrade_directory, + 'PRE', + ); + my $file; + if(!open($file, ">$filename")) + { + $self->throw_exception("Can't open $filename for writing ($!)"); + next; + } + 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"; +} + + +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 => $version, + installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) + }); + +} + +sub _read_sql_file { + 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; + return \@data; +} + +sub _source_exists +{ + my ($self, $rs) = @_; + + my $c = eval { + $rs->search({ 1, 0 })->count; + }; + return 0 if $@ || !defined $c; + + return 1; +} + 1; =head1 AUTHORS -Jess Robinson +Jess Robinson Luke Saunders =head1 LICENSE