From: Luke Saunders Date: Fri, 4 Jul 2008 12:03:51 +0000 (+0000) Subject: made versioning overwrite ddl and diff files where appropriate and made arg order... X-Git-Tag: v0.08240~410 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=99a74c4ad4029a2fde7665d47cd444c041737c58;p=dbsrgits%2FDBIx-Class.git made versioning overwrite ddl and diff files where appropriate and made arg order of ddl_filename consistent with create_ddl_filename --- diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 195fd09..39bf2e8 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -1105,11 +1105,11 @@ sub create_ddl_dir { =over 4 -=item Arguments: $directory, $database-type, $version, $preversion +=item Arguments: $database-type, $version, $directory, $preversion =back - my $filename = $table->ddl_filename($type, $dir, $version, $preversion) + my $filename = $table->ddl_filename($type, $version, $dir, $preversion) This method is called by C to compose a file name out of the supplied directory, database type and version number. The default file @@ -1121,14 +1121,14 @@ format. =cut sub ddl_filename { - my ($self, $type, $dir, $version, $pversion) = @_; + my ($self, $type, $version, $dir, $preversion) = @_; - my $filename = ref($self); - $filename =~ s/::/-/g; - $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql"); - $filename =~ s/$version/$pversion-$version/ if($pversion); - - return $filename; + my $filename = ref($self); + $filename =~ s/::/-/g; + $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql"); + $filename =~ s/$version/$preversion-$version/ if($preversion); + + return $filename; } =head2 sqlt_deploy_hook($sqlt_schema) diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index fa403ea..877b841 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -248,8 +248,8 @@ sub _create_db_to_schema_diff { my $filename = $self->ddl_filename( $db, - $self->upgrade_directory, $self->schema_version, + $self->upgrade_directory, 'PRE', ); my $file; @@ -304,8 +304,8 @@ sub upgrade my $upgrade_file = $self->ddl_filename( $self->storage->sqlt_type, - $self->upgrade_directory, $self->schema_version, + $self->upgrade_directory, $db_version, ); diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index aeb0da1..9cfb860 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1450,12 +1450,10 @@ hashref like the following =cut -sub create_ddl_dir -{ +sub create_ddl_dir { my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_; - if(!$dir || !-d $dir) - { + if(!$dir || !-d $dir) { warn "No directory given, using ./\n"; $dir = "./"; } @@ -1478,97 +1476,89 @@ sub create_ddl_dir $sqlt->parser('SQL::Translator::Parser::DBIx::Class'); my $sqlt_schema = $sqlt->translate({ data => $schema }) or die $sqlt->error; - foreach my $db (@$databases) - { + foreach my $db (@$databases) { $sqlt->reset(); $sqlt = $self->configure_sqlt($sqlt, $db); $sqlt->{schema} = $sqlt_schema; $sqlt->producer($db); my $file; - my $filename = $schema->ddl_filename($db, $dir, $version); - if(-e $filename) - { - warn("$filename already exists, skipping $db"); - next unless ($preversion); - } else { - my $output = $sqlt->translate; - if(!$output) - { - warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")"); - next; - } - if(!open($file, ">$filename")) - { - $self->throw_exception("Can't open $filename for writing ($!)"); - next; - } - print $file $output; - close($file); - } - if($preversion) - { - require SQL::Translator::Diff; + my $filename = $schema->ddl_filename($db, $version, $dir); + if (-e $filename && (!$version || ($version == $schema->schema_version()))) { + # if we are dumping the current version, overwrite the DDL + warn "Overwriting existing DDL file - $filename"; + unlink($filename); + } - my $prefilename = $schema->ddl_filename($db, $dir, $preversion); -# print "Previous version $prefilename\n"; - if(!-e $prefilename) - { - warn("No previous schema file found ($prefilename)"); - next; - } + my $output = $sqlt->translate; + if(!$output) { + warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")"); + next; + } + if(!open($file, ">$filename")) { + $self->throw_exception("Can't open $filename for writing ($!)"); + next; + } + print $file $output; + close($file); + + next unless ($preversion); - my $difffile = $schema->ddl_filename($db, $dir, $version, $preversion); - print STDERR "Diff: $difffile: $db, $dir, $version, $preversion \n"; - if(-e $difffile) - { - warn("$difffile already exists, skipping"); - next; - } + require SQL::Translator::Diff; - my $source_schema; - { - my $t = SQL::Translator->new($sqltargs); - $t->debug( 0 ); - $t->trace( 0 ); - $t->parser( $db ) or die $t->error; - $t = $self->configure_sqlt($t, $db); - my $out = $t->translate( $prefilename ) or die $t->error; - $source_schema = $t->schema; - unless ( $source_schema->name ) { - $source_schema->name( $prefilename ); - } - } + my $prefilename = $schema->ddl_filename($db, $preversion, $dir); + if(!-e $prefilename) { + warn("No previous schema file found ($prefilename)"); + next; + } - # The "new" style of producers have sane normalization and can support - # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't - # And we have to diff parsed SQL against parsed SQL. - my $dest_schema = $sqlt_schema; - - unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) { - my $t = SQL::Translator->new($sqltargs); - $t->debug( 0 ); - $t->trace( 0 ); - $t->parser( $db ) or die $t->error; - $t = $self->configure_sqlt($t, $db); - my $out = $t->translate( $filename ) or die $t->error; - $dest_schema = $t->schema; - $dest_schema->name( $filename ) - unless $dest_schema->name; + my $difffile = $schema->ddl_filename($db, $version, $dir, $preversion); + if(-e $difffile) { + warn("Overwriting existing diff file - $difffile"); + unlink($difffile); + } + + my $source_schema; + { + my $t = SQL::Translator->new($sqltargs); + $t->debug( 0 ); + $t->trace( 0 ); + $t->parser( $db ) or die $t->error; + $t = $self->configure_sqlt($t, $db); + my $out = $t->translate( $prefilename ) or die $t->error; + $source_schema = $t->schema; + unless ( $source_schema->name ) { + $source_schema->name( $prefilename ); } + } - my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db, - $dest_schema, $db, - $sqltargs - ); - if(!open $file, ">$difffile") - { - $self->throw_exception("Can't write to $difffile ($!)"); - next; - } - print $file $diff; - close($file); + # The "new" style of producers have sane normalization and can support + # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't + # And we have to diff parsed SQL against parsed SQL. + my $dest_schema = $sqlt_schema; + + unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) { + my $t = SQL::Translator->new($sqltargs); + $t->debug( 0 ); + $t->trace( 0 ); + $t->parser( $db ) or die $t->error; + $t = $self->configure_sqlt($t, $db); + my $out = $t->translate( $filename ) or die $t->error; + $dest_schema = $t->schema; + $dest_schema->name( $filename ) + unless $dest_schema->name; + } + + my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db, + $dest_schema, $db, + $sqltargs + ); + if(!open $file, ">$difffile") { + $self->throw_exception("Can't write to $difffile ($!)"); + next; } + print $file $diff; + close($file); } } diff --git a/t/94versioning.t b/t/94versioning.t index 5b1e603..0538f84 100644 --- a/t/94versioning.t +++ b/t/94versioning.t @@ -27,11 +27,11 @@ my $old_table_name = 'SchemaVersions'; use lib qw(t/lib); use_ok('DBICVersionOrig'); -my $schema_orig = DBICVersion::Schema->connect($dsn, $user, $pass); +my $schema_orig = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); eval { $schema_orig->storage->dbh->do('drop table ' . $version_table_name) }; eval { $schema_orig->storage->dbh->do('drop table ' . $old_table_name) }; -is($schema_orig->ddl_filename('MySQL', 't/var', '1.0'), File::Spec->catfile('t', 'var', 'DBICVersion-Schema-1.0-MySQL.sql'), 'Filename creation working'); +is($schema_orig->ddl_filename('MySQL', '1.0', 't/var'), File::Spec->catfile('t', 'var', 'DBICVersion-Schema-1.0-MySQL.sql'), 'Filename creation working'); unlink('t/var/DBICVersion-Schema-1.0-MySQL.sql') if (-e 't/var/DBICVersion-Schema-1.0-MySQL.sql'); $schema_orig->create_ddl_dir('MySQL', undef, 't/var'); @@ -47,7 +47,7 @@ eval "use DBICVersionNew"; unlink('t/var/DBICVersion-Schema-2.0-MySQL.sql'); unlink('t/var/DBICVersion-Schema-1.0-2.0-MySQL.sql'); - my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass); + my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); is($schema_upgrade->get_db_version(), '1.0', 'get_db_version ok'); is($schema_upgrade->schema_version, '2.0', 'schema version ok'); $schema_upgrade->create_ddl_dir('MySQL', '2.0', 't/var', '1.0'); @@ -59,6 +59,9 @@ eval "use DBICVersionNew"; $schema_upgrade->storage->dbh->do('select NewVersionName from TestVersion'); }; is($@, '', 'new column created'); + + # should overwrite files + $schema_upgrade->create_ddl_dir('MySQL', '2.0', 't/var', '1.0'); } {