[Bast-commits] r3689 - in
DBIx-Class/0.08/branches/versioned_enhancements/lib:
DBIx/Class/Schema SQL/Translator/Parser/DBIx
captainL at dev.catalyst.perl.org
captainL at dev.catalyst.perl.org
Tue Aug 21 12:56:31 GMT 2007
Author: captainL
Date: 2007-08-21 12:56:31 +0100 (Tue, 21 Aug 2007)
New Revision: 3689
Modified:
DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/branches/versioned_enhancements/lib/SQL/Translator/Parser/DBIx/Class.pm
Log:
works well, we now just require a nice way to deploy the SchemaVersions table
Modified: DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Schema/Versioned.pm 2007-08-20 22:14:48 UTC (rev 3688)
+++ DBIx-Class/0.08/branches/versioned_enhancements/lib/DBIx/Class/Schema/Versioned.pm 2007-08-21 11:56:31 UTC (rev 3689)
@@ -72,37 +72,18 @@
{
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;
}
@@ -129,6 +110,8 @@
my ($self, $rs) = @_;
my $vtable = $self->{vschema}->resultset('Table');
+ return 0 unless ($self->_source_exists($vtable));
+
my $psearch = $vtable->search(undef,
{ select => [
{ 'max' => 'Installed' },
@@ -160,37 +143,111 @@
$self->storage->backup($self->backup_directory());
}
+sub _generate_db_schema
+{
+ my ($self) = @_;
+
+
+
+
+
+
+}
sub upgrade
{
my ($self) = @_;
+ my $db_version = $self->get_db_version();
- my $file = $self->ddl_filename(
+ 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 => {
+ dsn => 'dbi:mysql:dbname=takkle_test',
+ db_user => 'newtakkle',
+ db_password => 'takkle123'
+ }
+ });
+
+ $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('1');
+ $dbic_tr->schema->name('2');
+
+
+ # 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,
- $self->get_db_version,
+ 'PRE',
);
+ my $file;
+ if(!open($file, ">$filename"))
+ {
+ $self->throw_exception("Can't open $filename for writing ($!)");
+ next;
+ }
+ print $file $diff;
+ close($file);
-# $file =~ s/@{[ $self->schema_version ]}/"${pversion}-" . $self->schema_version/e;
- if(!-f $file)
- {
- warn "Upgrade not possible, no upgrade file found ($file)\n";
- return;
- }
+ print "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL $filename to sync your DB.\n";
+ } else {
+ my $file = $self->ddl_filename(
+ $self->storage->sqlt_type,
+ $self->upgrade_directory,
+ $self->schema_version,
+ $db_version,
+ );
- 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;
+ if(!-f $file)
+ {
+ warn "Upgrade not possible, no upgrade file found ($file)\n";
+ return;
+ }
- $self->_filedata(\@data);
- $self->backup() if($self->do_backup);
+ 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();
- });
+ $self->txn_do(sub {
+ $self->do_upgrade();
+ });
+ }
my $vtable = $self->{vschema}->resultset('Table');
$vtable->create({ Version => $self->schema_version,
Modified: DBIx-Class/0.08/branches/versioned_enhancements/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/versioned_enhancements/lib/SQL/Translator/Parser/DBIx/Class.pm 2007-08-20 22:14:48 UTC (rev 3688)
+++ DBIx-Class/0.08/branches/versioned_enhancements/lib/SQL/Translator/Parser/DBIx/Class.pm 2007-08-21 11:56:31 UTC (rev 3689)
@@ -158,15 +158,24 @@
)
{
$created_FK_rels{$rel_table}->{$key_test} = 1;
- $table->add_constraint(
- type => 'foreign_key',
- name => "fk_$keys[0]",
- fields => \@keys,
- reference_fields => \@refkeys,
- reference_table => $rel_table,
- on_delete => $on_delete,
- on_update => $on_update
- );
+ if (scalar(@keys)) {
+ $table->add_constraint(
+ type => 'foreign_key',
+ name => "fk_$keys[0]",
+ fields => \@keys,
+ reference_fields => \@refkeys,
+ reference_table => $rel_table,
+ on_delete => $on_delete,
+ on_update => $on_update
+ );
+
+ my $index = $table->add_index(
+ name => $table->name . "_fk_$keys[0]",
+ fields => \@keys,
+ type => 'NORMAL',
+ );
+ }
+
}
}
}
More information about the Bast-commits
mailing list