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