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