lib/DBIx/Class/DeploymentHandler/Filesystem.pm

   1 package DBIx::Class::DeploymentHandler::Filesystem;
   2
   3 use Moose;
   4 use Method::Signatures::Simple;
   5 use File::Path 'mkpath';
   6 use File::Spec::Functions;
   7 use Try::Tiny;
   8
   9 has script_directory => (
  10   isa      => 'Str',
  11   is       => 'ro',
  12   required => 1,
  13   default  => 'sql',
  14 );
  15
  16 has ignore_ddl => ( is => 'ro' );
  17
  18 method __ddl_protoschema_consume_with_prefix($versions, $prefix) {
  19   my $base_dir = $self->script_directory;
  20
  21   my $dir;
  22   if ($prefix eq 'deploy') {
  23      $dir = catfile( $base_dir, '_source', $prefix, join q(-), @{$versions});
  24   } else {
  25      $dir = catfile( $base_dir, '_preprocess_schema', $prefix, join q(-), @{$versions});
  26   }
  27
  28   return [] unless -d $dir;
  29
  30   opendir my($dh), $dir;
  31   my %files = map { $_ => "$dir/$_" } grep { /\.pl$|\.yml$/ && -f "$dir/$_" } readdir $dh;
  32   closedir $dh;
  33
  34   return [@files{sort keys %files}]
  35 }
  36
  37 method _ddl_protoschema_deploy_consume_filenames($version) {
  38   $self->__ddl_protoschema_consume_with_prefix([$version], 'deploy')
  39 }
  40
  41 method _ddl_protoschema_upgrade_consume_filenames($versions) {
  42   $self->__ddl_protoschema_consume_with_prefix($versions, 'upgrade')
  43 }
  44
  45 method _ddl_protoschema_downgrade_consume_filenames($versions) {
  46   $self->__ddl_protoschema_consume_with_prefix($versions, 'downgrade')
  47 }
  48
  49
  50 method __ddl_consume_with_prefix($type, $versions, $prefix) {
  51   my $base_dir = $self->script_directory;
  52
  53   my $main    = catfile( $base_dir, $type      );
  54   my $common  =
  55     catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
  56
  57   my $common_any  =
  58     catfile( $base_dir, '_common', $prefix, '_any' );
  59
  60   my $dir;
  61   if (-d $main) {
  62     $dir = catfile($main, $prefix, join q(-), @{$versions})
  63   } else {
  64     if ($self->ignore_ddl) {
  65       return []
  66     } else {
  67       die "$main does not exist; please write/generate some SQL"
  68     }
  69   }
  70   my $dir_any = catfile($main, $prefix, '_any');
  71
  72   my %files;
  73   try {
  74      opendir my($dh), $dir;
  75      %files =
  76        map { $_ => "$dir/$_" }
  77        grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
  78        readdir $dh;
  79      closedir $dh;
  80   } catch {
  81     die $_ unless $self->ignore_ddl;
  82   };
  83   for my $dirname (grep { -d $_ } $common, $common_any, $dir_any) {
  84     opendir my($dh), $dirname;
  85     for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($dirname,$_) } readdir $dh) {
  86       unless ($files{$filename}) {
  87         $files{$filename} = catfile($dirname,$filename);
  88       }
  89     }
  90     closedir $dh;
  91   }
  92
  93   return [@files{sort keys %files}]
  94 }
  95
  96 method _ddl_initialize_consume_filenames($type, $version) {
  97   $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
  98 }
  99
 100 method _ddl_schema_consume_filenames($type, $version) {
 101   $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
 102 }
 103
 104 method _ddl_schema_upgrade_consume_filenames($type, $versions) {
 105   $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
 106 }
 107
 108 method _ddl_schema_downgrade_consume_filenames($type, $versions) {
 109   $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
 110 }
 111
 112
 113 method __ddl_produce_with_prefix($type, $versions, $suffix, $prefix) {
 114   my $dirname = catfile( $self->script_directory, $type, $prefix, join '-', @$versions );
 115   mkpath($dirname) unless -d $dirname;
 116
 117   return catfile( $dirname, "001-auto.$suffix" );
 118 }
 119
 120 method _ddl_schema_produce_filename($type, $version) {
 121   $self->__ddl_produce_with_prefix($type, [$version], 'sql', 'deploy');
 122 }
 123
 124 method _ddl_schema_upgrade_produce_filename($type, $versions) {
 125   $self->__ddl_produce_with_prefix($type, $versions, 'sql', 'upgrade');
 126 }
 127
 128 method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) {
 129   $self->__ddl_produce_with_prefix($type, $versions, 'sql', 'downgrade');
 130 }
 131
 132 method _ddl_protoschema_produce_filename($version) {
 133   $self->__ddl_produce_with_prefix('_source', [$version], 'yml', 'deploy');
 134 }
 135
 136
 137 method _read_sql_file($file) {
 138   return unless $file;
 139
 140   open my $fh, '<', $file;
 141   my @data = split /;\n/, join '', <$fh>;
 142   close $fh;
 143
 144   @data = grep {
 145     $_ && # remove blank lines
 146     !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
 147   } map {
 148     s/^\s+//; s/\s+$//; # trim whitespace
 149     join '', grep { !/^--/ } split /\n/ # remove comments
 150   } @data;
 151
 152   return \@data;
 153 }
 154
 155 method _coderefs_per_files($files) {
 156   no warnings 'redefine';
 157   [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
 158 }
 159
 160
 161 method _write_data_string($filename, $data) {
 162   open my $file, q(>), $filename;
 163   print {$file} $data;
 164   close $file;
 165 }
 166
 167
 168 method _write_data_list($filename, $data) {
 169   open my $file, q(>), $filename;
 170   print {$file} join ";\n", @$data;
 171   close $file;
 172 }
 173
 174 __PACKAGE__->meta->make_immutable;
 175
 176 1;