__PACKAGE__->mk_classdata('_filedata');
__PACKAGE__->mk_classdata('upgrade_directory');
__PACKAGE__->mk_classdata('backup_directory');
+__PACKAGE__->mk_classdata('do_backup');
sub schema_version {
my ($self) = @_;
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()});
+
+ my $pversion = $self->get_db_version();
- if(!$self->_source_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->schema_version)
{
warn "This version is already installed\n";
return 1;
}
-## use IC::DT?
-
if(!$pversion)
{
- $vtable->create({ Version => $self->schema_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;
}
return 1;
}
- $file = $self->ddl_filename(
- $self->storage->sqlt_type,
- $self->upgrade_directory,
- $self->schema_version,
- $pversion,
- );
-# $file =~ s/@{[ $self->schema_version ]}/"${pversion}-" . $self->schema_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->schema_version .
", your database contains version $pversion, please call upgrade on your Schema.\n";
-# $self->upgrade($pversion, $self->schema_version);
+}
+
+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
sub upgrade
{
my ($self) = @_;
+ my $db_version = $self->get_db_version();
- ## overridable sub, per default just run all the commands.
+ if (!$db_version) {
+ my %driver_to_db_map = (
+ 'mysql' => 'MySQL',
+ 'Pg' => 'PostgreSQL',
+ 'Oracle' => 'Oracle'
+ );
+ 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,
+ { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
+
+ my $filename = $self->ddl_filename(
+ $self->storage->sqlt_type,
+ $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 {
+ my $file = $self->ddl_filename(
+ $self->storage->sqlt_type,
+ $self->upgrade_directory,
+ $self->schema_version,
+ $db_version,
+ );
- $self->backup();
+ 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);
+ $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())
+ });
+
+}
+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->schema_version,
- Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
- });
}
-
sub run_upgrade
{
my ($self, $stm) = @_;
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<backup> is called from C<upgrade>, make sure you call it, if you write your
-own <upgrade> 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<run_upgrade>
any number of times to run the actual SQL commands, and in between you can
use warnings;
use Test::More;
use File::Spec;
+use File::Copy;
BEGIN {
eval "use DBD::SQLite; use SQL::Translator 0.08;";
{ AutoCommit => 1 },
);
-unlink('t/var/DBICVersion-Schema-2.0-SQLite.sql');
-unlink('t/var/DBICVersion-Schema-1.0-2.0-SQLite.sql');
-$schema_new->create_ddl_dir('SQLite', undef, 't/var', '1.0');
-ok(-f 't/var/DBICVersion-Schema-1.0-2.0-SQLite.sql', 'Created DDL upgrade file');
-
## create new to pick up filedata for upgrade files we just made (on_connect)
-my $schema_upgrade = DBICVersion::Schema->connect(
- "dbi:SQLite:$db_file",
- undef,
- undef,
- { AutoCommit => 1 },
-);
-## do this here or let Versioned.pm do it?
-$schema_upgrade->upgrade();
-$tvrs = $schema_upgrade->resultset('Table');
-is($schema_upgrade->_source_exists($tvrs), 1, 'Upgraded schema from DDL file');
+# {
+# unlink('t/var/DBICVersion-Schema-1.0-2.0-SQLite.sql');
+# copy('t/var/DBICVersion-Schema-1.0-2.0-SQLite-erroneous.sql', 't/var/DBICVersion-Schema-1.0-2.0-SQLite.sql');
+
+# my $schema_upgrade = DBICVersion::Schema->connect(
+# "dbi:SQLite:$db_file",
+# undef,
+# undef,
+# { AutoCommit => 1 },
+# );
+
+
+# is($schema_upgrade->get_db_version(), '1.0', 'get_db_version ok');
+
+# eval {
+# # this will die with errors
+# $schema_upgrade->upgrade();
+# };
+# isnt($@, '', 'dodgy upgrade dies');
+
+# eval {
+# my @results = $schema_upgrade->storage->dbh->do('select VersionName from TestVersion');
+# };
+# is($@, '', 'partial upgrade properly rolledback');
+# is($schema_upgrade->get_db_version(), '1.0', 'db version number not upgraded');
+# }
+
+{
+ unlink('t/var/DBICVersion-Schema-2.0-SQLite.sql');
+ unlink('t/var/DBICVersion-Schema-1.0-2.0-SQLite.sql');
+
+# $schema_new->create_ddl_dir('SQLite', undef, 't/var', '1.0');
+# ok(-f 't/var/DBICVersion-Schema-1.0-2.0-SQLite.sql', 'Created DDL upgrade file');
+
+ copy('t/var/DBICVersion-Schema-1.0-2.0-SQLite-proper.sql', 't/var/DBICVersion-Schema-1.0-2.0-SQLite.sql');
+
+ my $schema_upgrade = DBICVersion::Schema->connect(
+ "dbi:SQLite:$db_file",
+ undef,
+ undef,
+ { AutoCommit => 1 },
+ );
+
+
+ is($schema_upgrade->get_db_version(), '1.0', 'get_db_version ok');
+
+ eval {
+ # this should be okay
+ $schema_upgrade->upgrade();
+ };
+ is($@, '', 'proper upgrade okay');
+ eval {
+ $schema_upgrade->storage->dbh->do('select NewVersionName from TestVersion');
+ };
+ is($@, '', 'new column created');
+ is($schema_upgrade->get_db_version(), '2.0', 'db version number successfully upgraded');
+}
+exit;
unlink($db_file) if -e $db_file;
unlink($db_file . "-journal") if -e $db_file . "-journal";
unlink('t/var/DBICVersion-Schema-1.0-SQLite.sql');
projects / dbsrgits/DBIx-Class.git / commitdiff