X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=e5493ce7c2870ed1dc0f05672d10c1eca8885cf2;hb=3b9c0e6a15fe8b0838194a0f96d6fc2d098c9d7d;hp=755d88101a5eb261a9d73890e23107dde48bd143;hpb=e6129e560889691e4395d8c78835c2c8ace15c76;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 755d881..e5493ce 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -48,6 +48,7 @@ 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) = @_; @@ -71,37 +72,18 @@ sub _on_connect { my ($self) = @_; $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); - my $vtable = $self->{vschema}->resultset('Table'); - my $pversion; - if(!$self->_source_exists($vtable)) - { -# $self->{vschema}->storage->debug(1); - $self->{vschema}->storage->ensure_connected(); - $self->{vschema}->deploy(); - $pversion = 0; - } - else - { - $pversion = $self->get_db_version(); - } -# warn("Previous version: $pversion\n"); + 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->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; } @@ -116,33 +98,11 @@ sub _on_connect 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 @@ -150,13 +110,15 @@ 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; - $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'), + my $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'), })->first; $pversion = $pversion->Version if($pversion); return $pversion; @@ -184,14 +146,106 @@ sub backup 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; + } - $self->backup(); - $self->do_upgrade(); + 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()) }); + } sub do_upgrade