From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Tue, 12 Apr 2011 03:48:57 +0000 (-0500)
Subject: refactor ::Filesystem for more code reuse
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-DeploymentHandler.git;a=commitdiff_plain;h=d9b281301d8d0d94658ab11ace7ff510e9d5a758

refactor ::Filesystem for more code reuse
---

diff --git a/lib/DBIx/Class/DeploymentHandler/Filesystem.pm b/lib/DBIx/Class/DeploymentHandler/Filesystem.pm
index 2df9c13..dbbfa87 100644
--- a/lib/DBIx/Class/DeploymentHandler/Filesystem.pm
+++ b/lib/DBIx/Class/DeploymentHandler/Filesystem.pm
@@ -15,58 +15,38 @@ has script_directory => (
 
 has ignore_ddl => ( is => 'ro' );
 
-
-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_protoschema_deploy_consume_filenames($version) {
+method __ddl_protoschema_consume_with_prefix($versions, $prefix) {
   my $base_dir = $self->script_directory;
 
-  my $dir = catfile( $base_dir, '_source', 'deploy', $version);
+  my $dir;
+  if ($prefix eq 'deploy') {
+     $dir = catfile( $base_dir, '_source', $prefix, join q(-), @{$versions});
+  } else {
+     $dir = catfile( $base_dir, '_preprocess_schema', $prefix, join q(-), @{$versions});
+  }
+
   return [] unless -d $dir;
 
   opendir my($dh), $dir;
-  my %files = map { $_ => "$dir/$_" } grep { /\.yml$/ && -f "$dir/$_" } readdir $dh;
+  my %files = map { $_ => "$dir/$_" } grep { /\.pl$|\.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;
+method _ddl_protoschema_deploy_consume_filenames($version) {
+  $self->__ddl_protoschema_consume_with_prefix([$version], 'deploy')
+}
 
-  return [@files{sort keys %files}]
+method _ddl_protoschema_upgrade_consume_filenames($versions) {
+  $self->__ddl_protoschema_consume_with_prefix($versions, 'upgrade')
 }
 
 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}]
+  $self->__ddl_protoschema_consume_with_prefix($versions, 'downgrade')
 }
 
 
-
 method __ddl_consume_with_prefix($type, $versions, $prefix) {
   my $base_dir = $self->script_directory;
 
@@ -130,27 +110,27 @@ method _ddl_schema_downgrade_consume_filenames($type, $versions) {
 }
 
 
-method _ddl_schema_produce_filename($type, $version) {
-  my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
+method __ddl_produce_with_prefix($type, $versions, $suffix, $prefix) {
+  my $dirname = catfile( $self->script_directory, $type, $prefix, join '-', @$versions );
   mkpath($dirname) unless -d $dirname;
 
-  return catfile( $dirname, '001-auto.sql' );
+  return catfile( $dirname, "001-auto.$suffix" );
 }
 
-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;
+method _ddl_schema_produce_filename($type, $version) {
+  $self->__ddl_produce_with_prefix($type, [$version], 'sql', 'deploy');
+}
 
-  return catfile( $dirname, '001-auto.sql' );
+method _ddl_schema_upgrade_produce_filename($type, $versions) {
+  $self->__ddl_produce_with_prefix($type, $versions, 'sql', 'upgrade');
 }
 
 method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) {
-  my $dirname = catfile( $dir, $type, 'downgrade', join q(-), @{$versions} );
-  mkpath($dirname) unless -d $dirname;
+  $self->__ddl_produce_with_prefix($type, $versions, 'sql', 'downgrade');
+}
 
-  return catfile( $dirname, '001-auto.sql');
+method _ddl_protoschema_produce_filename($version) {
+  $self->__ddl_produce_with_prefix('_source', [$version], 'yml', 'deploy');
 }