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 Log::Contextual::WarnLogger;
   9 use Log::Contextual qw(:log :dlog), -default_logger => Log::Contextual::WarnLogger->new({
  10    env_prefix => 'DBICDH'
  11 });
  12 use Data::Dumper::Concise;
  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 has _json => (
  83   is => 'ro',
  84   lazy_build => 1,
  85 );
  86
  87 sub _build__json { require JSON; JSON->new->pretty }
  88
  89 method __ddl_consume_with_prefix($type, $versions, $prefix) {
  90   my $base_dir = $self->script_directory;
  91
  92   my $main    = catfile( $base_dir, $type      );
  93   my $generic = catfile( $base_dir, '_generic' );
  94   my $common  =
  95     catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
  96
  97   my $dir;
  98   if (-d $main) {
  99     $dir = catfile($main, $prefix, join q(-), @{$versions})
 100   } elsif (-d $generic) {
 101     $dir = catfile($generic, $prefix, join q(-), @{$versions});
 102   } else {
 103     croak "neither $main or $generic exist; please write/generate some SQL";
 104   }
 105
 106   opendir my($dh), $dir;
 107   my %files = map { $_ => "$dir/$_" } grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" } readdir $dh;
 108   closedir $dh;
 109
 110   if (-d $common) {
 111     opendir my($dh), $common;
 112     for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($common,$_) } readdir $dh) {
 113       unless ($files{$filename}) {
 114         $files{$filename} = catfile($common,$filename);
 115       }
 116     }
 117     closedir $dh;
 118   }
 119
 120   return [@files{sort keys %files}]
 121 }
 122
 123 method _ddl_preinstall_consume_filenames($type, $version) {
 124   $self->__ddl_consume_with_prefix($type, [ $version ], 'preinstall')
 125 }
 126
 127 method _ddl_schema_consume_filenames($type, $version) {
 128   $self->__ddl_consume_with_prefix($type, [ $version ], 'schema')
 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-json' );
 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-json' );
 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-json');
 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   log_trace { '[DBICDH] Running SQL ' . Dumper($sql) };
 174   foreach my $line (@{$sql}) {
 175     $storage->_query_start($line);
 176     try {
 177       # do a dbh_do cycle here, as we need some error checking in
 178       # place (even though we will ignore errors)
 179       $storage->dbh_do (sub { $_[1]->do($line) });
 180     }
 181     catch {
 182       carp "$_ (running '${line}')"
 183     }
 184     $storage->_query_end($line);
 185   }
 186   return join "\n", @$sql
 187 }
 188
 189 method _run_sql($filename) {
 190   log_debug { "[DBICDH] Running SQL from $filename" };
 191   return $self->_run_sql_array($self->_read_sql_file($filename));
 192 }
 193
 194 method _run_perl($filename) {
 195   log_debug { "[DBICDH] Running Perl from $filename" };
 196   my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 197
 198   no warnings 'redefine';
 199   my $fn = eval "$filedata";
 200   use warnings;
 201   log_trace { '[DBICDH] Running Perl ' . Dumper($fn) };
 202
 203   if ($@) {
 204     carp "$filename failed to compile: $@";
 205   } elsif (ref $fn eq 'CODE') {
 206     $fn->($self->schema)
 207   } else {
 208     carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
 209   }
 210 }
 211
 212 method _run_serialized_sql($filename, $type) {
 213   if (lc $type eq 'json') {
 214     return $self->_run_sql_array($self->_json->decode(
 215       do { local( @ARGV, $/ ) = $filename; <> } # slurp
 216     ))
 217   } else {
 218     croak "$type is not one of the supported serialzed types"
 219   }
 220 }
 221
 222 method _run_sql_and_perl($filenames) {
 223   my @files   = @{$filenames};
 224   my $guard   = $self->schema->txn_scope_guard if $self->txn_wrap;
 225
 226   my $sql = '';
 227   for my $filename (@files) {
 228     if ($filename =~ /\.sql$/) {
 229        $sql .= $self->_run_sql($filename)
 230     } elsif ( $filename =~ /\.sql-(\w+)$/ ) {
 231        $sql .= $self->_run_serialized_sql($filename, $1)
 232     } elsif ( $filename =~ /\.pl$/ ) {
 233        $self->_run_perl($filename)
 234     } else {
 235       croak "A file ($filename) got to deploy that wasn't sql or perl!";
 236     }
 237   }
 238
 239   $guard->commit if $self->txn_wrap;
 240
 241   return $sql;
 242 }
 243
 244 sub deploy {
 245   my $self = shift;
 246   my $version = (shift @_ || {})->{version} || $self->schema_version;
 247   log_info { "[DBICDH] deploying version $version" };
 248
 249   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
 250     $self->storage->sqlt_type,
 251     $version,
 252   ));
 253 }
 254
 255 sub preinstall {
 256   my $self         = shift;
 257   my $args         = shift;
 258   my $version      = $args->{version}      || $self->schema_version;
 259   log_info { "[DBICDH] preinstalling version $version" };
 260   my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
 261
 262   my @files = @{$self->_ddl_preinstall_consume_filenames(
 263     $storage_type,
 264     $version,
 265   )};
 266
 267   for my $filename (@files) {
 268     # We ignore sql for now (till I figure out what to do with it)
 269     if ( $filename =~ /^(.+)\.pl$/ ) {
 270       my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 271
 272       no warnings 'redefine';
 273       my $fn = eval "$filedata";
 274       use warnings;
 275
 276       if ($@) {
 277         carp "$filename failed to compile: $@";
 278       } elsif (ref $fn eq 'CODE') {
 279         $fn->()
 280       } else {
 281         carp "$filename should define an anonymous sub but it didn't!";
 282       }
 283     } else {
 284       croak "A file ($filename) got to preinstall_scripts that wasn't sql or perl!";
 285     }
 286   }
 287 }
 288
 289 sub _prepare_install {
 290   my $self      = shift;
 291   my $sqltargs  = { %{$self->sql_translator_args}, %{shift @_} };
 292   my $to_file   = shift;
 293   my $schema    = $self->schema;
 294   my $databases = $self->databases;
 295   my $dir       = $self->script_directory;
 296   my $version   = $self->schema_version;
 297
 298   my $sqlt = SQL::Translator->new({
 299     no_comments             => 1,
 300     add_drop_table          => 1,
 301     ignore_constraint_names => 1,
 302     ignore_index_names      => 1,
 303     parser                  => 'SQL::Translator::Parser::DBIx::Class',
 304     %{$sqltargs}
 305   });
 306
 307   my $sqlt_schema = $sqlt->translate( data => $schema )
 308     or croak($sqlt->error);
 309
 310   foreach my $db (@$databases) {
 311     $sqlt->reset;
 312     $sqlt->{schema} = $sqlt_schema;
 313     $sqlt->producer($db);
 314
 315     my $filename = $self->$to_file($db, $version, $dir);
 316     if (-e $filename ) {
 317       carp "Overwriting existing DDL file - $filename";
 318       unlink $filename;
 319     }
 320
 321     my $sql = $self->_generate_final_sql($sqlt);
 322     if(!$sql) {
 323       carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
 324       next;
 325     }
 326     open my $file, q(>), $filename;
 327     print {$file} $sql;
 328     close $file;
 329   }
 330 }
 331
 332 method _generate_final_sql($sqlt) {
 333   my @output = $sqlt->translate;
 334   $self->_json->encode(\@output);
 335 }
 336
 337 sub _resultsource_install_filename {
 338   my ($self, $source_name) = @_;
 339   return sub {
 340     my ($self, $type, $version) = @_;
 341     my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
 342     mkpath($dirname) unless -d $dirname;
 343
 344     return catfile( $dirname, "001-auto-$source_name.sql-json" );
 345   }
 346 }
 347
 348 sub install_resultsource {
 349   my ($self, $args) = @_;
 350   my $source          = $args->{result_source};
 351   my $version         = $args->{version};
 352   log_info { '[DBICDH] installing_resultsource ' . $source->source_name . ", version $version" };
 353   my $rs_install_file =
 354     $self->_resultsource_install_filename($source->source_name);
 355
 356   my $files = [
 357      $self->$rs_install_file(
 358       $self->storage->sqlt_type,
 359       $version,
 360     )
 361   ];
 362   $self->_run_sql_and_perl($files);
 363 }
 364
 365 sub prepare_resultsource_install {
 366   my $self = shift;
 367   my $source = (shift @_)->{result_source};
 368   log_info { '[DBICDH] preparing install for resultsource ' . $source->source_name };
 369
 370   my $filename = $self->_resultsource_install_filename($source->source_name);
 371   $self->_prepare_install({
 372       parser_args => { sources => [$source->source_name], }
 373     }, $filename);
 374 }
 375
 376 sub prepare_deploy {
 377   log_info { '[DBICDH] preparing deploy' };
 378   my $self = shift;
 379   $self->_prepare_install({}, '_ddl_schema_produce_filename');
 380 }
 381
 382 sub prepare_upgrade {
 383   my ($self, $args) = @_;
 384   log_info {
 385      '[DBICDH] preparing upgrade ' .
 386      "from $args->{from_version} to $args->{to_version}"
 387   };
 388   $self->_prepare_changegrade(
 389     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'up'
 390   );
 391 }
 392
 393 sub prepare_downgrade {
 394   my ($self, $args) = @_;
 395   log_info {
 396      '[DBICDH] preparing downgrade ' .
 397      "from $args->{from_version} to $args->{to_version}"
 398   };
 399   $self->_prepare_changegrade(
 400     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'down'
 401   );
 402 }
 403
 404 method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
 405   my $schema    = $self->schema;
 406   my $databases = $self->databases;
 407   my $dir       = $self->script_directory;
 408   my $sqltargs  = $self->sql_translator_args;
 409
 410   my $schema_version = $self->schema_version;
 411
 412   $sqltargs = {
 413     add_drop_table => 1,
 414     no_comments => 1,
 415     ignore_constraint_names => 1,
 416     ignore_index_names => 1,
 417     %{$sqltargs}
 418   };
 419
 420   my $sqlt = SQL::Translator->new( $sqltargs );
 421
 422   $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
 423   my $sqlt_schema = $sqlt->translate( data => $schema )
 424     or croak($sqlt->error);
 425
 426   foreach my $db (@$databases) {
 427     $sqlt->reset;
 428     $sqlt->{schema} = $sqlt_schema;
 429     $sqlt->producer($db);
 430
 431     my $prefilename = $self->_ddl_schema_produce_filename($db, $from_version, $dir);
 432     unless(-e $prefilename) {
 433       carp("No previous schema file found ($prefilename)");
 434       next;
 435     }
 436     my $diff_file_method = "_ddl_schema_${direction}_produce_filename";
 437     my $diff_file = $self->$diff_file_method($db, $version_set, $dir );
 438     if(-e $diff_file) {
 439       carp("Overwriting existing $direction-diff file - $diff_file");
 440       unlink $diff_file;
 441     }
 442
 443     my $source_schema;
 444     {
 445       my $t = SQL::Translator->new({
 446          %{$sqltargs},
 447          debug => 0,
 448          trace => 0,
 449       });
 450
 451       $t->parser( $db ) # could this really throw an exception?
 452         or croak($t->error);
 453
 454       my $sql = $self->_default_read_sql_file_as_string($prefilename);
 455       my $out = $t->translate( \$sql )
 456         or croak($t->error);
 457
 458       $source_schema = $t->schema;
 459
 460       $source_schema->name( $prefilename )
 461         unless  $source_schema->name;
 462     }
 463
 464     # The "new" style of producers have sane normalization and can support
 465     # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
 466     # And we have to diff parsed SQL against parsed SQL.
 467     my $dest_schema = $sqlt_schema;
 468
 469     unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
 470       my $t = SQL::Translator->new({
 471          %{$sqltargs},
 472          debug => 0,
 473          trace => 0,
 474       });
 475
 476       $t->parser( $db ) # could this really throw an exception?
 477         or croak($t->error);
 478
 479       my $filename = $self->_ddl_schema_produce_filename($db, $to_version, $dir);
 480       my $sql = $self->_default_read_sql_file_as_string($filename);
 481       my $out = $t->translate( \$sql )
 482         or croak($t->error);
 483
 484       $dest_schema = $t->schema;
 485
 486       $dest_schema->name( $filename )
 487         unless $dest_schema->name;
 488     }
 489
 490     open my $file, q(>), $diff_file;
 491     print {$file}
 492       $self->_generate_final_diff($source_schema, $dest_schema, $db, $sqltargs);
 493     close $file;
 494   }
 495 }
 496
 497 method _generate_final_diff($source_schema, $dest_schema, $db, $sqltargs) {
 498   $self->_json->encode([
 499      SQL::Translator::Diff::schema_diff(
 500         $source_schema, $db,
 501         $dest_schema,   $db,
 502         $sqltargs
 503      )
 504   ])
 505 }
 506
 507 method _read_sql_file($file) {
 508   return unless $file;
 509
 510   open my $fh, '<', $file;
 511   my @data = split /;\n/, join '', <$fh>;
 512   close $fh;
 513
 514   return \@data;
 515 }
 516
 517 method _default_read_sql_file_as_string($file) {
 518   return join q(), map "$_;\n", @{$self->_json->decode(
 519     do { local( @ARGV, $/ ) = $file; <> } # slurp
 520   )};
 521 }
 522
 523 sub downgrade_single_step {
 524   my $self = shift;
 525   my $version_set = (shift @_)->{version_set};
 526   log_info { qq([DBICDH] downgrade_single_step'ing ) . Dumper($version_set) };
 527
 528   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
 529     $self->storage->sqlt_type,
 530     $version_set,
 531   ));
 532
 533   return ['', $sql];
 534 }
 535
 536 sub upgrade_single_step {
 537   my $self = shift;
 538   my $version_set = (shift @_)->{version_set};
 539   log_info { qq([DBICDH] upgrade_single_step'ing ) . Dumper($version_set) };
 540
 541   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
 542     $self->storage->sqlt_type,
 543     $version_set,
 544   ));
 545   return ['', $sql];
 546 }
 547
 548 __PACKAGE__->meta->make_immutable;
 549
 550 1;
 551
 552 # vim: ts=2 sw=2 expandtab
 553
 554 __END__
 555
 556 =head1 DESCRIPTION
 557
 558 This class is the meat of L<DBIx::Class::DeploymentHandler>.  It takes care of
 559 generating sql files representing schemata as well as sql files to move from
 560 one version of a schema to the rest.  One of the hallmark features of this
 561 class is that it allows for multiple sql files for deploy and upgrade, allowing
 562 developers to fine tune deployment.  In addition it also allows for perl files
 563 to be run at any stage of the process.
 564
 565 For basic usage see L<DBIx::Class::DeploymentHandler::HandlesDeploy>.  What's
 566 documented here is extra fun stuff or private methods.
 567
 568 =head1 DIRECTORY LAYOUT
 569
 570 Arguably this is the best feature of L<DBIx::Class::DeploymentHandler>.  It's
 571 heavily based upon L<DBIx::Migration::Directories>, but has some extensions and
 572 modifications, so even if you are familiar with it, please read this.  I feel
 573 like the best way to describe the layout is with the following example:
 574
 575  $sql_migration_dir
 576  |- SQLite
 577  |  |- down
 578  |  |  `- 2-1
 579  |  |     `- 001-auto.sql
 580  |  |- schema
 581  |  |  `- 1
 582  |  |     `- 001-auto.sql
 583  |  `- up
 584  |     |- 1-2
 585  |     |  `- 001-auto.sql
 586  |     `- 2-3
 587  |        `- 001-auto.sql
 588  |- _common
 589  |  |- down
 590  |  |  `- 2-1
 591  |  |     `- 002-remove-customers.pl
 592  |  `- up
 593  |     `- 1-2
 594  |        `- 002-generate-customers.pl
 595  |- _generic
 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  |        `- 002-create-stored-procedures.sql
 606  `- MySQL
 607     |- down
 608     |  `- 2-1
 609     |     `- 001-auto.sql
 610     |- preinstall
 611     |  `- 1
 612     |     |- 001-create_database.pl
 613     |     `- 002-create_users_and_permissions.pl
 614     |- schema
 615     |  `- 1
 616     |     `- 001-auto.sql
 617     `- up
 618        `- 1-2
 619           `- 001-auto.sql
 620
 621 So basically, the code
 622
 623  $dm->deploy(1)
 624
 625 on an C<SQLite> database that would simply run
 626 C<$sql_migration_dir/SQLite/schema/1/001-auto.sql>.  Next,
 627
 628  $dm->upgrade_single_step([1,2])
 629
 630 would run C<$sql_migration_dir/SQLite/up/1-2/001-auto.sql> followed by
 631 C<$sql_migration_dir/_common/up/1-2/002-generate-customers.pl>.
 632
 633 Now, a C<.pl> file doesn't have to be in the C<_common> directory, but most of
 634 the time it probably should be, since perl scripts will mostly be database
 635 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