X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;h=0d232fd1762507a04e5949477a1c2fe8189189ce;hb=be140a5f1f8ab40705bf4cbedb74761c4994a765;hp=7d5f622ba067e4c0493715ba5b22d8ea5be6da46;hpb=5e3d0d5878429cfcf6760a17d5cd22d6e8a4aa2b;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git

diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index 7d5f622..0d232fd 100644
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -176,9 +176,9 @@ method _run_sql_and_perl($filenames) {
       my $fn = eval "$filedata";
       use warnings;
 
-		if ($@) {
+      if ($@) {
         carp "$filename failed to compile: $@";
-		} elsif (ref $fn eq 'CODE') {
+      } elsif (ref $fn eq 'CODE') {
         $fn->($self->schema)
       } else {
         carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
@@ -195,7 +195,7 @@ method _run_sql_and_perl($filenames) {
 
 sub deploy {
   my $self = shift;
-  my $version = shift || $self->schema_version;
+  my $version = (shift @_ || {})->{version} || $self->schema_version;
 
   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
     $self->storage->sqlt_type,
@@ -203,12 +203,14 @@ sub deploy {
   ));
 }
 
-sub preinstall_scripts {
-  my $self = shift;
-  my $version = shift || $self->schema_version;
+sub preinstall {
+  my $self         = shift;
+  my $args         = shift;
+  my $version      = $args->{version}      || $self->schema_version;
+  my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
 
   my @files = @{$self->_ddl_preinstall_consume_filenames(
-    $self->storage->sqlt_type,
+    $storage_type,
     $version,
   )};
 
@@ -217,13 +219,13 @@ sub preinstall_scripts {
     if ( $filename =~ /^(.+)\.pl$/ ) {
       my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 
-		no warnings 'redefine';
+      no warnings 'redefine';
       my $fn = eval "$filedata";
       use warnings;
 
-		if ($@) {
+      if ($@) {
         carp "$filename failed to compile: $@";
-		} elsif (ref $fn eq 'CODE') {
+      } elsif (ref $fn eq 'CODE') {
         $fn->()
       } else {
         carp "$filename should define an anonymous sub but it didn't!";
@@ -288,8 +290,9 @@ sub _resultsource_install_filename {
 }
 
 sub install_resultsource {
-  my ($self, $source, $version) = @_;
-
+  my ($self, $args) = @_;
+  my $source          = $args->{result_source};
+  my $version         = $args->{version};
   my $rs_install_file =
     $self->_resultsource_install_filename($source->source_name);
 
@@ -304,7 +307,7 @@ sub install_resultsource {
 
 sub prepare_resultsource_install {
   my $self = shift;
-  my $source = shift;
+  my $source = (shift @_)->{result_source};
 
   my $filename = $self->_resultsource_install_filename($source->source_name);
   $self->_prepare_install({
@@ -318,14 +321,17 @@ sub prepare_deploy {
 }
 
 sub prepare_upgrade {
-  my ($self, $from_version, $to_version, $version_set) = @_;
-  $self->_prepare_changegrade($from_version, $to_version, $version_set, 'up');
+  my ($self, $args) = @_;
+  $self->_prepare_changegrade(
+    $args->{from_version}, $args->{to_version}, $args->{version_set}, 'up'
+  );
 }
 
 sub prepare_downgrade {
-  my ($self, $from_version, $to_version, $version_set) = @_;
-
-  $self->_prepare_changegrade($from_version, $to_version, $version_set, 'down');
+  my ($self, $args) = @_;
+  $self->_prepare_changegrade(
+    $args->{from_version}, $args->{to_version}, $args->{version_set}, 'down'
+  );
 }
 
 method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
@@ -442,7 +448,7 @@ method _read_sql_file($file) {
 
 sub downgrade_single_step {
   my $self = shift;
-  my $version_set = shift @_;
+  my $version_set = (shift @_)->{version_set};
 
   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
     $self->storage->sqlt_type,
@@ -454,7 +460,7 @@ sub downgrade_single_step {
 
 sub upgrade_single_step {
   my $self = shift;
-  my $version_set = shift @_;
+  my $version_set = (shift @_)->{version_set};
 
   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
     $self->storage->sqlt_type,
@@ -493,7 +499,7 @@ like the best way to describe the layout is with the following example:
  $sql_migration_dir
  |- SQLite
  |  |- down
- |  |  `- 1-2
+ |  |  `- 2-1
  |  |     `- 001-auto.sql
  |  |- schema
  |  |  `- 1
@@ -505,14 +511,14 @@ like the best way to describe the layout is with the following example:
  |        `- 001-auto.sql
  |- _common
  |  |- down
- |  |  `- 1-2
+ |  |  `- 2-1
  |  |     `- 002-remove-customers.pl
  |  `- up
  |     `- 1-2
  |        `- 002-generate-customers.pl
  |- _generic
  |  |- down
- |  |  `- 1-2
+ |  |  `- 2-1
  |  |     `- 001-auto.sql
  |  |- schema
  |  |  `- 1
@@ -523,8 +529,12 @@ like the best way to describe the layout is with the following example:
  |        `- 002-create-stored-procedures.sql
  `- MySQL
     |- down
-    |  `- 1-2
+    |  `- 2-1
     |     `- 001-auto.sql
+    |- preinstall
+    |  `- 1
+    |     |- 001-create_database.pl
+    |     `- 002-create_users_and_permissions.pl
     |- schema
     |  `- 1
     |     `- 001-auto.sql
@@ -551,6 +561,13 @@ independent.
 C<_generic> exists for when you for some reason are sure that your SQL is
 generic enough to run on all databases.  Good luck with that one.
 
+Note that unlike most steps in the process, C<preinstall> will not run SQL, as
+there may not even be an database at preinstall time.  It will run perl scripts
+just like the other steps in the process, but nothing is passed to them.
+Until people have used this more it will remain freeform, but a recommended use
+of preinstall is to have it prompt for username and password, and then call the
+appropriate C<< CREATE DATABASE >> commands etc.
+
 =head1 PERL SCRIPTS
 
 A perl script for this tool is very simple.  It merely needs to contain an