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