X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-DeploymentHandler.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;h=32d4a0ea537fe2a26386bdd35a11fd699bd26cb0;hp=d576bc101d9deab1ba666021f4161cf071431710;hb=8a3edcedddb89028adcd9942b04013967c071900;hpb=25c3bec32fc9c632b30dd8f90f109de1dd1c20d4

diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index d576bc1..32d4a0e 100644
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -60,6 +60,7 @@ has sql_translator_args => (
   is  => 'ro',
   default => sub { {} },
 );
+
 has script_directory => (
   isa      => 'Str',
   is       => 'ro',
@@ -67,6 +68,37 @@ has script_directory => (
   default  => 'sql',
 );
 
+has _filesystem_interface => (
+  is         => 'ro',
+  lazy_build => 1,
+  handles => {
+    _ddl_initialize_consume_filenames            => '_ddl_initialize_consume_filenames',
+    _ddl_schema_consume_filenames                => '_ddl_schema_consume_filenames',
+    _ddl_protoschema_deploy_consume_filenames    => '_ddl_protoschema_deploy_consume_filenames',
+    _ddl_protoschema_upgrade_consume_filenames   => '_ddl_protoschema_upgrade_consume_filenames',
+    _ddl_protoschema_downgrade_consume_filenames => '_ddl_protoschema_downgrade_consume_filenames',
+    _ddl_protoschema_produce_filename            => '_ddl_protoschema_produce_filename',
+    _ddl_schema_produce_filename                 => '_ddl_schema_produce_filename',
+    _ddl_schema_upgrade_consume_filenames        => '_ddl_schema_upgrade_consume_filenames',
+    _ddl_schema_downgrade_consume_filenames      => '_ddl_schema_downgrade_consume_filenames',
+    _ddl_schema_upgrade_produce_filename         => '_ddl_schema_upgrade_produce_filename',
+    _ddl_schema_downgrade_produce_filename       => '_ddl_schema_downgrade_produce_filename',
+
+    _read_sql_file                               => '_read_sql_file',
+    _coderefs_per_files                          => '_coderefs_per_files',
+    _write_data_string                           => '_write_data_string',
+    _write_data_list                             => '_write_data_list',
+  },
+);
+
+sub _build__filesystem_interface {
+   use DBIx::Class::DeploymentHandler::Filesystem;
+   DBIx::Class::DeploymentHandler::Filesystem->new(
+     script_directory => $_[0]->script_directory,
+     ignore_ddl => $_[0]->ignore_ddl
+   )
+}
+
 has databases => (
   coerce  => 1,
   isa     => 'DBIx::Class::DeploymentHandler::Databases',
@@ -91,139 +123,6 @@ has schema_version => (
 # is built the same way, but we leave this in place
 method _build_schema_version { $self->schema->schema_version }
 
-method __ddl_consume_with_prefix($type, $versions, $prefix) {
-  my $base_dir = $self->script_directory;
-
-  my $main    = catfile( $base_dir, $type      );
-  my $common  =
-    catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
-
-  my $common_any  =
-    catfile( $base_dir, '_common', $prefix, '_any' );
-
-  my $dir;
-  if (-d $main) {
-    $dir = catfile($main, $prefix, join q(-), @{$versions})
-  } else {
-    if ($self->ignore_ddl) {
-      return []
-    } else {
-      croak "$main does not exist; please write/generate some SQL"
-    }
-  }
-  my $dir_any = catfile($main, $prefix, '_any');
-
-  my %files;
-  try {
-     opendir my($dh), $dir;
-     %files =
-       map { $_ => "$dir/$_" }
-       grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
-       readdir $dh;
-     closedir $dh;
-  } catch {
-    die $_ unless $self->ignore_ddl;
-  };
-  for my $dirname (grep { -d $_ } $common, $common_any, $dir_any) {
-    opendir my($dh), $dirname;
-    for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($dirname,$_) } readdir $dh) {
-      unless ($files{$filename}) {
-        $files{$filename} = catfile($dirname,$filename);
-      }
-    }
-    closedir $dh;
-  }
-
-  return [@files{sort keys %files}]
-}
-
-method _ddl_initialize_consume_filenames($type, $version) {
-  $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
-}
-
-method _ddl_schema_consume_filenames($type, $version) {
-  $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
-}
-
-method _ddl_protoschema_deploy_consume_filenames($version) {
-  my $base_dir = $self->script_directory;
-
-  my $dir = catfile( $base_dir, '_source', 'deploy', $version);
-  return [] unless -d $dir;
-
-  opendir my($dh), $dir;
-  my %files = map { $_ => "$dir/$_" } grep { /\.yml$/ && -f "$dir/$_" } readdir $dh;
-  closedir $dh;
-
-  return [@files{sort keys %files}]
-}
-
-method _ddl_protoschema_upgrade_consume_filenames($versions) {
-  my $base_dir = $self->script_directory;
-
-  my $dir = catfile( $base_dir, '_preprocess_schema', 'upgrade', join q(-), @{$versions});
-
-  return [] unless -d $dir;
-
-  opendir my($dh), $dir;
-  my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
-  closedir $dh;
-
-  return [@files{sort keys %files}]
-}
-
-method _ddl_protoschema_downgrade_consume_filenames($versions) {
-  my $base_dir = $self->script_directory;
-
-  my $dir = catfile( $base_dir, '_preprocess_schema', 'downgrade', join q(-), @{$versions});
-
-  return [] unless -d $dir;
-
-  opendir my($dh), $dir;
-  my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
-  closedir $dh;
-
-  return [@files{sort keys %files}]
-}
-
-method _ddl_protoschema_produce_filename($version) {
-  my $dirname = catfile( $self->script_directory, '_source', 'deploy',  $version );
-  mkpath($dirname) unless -d $dirname;
-
-  return catfile( $dirname, '001-auto.yml' );
-}
-
-method _ddl_schema_produce_filename($type, $version) {
-  my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
-  mkpath($dirname) unless -d $dirname;
-
-  return catfile( $dirname, '001-auto.sql' );
-}
-
-method _ddl_schema_upgrade_consume_filenames($type, $versions) {
-  $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
-}
-
-method _ddl_schema_downgrade_consume_filenames($type, $versions) {
-  $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
-}
-
-method _ddl_schema_upgrade_produce_filename($type, $versions) {
-  my $dir = $self->script_directory;
-
-  my $dirname = catfile( $dir, $type, 'upgrade', join q(-), @{$versions});
-  mkpath($dirname) unless -d $dirname;
-
-  return catfile( $dirname, '001-auto.sql' );
-}
-
-method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) {
-  my $dirname = catfile( $dir, $type, 'downgrade', join q(-), @{$versions} );
-  mkpath($dirname) unless -d $dirname;
-
-  return catfile( $dirname, '001-auto.sql');
-}
-
 method _run_sql_array($sql) {
   my $storage = $self->storage;
 
@@ -467,9 +366,8 @@ sub _prepare_install {
          die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
       }
     }
-    open my $file, q(>), $filename;
-    print {$file} join ";\n", @$sql;
-    close $file;
+
+    $self->_write_data_list($filename, $sql);
   }
 }
 
@@ -557,11 +455,6 @@ sub prepare_downgrade {
   );
 }
 
-method _coderefs_per_files($files) {
-  no warnings 'redefine';
-  [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
-}
-
 method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
   my $schema    = $self->schema;
   my $databases = $self->databases;
@@ -580,30 +473,12 @@ method _prepare_changegrade($from_version, $to_version, $version_set, $direction
       }
     }
 
-    open my $file, q(>), $diff_file;
-    print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
-    close $file;
+    $self->_write_data_list($diff_file,
+      $self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)
+    );
   }
 }
 
-method _read_sql_file($file) {
-  return unless $file;
-
-  open my $fh, '<', $file;
-  my @data = split /;\n/, join '', <$fh>;
-  close $fh;
-
-  @data = grep {
-    $_ && # remove blank lines
-    !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
-  } map {
-    s/^\s+//; s/\s+$//; # trim whitespace
-    join '', grep { !/^--/ } split /\n/ # remove comments
-  } @data;
-
-  return \@data;
-}
-
 sub downgrade_single_step {
   my $self = shift;
   my $version_set = (shift @_)->{version_set};
@@ -673,9 +548,7 @@ sub prepare_protoschema {
     }
   }
 
-  open my $file, q(>), $filename;
-  print {$file} $yml;
-  close $file;
+  $self->_write_data_string($filename, $yml);
 }
 
 __PACKAGE__->meta->make_immutable;