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 $common  =
  93     catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
  94
  95   my $dir;
  96   if (-d $main) {
  97     $dir = catfile($main, $prefix, join q(-), @{$versions})
  98   } else {
  99     croak "$main does not exist; please write/generate some SQL";
 100   }
 101
 102   my %files;
 103   try {
 104      opendir my($dh), $dir;
 105      %files =
 106        map { $_ => "$dir/$_" }
 107        grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
 108        readdir $dh;
 109      closedir $dh;
 110   } catch {
 111     die $_ unless $self->ignore_ddl;
 112   };
 113   if (-d $common) {
 114     opendir my($dh), $common;
 115     for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($common,$_) } readdir $dh) {
 116       unless ($files{$filename}) {
 117         $files{$filename} = catfile($common,$filename);
 118       }
 119     }
 120     closedir $dh;
 121   }
 122
 123   return [@files{sort keys %files}]
 124 }
 125
 126 method _ddl_preinstall_consume_filenames($type, $version) {
 127   $self->__ddl_consume_with_prefix($type, [ $version ], 'preinstall')
 128 }
 129
 130 method _ddl_schema_consume_filenames($type, $version) {
 131   $self->__ddl_consume_with_prefix($type, [ $version ], 'schema')
 132 }
 133
 134 method _ddl_protoschema_up_consume_filenames($versions) {
 135   my $base_dir = $self->script_directory;
 136
 137   my $dir = catfile( $base_dir, '_protoschema', 'up', join q(-), @{$versions});
 138
 139   return [] unless -d $dir;
 140
 141   opendir my($dh), $dir;
 142   my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
 143   closedir $dh;
 144
 145   return [@files{sort keys %files}]
 146 }
 147
 148 method _ddl_protoschema_down_consume_filenames($versions) {
 149   my $base_dir = $self->script_directory;
 150
 151   my $dir = catfile( $base_dir, '_protoschema', 'down', join q(-), @{$versions});
 152
 153   return [] unless -d $dir;
 154
 155   opendir my($dh), $dir;
 156   my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
 157   closedir $dh;
 158
 159   return [@files{sort keys %files}]
 160 }
 161
 162 method _ddl_protoschema_produce_filename($version) {
 163   my $dirname = catfile( $self->script_directory, '_protoschema', 'schema',  $version );
 164   mkpath($dirname) unless -d $dirname;
 165
 166   return catfile( $dirname, '001-auto.yml' );
 167 }
 168
 169 method _ddl_schema_produce_filename($type, $version) {
 170   my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
 171   mkpath($dirname) unless -d $dirname;
 172
 173   return catfile( $dirname, '001-auto.sql' );
 174 }
 175
 176 method _ddl_schema_up_consume_filenames($type, $versions) {
 177   $self->__ddl_consume_with_prefix($type, $versions, 'up')
 178 }
 179
 180 method _ddl_schema_down_consume_filenames($type, $versions) {
 181   $self->__ddl_consume_with_prefix($type, $versions, 'down')
 182 }
 183
 184 method _ddl_schema_up_produce_filename($type, $versions) {
 185   my $dir = $self->script_directory;
 186
 187   my $dirname = catfile( $dir, $type, 'up', join q(-), @{$versions});
 188   mkpath($dirname) unless -d $dirname;
 189
 190   return catfile( $dirname, '001-auto.sql' );
 191 }
 192
 193 method _ddl_schema_down_produce_filename($type, $versions, $dir) {
 194   my $dirname = catfile( $dir, $type, 'down', join q(-), @{$versions} );
 195   mkpath($dirname) unless -d $dirname;
 196
 197   return catfile( $dirname, '001-auto.sql');
 198 }
 199
 200 method _run_sql_array($sql) {
 201   my $storage = $self->storage;
 202
 203   $sql = [grep {
 204     $_ && # remove blank lines
 205     !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
 206   } map {
 207     s/^\s+//; s/\s+$//; # trim whitespace
 208     join '', grep { !/^--/ } split /\n/ # remove comments
 209   } @$sql];
 210
 211   Dlog_trace { "Running SQL $_" } $sql;
 212   foreach my $line (@{$sql}) {
 213     $storage->_query_start($line);
 214     # the whole reason we do this is so that we can see the line that was run
 215     try {
 216       $storage->dbh_do (sub { $_[1]->do($line) });
 217     }
 218     catch {
 219       die "$_ (running line '$line')"
 220     }
 221     $storage->_query_end($line);
 222   }
 223   return join "\n", @$sql
 224 }
 225
 226 method _run_sql($filename) {
 227   log_debug { "Running SQL from $filename" };
 228   return $self->_run_sql_array($self->_read_sql_file($filename));
 229 }
 230
 231 method _run_perl($filename) {
 232   log_debug { "Running Perl from $filename" };
 233   my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 234
 235   no warnings 'redefine';
 236   my $fn = eval "$filedata";
 237   use warnings;
 238   Dlog_trace { "Running Perl $_" } $fn;
 239
 240   if ($@) {
 241     carp "$filename failed to compile: $@";
 242   } elsif (ref $fn eq 'CODE') {
 243     $fn->($self->schema)
 244   } else {
 245     carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
 246   }
 247 }
 248
 249 method _run_sql_and_perl($filenames, $sql_to_run) {
 250   my @files   = @{$filenames};
 251   my $guard   = $self->schema->txn_scope_guard if $self->txn_wrap;
 252
 253   $self->_run_sql_array($sql_to_run) if $self->ignore_ddl;
 254
 255   my $sql = ($sql_to_run)?join ";\n", @$sql_to_run:'';
 256   FILENAME:
 257   for my $filename (@files) {
 258     if ($self->ignore_ddl && $filename =~ /^[^_]*-auto.*\.sql$/) {
 259       next FILENAME
 260     } elsif ($filename =~ /\.sql$/) {
 261        $sql .= $self->_run_sql($filename)
 262     } elsif ( $filename =~ /\.pl$/ ) {
 263        $self->_run_perl($filename)
 264     } else {
 265       croak "A file ($filename) got to deploy that wasn't sql or perl!";
 266     }
 267   }
 268
 269   $guard->commit if $self->txn_wrap;
 270
 271   return $sql;
 272 }
 273
 274 sub deploy {
 275   my $self = shift;
 276   my $version = (shift @_ || {})->{version} || $self->schema_version;
 277   log_info { "deploying version $version" };
 278   my $sqlt_type = $self->storage->sqlt_type;
 279   my $sql;
 280   if ($self->ignore_ddl) {
 281      $sql = $self->_sql_from_yaml({},
 282        '_ddl_protoschema_produce_filename', $sqlt_type
 283      );
 284   }
 285   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
 286     $sqlt_type,
 287     $version,
 288   ), $sql);
 289 }
 290
 291 sub preinstall {
 292   my $self         = shift;
 293   my $args         = shift;
 294   my $version      = $args->{version}      || $self->schema_version;
 295   log_info { "preinstalling version $version" };
 296   my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
 297
 298   my @files = @{$self->_ddl_preinstall_consume_filenames(
 299     $storage_type,
 300     $version,
 301   )};
 302
 303   for my $filename (@files) {
 304     # We ignore sql for now (till I figure out what to do with it)
 305     if ( $filename =~ /^(.+)\.pl$/ ) {
 306       my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 307
 308       no warnings 'redefine';
 309       my $fn = eval "$filedata";
 310       use warnings;
 311
 312       if ($@) {
 313         carp "$filename failed to compile: $@";
 314       } elsif (ref $fn eq 'CODE') {
 315         $fn->()
 316       } else {
 317         carp "$filename should define an anonymous sub but it didn't!";
 318       }
 319     } else {
 320       croak "A file ($filename) got to preinstall_scripts that wasn't sql or perl!";
 321     }
 322   }
 323 }
 324
 325 method _sqldiff_from_yaml($from_version, $to_version, $db, $direction) {
 326   my $dir       = $self->script_directory;
 327   my $sqltargs = {
 328     add_drop_table => 1,
 329     ignore_constraint_names => 1,
 330     ignore_index_names => 1,
 331     %{$self->sql_translator_args}
 332   };
 333
 334   my $source_schema;
 335   {
 336     my $prefilename = $self->_ddl_protoschema_produce_filename($from_version, $dir);
 337
 338     # should probably be a croak
 339     carp("No previous schema file found ($prefilename)")
 340        unless -e $prefilename;
 341
 342     my $t = SQL::Translator->new({
 343        %{$sqltargs},
 344        debug => 0,
 345        trace => 0,
 346        parser => 'SQL::Translator::Parser::YAML',
 347     });
 348
 349     my $out = $t->translate( $prefilename )
 350       or croak($t->error);
 351
 352     $source_schema = $t->schema;
 353
 354     $source_schema->name( $prefilename )
 355       unless  $source_schema->name;
 356   }
 357
 358   my $dest_schema;
 359   {
 360     my $filename = $self->_ddl_protoschema_produce_filename($to_version, $dir);
 361
 362     # should probably be a croak
 363     carp("No next schema file found ($filename)")
 364        unless -e $filename;
 365
 366     my $t = SQL::Translator->new({
 367        %{$sqltargs},
 368        debug => 0,
 369        trace => 0,
 370        parser => 'SQL::Translator::Parser::YAML',
 371     });
 372
 373     my $out = $t->translate( $filename )
 374       or croak($t->error);
 375
 376     $dest_schema = $t->schema;
 377
 378     $dest_schema->name( $filename )
 379       unless $dest_schema->name;
 380   }
 381
 382   my $transform_files_method =  "_ddl_protoschema_${direction}_consume_filenames";
 383   my $transforms = $self->_coderefs_per_files(
 384     $self->$transform_files_method([$from_version, $to_version])
 385   );
 386   $_->($source_schema, $dest_schema) for @$transforms;
 387
 388   return [SQL::Translator::Diff::schema_diff(
 389      $source_schema, $db,
 390      $dest_schema,   $db,
 391      $sqltargs
 392   )];
 393 }
 394
 395 method _sql_from_yaml($sqltargs, $from_file, $db) {
 396   my $schema    = $self->schema;
 397   my $version   = $self->schema_version;
 398
 399   my $sqlt = SQL::Translator->new({
 400     add_drop_table          => 0,
 401     parser                  => 'SQL::Translator::Parser::YAML',
 402     %{$sqltargs},
 403     producer => $db,
 404   });
 405
 406   my $yaml_filename = $self->$from_file($version);
 407
 408   my @sql = $sqlt->translate($yaml_filename);
 409   if(!@sql) {
 410     carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
 411     return undef;
 412   }
 413   return \@sql;
 414 }
 415
 416 sub _prepare_install {
 417   my $self      = shift;
 418   my $sqltargs  = { %{$self->sql_translator_args}, %{shift @_} };
 419   my $from_file = shift;
 420   my $to_file   = shift;
 421   my $dir       = $self->script_directory;
 422   my $databases = $self->databases;
 423   my $version   = $self->schema_version;
 424
 425   foreach my $db (@$databases) {
 426     my $sql = $self->_sql_from_yaml($sqltargs, $from_file, $db ) or next;
 427
 428     my $filename = $self->$to_file($db, $version, $dir);
 429     if (-e $filename ) {
 430       carp "Overwriting existing DDL file - $filename";
 431       unlink $filename;
 432     }
 433     open my $file, q(>), $filename;
 434     print {$file} join ";\n", @$sql;
 435     close $file;
 436   }
 437 }
 438
 439 sub _resultsource_install_filename {
 440   my ($self, $source_name) = @_;
 441   return sub {
 442     my ($self, $type, $version) = @_;
 443     my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
 444     mkpath($dirname) unless -d $dirname;
 445
 446     return catfile( $dirname, "001-auto-$source_name.sql" );
 447   }
 448 }
 449
 450 sub _resultsource_protoschema_filename {
 451   my ($self, $source_name) = @_;
 452   return sub {
 453     my ($self, $version) = @_;
 454     my $dirname = catfile( $self->script_directory, '_protoschema', $version );
 455     mkpath($dirname) unless -d $dirname;
 456
 457     return catfile( $dirname, "001-auto-$source_name.yml" );
 458   }
 459 }
 460
 461 sub install_resultsource {
 462   my ($self, $args) = @_;
 463   my $source          = $args->{result_source};
 464   my $version         = $args->{version};
 465   log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
 466   my $rs_install_file =
 467     $self->_resultsource_install_filename($source->source_name);
 468
 469   my $files = [
 470      $self->$rs_install_file(
 471       $self->storage->sqlt_type,
 472       $version,
 473     )
 474   ];
 475   $self->_run_sql_and_perl($files);
 476 }
 477
 478 sub prepare_resultsource_install {
 479   my $self = shift;
 480   my $source = (shift @_)->{result_source};
 481   log_info { 'preparing install for resultsource ' . $source->source_name };
 482
 483   my $install_filename = $self->_resultsource_install_filename($source->source_name);
 484   my $proto_filename = $self->_resultsource_protoschema_filename($source->source_name);
 485   $self->prepare_protoschema({
 486       parser_args => { sources => [$source->source_name], }
 487   }, $proto_filename);
 488   $self->_prepare_install({}, $proto_filename, $install_filename);
 489 }
 490
 491 sub prepare_deploy {
 492   log_info { 'preparing deploy' };
 493   my $self = shift;
 494   $self->prepare_protoschema({}, '_ddl_protoschema_produce_filename');
 495   $self->_prepare_install({}, '_ddl_protoschema_produce_filename', '_ddl_schema_produce_filename');
 496 }
 497
 498 sub prepare_upgrade {
 499   my ($self, $args) = @_;
 500   log_info {
 501      "preparing upgrade from $args->{from_version} to $args->{to_version}"
 502   };
 503   $self->_prepare_changegrade(
 504     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'up'
 505   );
 506 }
 507
 508 sub prepare_downgrade {
 509   my ($self, $args) = @_;
 510   log_info {
 511      "preparing downgrade from $args->{from_version} to $args->{to_version}"
 512   };
 513   $self->_prepare_changegrade(
 514     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'down'
 515   );
 516 }
 517
 518 method _coderefs_per_files($files) {
 519   no warnings 'redefine';
 520   [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
 521 }
 522
 523 method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
 524   my $schema    = $self->schema;
 525   my $databases = $self->databases;
 526   my $dir       = $self->script_directory;
 527
 528   my $schema_version = $self->schema_version;
 529   my $diff_file_method = "_ddl_schema_${direction}_produce_filename";
 530   foreach my $db (@$databases) {
 531     my $diff_file = $self->$diff_file_method($db, $version_set, $dir );
 532     if(-e $diff_file) {
 533       carp("Overwriting existing $direction-diff file - $diff_file");
 534       unlink $diff_file;
 535     }
 536
 537     open my $file, q(>), $diff_file;
 538     print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
 539     close $file;
 540   }
 541 }
 542
 543 method _read_sql_file($file) {
 544   return unless $file;
 545
 546   open my $fh, '<', $file;
 547   my @data = split /;\n/, join '', <$fh>;
 548   close $fh;
 549
 550   @data = grep {
 551     $_ && # remove blank lines
 552     !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
 553   } map {
 554     s/^\s+//; s/\s+$//; # trim whitespace
 555     join '', grep { !/^--/ } split /\n/ # remove comments
 556   } @data;
 557
 558   return \@data;
 559 }
 560
 561 sub downgrade_single_step {
 562   my $self = shift;
 563   my $version_set = (shift @_)->{version_set};
 564   Dlog_info { "downgrade_single_step'ing $_" } $version_set;
 565
 566   my $sqlt_type = $self->storage->sqlt_type;
 567   my $sql_to_run;
 568   if ($self->ignore_ddl) {
 569      $sql_to_run = $self->_sqldiff_from_yaml(
 570        $version_set->[0], $version_set->[1], $sqlt_type, 'down',
 571      );
 572   }
 573   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
 574     $sqlt_type,
 575     $version_set,
 576   ), $sql_to_run);
 577
 578   return ['', $sql];
 579 }
 580
 581 sub upgrade_single_step {
 582   my $self = shift;
 583   my $version_set = (shift @_)->{version_set};
 584   Dlog_info { "upgrade_single_step'ing $_" } $version_set;
 585
 586   my $sqlt_type = $self->storage->sqlt_type;
 587   my $sql_to_run;
 588   if ($self->ignore_ddl) {
 589      $sql_to_run = $self->_sqldiff_from_yaml(
 590        $version_set->[0], $version_set->[1], $sqlt_type, 'up',
 591      );
 592   }
 593   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
 594     $sqlt_type,
 595     $version_set,
 596   ), $sql_to_run);
 597   return ['', $sql];
 598 }
 599
 600 sub prepare_protoschema {
 601   my $self      = shift;
 602   my $sqltargs  = { %{$self->sql_translator_args}, %{shift @_} };
 603   my $to_file   = shift;
 604   my $filename
 605     = $self->$to_file($self->schema_version);
 606
 607   # we do this because the code that uses this sets parser args,
 608   # so we just need to merge in the package
 609   $sqltargs->{parser_args}{package} = $self->schema;
 610   my $sqlt = SQL::Translator->new({
 611     parser                  => 'SQL::Translator::Parser::DBIx::Class',
 612     producer                => 'SQL::Translator::Producer::YAML',
 613     %{ $sqltargs },
 614   });
 615
 616   my $yml = $sqlt->translate;
 617
 618   croak("Failed to translate to YAML: " . $sqlt->error)
 619     unless $yml;
 620
 621   if (-e $filename ) {
 622     carp "Overwriting existing DDL-YML file - $filename";
 623     unlink $filename;
 624   }
 625
 626   open my $file, q(>), $filename;
 627   print {$file} $yml;
 628   close $file;
 629 }
 630
 631 __PACKAGE__->meta->make_immutable;
 632
 633 1;
 634
 635 # vim: ts=2 sw=2 expandtab
 636
 637 __END__
 638
 639 =head1 DESCRIPTION
 640
 641 This class is the meat of L<DBIx::Class::DeploymentHandler>.  It takes care
 642 of generating serialized schemata  as well as sql files to move from one
 643 version of a schema to the rest.  One of the hallmark features of this class
 644 is that it allows for multiple sql files for deploy and upgrade, allowing
 645 developers to fine tune deployment.  In addition it also allows for perl
 646 files to be run at any stage of the process.
 647
 648 For basic usage see L<DBIx::Class::DeploymentHandler::HandlesDeploy>.  What's
 649 documented here is extra fun stuff or private methods.
 650
 651 =head1 DIRECTORY LAYOUT
 652
 653 Arguably this is the best feature of L<DBIx::Class::DeploymentHandler>.  It's
 654 heavily based upon L<DBIx::Migration::Directories>, but has some extensions and
 655 modifications, so even if you are familiar with it, please read this.  I feel
 656 like the best way to describe the layout is with the following example:
 657
 658  $sql_migration_dir
 659  |- _protoschema
 660  |  |- schema
 661  |     |- 1
 662  |     |  `- 001-auto.yml
 663  |     |- 2
 664  |     |  `- 001-auto.yml
 665  |     `- 3
 666  |        `- 001-auto.yml
 667  |- SQLite
 668  |  |- down
 669  |  |  `- 2-1
 670  |  |     `- 001-auto.sql
 671  |  |- schema
 672  |  |  `- 1
 673  |  |     `- 001-auto.sql
 674  |  `- up
 675  |     |- 1-2
 676  |     |  `- 001-auto.sql
 677  |     `- 2-3
 678  |        `- 001-auto.sql
 679  |- _common
 680  |  |- down
 681  |  |  `- 2-1
 682  |  |     `- 002-remove-customers.pl
 683  |  `- up
 684  |     `- 1-2
 685  |        `- 002-generate-customers.pl
 686  `- MySQL
 687     |- down
 688     |  `- 2-1
 689     |     `- 001-auto.sql
 690     |- preinstall
 691     |  `- 1
 692     |     |- 001-create_database.pl
 693     |     `- 002-create_users_and_permissions.pl
 694     |- schema
 695     |  `- 1
 696     |     `- 001-auto.sql
 697     `- up
 698        `- 1-2
 699           `- 001-auto.sql
 700
 701 So basically, the code
 702
 703  $dm->deploy(1)
 704
 705 on an C<SQLite> database that would simply run
 706 C<$sql_migration_dir/SQLite/schema/1/001-auto.sql>.  Next,
 707
 708  $dm->upgrade_single_step([1,2])
 709
 710 would run C<$sql_migration_dir/SQLite/up/1-2/001-auto.sql> followed by
 711 C<$sql_migration_dir/_common/up/1-2/002-generate-customers.pl>.
 712
 713 C<.pl> files don't have to be in the C<_common> directory, but most of the time
 714 they should be, because perl scripts are generally be database independent.
 715
 716 Note that unlike most steps in the process, C<preinstall> will not run SQL, as
 717 there may not even be an database at preinstall time.  It will run perl scripts
 718 just like the other steps in the process, but nothing is passed to them.
 719 Until people have used this more it will remain freeform, but a recommended use
 720 of preinstall is to have it prompt for username and password, and then call the
 721 appropriate C<< CREATE DATABASE >> commands etc.
 722
 723 =head2 Directory Specification
 724
 725 The following subdirectories are recognized by this DeployMethod:
 726
 727 =over 2
 728
 729 =item C<_protoschema> This directory can contain the following directories:
 730
 731 =over 2
 732
 733 =item C<down> This directory merely contains directories named after
 734 migrations, which are of the form C<$from_version-$to_version>.  Inside of
 735 these directories you may put Perl scripts which are to return a subref
 736 that takes the arguments C<< $from_schema, $to_schema >>, which are
 737 L<SQL::Translator::Schema> objects.
 738
 739 =item C<up> This directory merely contains directories named after
 740 migrations, which are of the form C<$from_version-$to_version>.  Inside of
 741 these directories you may put Perl scripts which are to return a subref
 742 that takes the arguments C<< $from_schema, $to_schema >>, which are
 743 L<SQL::Translator::Schema> objects.
 744
 745 =item C<schema> This directory merely contains directories named after schema
 746 versions, which in turn contain C<yaml> files that are serialized versions
 747 of the schema at that version.  These files are not for editing by hand.
 748
 749 =back
 750
 751 =item C<$storage_type> This is a set of scripts that gets run depending on what
 752 your storage type is.  If you are not sure what your storage type is, take a
 753 look at the producers listed for L<SQL::Translator>.  Also note, C<_common>
 754 is a special case.  C<_common> will get merged into whatever other files you
 755 already have.  This directory can containt the following directories itself:
 756
 757 =over 2
 758
 759 =item C<preinstall> Gets run before the C<schema> is C<deploy>ed.  Has the
 760 same structure as the C<schema> subdirectory as well; that is, it has a
 761 directory for each schema version.  Unlike C<schema>, C<up>, and C<down>
 762 though, it can only run C<.pl> files, and the coderef in the perl files get
 763 no arguments passed to them.
 764
 765 =item C<schema> Gets run when the schema is C<deploy>ed.  Structure is a
 766 directory per schema version, and then files are merged with C<_common> and run
 767 in filename order.  C<.sql> files are merely run, as expected.  C<.pl> files are
 768 run according to L</PERL SCRIPTS>.
 769
 770 =item C<up> Gets run when the schema is C<upgrade>d.  Structure is a directory
 771 per upgrade step, (for example, C<1-2> for upgrading from version 1 to version
 772 2,) and then files are merged with C<_common> and run in filename order.
 773 C<.sql> files are merely run, as expected.  C<.pl> files are run according
 774 to L</PERL SCRIPTS>.
 775
 776 =item C<down> Gets run when the schema is C<downgrade>d.  Structure is a directory
 777 per downgrade step, (for example, C<2-1> for downgrading from version 2 to version
 778 1,) and then files are merged with C<_common> and run in filename order.
 779 C<.sql> files are merely run, as expected.  C<.pl> files are run according
 780 to L</PERL SCRIPTS>.
 781
 782
 783 =back
 784
 785 =back
 786
 787 =head1 PERL SCRIPTS
 788
 789 A perl script for this tool is very simple.  It merely needs to contain an
 790 anonymous sub that takes a L<DBIx::Class::Schema> as it's only argument.
 791 A very basic perl script might look like:
 792
 793  #!perl
 794
 795  use strict;
 796  use warnings;
 797
 798  sub {
 799    my $schema = shift;
 800
 801    $schema->resultset('Users')->create({
 802      name => 'root',
 803      password => 'root',
 804    })
 805  }
 806
 807 =attr schema
 808
 809 The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database
 810 and generate the DDL.
 811
 812 =attr storage
 813
 814 The L<DBIx::Class::Storage> that is I<actually> used to talk to the database
 815 and generate the DDL.  This is automatically created with L</_build_storage>.
 816
 817 =attr sql_translator_args
 818
 819 The arguments that get passed to L<SQL::Translator> when it's used.
 820
 821 =attr script_directory
 822
 823 The directory (default C<'sql'>) that scripts are stored in
 824
 825 =attr databases
 826
 827 The types of databases (default C<< [qw( MySQL SQLite PostgreSQL )] >>) to
 828 generate files for
 829
 830 =attr txn_wrap
 831
 832 Set to true (which is the default) to wrap all upgrades and deploys in a single
 833 transaction.
 834
 835 =attr schema_version
 836
 837 The version the schema on your harddrive is at.  Defaults to
 838 C<< $self->schema->schema_version >>.
 839
 840 =begin comment
 841
 842 =head2 __ddl_consume_with_prefix
 843
 844  $dm->__ddl_consume_with_prefix( 'SQLite', [qw( 1.00 1.01 )], 'up' )
 845
 846 This is the meat of the multi-file upgrade/deploy stuff.  It returns a list of
 847 files in the order that they should be run for a generic "type" of upgrade.
 848 You should not be calling this in user code.
 849
 850 =head2 _ddl_schema_consume_filenames
 851
 852  $dm->__ddl_schema_consume_filenames( 'SQLite', [qw( 1.00 )] )
 853
 854 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for an
 855 initial deploy.
 856
 857 =head2 _ddl_schema_produce_filename
 858
 859  $dm->__ddl_schema_produce_filename( 'SQLite', [qw( 1.00 )] )
 860
 861 Returns a single file in which an initial schema will be stored.
 862
 863 =head2 _ddl_schema_up_consume_filenames
 864
 865  $dm->_ddl_schema_up_consume_filenames( 'SQLite', [qw( 1.00 )] )
 866
 867 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for an
 868 upgrade.
 869
 870 =head2 _ddl_schema_down_consume_filenames
 871
 872  $dm->_ddl_schema_down_consume_filenames( 'SQLite', [qw( 1.00 )] )
 873
 874 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for a
 875 downgrade.
 876
 877 =head2 _ddl_schema_up_produce_filenames
 878
 879  $dm->_ddl_schema_up_produce_filename( 'SQLite', [qw( 1.00 1.01 )] )
 880
 881 Returns a single file in which the sql to upgrade from one schema to another
 882 will be stored.
 883
 884 =head2 _ddl_schema_down_produce_filename
 885
 886  $dm->_ddl_schema_down_produce_filename( 'SQLite', [qw( 1.00 1.01 )] )
 887
 888 Returns a single file in which the sql to downgrade from one schema to another
 889 will be stored.
 890
 891 =head2 _resultsource_install_filename
 892
 893  my $filename_fn = $dm->_resultsource_install_filename('User');
 894  $dm->$filename_fn('SQLite', '1.00')
 895
 896 Returns a function which in turn returns a single filename used to install a
 897 single resultsource.  Weird interface is convenient for me.  Deal with it.
 898
 899 =head2 _run_sql_and_perl
 900
 901  $dm->_run_sql_and_perl([qw( list of filenames )])
 902
 903 Simply put, this runs the list of files passed to it.  If the file ends in
 904 C<.sql> it runs it as sql and if it ends in C<.pl> it runs it as a perl file.
 905
 906 Depending on L</txn_wrap> all of the files run will be wrapped in a single
 907 transaction.
 908
 909 =head2 _prepare_install
 910
 911  $dm->_prepare_install({ add_drop_table => 0 }, sub { 'file_to_create' })
 912
 913 Generates the sql file for installing the database.  First arg is simply
 914 L<SQL::Translator> args and the second is a coderef that returns the filename
 915 to store the sql in.
 916
 917 =head2 _prepare_changegrade
 918
 919  $dm->_prepare_changegrade('1.00', '1.01', [qw( 1.00 1.01)], 'up')
 920
 921 Generates the sql file for migrating from one schema version to another.  First
 922 arg is the version to start from, second is the version to go to, third is the
 923 L<version set|DBIx::Class::DeploymentHandler/VERSION SET>, and last is the
 924 direction of the changegrade, be it 'up' or 'down'.
 925
 926 =head2 _read_sql_file
 927
 928  $dm->_read_sql_file('foo.sql')
 929
 930 Reads a sql file and returns lines in an C<ArrayRef>.  Strips out comments,
 931 transactions, and blank lines.
 932
 933 =end comment