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