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