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