X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=99e2e5a370b095ea06b3caf82f03e93c1a597c69;hb=b7e303a8b3f93ecfbb959b2c7504b2b1cc707cac;hp=6ab73e42959a617dd83084ead945139ae50e709e;hpb=e2c0df8e0b707050eb005ac6f68548f857a36acf;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 6ab73e4..99e2e5a 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -6,16 +6,16 @@ use warnings; __PACKAGE__->load_components(qw/ Core/); __PACKAGE__->table('SchemaVersions'); -__PACKAGE__->add_columns - ( 'Version' => { - 'data_type' => 'VARCHAR', - 'is_auto_increment' => 0, - 'default_value' => undef, - 'is_foreign_key' => 0, - 'name' => 'Version', - 'is_nullable' => 0, - 'size' => '10' - }, +__PACKAGE__->add_columns( + 'Version' => { + 'data_type' => 'VARCHAR', + 'is_auto_increment' => 0, + 'default_value' => undef, + 'is_foreign_key' => 0, + 'name' => 'Version', + 'is_nullable' => 0, + 'size' => '10' + }, 'Installed' => { 'data_type' => 'VARCHAR', 'is_auto_increment' => 0, @@ -24,8 +24,8 @@ __PACKAGE__->add_columns 'name' => 'Installed', 'is_nullable' => 0, 'size' => '20' - }, - ); + }, +); __PACKAGE__->set_primary_key('Version'); package DBIx::Class::Version; @@ -47,57 +47,50 @@ use Data::Dumper; __PACKAGE__->mk_classdata('_filedata'); __PACKAGE__->mk_classdata('upgrade_directory'); +__PACKAGE__->mk_classdata('backup_directory'); +__PACKAGE__->mk_classdata('do_backup'); + +sub schema_version { + my ($self) = @_; + my $class = ref($self)||$self; + my $version; + { + no strict 'refs'; + $version = ${"${class}::VERSION"}; + } + return $version; +} + +sub connection { + my $self = shift; + $self->next::method(@_); + $self->_on_connect; + return $self; +} -sub on_connect +sub _on_connect { my ($self) = @_; - my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); - my $vtable = $vschema->resultset('Table'); - my $pversion; + $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); - if(!$self->exists($vtable)) - { -# $vschema->storage->debug(1); - $vschema->storage->ensure_connected(); - $vschema->deploy(); - $pversion = 0; - } - else - { - my $psearch = $vtable->search(undef, - { select => [ - { 'max' => 'Installed' }, - ], - as => ['maxinstall'], - })->first; - $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'), - })->first; - $pversion = $pversion->Version if($pversion); - } -# warn("Previous version: $pversion\n"); - if($pversion eq $self->VERSION) + my $pversion = $self->get_db_version(); + + if($pversion eq $self->schema_version) { warn "This version is already installed\n"; return 1; } -## use IC::DT? - if(!$pversion) { - $vtable->create({ Version => $self->VERSION, - Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) - }); - ## If we let the user do this, where does the Version table get updated? - warn "No previous version found, calling deploy to install this version.\n"; - $self->deploy(); + warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n"; return 1; } my $file = $self->ddl_filename( $self->storage->sqlt_type, $self->upgrade_directory, - $self->VERSION + $self->schema_version ); if(!$file) { @@ -105,36 +98,33 @@ sub on_connect return 1; } - $file = $self->ddl_filename( - $self->storage->sqlt_type, - $self->upgrade_directory, - $self->VERSION, - $pversion, - ); -# $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e; - if(!-f $file) - { - warn "Upgrade not possible, no upgrade file found ($file)\n"; - return; - } - - my $fh; - open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)"); - my @data = split(/;\n/, join('', <$fh>)); - close($fh); - @data = grep { $_ && $_ !~ /^-- / } @data; - @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data; - - $self->_filedata(\@data); ## Don't do this yet, do only on command? ## If we do this later, where does the Version table get updated?? - warn "Versions out of sync. This is " . $self->VERSION . + warn "Versions out of sync. This is " . $self->schema_version . ", your database contains version $pversion, please call upgrade on your Schema.\n"; -# $self->upgrade($pversion, $self->VERSION); } -sub exists +sub get_db_version +{ + my ($self, $rs) = @_; + + my $vtable = $self->{vschema}->resultset('Table'); + return 0 unless ($self->_source_exists($vtable)); + + my $psearch = $vtable->search(undef, + { select => [ + { 'max' => 'Installed' }, + ], + as => ['maxinstall'], + })->first; + my $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'), + })->first; + $pversion = $pversion->Version if($pversion); + return $pversion; +} + +sub _source_exists { my ($self, $rs) = @_; @@ -150,32 +140,127 @@ sub backup { my ($self) = @_; ## Make each ::DBI::Foo do this - $self->storage->backup(); + $self->storage->backup($self->backup_directory()); } +# TODO: some of this needs to be merged with ->create_ddl_dir sub upgrade { my ($self) = @_; + my $db_version = $self->get_db_version(); + + my %driver_to_db_map = ( + 'mysql' => 'MySQL' + ); + if (!$db_version) { + my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}}; + unless ($db) { + print "Sorry, this is an unsupported DB\n"; + return; + } + + require SQL::Translator; + require SQL::Translator::Diff; + 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); + + $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, + { caseopt => 1 }); + + 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); + + # create versions table + $self->{vschema}->deploy; + + 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"; + } else { + if ($db_version eq $self->schema_version) { + print "Upgrade not necessary\n"; + return; + } - ## overridable sub, per default just run all the commands. + my $file = $self->ddl_filename( + $self->storage->sqlt_type, + $self->upgrade_directory, + $self->schema_version, + $db_version, + ); + + if(!-f $file) + { + warn "Upgrade not possible, no upgrade file found ($file)\n"; + 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; + + $self->_filedata(\@data); + $self->backup() if($self->do_backup); + + $self->txn_do(sub { + $self->do_upgrade(); + }); + } + + my $vtable = $self->{vschema}->resultset('Table'); + $vtable->create({ Version => $self->schema_version, + Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) + }); - $self->backup(); +} + +sub do_upgrade +{ + my ($self) = @_; + ## overridable sub, per default just run all the commands. $self->run_upgrade(qr/create/i); $self->run_upgrade(qr/alter table .*? add/i); $self->run_upgrade(qr/alter table .*? (?!drop)/i); $self->run_upgrade(qr/alter table .*? drop/i); $self->run_upgrade(qr/drop/i); -# $self->run_upgrade(qr//i); - - my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); - my $vtable = $vschema->resultset('Table'); - $vtable->create({ Version => $self->VERSION, - Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) - }); } - sub run_upgrade { my ($self, $stm) = @_; @@ -186,9 +271,9 @@ sub run_upgrade for (@statements) { - $self->storage->debugfh->print("$_\n") if $self->storage->debug; -# print "Running \n>>$_<<\n"; + $self->storage->debugobj->query_start($_) if $self->storage->debug; $self->storage->dbh->do($_) or warn "SQL was:\n $_"; + $self->storage->debugobj->query_end($_) if $self->storage->debug; } return 1; @@ -198,7 +283,7 @@ sub run_upgrade =head1 NAME -DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades +DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades =head1 SYNOPSIS @@ -209,6 +294,7 @@ DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/); __PACKAGE__->upgrade_directory('/path/to/upgrades/'); + __PACKAGE__->backup_directory('/path/to/backups/'); sub backup { @@ -247,6 +333,11 @@ in L. Return a false value if there is no upgrade path between the two versions supplied. By default, every change in your VERSION is regarded as needing an upgrade. +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. + NB: At the moment, SQLite upgrading is rather spotty, as SQL::Translator::Diff returns SQL statements that SQLite does not support. @@ -260,13 +351,15 @@ 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. - -C is called from C, make sure you call it, if you write your -own method. +This method should return the name of the backup file, if appropriate.. =head2 upgrade +This is the main upgrade method which calls the overridable do_upgrade and +also handles the backups and updating of the SchemaVersion table. + +=head2 do_upgrade + This is an overwritable method used to run your upgrade. The freeform method allows you to run your upgrade any way you please, you can call C any number of times to run the actual SQL commands, and in between you can @@ -283,6 +376,21 @@ idea is that this method can be called any number of times from your C method, running whichever commands you specify via the regex in the parameter. +=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. + +=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 AUTHOR Jess Robinson