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