initial cut at install_resultsource (and therefore install_version_storage)
Arthur Axel 'fREW' Schmidt [Tue, 30 Mar 2010 01:05:43 +0000 (20:05 -0500)]
lib/DBIx/Class/DeploymentHandler.pm
lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
lib/DBIx/Class/DeploymentHandler/HandlesDeploy.pm
lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm
t/version_storages/standard.t

index 093ea62..389d6e1 100644 (file)
@@ -10,6 +10,22 @@ with 'DBIx::Class::DeploymentHandler::WithSqltDeployMethod',
      'DBIx::Class::DeploymentHandler::WithStandardVersionStorage';
 with 'DBIx::Class::DeploymentHandler::WithReasonableDefaults';
 
+sub prepare_version_storage_install {
+  my $self = shift;
+
+  $self->prepare_resultsource_install(
+    $self->version_storage->version_rs->result_source
+  );
+}
+
+sub install_version_storage {
+  my $self = shift;
+
+  $self->install_resultsource(
+    $self->version_storage->version_rs->result_source
+  );
+}
+
 __PACKAGE__->meta->make_immutable;
 
 1;
index 23081ab..2ff2375 100644 (file)
@@ -142,6 +142,7 @@ method _run_sql_and_perl($filenames) {
   my @files = @{$filenames};
   my $storage = $self->storage;
 
+
   my $guard = $self->schema->txn_scope_guard if $self->txn_wrap;
 
   my $sql;
@@ -196,12 +197,13 @@ sub deploy {
   ));
 }
 
-sub prepare_install {
+sub _prepare_install {
   my $self = shift;
+  my $sqltargs  = { %{$self->sqltargs}, %{shift @_} };
+  my $to_file   = shift;
   my $schema    = $self->schema;
   my $databases = $self->databases;
   my $dir       = $self->upgrade_directory;
-  my $sqltargs  = $self->sqltargs;
   my $version = $schema->schema_version;
 
   my $sqlt = SQL::Translator->new({
@@ -220,7 +222,7 @@ sub prepare_install {
     $sqlt->{schema} = $sqlt_schema;
     $sqlt->producer($db);
 
-    my $filename = $self->_ddl_schema_produce_filename($db, $version, $dir);
+    my $filename = $self->$to_file($db, $version, $dir);
     if (-e $filename ) {
       carp "Overwriting existing DDL file - $filename";
       unlink $filename;
@@ -237,6 +239,47 @@ sub prepare_install {
   }
 }
 
+sub _resultsource_install_filename {
+  my ($self, $source_name) = @_;
+  return sub {
+    my ($self, $type, $version) = @_;
+    my $dirname = catfile( $self->upgrade_directory, $type, 'schema', $version );
+    mkpath($dirname) unless -d $dirname;
+
+    return catfile( $dirname, "001-auto-$source_name.sql" );
+  }
+}
+
+sub install_resultsource {
+  my ($self, $source, $version) = @_;
+
+  my $rs_install_file =
+    $self->_resultsource_install_filename($source->source_name);
+
+  my $files = [
+     $self->$rs_install_file(
+      $self->storage->sqlt_type,
+      $version,
+    )
+  ];
+  $self->_run_sql_and_perl($files);
+}
+
+sub prepare_resultsource_install {
+  my $self = shift;
+  my $source = shift;
+
+  my $filename = $self->_resultsource_install_filename($source->source_name);
+  $self->_prepare_install({
+      parser_args => { sources => [$source->source_name], }
+    }, $filename);
+}
+
+sub prepare_install {
+  my $self = shift;
+  $self->_prepare_install({}, '_ddl_schema_produce_filename');
+}
+
 sub prepare_upgrade {
   my ($self, $from_version, $to_version, $version_set) = @_;
   # for updates prepared automatically (rob's stuff)
index edc39ca..edb52e6 100644 (file)
@@ -2,6 +2,8 @@ package DBIx::Class::DeploymentHandler::HandlesDeploy;
 use Moose::Role;
 
 requires 'prepare_install';
+requires 'prepare_resultsource_install';
+requires 'install_resultsource';
 requires 'prepare_upgrade';
 requires 'prepare_downgrade';
 requires 'upgrade_single_step';
index 74c937b..8a36cf0 100644 (file)
@@ -26,6 +26,14 @@ around prepare_downgrade => sub {
   $self->$orig($from_version, $to_version, $version_set);
 };
 
+around install_resultsource => sub {
+  my $orig = shift;
+  my $self = shift;
+  my $source = shift;
+  my $version = shift || $self->to_version;
+
+  $self->$orig($source, $version);
+};
 
 1;
 
index f25a9cb..f714b6d 100644 (file)
@@ -7,6 +7,7 @@ use Test::Exception;
 use lib 't/lib';
 use DBICDHTest;
 use aliased 'DBIx::Class::DeploymentHandler::VersionStorage::Standard';
+use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
 
 use DBICVersion_v1;
 use DBIx::Class::DeploymentHandler;
@@ -24,26 +25,35 @@ my $s = DBICVersion::Schema->connect(@connection);
 
 DBICDHTest::ready;
 
-my $handler = DBIx::Class::DeploymentHandler->new({
+my $dm = Translator->new({
+       schema            => $s,
        upgrade_directory => $sql_dir,
-       schema => $s,
-       databases => 'SQLite',
-       sqltargs => { add_drop_table => 0 },
+       databases         => ['SQLite'],
+       sqltargs          => { add_drop_table => 0 },
 });
 
-$handler->prepare_install();
-
 my $vs = Standard->new({ schema => $s });
 
+$dm->prepare_resultsource_install(
+       $vs->version_rs->result_source
+);
+
 ok( $vs, 'DBIC::DH::VersionStorage::Standard instantiates correctly' );
 
 ok( !$vs->version_storage_is_installed, 'VersionStorage is not yet installed' );
 
-$handler->install();
+$dm->install_resultsource(
+       $vs->version_rs->result_source,
+       '1.0',
+);
 
 ok( $vs->version_storage_is_installed, 'VersionStorage is now installed' );
 
 
+$vs->add_database_version({
+       version => '1.0',
+});
+
 ok(
        eq_array(
                [ $vs->version_rs->search(undef, {order_by => 'id'})->get_column('version')->all],