[Bast-commits] r4554 - in DBIx-Class/0.08/trunk: lib/DBIx/Class
lib/DBIx/Class/Schema lib/DBIx/Class/Storage t
lukes at dev.catalyst.perl.org
lukes at dev.catalyst.perl.org
Fri Jul 4 13:03:51 BST 2008
Author: lukes
Date: 2008-07-04 13:03:51 +0100 (Fri, 04 Jul 2008)
New Revision: 4554
Modified:
DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/trunk/t/94versioning.t
Log:
made versioning overwrite ddl and diff files where appropriate and made arg order of ddl_filename consistent with create_ddl_filename
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema/Versioned.pm 2008-07-03 23:52:31 UTC (rev 4553)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema/Versioned.pm 2008-07-04 12:03:51 UTC (rev 4554)
@@ -248,8 +248,8 @@
my $filename = $self->ddl_filename(
$db,
+ $self->schema_version,
$self->upgrade_directory,
- $self->schema_version,
'PRE',
);
my $file;
@@ -304,8 +304,8 @@
my $upgrade_file = $self->ddl_filename(
$self->storage->sqlt_type,
+ $self->schema_version,
$self->upgrade_directory,
- $self->schema_version,
$db_version,
);
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema.pm 2008-07-03 23:52:31 UTC (rev 4553)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema.pm 2008-07-04 12:03:51 UTC (rev 4554)
@@ -1105,11 +1105,11 @@
=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<create_ddl_dir> to compose a file name out of
the supplied directory, database type and version number. The default file
@@ -1121,14 +1121,14 @@
=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)
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2008-07-03 23:52:31 UTC (rev 4553)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2008-07-04 12:03:51 UTC (rev 4554)
@@ -1450,12 +1450,10 @@
=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 @@
$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);
}
}
Modified: DBIx-Class/0.08/trunk/t/94versioning.t
===================================================================
--- DBIx-Class/0.08/trunk/t/94versioning.t 2008-07-03 23:52:31 UTC (rev 4553)
+++ DBIx-Class/0.08/trunk/t/94versioning.t 2008-07-04 12:03:51 UTC (rev 4554)
@@ -27,11 +27,11 @@
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 @@
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 @@
$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');
}
{
More information about the Bast-commits
mailing list