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