lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm

   1 package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator;
   2 use Moose;
   3
   4 # ABSTRACT: Manage your SQL and Perl migrations in nicely laid out directories
   5
   6 use autodie;
   7 use Carp qw( carp croak );
   8 use DBIx::Class::DeploymentHandler::Logger;
   9 use Log::Contextual qw(:log :dlog), -package_logger =>
  10   DBIx::Class::DeploymentHandler::Logger->new({
  11     env_prefix => 'DBICDH'
  12   });
  13
  14 use Method::Signatures::Simple;
  15 use Try::Tiny;
  16
  17 use SQL::Translator;
  18 require SQL::Translator::Diff;
  19
  20 require DBIx::Class::Storage;   # loaded for type constraint
  21 use DBIx::Class::DeploymentHandler::Types;
  22
  23 use File::Path 'mkpath';
  24 use File::Spec::Functions;
  25
  26 with 'DBIx::Class::DeploymentHandler::HandlesDeploy';
  27
  28 has ignore_ddl => (
  29   isa      => 'Bool',
  30   is       => 'ro',
  31   default  => undef,
  32 );
  33
  34 has force_overwrite => (
  35   isa      => 'Bool',
  36   is       => 'ro',
  37   default  => undef,
  38 );
  39
  40 has schema => (
  41   isa      => 'DBIx::Class::Schema',
  42   is       => 'ro',
  43   required => 1,
  44 );
  45
  46 has storage => (
  47   isa        => 'DBIx::Class::Storage',
  48   is         => 'ro',
  49   lazy_build => 1,
  50 );
  51
  52 method _build_storage {
  53   my $s = $self->schema->storage;
  54   $s->_determine_driver;
  55   $s
  56 }
  57
  58 has sql_translator_args => (
  59   isa => 'HashRef',
  60   is  => 'ro',
  61   default => sub { {} },
  62 );
  63 has script_directory => (
  64   isa      => 'Str',
  65   is       => 'ro',
  66   required => 1,
  67   default  => 'sql',
  68 );
  69
  70 has databases => (
  71   coerce  => 1,
  72   isa     => 'DBIx::Class::DeploymentHandler::Databases',
  73   is      => 'ro',
  74   default => sub { [qw( MySQL SQLite PostgreSQL )] },
  75 );
  76
  77 has txn_wrap => (
  78   is => 'ro',
  79   isa => 'Bool',
  80   default => 1,
  81 );
  82
  83 has schema_version => (
  84   is => 'ro',
  85   isa => 'Str',
  86   lazy_build => 1,
  87 );
  88
  89 # this will probably never get called as the DBICDH
  90 # will be passing down a schema_version normally, which
  91 # is built the same way, but we leave this in place
  92 method _build_schema_version { $self->schema->schema_version }
  93
  94 method __ddl_consume_with_prefix($type, $versions, $prefix) {
  95   my $base_dir = $self->script_directory;
  96
  97   my $main    = catfile( $base_dir, $type      );
  98   my $common  =
  99     catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
 100
 101   my $common_any  =
 102     catfile( $base_dir, '_common', $prefix, '_any' );
 103
 104   my $dir;
 105   if (-d $main) {
 106     $dir = catfile($main, $prefix, join q(-), @{$versions})
 107   } else {
 108     if ($self->ignore_ddl) {
 109       return []
 110     } else {
 111       croak "$main does not exist; please write/generate some SQL"
 112     }
 113   }
 114   my $dir_any = catfile($main, $prefix, '_any');
 115
 116   my %files;
 117   try {
 118      opendir my($dh), $dir;
 119      %files =
 120        map { $_ => "$dir/$_" }
 121        grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
 122        readdir $dh;
 123      closedir $dh;
 124   } catch {
 125     die $_ unless $self->ignore_ddl;
 126   };
 127   for my $dirname (grep { -d $_ } $common, $common_any, $dir_any) {
 128     opendir my($dh), $dirname;
 129     for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($dirname,$_) } readdir $dh) {
 130       unless ($files{$filename}) {
 131         $files{$filename} = catfile($dirname,$filename);
 132       }
 133     }
 134     closedir $dh;
 135   }
 136
 137   return [@files{sort keys %files}]
 138 }
 139
 140 method _ddl_initialize_consume_filenames($type, $version) {
 141   $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
 142 }
 143
 144 method _ddl_schema_consume_filenames($type, $version) {
 145   $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
 146 }
 147
 148 method _ddl_protoschema_deploy_consume_filenames($version) {
 149   my $base_dir = $self->script_directory;
 150
 151   my $dir = catfile( $base_dir, '_source', 'deploy', $version);
 152   return [] unless -d $dir;
 153
 154   opendir my($dh), $dir;
 155   my %files = map { $_ => "$dir/$_" } grep { /\.yml$/ && -f "$dir/$_" } readdir $dh;
 156   closedir $dh;
 157
 158   return [@files{sort keys %files}]
 159 }
 160
 161 method _ddl_protoschema_upgrade_consume_filenames($versions) {
 162   my $base_dir = $self->script_directory;
 163
 164   my $dir = catfile( $base_dir, '_preprocess_schema', 'upgrade', join q(-), @{$versions});
 165
 166   return [] unless -d $dir;
 167
 168   opendir my($dh), $dir;
 169   my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
 170   closedir $dh;
 171
 172   return [@files{sort keys %files}]
 173 }
 174
 175 method _ddl_protoschema_downgrade_consume_filenames($versions) {
 176   my $base_dir = $self->script_directory;
 177
 178   my $dir = catfile( $base_dir, '_preprocess_schema', 'downgrade', join q(-), @{$versions});
 179
 180   return [] unless -d $dir;
 181
 182   opendir my($dh), $dir;
 183   my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
 184   closedir $dh;
 185
 186   return [@files{sort keys %files}]
 187 }
 188
 189 method _ddl_protoschema_produce_filename($version) {
 190   my $dirname = catfile( $self->script_directory, '_source', 'deploy',  $version );
 191   mkpath($dirname) unless -d $dirname;
 192
 193   return catfile( $dirname, '001-auto.yml' );
 194 }
 195
 196 method _ddl_schema_produce_filename($type, $version) {
 197   my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
 198   mkpath($dirname) unless -d $dirname;
 199
 200   return catfile( $dirname, '001-auto.sql' );
 201 }
 202
 203 method _ddl_schema_upgrade_consume_filenames($type, $versions) {
 204   $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
 205 }
 206
 207 method _ddl_schema_downgrade_consume_filenames($type, $versions) {
 208   $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
 209 }
 210
 211 method _ddl_schema_upgrade_produce_filename($type, $versions) {
 212   my $dir = $self->script_directory;
 213
 214   my $dirname = catfile( $dir, $type, 'upgrade', join q(-), @{$versions});
 215   mkpath($dirname) unless -d $dirname;
 216
 217   return catfile( $dirname, '001-auto.sql' );
 218 }
 219
 220 method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) {
 221   my $dirname = catfile( $dir, $type, 'downgrade', join q(-), @{$versions} );
 222   mkpath($dirname) unless -d $dirname;
 223
 224   return catfile( $dirname, '001-auto.sql');
 225 }
 226
 227 method _run_sql_array($sql) {
 228   my $storage = $self->storage;
 229
 230   $sql = [grep {
 231     $_ && # remove blank lines
 232     !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
 233   } map {
 234     s/^\s+//; s/\s+$//; # trim whitespace
 235     join '', grep { !/^--/ } split /\n/ # remove comments
 236   } @$sql];
 237
 238   Dlog_trace { "Running SQL $_" } $sql;
 239   foreach my $line (@{$sql}) {
 240     $storage->_query_start($line);
 241     # the whole reason we do this is so that we can see the line that was run
 242     try {
 243       $storage->dbh_do (sub { $_[1]->do($line) });
 244     }
 245     catch {
 246       die "$_ (running line '$line')"
 247     };
 248     $storage->_query_end($line);
 249   }
 250   return join "\n", @$sql
 251 }
 252
 253 method _run_sql($filename) {
 254   log_debug { "Running SQL from $filename" };
 255   return $self->_run_sql_array($self->_read_sql_file($filename));
 256 }
 257
 258 method _run_perl($filename, $versions) {
 259   log_debug { "Running Perl from $filename" };
 260   my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 261
 262   no warnings 'redefine';
 263   my $fn = eval "$filedata";
 264   use warnings;
 265   Dlog_trace { "Running Perl $_" } $fn;
 266
 267   if ($@) {
 268     carp "$filename failed to compile: $@";
 269   } elsif (ref $fn eq 'CODE') {
 270     $fn->($self->schema, $versions)
 271   } else {
 272     carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
 273   }
 274 }
 275
 276 method _run_sql_and_perl($filenames, $sql_to_run, $versions) {
 277   my @files   = @{$filenames};
 278   my $guard   = $self->schema->txn_scope_guard if $self->txn_wrap;
 279
 280   $self->_run_sql_array($sql_to_run) if $self->ignore_ddl;
 281
 282   my $sql = ($sql_to_run)?join ";\n", @$sql_to_run:'';
 283   FILENAME:
 284   for my $filename (@files) {
 285     if ($self->ignore_ddl && $filename =~ /^[^_]*-auto.*\.sql$/) {
 286       next FILENAME
 287     } elsif ($filename =~ /\.sql$/) {
 288        $sql .= $self->_run_sql($filename)
 289     } elsif ( $filename =~ /\.pl$/ ) {
 290        $self->_run_perl($filename, $versions)
 291     } else {
 292       croak "A file ($filename) got to deploy that wasn't sql or perl!";
 293     }
 294   }
 295
 296   $guard->commit if $self->txn_wrap;
 297
 298   return $sql;
 299 }
 300
 301 sub deploy {
 302   my $self = shift;
 303   my $version = (shift @_ || {})->{version} || $self->schema_version;
 304   log_info { "deploying version $version" };
 305   my $sqlt_type = $self->storage->sqlt_type;
 306   my $sql;
 307   if ($self->ignore_ddl) {
 308      $sql = $self->_sql_from_yaml({},
 309        '_ddl_protoschema_deploy_consume_filenames', $sqlt_type
 310      );
 311   }
 312   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
 313     $sqlt_type,
 314     $version,
 315   ), $sql, [$version]);
 316 }
 317
 318 sub initialize {
 319   my $self         = shift;
 320   my $args         = shift;
 321   my $version      = $args->{version}      || $self->schema_version;
 322   log_info { "initializing version $version" };
 323   my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
 324
 325   my @files = @{$self->_ddl_initialize_consume_filenames(
 326     $storage_type,
 327     $version,
 328   )};
 329
 330   for my $filename (@files) {
 331     # We ignore sql for now (till I figure out what to do with it)
 332     if ( $filename =~ /^(.+)\.pl$/ ) {
 333       my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 334
 335       no warnings 'redefine';
 336       my $fn = eval "$filedata";
 337       use warnings;
 338
 339       if ($@) {
 340         carp "$filename failed to compile: $@";
 341       } elsif (ref $fn eq 'CODE') {
 342         $fn->()
 343       } else {
 344         carp "$filename should define an anonymous sub but it didn't!";
 345       }
 346     } else {
 347       croak "A file ($filename) got to initialize_scripts that wasn't sql or perl!";
 348     }
 349   }
 350 }
 351
 352 method _sqldiff_from_yaml($from_version, $to_version, $db, $direction) {
 353   my $dir       = $self->script_directory;
 354   my $sqltargs = {
 355     add_drop_table => 1,
 356     ignore_constraint_names => 1,
 357     ignore_index_names => 1,
 358     %{$self->sql_translator_args}
 359   };
 360
 361   my $source_schema;
 362   {
 363     my $prefilename = $self->_ddl_protoschema_produce_filename($from_version, $dir);
 364
 365     # should probably be a croak
 366     carp("No previous schema file found ($prefilename)")
 367        unless -e $prefilename;
 368
 369     my $t = SQL::Translator->new({
 370        %{$sqltargs},
 371        debug => 0,
 372        trace => 0,
 373        parser => 'SQL::Translator::Parser::YAML',
 374     });
 375
 376     my $out = $t->translate( $prefilename )
 377       or croak($t->error);
 378
 379     $source_schema = $t->schema;
 380
 381     $source_schema->name( $prefilename )
 382       unless  $source_schema->name;
 383   }
 384
 385   my $dest_schema;
 386   {
 387     my $filename = $self->_ddl_protoschema_produce_filename($to_version, $dir);
 388
 389     # should probably be a croak
 390     carp("No next schema file found ($filename)")
 391        unless -e $filename;
 392
 393     my $t = SQL::Translator->new({
 394        %{$sqltargs},
 395        debug => 0,
 396        trace => 0,
 397        parser => 'SQL::Translator::Parser::YAML',
 398     });
 399
 400     my $out = $t->translate( $filename )
 401       or croak($t->error);
 402
 403     $dest_schema = $t->schema;
 404
 405     $dest_schema->name( $filename )
 406       unless $dest_schema->name;
 407   }
 408
 409   my $transform_files_method =  "_ddl_protoschema_${direction}_consume_filenames";
 410   my $transforms = $self->_coderefs_per_files(
 411     $self->$transform_files_method([$from_version, $to_version])
 412   );
 413   $_->($source_schema, $dest_schema) for @$transforms;
 414
 415   return [SQL::Translator::Diff::schema_diff(
 416      $source_schema, $db,
 417      $dest_schema,   $db,
 418      $sqltargs
 419   )];
 420 }
 421
 422 method _sql_from_yaml($sqltargs, $from_file, $db) {
 423   my $schema    = $self->schema;
 424   my $version   = $self->schema_version;
 425
 426   my @sql;
 427
 428   my $actual_file = $self->$from_file($version);
 429   for my $yaml_filename (@{
 430      DlogS_trace { "generating SQL from Serialized SQL Files: $_" }
 431         (ref $actual_file?$actual_file:[$actual_file])
 432   }) {
 433      my $sqlt = SQL::Translator->new({
 434        add_drop_table          => 0,
 435        parser                  => 'SQL::Translator::Parser::YAML',
 436        %{$sqltargs},
 437        producer => $db,
 438      });
 439
 440      push @sql, $sqlt->translate($yaml_filename);
 441      if(!@sql) {
 442        carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
 443        return undef;
 444      }
 445   }
 446   return \@sql;
 447 }
 448
 449 sub _prepare_install {
 450   my $self      = shift;
 451   my $sqltargs  = { %{$self->sql_translator_args}, %{shift @_} };
 452   my $from_file = shift;
 453   my $to_file   = shift;
 454   my $dir       = $self->script_directory;
 455   my $databases = $self->databases;
 456   my $version   = $self->schema_version;
 457
 458   foreach my $db (@$databases) {
 459     my $sql = $self->_sql_from_yaml($sqltargs, $from_file, $db ) or next;
 460
 461     my $filename = $self->$to_file($db, $version, $dir);
 462     if (-e $filename ) {
 463       if ($self->force_overwrite) {
 464          carp "Overwriting existing DDL file - $filename";
 465          unlink $filename;
 466       } else {
 467          die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
 468       }
 469     }
 470     open my $file, q(>), $filename;
 471     print {$file} join ";\n", @$sql;
 472     close $file;
 473   }
 474 }
 475
 476 sub _resultsource_install_filename {
 477   my ($self, $source_name) = @_;
 478   return sub {
 479     my ($self, $type, $version) = @_;
 480     my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
 481     mkpath($dirname) unless -d $dirname;
 482
 483     return catfile( $dirname, "001-auto-$source_name.sql" );
 484   }
 485 }
 486
 487 sub _resultsource_protoschema_filename {
 488   my ($self, $source_name) = @_;
 489   return sub {
 490     my ($self, $version) = @_;
 491     my $dirname = catfile( $self->script_directory, '_source', 'deploy', $version );
 492     mkpath($dirname) unless -d $dirname;
 493
 494     return catfile( $dirname, "001-auto-$source_name.yml" );
 495   }
 496 }
 497
 498 sub install_resultsource {
 499   my ($self, $args) = @_;
 500   my $source          = $args->{result_source}
 501     or die 'result_source must be passed to install_resultsource';
 502   my $version         = $args->{version}
 503     or die 'version must be passed to install_resultsource';
 504   log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
 505   my $rs_install_file =
 506     $self->_resultsource_install_filename($source->source_name);
 507
 508   my $files = [
 509      $self->$rs_install_file(
 510       $self->storage->sqlt_type,
 511       $version,
 512     )
 513   ];
 514   $self->_run_sql_and_perl($files, '', [$version]);
 515 }
 516
 517 sub prepare_resultsource_install {
 518   my $self = shift;
 519   my $source = (shift @_)->{result_source};
 520   log_info { 'preparing install for resultsource ' . $source->source_name };
 521
 522   my $install_filename = $self->_resultsource_install_filename($source->source_name);
 523   my $proto_filename = $self->_resultsource_protoschema_filename($source->source_name);
 524   $self->prepare_protoschema({
 525       parser_args => { sources => [$source->source_name], }
 526   }, $proto_filename);
 527   $self->_prepare_install({}, $proto_filename, $install_filename);
 528 }
 529
 530 sub prepare_deploy {
 531   log_info { 'preparing deploy' };
 532   my $self = shift;
 533   $self->prepare_protoschema({
 534       # Exclude __VERSION so that it gets installed separately
 535       parser_args => { sources => [grep { $_ ne '__VERSION' } $self->schema->sources], }
 536   }, '_ddl_protoschema_produce_filename');
 537   $self->_prepare_install({}, '_ddl_protoschema_produce_filename', '_ddl_schema_produce_filename');
 538 }
 539
 540 sub prepare_upgrade {
 541   my ($self, $args) = @_;
 542   log_info {
 543      "preparing upgrade from $args->{from_version} to $args->{to_version}"
 544   };
 545   $self->_prepare_changegrade(
 546     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'upgrade'
 547   );
 548 }
 549
 550 sub prepare_downgrade {
 551   my ($self, $args) = @_;
 552   log_info {
 553      "preparing downgrade from $args->{from_version} to $args->{to_version}"
 554   };
 555   $self->_prepare_changegrade(
 556     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'downgrade'
 557   );
 558 }
 559
 560 method _coderefs_per_files($files) {
 561   no warnings 'redefine';
 562   [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
 563 }
 564
 565 method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
 566   my $schema    = $self->schema;
 567   my $databases = $self->databases;
 568   my $dir       = $self->script_directory;
 569
 570   my $schema_version = $self->schema_version;
 571   my $diff_file_method = "_ddl_schema_${direction}_produce_filename";
 572   foreach my $db (@$databases) {
 573     my $diff_file = $self->$diff_file_method($db, $version_set, $dir );
 574     if(-e $diff_file) {
 575       if ($self->force_overwrite) {
 576          carp("Overwriting existing $direction-diff file - $diff_file");
 577          unlink $diff_file;
 578       } else {
 579          die "Cannot overwrite '$diff_file', either enable force_overwrite or delete it"
 580       }
 581     }
 582
 583     open my $file, q(>), $diff_file;
 584     print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
 585     close $file;
 586   }
 587 }
 588
 589 method _read_sql_file($file) {
 590   return unless $file;
 591
 592   open my $fh, '<', $file;
 593   my @data = split /;\n/, join '', <$fh>;
 594   close $fh;
 595
 596   @data = grep {
 597     $_ && # remove blank lines
 598     !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
 599   } map {
 600     s/^\s+//; s/\s+$//; # trim whitespace
 601     join '', grep { !/^--/ } split /\n/ # remove comments
 602   } @data;
 603
 604   return \@data;
 605 }
 606
 607 sub downgrade_single_step {
 608   my $self = shift;
 609   my $version_set = (shift @_)->{version_set};
 610   Dlog_info { "downgrade_single_step'ing $_" } $version_set;
 611
 612   my $sqlt_type = $self->storage->sqlt_type;
 613   my $sql_to_run;
 614   if ($self->ignore_ddl) {
 615      $sql_to_run = $self->_sqldiff_from_yaml(
 616        $version_set->[0], $version_set->[1], $sqlt_type, 'downgrade',
 617      );
 618   }
 619   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_downgrade_consume_filenames(
 620     $sqlt_type,
 621     $version_set,
 622   ), $sql_to_run, $version_set);
 623
 624   return ['', $sql];
 625 }
 626
 627 sub upgrade_single_step {
 628   my $self = shift;
 629   my $version_set = (shift @_)->{version_set};
 630   Dlog_info { "upgrade_single_step'ing $_" } $version_set;
 631
 632   my $sqlt_type = $self->storage->sqlt_type;
 633   my $sql_to_run;
 634   if ($self->ignore_ddl) {
 635      $sql_to_run = $self->_sqldiff_from_yaml(
 636        $version_set->[0], $version_set->[1], $sqlt_type, 'upgrade',
 637      );
 638   }
 639   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_upgrade_consume_filenames(
 640     $sqlt_type,
 641     $version_set,
 642   ), $sql_to_run, $version_set);
 643   return ['', $sql];
 644 }
 645
 646 sub prepare_protoschema {
 647   my $self      = shift;
 648   my $sqltargs  = { %{$self->sql_translator_args}, %{shift @_} };
 649   my $to_file   = shift;
 650   my $filename
 651     = $self->$to_file($self->schema_version);
 652
 653   # we do this because the code that uses this sets parser args,
 654   # so we just need to merge in the package
 655   $sqltargs->{parser_args}{package} = $self->schema;
 656   my $sqlt = SQL::Translator->new({
 657     parser                  => 'SQL::Translator::Parser::DBIx::Class',
 658     producer                => 'SQL::Translator::Producer::YAML',
 659     %{ $sqltargs },
 660   });
 661
 662   my $yml = $sqlt->translate;
 663
 664   croak("Failed to translate to YAML: " . $sqlt->error)
 665     unless $yml;
 666
 667   if (-e $filename ) {
 668     if ($self->force_overwrite) {
 669        carp "Overwriting existing DDL-YML file - $filename";
 670        unlink $filename;
 671     } else {
 672        die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
 673     }
 674   }
 675
 676   open my $file, q(>), $filename;
 677   print {$file} $yml;
 678   close $file;
 679 }
 680
 681 __PACKAGE__->meta->make_immutable;
 682
 683 1;
 684
 685 # vim: ts=2 sw=2 expandtab
 686
 687 __END__
 688
 689 =head1 DESCRIPTION
 690
 691 This class is the meat of L<DBIx::Class::DeploymentHandler>.  It takes care
 692 of generating serialized schemata  as well as sql files to move from one
 693 version of a schema to the rest.  One of the hallmark features of this class
 694 is that it allows for multiple sql files for deploy and upgrade, allowing
 695 developers to fine tune deployment.  In addition it also allows for perl
 696 files to be run at any stage of the process.
 697
 698 For basic usage see L<DBIx::Class::DeploymentHandler::HandlesDeploy>.  What's
 699 documented here is extra fun stuff or private methods.
 700
 701 =head1 DIRECTORY LAYOUT
 702
 703 Arguably this is the best feature of L<DBIx::Class::DeploymentHandler>.
 704 It's spiritually based upon L<DBIx::Migration::Directories>, but has a
 705 lot of extensions and modifications, so even if you are familiar with it,
 706 please read this.  I feel like the best way to describe the layout is with
 707 the following example:
 708
 709  $sql_migration_dir
 710  |- _source
 711  |  |- deploy
 712  |     |- 1
 713  |     |  `- 001-auto.yml
 714  |     |- 2
 715  |     |  `- 001-auto.yml
 716  |     `- 3
 717  |        `- 001-auto.yml
 718  |- SQLite
 719  |  |- downgrade
 720  |  |  `- 2-1
 721  |  |     `- 001-auto.sql
 722  |  |- deploy
 723  |  |  `- 1
 724  |  |     `- 001-auto.sql
 725  |  `- upgrade
 726  |     |- 1-2
 727  |     |  `- 001-auto.sql
 728  |     `- 2-3
 729  |        `- 001-auto.sql
 730  |- _common
 731  |  |- downgrade
 732  |  |  `- 2-1
 733  |  |     `- 002-remove-customers.pl
 734  |  `- upgrade
 735  |     `- 1-2
 736  |     |  `- 002-generate-customers.pl
 737  |     `- _any
 738  |        `- 999-bump-action.pl
 739  `- MySQL
 740     |- downgrade
 741     |  `- 2-1
 742     |     `- 001-auto.sql
 743     |- initialize
 744     |  `- 1
 745     |     |- 001-create_database.pl
 746     |     `- 002-create_users_and_permissions.pl
 747     |- deploy
 748     |  `- 1
 749     |     `- 001-auto.sql
 750     `- upgrade
 751        `- 1-2
 752           `- 001-auto.sql
 753
 754 So basically, the code
 755
 756  $dm->deploy(1)
 757
 758 on an C<SQLite> database that would simply run
 759 C<$sql_migration_dir/SQLite/deploy/1/001-auto.sql>.  Next,
 760
 761  $dm->upgrade_single_step([1,2])
 762
 763 would run C<$sql_migration_dir/SQLite/upgrade/1-2/001-auto.sql> followed by
 764 C<$sql_migration_dir/_common/upgrade/1-2/002-generate-customers.pl>, and
 765 finally punctuated by
 766 C<$sql_migration_dir/_common/upgrade/_any/999-bump-action.pl>.
 767
 768 C<.pl> files don't have to be in the C<_common> directory, but most of the time
 769 they should be, because perl scripts are generally database independent.
 770
 771 Note that unlike most steps in the process, C<initialize> will not run SQL, as
 772 there may not even be an database at initialize time.  It will run perl scripts
 773 just like the other steps in the process, but nothing is passed to them.
 774 Until people have used this more it will remain freeform, but a recommended use
 775 of initialize is to have it prompt for username and password, and then call the
 776 appropriate C<< CREATE DATABASE >> commands etc.
 777
 778 =head2 Directory Specification
 779
 780 The following subdirectories are recognized by this DeployMethod:
 781
 782 =over 2
 783
 784 =item C<_source> This directory can contain the following directories:
 785
 786 =over 2
 787
 788 =item C<deploy> This directory merely contains directories named after schema
 789 versions, which in turn contain C<yaml> files that are serialized versions
 790 of the schema at that version.  These files are not for editing by hand.
 791
 792 =back
 793
 794 =item C<_preprocess_schema> This directory can contain the following
 795 directories:
 796
 797 =over 2
 798
 799 =item C<downgrade> This directory merely contains directories named after
 800 migrations, which are of the form C<$from_version-$to_version>.  Inside of
 801 these directories you may put Perl scripts which are to return a subref
 802 that takes the arguments C<< $from_schema, $to_schema >>, which are
 803 L<SQL::Translator::Schema> objects.
 804
 805 =item C<upgrade> This directory merely contains directories named after
 806 migrations, which are of the form C<$from_version-$to_version>.  Inside of
 807 these directories you may put Perl scripts which are to return a subref
 808 that takes the arguments C<< $from_schema, $to_schema >>, which are
 809 L<SQL::Translator::Schema> objects.
 810
 811 =back
 812
 813 =item C<$storage_type> This is a set of scripts that gets run depending on what
 814 your storage type is.  If you are not sure what your storage type is, take a
 815 look at the producers listed for L<SQL::Translator>.  Also note, C<_common>
 816 is a special case.  C<_common> will get merged into whatever other files you
 817 already have.  This directory can contain the following directories itself:
 818
 819 =over 2
 820
 821 =item C<initialize> Gets run before the C<deploy> is C<deploy>ed.  Has the
 822 same structure as the C<deploy> subdirectory as well; that is, it has a
 823 directory for each schema version.  Unlike C<deploy>, C<upgrade>, and C<downgrade>
 824 though, it can only run C<.pl> files, and the coderef in the perl files get
 825 no arguments passed to them.
 826
 827 =item C<deploy> Gets run when the schema is C<deploy>ed.  Structure is a
 828 directory per schema version, and then files are merged with C<_common> and run
 829 in filename order.  C<.sql> files are merely run, as expected.  C<.pl> files are
 830 run according to L</PERL SCRIPTS>.
 831
 832 =item C<upgrade> Gets run when the schema is C<upgrade>d.  Structure is a directory
 833 per upgrade step, (for example, C<1-2> for upgrading from version 1 to version
 834 2,) and then files are merged with C<_common> and run in filename order.
 835 C<.sql> files are merely run, as expected.  C<.pl> files are run according
 836 to L</PERL SCRIPTS>.
 837
 838 =item C<downgrade> Gets run when the schema is C<downgrade>d.  Structure is a directory
 839 per downgrade step, (for example, C<2-1> for downgrading from version 2 to version
 840 1,) and then files are merged with C<_common> and run in filename order.
 841 C<.sql> files are merely run, as expected.  C<.pl> files are run according
 842 to L</PERL SCRIPTS>.
 843
 844
 845 =back
 846
 847 =back
 848
 849 Note that there can be an C<_any> in the place of any of the versions (like
 850 C<1-2> or C<1>), which means those scripts will be run B<every> time.  So if
 851 you have an C<_any> in C<_common/upgrade>, that script will get run for every
 852 upgrade.
 853
 854 =head1 PERL SCRIPTS
 855
 856 A perl script for this tool is very simple.  It merely needs to contain an
 857 anonymous sub that takes a L<DBIx::Class::Schema> and the version set as it's
 858 arguments.
 859
 860 A very basic perl script might look like:
 861
 862  #!perl
 863
 864  use strict;
 865  use warnings;
 866
 867  sub {
 868    my $schema = shift;
 869
 870    # [1] for deploy, [1,2] for upgrade or downgrade, probably used with _any
 871    my $versions = shift;
 872
 873    $schema->resultset('Users')->create({
 874      name => 'root',
 875      password => 'root',
 876    })
 877  }
 878
 879 =attr ignore_ddl
 880
 881 This attribute will, when set to true (default is false), cause the DM to use
 882 L<SQL::Translator> to use the C<_source>'s serialized SQL::Translator::Schema
 883 instead of any pregenerated SQL.  If you have a development server this is
 884 probably the best plan of action as you will not be putting as many generated
 885 files in your version control.  Goes well with with C<databases> of C<[]>.
 886
 887 =attr force_overwrite
 888
 889 When this attribute is true generated files will be overwritten when the
 890 methods which create such files are run again.  The default is false, in which
 891 case the program will die with a message saying which file needs to be deleted.
 892
 893 =attr schema
 894
 895 The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database
 896 and generate the DDL.
 897
 898 =attr storage
 899
 900 The L<DBIx::Class::Storage> that is I<actually> used to talk to the database
 901 and generate the DDL.  This is automatically created with L</_build_storage>.
 902
 903 =attr sql_translator_args
 904
 905 The arguments that get passed to L<SQL::Translator> when it's used.
 906
 907 =attr script_directory
 908
 909 The directory (default C<'sql'>) that scripts are stored in
 910
 911 =attr databases
 912
 913 The types of databases (default C<< [qw( MySQL SQLite PostgreSQL )] >>) to
 914 generate files for
 915
 916 =attr txn_wrap
 917
 918 Set to true (which is the default) to wrap all upgrades and deploys in a single
 919 transaction.
 920
 921 =attr schema_version
 922
 923 The version the schema on your harddrive is at.  Defaults to
 924 C<< $self->schema->schema_version >>.