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