X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=e315b63448387a311d18ec120fa73e02a1972f98;hb=a705b1758c359438b683daa2c2b1e8cb5a3377da;hp=44e01722cdcd54923dd8124cbae78ad50bfcc16d;hpb=abc8f12a6852a8615a74d645bcd9b435f2e15e46;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 44e0172..e315b63 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -1,10 +1,9 @@ package # Hide from PAUSE DBIx::Class::Version::Table; -use base 'DBIx::Class'; +use base 'DBIx::Class::Core'; use strict; use warnings; -__PACKAGE__->load_components(qw/ Core/); __PACKAGE__->table('dbix_class_schema_versions'); __PACKAGE__->add_columns @@ -31,8 +30,7 @@ __PACKAGE__->set_primary_key('version'); package # Hide from PAUSE DBIx::Class::Version::TableCompat; -use base 'DBIx::Class'; -__PACKAGE__->load_components(qw/ Core/); +use base 'DBIx::Class::Core'; __PACKAGE__->table('SchemaVersions'); __PACKAGE__->add_columns @@ -70,12 +68,12 @@ DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades =head1 SYNOPSIS - package Library::Schema; + package MyApp::Schema; use base qw/DBIx::Class::Schema/; our $VERSION = 0.001; - # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD + # load MyApp::Schema::CD, MyApp::Schema::Book, MyApp::Schema::DVD __PACKAGE__->load_classes(qw/CD Book DVD/); __PACKAGE__->load_components(qw/Schema::Versioned/); @@ -180,9 +178,10 @@ package DBIx::Class::Schema::Versioned; use strict; use warnings; -use base 'DBIx::Class'; +use base 'DBIx::Class::Schema'; + +use Carp::Clan qw/^DBIx::Class/; use POSIX 'strftime'; -use Data::Dumper; __PACKAGE__->mk_classdata('_filedata'); __PACKAGE__->mk_classdata('upgrade_directory'); @@ -226,7 +225,7 @@ sub install # 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 @@ -235,7 +234,7 @@ sub install if ($new_version) { # create versions table and version row $self->{vschema}->deploy; - $self->_set_db_version; + $self->_set_db_version({ version => $new_version }); } } @@ -251,6 +250,27 @@ sub deploy { $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 @@ -271,13 +291,13 @@ sub upgrade # 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; } @@ -286,7 +306,7 @@ 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->schema_version, @@ -294,11 +314,15 @@ sub upgrade $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); @@ -367,7 +391,7 @@ differently. sub apply_statement { my ($self, $statement) = @_; - $self->storage->dbh->do($_) or warn "SQL was:\n $_"; + $self->storage->dbh->do($_) or carp "SQL was:\n $_"; } =head2 get_db_version @@ -446,9 +470,13 @@ sub _on_connect my ($self, $args) = @_; $args = {} unless $args; + $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})); + # 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)) { @@ -460,23 +488,21 @@ sub _on_connect } } - # 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"; } @@ -494,13 +520,11 @@ sub _create_db_to_schema_diff { 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 } }); @@ -508,7 +532,6 @@ sub _create_db_to_schema_diff { $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); @@ -540,15 +563,18 @@ sub _create_db_to_schema_diff { 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()) }); @@ -559,7 +585,7 @@ sub _read_sql_file { 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)); @@ -586,7 +612,7 @@ sub _source_exists =head1 AUTHORS -Jess Robinson +Jess Robinson Luke Saunders =head1 LICENSE