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 schema => (
  29   isa      => 'DBIx::Class::Schema',
  30   is       => 'ro',
  31   required => 1,
  32 );
  33
  34 has storage => (
  35   isa        => 'DBIx::Class::Storage',
  36   is         => 'ro',
  37   lazy_build => 1,
  38 );
  39
  40 method _build_storage {
  41   my $s = $self->schema->storage;
  42   $s->_determine_driver;
  43   $s
  44 }
  45
  46 has sql_translator_args => (
  47   isa => 'HashRef',
  48   is  => 'ro',
  49   default => sub { {} },
  50 );
  51 has script_directory => (
  52   isa      => 'Str',
  53   is       => 'ro',
  54   required => 1,
  55   default  => 'sql',
  56 );
  57
  58 has databases => (
  59   coerce  => 1,
  60   isa     => 'DBIx::Class::DeploymentHandler::Databases',
  61   is      => 'ro',
  62   default => sub { [qw( MySQL SQLite PostgreSQL )] },
  63 );
  64
  65 has txn_wrap => (
  66   is => 'ro',
  67   isa => 'Bool',
  68   default => 1,
  69 );
  70
  71 has schema_version => (
  72   is => 'ro',
  73   isa => 'Str',
  74   lazy_build => 1,
  75 );
  76
  77 # this will probably never get called as the DBICDH
  78 # will be passing down a schema_version normally, which
  79 # is built the same way, but we leave this in place
  80 method _build_schema_version { $self->schema->schema_version }
  81
  82 method __ddl_consume_with_prefix($type, $versions, $prefix) {
  83   my $base_dir = $self->script_directory;
  84
  85   my $main    = catfile( $base_dir, $type      );
  86   my $generic = catfile( $base_dir, '_generic' );
  87   my $common  =
  88     catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
  89
  90   my $dir;
  91   if (-d $main) {
  92     $dir = catfile($main, $prefix, join q(-), @{$versions})
  93   } elsif (-d $generic) {
  94     $dir = catfile($generic, $prefix, join q(-), @{$versions});
  95   } else {
  96     croak "neither $main or $generic exist; please write/generate some SQL";
  97   }
  98
  99   opendir my($dh), $dir;
 100   my %files = map { $_ => "$dir/$_" } grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" } readdir $dh;
 101   closedir $dh;
 102
 103   if (-d $common) {
 104     opendir my($dh), $common;
 105     for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($common,$_) } readdir $dh) {
 106       unless ($files{$filename}) {
 107         $files{$filename} = catfile($common,$filename);
 108       }
 109     }
 110     closedir $dh;
 111   }
 112
 113   return [@files{sort keys %files}]
 114 }
 115
 116 method _ddl_preinstall_consume_filenames($type, $version) {
 117   $self->__ddl_consume_with_prefix($type, [ $version ], 'preinstall')
 118 }
 119
 120 method _ddl_schema_consume_filenames($type, $version) {
 121   $self->__ddl_consume_with_prefix($type, [ $version ], 'schema')
 122 }
 123
 124 method _ddl_schema_produce_filename($type, $version) {
 125   my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
 126   mkpath($dirname) unless -d $dirname;
 127
 128   return catfile( $dirname, '001-auto.sql' );
 129 }
 130
 131 method _ddl_schema_up_consume_filenames($type, $versions) {
 132   $self->__ddl_consume_with_prefix($type, $versions, 'up')
 133 }
 134
 135 method _ddl_schema_down_consume_filenames($type, $versions) {
 136   $self->__ddl_consume_with_prefix($type, $versions, 'down')
 137 }
 138
 139 method _ddl_schema_up_produce_filename($type, $versions) {
 140   my $dir = $self->script_directory;
 141
 142   my $dirname = catfile( $dir, $type, 'up', join q(-), @{$versions});
 143   mkpath($dirname) unless -d $dirname;
 144
 145   return catfile( $dirname, '001-auto.sql'
 146   );
 147 }
 148
 149 method _ddl_schema_down_produce_filename($type, $versions, $dir) {
 150   my $dirname = catfile( $dir, $type, 'down', join q(-), @{$versions} );
 151   mkpath($dirname) unless -d $dirname;
 152
 153   return catfile( $dirname, '001-auto.sql');
 154 }
 155
 156 method _run_sql_array($sql) {
 157   my $storage = $self->storage;
 158
 159   $sql = [grep {
 160     $_ && # remove blank lines
 161     !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
 162   } map {
 163     s/^\s+//; s/\s+$//; # trim whitespace
 164     join '', grep { !/^--/ } split /\n/ # remove comments
 165   } @$sql];
 166
 167   Dlog_trace { "Running SQL $_" } $sql;
 168   foreach my $line (@{$sql}) {
 169     $storage->_query_start($line);
 170     # the whole reason we do this is so that we can see the line that was run
 171     try {
 172       $storage->dbh_do (sub { $_[1]->do($line) });
 173     }
 174     catch {
 175       die "$_ (running line '$line')"
 176     }
 177     $storage->_query_end($line);
 178   }
 179   return join "\n", @$sql
 180 }
 181
 182 method _run_sql($filename) {
 183   log_debug { "Running SQL from $filename" };
 184   return $self->_run_sql_array($self->_read_sql_file($filename));
 185 }
 186
 187 method _run_perl($filename) {
 188   log_debug { "Running Perl from $filename" };
 189   my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 190
 191   no warnings 'redefine';
 192   my $fn = eval "$filedata";
 193   use warnings;
 194   Dlog_trace { "Running Perl $_" } $fn;
 195
 196   if ($@) {
 197     carp "$filename failed to compile: $@";
 198   } elsif (ref $fn eq 'CODE') {
 199     $fn->($self->schema)
 200   } else {
 201     carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
 202   }
 203 }
 204 {
 205    my $json;
 206
 207    method _run_serialized_sql($filename, $type) {
 208       if ($type eq 'json') {
 209          require JSON;
 210          $json ||= JSON->new->pretty;
 211          my @sql = @{$json->decode($filename)};
 212       } else {
 213          croak "A file ($filename) got to deploy that wasn't sql or perl!";
 214       }
 215    }
 216
 217 }
 218
 219 method _run_sql_and_perl($filenames) {
 220   my @files   = @{$filenames};
 221   my $guard   = $self->schema->txn_scope_guard if $self->txn_wrap;
 222
 223   my $sql = '';
 224   for my $filename (@files) {
 225     if ($filename =~ /\.sql$/) {
 226        $sql .= $self->_run_sql($filename)
 227     } elsif ( $filename =~ /\.sql-(\w+)$/ ) {
 228        $sql .= $self->_run_serialized_sql($filename, $1)
 229     } elsif ( $filename =~ /\.pl$/ ) {
 230        $self->_run_perl($filename)
 231     } else {
 232       croak "A file ($filename) got to deploy that wasn't sql or perl!";
 233     }
 234   }
 235
 236   $guard->commit if $self->txn_wrap;
 237
 238   return $sql;
 239 }
 240
 241 sub deploy {
 242   my $self = shift;
 243   my $version = (shift @_ || {})->{version} || $self->schema_version;
 244   log_info { "deploying version $version" };
 245
 246   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
 247     $self->storage->sqlt_type,
 248     $version,
 249   ));
 250 }
 251
 252 sub preinstall {
 253   my $self         = shift;
 254   my $args         = shift;
 255   my $version      = $args->{version}      || $self->schema_version;
 256   log_info { "preinstalling version $version" };
 257   my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
 258
 259   my @files = @{$self->_ddl_preinstall_consume_filenames(
 260     $storage_type,
 261     $version,
 262   )};
 263
 264   for my $filename (@files) {
 265     # We ignore sql for now (till I figure out what to do with it)
 266     if ( $filename =~ /^(.+)\.pl$/ ) {
 267       my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 268
 269       no warnings 'redefine';
 270       my $fn = eval "$filedata";
 271       use warnings;
 272
 273       if ($@) {
 274         carp "$filename failed to compile: $@";
 275       } elsif (ref $fn eq 'CODE') {
 276         $fn->()
 277       } else {
 278         carp "$filename should define an anonymous sub but it didn't!";
 279       }
 280     } else {
 281       croak "A file ($filename) got to preinstall_scripts that wasn't sql or perl!";
 282     }
 283   }
 284 }
 285
 286 sub _prepare_install {
 287   my $self      = shift;
 288   my $sqltargs  = { %{$self->sql_translator_args}, %{shift @_} };
 289   my $to_file   = shift;
 290   my $schema    = $self->schema;
 291   my $databases = $self->databases;
 292   my $dir       = $self->script_directory;
 293   my $version   = $self->schema_version;
 294
 295   my $sqlt = SQL::Translator->new({
 296     add_drop_table          => 1,
 297     ignore_constraint_names => 1,
 298     ignore_index_names      => 1,
 299     parser                  => 'SQL::Translator::Parser::DBIx::Class',
 300     %{$sqltargs}
 301   });
 302
 303   my $sqlt_schema = $sqlt->translate( data => $schema )
 304     or croak($sqlt->error);
 305
 306   foreach my $db (@$databases) {
 307     $sqlt->reset;
 308     $sqlt->{schema} = $sqlt_schema;
 309     $sqlt->producer($db);
 310
 311     my $filename = $self->$to_file($db, $version, $dir);
 312     if (-e $filename ) {
 313       carp "Overwriting existing DDL file - $filename";
 314       unlink $filename;
 315     }
 316
 317     my $output = $sqlt->translate;
 318     if(!$output) {
 319       carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
 320       next;
 321     }
 322     open my $file, q(>), $filename;
 323     print {$file} $output;
 324     close $file;
 325   }
 326 }
 327
 328 sub _resultsource_install_filename {
 329   my ($self, $source_name) = @_;
 330   return sub {
 331     my ($self, $type, $version) = @_;
 332     my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
 333     mkpath($dirname) unless -d $dirname;
 334
 335     return catfile( $dirname, "001-auto-$source_name.sql" );
 336   }
 337 }
 338
 339 sub install_resultsource {
 340   my ($self, $args) = @_;
 341   my $source          = $args->{result_source};
 342   my $version         = $args->{version};
 343   log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
 344   my $rs_install_file =
 345     $self->_resultsource_install_filename($source->source_name);
 346
 347   my $files = [
 348      $self->$rs_install_file(
 349       $self->storage->sqlt_type,
 350       $version,
 351     )
 352   ];
 353   $self->_run_sql_and_perl($files);
 354 }
 355
 356 sub prepare_resultsource_install {
 357   my $self = shift;
 358   my $source = (shift @_)->{result_source};
 359   log_info { 'preparing install for resultsource ' . $source->source_name };
 360
 361   my $filename = $self->_resultsource_install_filename($source->source_name);
 362   $self->_prepare_install({
 363       parser_args => { sources => [$source->source_name], }
 364     }, $filename);
 365 }
 366
 367 sub prepare_deploy {
 368   log_info { 'preparing deploy' };
 369   my $self = shift;
 370   $self->_prepare_install({}, '_ddl_schema_produce_filename');
 371 }
 372
 373 sub prepare_upgrade {
 374   my ($self, $args) = @_;
 375   log_info {
 376      "preparing upgrade from $args->{from_version} to $args->{to_version}"
 377   };
 378   $self->_prepare_changegrade(
 379     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'up'
 380   );
 381 }
 382
 383 sub prepare_downgrade {
 384   my ($self, $args) = @_;
 385   log_info {
 386      "preparing downgrade from $args->{from_version} to $args->{to_version}"
 387   };
 388   $self->_prepare_changegrade(
 389     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'down'
 390   );
 391 }
 392
 393 method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
 394   my $schema    = $self->schema;
 395   my $databases = $self->databases;
 396   my $dir       = $self->script_directory;
 397   my $sqltargs  = $self->sql_translator_args;
 398
 399   my $schema_version = $self->schema_version;
 400
 401   $sqltargs = {
 402     add_drop_table => 1,
 403     ignore_constraint_names => 1,
 404     ignore_index_names => 1,
 405     %{$sqltargs}
 406   };
 407
 408   my $sqlt = SQL::Translator->new( $sqltargs );
 409
 410   $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
 411   my $sqlt_schema = $sqlt->translate( data => $schema )
 412     or croak($sqlt->error);
 413
 414   foreach my $db (@$databases) {
 415     $sqlt->reset;
 416     $sqlt->{schema} = $sqlt_schema;
 417     $sqlt->producer($db);
 418
 419     my $prefilename = $self->_ddl_schema_produce_filename($db, $from_version, $dir);
 420     unless(-e $prefilename) {
 421       carp("No previous schema file found ($prefilename)");
 422       next;
 423     }
 424     my $diff_file_method = "_ddl_schema_${direction}_produce_filename";
 425     my $diff_file = $self->$diff_file_method($db, $version_set, $dir );
 426     if(-e $diff_file) {
 427       carp("Overwriting existing $direction-diff file - $diff_file");
 428       unlink $diff_file;
 429     }
 430
 431     my $source_schema;
 432     {
 433       my $t = SQL::Translator->new({
 434          %{$sqltargs},
 435          debug => 0,
 436          trace => 0,
 437       });
 438
 439       $t->parser( $db ) # could this really throw an exception?
 440         or croak($t->error);
 441
 442       my $out = $t->translate( $prefilename )
 443         or croak($t->error);
 444
 445       $source_schema = $t->schema;
 446
 447       $source_schema->name( $prefilename )
 448         unless  $source_schema->name;
 449     }
 450
 451     # The "new" style of producers have sane normalization and can support
 452     # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
 453     # And we have to diff parsed SQL against parsed SQL.
 454     my $dest_schema = $sqlt_schema;
 455
 456     unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
 457       my $t = SQL::Translator->new({
 458          %{$sqltargs},
 459          debug => 0,
 460          trace => 0,
 461       });
 462
 463       $t->parser( $db ) # could this really throw an exception?
 464         or croak($t->error);
 465
 466       my $filename = $self->_ddl_schema_produce_filename($db, $to_version, $dir);
 467       my $out = $t->translate( $filename )
 468         or croak($t->error);
 469
 470       $dest_schema = $t->schema;
 471
 472       $dest_schema->name( $filename )
 473         unless $dest_schema->name;
 474     }
 475
 476     my $diff = SQL::Translator::Diff::schema_diff(
 477        $source_schema, $db,
 478        $dest_schema,   $db,
 479        $sqltargs
 480     );
 481     open my $file, q(>), $diff_file;
 482     print {$file} $diff;
 483     close $file;
 484   }
 485 }
 486
 487 method _read_sql_file($file) {
 488   return unless $file;
 489
 490   open my $fh, '<', $file;
 491   my @data = split /;\n/, join '', <$fh>;
 492   close $fh;
 493
 494   @data = grep {
 495     $_ && # remove blank lines
 496     !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
 497   } map {
 498     s/^\s+//; s/\s+$//; # trim whitespace
 499     join '', grep { !/^--/ } split /\n/ # remove comments
 500   } @data;
 501
 502   return \@data;
 503 }
 504
 505 sub downgrade_single_step {
 506   my $self = shift;
 507   my $version_set = (shift @_)->{version_set};
 508   Dlog_info { "downgrade_single_step'ing $_" } $version_set;
 509
 510   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
 511     $self->storage->sqlt_type,
 512     $version_set,
 513   ));
 514
 515   return ['', $sql];
 516 }
 517
 518 sub upgrade_single_step {
 519   my $self = shift;
 520   my $version_set = (shift @_)->{version_set};
 521   Dlog_info { "upgrade_single_step'ing $_" } $version_set;
 522
 523   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
 524     $self->storage->sqlt_type,
 525     $version_set,
 526   ));
 527   return ['', $sql];
 528 }
 529
 530 __PACKAGE__->meta->make_immutable;
 531
 532 1;
 533
 534 # vim: ts=2 sw=2 expandtab
 535
 536 __END__
 537
 538 =head1 DESCRIPTION
 539
 540 This class is the meat of L<DBIx::Class::DeploymentHandler>.  It takes
 541 care of generating serialized sql files representing schemata as well
 542 as serialized sql files to move from one version of a schema to the rest.
 543 One of the hallmark features of this class is that it allows for multiple sql
 544 files for deploy and upgrade, allowing developers to fine tune deployment.
 545 In addition it also allows for perl files to be run
 546 at any stage of the process.
 547
 548 For basic usage see L<DBIx::Class::DeploymentHandler::HandlesDeploy>.  What's
 549 documented here is extra fun stuff or private methods.
 550
 551 =head1 DIRECTORY LAYOUT
 552
 553 Arguably this is the best feature of L<DBIx::Class::DeploymentHandler>.  It's
 554 heavily based upon L<DBIx::Migration::Directories>, but has some extensions and
 555 modifications, so even if you are familiar with it, please read this.  I feel
 556 like the best way to describe the layout is with the following example:
 557
 558  $sql_migration_dir
 559  |- SQLite
 560  |  |- down
 561  |  |  `- 2-1
 562  |  |     `- 001-auto.sql-json
 563  |  |- schema
 564  |  |  `- 1
 565  |  |     `- 001-auto.sql-json
 566  |  `- up
 567  |     |- 1-2
 568  |     |  `- 001-auto.sql-json
 569  |     `- 2-3
 570  |        `- 001-auto.sql-json
 571  |- _common
 572  |  |- down
 573  |  |  `- 2-1
 574  |  |     `- 002-remove-customers.pl
 575  |  `- up
 576  |     `- 1-2
 577  |        `- 002-generate-customers.pl
 578  |- _generic
 579  |  |- down
 580  |  |  `- 2-1
 581  |  |     `- 001-auto.sql-json
 582  |  |- schema
 583  |  |  `- 1
 584  |  |     `- 001-auto.sql-json
 585  |  `- up
 586  |     `- 1-2
 587  |        |- 001-auto.sql-json
 588  |        `- 002-create-stored-procedures.sql
 589  `- MySQL
 590     |- down
 591     |  `- 2-1
 592     |     `- 001-auto.sql-json
 593     |- preinstall
 594     |  `- 1
 595     |     |- 001-create_database.pl
 596     |     `- 002-create_users_and_permissions.pl
 597     |- schema
 598     |  `- 1
 599     |     `- 001-auto.sql-json
 600     `- up
 601        `- 1-2
 602           `- 001-auto.sql-json
 603
 604 So basically, the code
 605
 606  $dm->deploy(1)
 607
 608 on an C<SQLite> database that would simply run
 609 C<$sql_migration_dir/SQLite/schema/1/001-auto.sql-json>.  Next,
 610
 611  $dm->upgrade_single_step([1,2])
 612
 613 would run C<$sql_migration_dir/SQLite/up/1-2/001-auto.sql-json> followed by
 614 C<$sql_migration_dir/_common/up/1-2/002-generate-customers.pl>.
 615
 616 C<.pl> files don't have to be in the C<_common> directory, but most of the time
 617 they should be, because perl scripts are generally be database independent.
 618
 619 C<_generic> exists for when you for some reason are sure that your SQL is
 620 generic enough to run on all databases.  Good luck with that one.
 621
 622 Note that unlike most steps in the process, C<preinstall> will not run SQL, as
 623 there may not even be an database at preinstall time.  It will run perl scripts
 624 just like the other steps in the process, but nothing is passed to them.
 625 Until people have used this more it will remain freeform, but a recommended use
 626 of preinstall is to have it prompt for username and password, and then call the
 627 appropriate C<< CREATE DATABASE >> commands etc.
 628
 629 =head1 SERIALIZED SQL
 630
 631 The SQL that this module generates and uses is serialized into an array of
 632 SQL statements.  The reason being that some databases handle multiple
 633 statements in a single execution differently.  Generally you do not need to
 634 worry about this as these are scripts generated for you.  If you find that
 635 you are editing them on a regular basis something is wrong and you either need
 636 to submit a bug or consider writing extra serialized SQL or Perl scripts to run
 637 before or after the automatically generated script.
 638
 639 B<NOTE:> Currently the SQL is serialized into JSON.  I am willing to merge in
 640 patches that will allow more serialization formats if you want that feature,
 641 but if you do send me a patch for that realize that I do not want to add YAML
 642 support or whatever, I would rather add a generic method of adding any
 643 serialization format.
 644
 645 =head1 PERL SCRIPTS
 646
 647 A perl script for this tool is very simple.  It merely needs to contain an
 648 anonymous sub that takes a L<DBIx::Class::Schema> as it's only argument.
 649 A very basic perl script might look like:
 650
 651  #!perl
 652
 653  use strict;
 654  use warnings;
 655
 656  sub {
 657    my $schema = shift;
 658
 659    $schema->resultset('Users')->create({
 660      name => 'root',
 661      password => 'root',
 662    })
 663  }
 664
 665 =attr schema
 666
 667 The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database
 668 and generate the DDL.
 669
 670 =attr storage
 671
 672 The L<DBIx::Class::Storage> that is I<actually> used to talk to the database
 673 and generate the DDL.  This is automatically created with L</_build_storage>.
 674
 675 =attr sql_translator_args
 676
 677 The arguments that get passed to L<SQL::Translator> when it's used.
 678
 679 =attr script_directory
 680
 681 The directory (default C<'sql'>) that scripts are stored in
 682
 683 =attr databases
 684
 685 The types of databases (default C<< [qw( MySQL SQLite PostgreSQL )] >>) to
 686 generate files for
 687
 688 =attr txn_wrap
 689
 690 Set to true (which is the default) to wrap all upgrades and deploys in a single
 691 transaction.
 692
 693 =attr schema_version
 694
 695 The version the schema on your harddrive is at.  Defaults to
 696 C<< $self->schema->schema_version >>.
 697
 698 =begin comment
 699
 700 =head2 __ddl_consume_with_prefix
 701
 702  $dm->__ddl_consume_with_prefix( 'SQLite', [qw( 1.00 1.01 )], 'up' )
 703
 704 This is the meat of the multi-file upgrade/deploy stuff.  It returns a list of
 705 files in the order that they should be run for a generic "type" of upgrade.
 706 You should not be calling this in user code.
 707
 708 =head2 _ddl_schema_consume_filenames
 709
 710  $dm->__ddl_schema_consume_filenames( 'SQLite', [qw( 1.00 )] )
 711
 712 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for an
 713 initial deploy.
 714
 715 =head2 _ddl_schema_produce_filename
 716
 717  $dm->__ddl_schema_produce_filename( 'SQLite', [qw( 1.00 )] )
 718
 719 Returns a single file in which an initial schema will be stored.
 720
 721 =head2 _ddl_schema_up_consume_filenames
 722
 723  $dm->_ddl_schema_up_consume_filenames( 'SQLite', [qw( 1.00 )] )
 724
 725 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for an
 726 upgrade.
 727
 728 =head2 _ddl_schema_down_consume_filenames
 729
 730  $dm->_ddl_schema_down_consume_filenames( 'SQLite', [qw( 1.00 )] )
 731
 732 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for a
 733 downgrade.
 734
 735 =head2 _ddl_schema_up_produce_filenames
 736
 737  $dm->_ddl_schema_up_produce_filename( 'SQLite', [qw( 1.00 1.01 )] )
 738
 739 Returns a single file in which the sql to upgrade from one schema to another
 740 will be stored.
 741
 742 =head2 _ddl_schema_down_produce_filename
 743
 744  $dm->_ddl_schema_down_produce_filename( 'SQLite', [qw( 1.00 1.01 )] )
 745
 746 Returns a single file in which the sql to downgrade from one schema to another
 747 will be stored.
 748
 749 =head2 _resultsource_install_filename
 750
 751  my $filename_fn = $dm->_resultsource_install_filename('User');
 752  $dm->$filename_fn('SQLite', '1.00')
 753
 754 Returns a function which in turn returns a single filename used to install a
 755 single resultsource.  Weird interface is convenient for me.  Deal with it.
 756
 757 =head2 _run_sql_and_perl
 758
 759  $dm->_run_sql_and_perl([qw( list of filenames )])
 760
 761 Simply put, this runs the list of files passed to it.  If the file ends in
 762 C<.sql> it runs it as sql and if it ends in C<.pl> it runs it as a perl file.
 763
 764 Depending on L</txn_wrap> all of the files run will be wrapped in a single
 765 transaction.
 766
 767 =head2 _prepare_install
 768
 769  $dm->_prepare_install({ add_drop_table => 0 }, sub { 'file_to_create' })
 770
 771 Generates the sql file for installing the database.  First arg is simply
 772 L<SQL::Translator> args and the second is a coderef that returns the filename
 773 to store the sql in.
 774
 775 =head2 _prepare_changegrade
 776
 777  $dm->_prepare_changegrade('1.00', '1.01', [qw( 1.00 1.01)], 'up')
 778
 779 Generates the sql file for migrating from one schema version to another.  First
 780 arg is the version to start from, second is the version to go to, third is the
 781 L<version set|DBIx::Class::DeploymentHandler/VERSION SET>, and last is the
 782 direction of the changegrade, be it 'up' or 'down'.
 783
 784 =head2 _read_sql_file
 785
 786  $dm->_read_sql_file('foo.sql')
 787
 788 Reads a sql file and returns lines in an C<ArrayRef>.  Strips out comments,
 789 transactions, and blank lines.
 790
 791 =end comment