0e890984b125f448db276c69a802f4a54d02f41f
[dbsrgits/DBIx-Class-DeploymentHandler.git] / 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::LogImporter qw(:log :dlog);
9 use Context::Preserve;
10
11 use Try::Tiny;
12
13 use SQL::Translator;
14 require SQL::Translator::Diff;
15
16 require DBIx::Class::Storage;   # loaded for type constraint
17 use DBIx::Class::DeploymentHandler::Types;
18
19 use File::Path 'mkpath';
20 use File::Spec::Functions;
21
22 with 'DBIx::Class::DeploymentHandler::HandlesDeploy';
23
24 has ignore_ddl => (
25   isa      => 'Bool',
26   is       => 'ro',
27   default  => undef,
28 );
29
30 has force_overwrite => (
31   isa      => 'Bool',
32   is       => 'ro',
33   default  => undef,
34 );
35
36 has schema => (
37   is       => 'ro',
38   required => 1,
39 );
40
41 has storage => (
42   isa        => 'DBIx::Class::Storage',
43   is         => 'ro',
44   lazy_build => 1,
45 );
46
47 sub _build_storage {
48   my $self = shift;
49   my $s = $self->schema->storage;
50   $s->_determine_driver;
51   $s
52 }
53
54 has sql_translator_args => (
55   isa => 'HashRef',
56   is  => 'ro',
57   default => sub { {} },
58 );
59 has script_directory => (
60   isa      => 'Str',
61   is       => 'ro',
62   required => 1,
63   default  => 'sql',
64 );
65
66 has databases => (
67   coerce  => 1,
68   isa     => 'DBIx::Class::DeploymentHandler::Databases',
69   is      => 'ro',
70   default => sub { [qw( MySQL SQLite PostgreSQL )] },
71 );
72
73 has txn_wrap => (
74   is => 'ro',
75   isa => 'Bool',
76   default => 1,
77 );
78
79 has schema_version => (
80   is => 'ro',
81   isa => 'Str',
82   lazy_build => 1,
83 );
84
85 # this will probably never get called as the DBICDH
86 # will be passing down a schema_version normally, which
87 # is built the same way, but we leave this in place
88 sub _build_schema_version {
89   my $self = shift;
90   $self->schema->schema_version
91 }
92
93 sub __ddl_consume_with_prefix {
94   my ($self, $type, $versions, $prefix) = @_;
95   my $base_dir = $self->script_directory;
96
97   my $main    = catfile( $base_dir, $type      );
98   my $common  =
99     catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
100
101   my $common_any  =
102     catfile( $base_dir, '_common', $prefix, '_any' );
103
104   my $dir;
105   if (-d $main) {
106     $dir = catfile($main, $prefix, join q(-), @{$versions})
107   } else {
108     if ($self->ignore_ddl) {
109       return []
110     } else {
111       croak "$main does not exist; please write/generate some SQL"
112     }
113   }
114   my $dir_any = catfile($main, $prefix, '_any');
115
116   my %files;
117   try {
118      opendir my($dh), $dir;
119      %files =
120        map { $_ => "$dir/$_" }
121        grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
122        readdir $dh;
123      closedir $dh;
124   } catch {
125     die $_ unless $self->ignore_ddl;
126   };
127   for my $dirname (grep { -d $_ } $common, $common_any, $dir_any) {
128     opendir my($dh), $dirname;
129     for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($dirname,$_) } readdir $dh) {
130       unless ($files{$filename}) {
131         $files{$filename} = catfile($dirname,$filename);
132       }
133     }
134     closedir $dh;
135   }
136
137   return [@files{sort keys %files}]
138 }
139
140 sub _ddl_initialize_consume_filenames {
141   my ($self, $type, $version) = @_;
142   $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
143 }
144
145 sub _ddl_schema_consume_filenames {
146   my ($self, $type, $version) = @_;
147   $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
148 }
149
150 sub _ddl_protoschema_deploy_consume_filenames {
151   my ($self, $version) = @_;
152   my $base_dir = $self->script_directory;
153
154   my $dir = catfile( $base_dir, '_source', 'deploy', $version);
155   return [] unless -d $dir;
156
157   opendir my($dh), $dir;
158   my %files = map { $_ => "$dir/$_" } grep { /\.yml$/ && -f "$dir/$_" } readdir $dh;
159   closedir $dh;
160
161   return [@files{sort keys %files}]
162 }
163
164 sub _ddl_protoschema_upgrade_consume_filenames {
165   my ($self, $versions) = @_;
166   my $base_dir = $self->script_directory;
167
168   my $dir = catfile( $base_dir, '_preprocess_schema', 'upgrade', join q(-), @{$versions});
169
170   return [] unless -d $dir;
171
172   opendir my($dh), $dir;
173   my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
174   closedir $dh;
175
176   return [@files{sort keys %files}]
177 }
178
179 sub _ddl_protoschema_downgrade_consume_filenames {
180   my ($self, $versions) = @_;
181   my $base_dir = $self->script_directory;
182
183   my $dir = catfile( $base_dir, '_preprocess_schema', 'downgrade', join q(-), @{$versions});
184
185   return [] unless -d $dir;
186
187   opendir my($dh), $dir;
188   my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
189   closedir $dh;
190
191   return [@files{sort keys %files}]
192 }
193
194 sub _ddl_protoschema_produce_filename {
195   my ($self, $version) = @_;
196   my $dirname = catfile( $self->script_directory, '_source', 'deploy',  $version );
197   mkpath($dirname) unless -d $dirname;
198
199   return catfile( $dirname, '001-auto.yml' );
200 }
201
202 sub _ddl_schema_produce_filename {
203   my ($self, $type, $version) = @_;
204   my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
205   mkpath($dirname) unless -d $dirname;
206
207   return catfile( $dirname, '001-auto.sql' );
208 }
209
210 sub _ddl_schema_upgrade_consume_filenames {
211   my ($self, $type, $versions) = @_;
212   $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
213 }
214
215 sub _ddl_schema_downgrade_consume_filenames {
216   my ($self, $type, $versions) = @_;
217   $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
218 }
219
220 sub _ddl_schema_upgrade_produce_filename {
221   my ($self, $type, $versions) = @_;
222   my $dir = $self->script_directory;
223
224   my $dirname = catfile( $dir, $type, 'upgrade', join q(-), @{$versions});
225   mkpath($dirname) unless -d $dirname;
226
227   return catfile( $dirname, '001-auto.sql' );
228 }
229
230 sub _ddl_schema_downgrade_produce_filename {
231   my ($self, $type, $versions, $dir) = @_;
232   my $dirname = catfile( $dir, $type, 'downgrade', join q(-), @{$versions} );
233   mkpath($dirname) unless -d $dirname;
234
235   return catfile( $dirname, '001-auto.sql');
236 }
237
238 sub _run_sql_array {
239   my ($self, $sql) = @_;
240   my $storage = $self->storage;
241
242   $sql = [ _split_sql_chunk( @$sql ) ];
243
244   Dlog_trace { "Running SQL $_" } $sql;
245   foreach my $line (@{$sql}) {
246     $storage->_query_start($line);
247     # the whole reason we do this is so that we can see the line that was run
248     try {
249       $storage->dbh_do (sub { $_[1]->do($line) });
250     }
251     catch {
252       die "$_ (running line '$line')"
253     };
254     $storage->_query_end($line);
255   }
256   return join "\n", @$sql
257 }
258
259 # split a chunk o' SQL into statements
260 sub _split_sql_chunk {
261     my @sql = map { split /;\n/, $_ } @_;
262
263     for ( @sql ) {
264         # strip transactions
265         s/^(?:BEGIN|BEGIN TRANSACTION|COMMIT).*//mgi;
266
267         # trim whitespaces
268         s/^\s+|\s+$//mg;
269
270         # remove comments
271         s/^--.*//gm;
272
273         # remove blank lines
274         s/^\n//mg;
275
276         # put on single line
277         s/\n/ /g;
278     }
279
280     return @sql;
281 }
282
283 sub _run_sql {
284   my ($self, $filename) = @_;
285   log_debug { "Running SQL from $filename" };
286   return $self->_run_sql_array($self->_read_sql_file($filename));
287 }
288
289 sub _load_sandbox {
290   my $_file = shift;
291
292   my $_package = $_file;
293   $_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", ord($1))/eg;
294
295   my $fn = eval sprintf <<'END_EVAL', $_package;
296 package DBICDH::Sandbox::%s;
297 {
298   our $app;
299   $app ||= require $_file;
300   if ( !$app && ( my $error = $@ || $! )) { die $error; }
301   $app;
302 }
303 END_EVAL
304
305   croak $@ if $@;
306
307   croak "$_file should define an anonymous sub that takes a schema but it didn't!"
308      unless ref $fn && ref $fn eq 'CODE';
309
310   return $fn;
311 }
312
313 sub _run_perl {
314   my ($self, $filename, $versions) = @_;
315   log_debug { "Running Perl from $filename" };
316
317   my $fn = _load_sandbox($filename);
318
319   Dlog_trace { "Running Perl $_" } $fn;
320
321   $fn->($self->schema, $versions)
322 }
323
324 sub txn_do {
325    my ( $self, $code ) = @_;
326    return $code->() unless $self->txn_wrap;
327
328    my $guard = $self->schema->txn_scope_guard;
329
330    return preserve_context { $code->() } after => sub { $guard->commit };
331 }
332
333 sub _run_sql_and_perl {
334   my ($self, $filenames, $sql_to_run, $versions) = @_;
335   my @files   = @{$filenames};
336   $self->txn_do(sub {
337      $self->_run_sql_array($sql_to_run) if $self->ignore_ddl;
338
339      my $sql = ($sql_to_run)?join ";\n", @$sql_to_run:'';
340      FILENAME:
341      for my $filename (@files) {
342        if ($self->ignore_ddl && $filename =~ /^[^_]*-auto.*\.sql$/) {
343          next FILENAME
344        } elsif ($filename =~ /\.sql$/) {
345           $sql .= $self->_run_sql($filename)
346        } elsif ( $filename =~ /\.pl$/ ) {
347           $self->_run_perl($filename, $versions)
348        } else {
349          croak "A file ($filename) got to deploy that wasn't sql or perl!";
350        }
351      }
352
353      return $sql;
354   });
355 }
356
357 sub deploy {
358   my $self = shift;
359   my $version = (shift @_ || {})->{version} || $self->schema_version;
360   log_info { "deploying version $version" };
361   my $sqlt_type = $self->storage->sqlt_type;
362   my $sql;
363   if ($self->ignore_ddl) {
364      $sql = $self->_sql_from_yaml({},
365        '_ddl_protoschema_deploy_consume_filenames', $sqlt_type
366      );
367   }
368   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
369     $sqlt_type,
370     $version,
371   ), $sql, [$version]);
372 }
373
374 sub initialize {
375   my $self         = shift;
376   my $args         = shift;
377   my $version      = $args->{version}      || $self->schema_version;
378   log_info { "initializing version $version" };
379   my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
380
381   my @files = @{$self->_ddl_initialize_consume_filenames(
382     $storage_type,
383     $version,
384   )};
385
386   for my $filename (@files) {
387     # We ignore sql for now (till I figure out what to do with it)
388     if ( $filename =~ /^(.+)\.pl$/ ) {
389       my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
390
391       no warnings 'redefine';
392       my $fn = eval "$filedata";
393       use warnings;
394
395       if ($@) {
396         croak "$filename failed to compile: $@";
397       } elsif (ref $fn eq 'CODE') {
398         $fn->()
399       } else {
400         croak "$filename should define an anonymous sub but it didn't!";
401       }
402     } else {
403       croak "A file ($filename) got to initialize_scripts that wasn't sql or perl!";
404     }
405   }
406 }
407
408 sub _sqldiff_from_yaml {
409   my ($self, $from_version, $to_version, $db, $direction) = @_;
410   my $dir       = $self->script_directory;
411   my $sqltargs = {
412     add_drop_table => 1,
413     ignore_constraint_names => 1,
414     ignore_index_names => 1,
415     %{$self->sql_translator_args}
416   };
417
418   my $source_schema;
419   {
420     my $prefilename = $self->_ddl_protoschema_produce_filename($from_version, $dir);
421
422     # should probably be a croak
423     carp("No previous schema file found ($prefilename)")
424        unless -e $prefilename;
425
426     my $t = SQL::Translator->new({
427        %{$sqltargs},
428        debug => 0,
429        trace => 0,
430        parser => 'SQL::Translator::Parser::YAML',
431     });
432
433     my $out = $t->translate( $prefilename )
434       or croak($t->error);
435
436     $source_schema = $t->schema;
437
438     $source_schema->name( $prefilename )
439       unless  $source_schema->name;
440   }
441
442   my $dest_schema;
443   {
444     my $filename = $self->_ddl_protoschema_produce_filename($to_version, $dir);
445
446     # should probably be a croak
447     carp("No next schema file found ($filename)")
448        unless -e $filename;
449
450     my $t = SQL::Translator->new({
451        %{$sqltargs},
452        debug => 0,
453        trace => 0,
454        parser => 'SQL::Translator::Parser::YAML',
455     });
456
457     my $out = $t->translate( $filename )
458       or croak($t->error);
459
460     $dest_schema = $t->schema;
461
462     $dest_schema->name( $filename )
463       unless $dest_schema->name;
464   }
465
466   my $transform_files_method =  "_ddl_protoschema_${direction}_consume_filenames";
467   my $transforms = $self->_coderefs_per_files(
468     $self->$transform_files_method([$from_version, $to_version])
469   );
470   $_->($source_schema, $dest_schema) for @$transforms;
471
472   return [SQL::Translator::Diff::schema_diff(
473      $source_schema, $db,
474      $dest_schema,   $db,
475      $sqltargs
476   )];
477 }
478
479 sub _sql_from_yaml {
480   my ($self, $sqltargs, $from_file, $db) = @_;
481   my $schema    = $self->schema;
482   my $version   = $self->schema_version;
483
484   my @sql;
485
486   my $actual_file = $self->$from_file($version);
487   for my $yaml_filename (@{
488      DlogS_trace { "generating SQL from Serialized SQL Files: $_" }
489         (ref $actual_file?$actual_file:[$actual_file])
490   }) {
491      my $sqlt = SQL::Translator->new({
492        add_drop_table          => 0,
493        parser                  => 'SQL::Translator::Parser::YAML',
494        %{$sqltargs},
495        producer => $db,
496      });
497
498      push @sql, $sqlt->translate($yaml_filename);
499      if(!@sql) {
500        carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
501        return undef;
502      }
503   }
504   return \@sql;
505 }
506
507 sub _prepare_install {
508   my $self      = shift;
509   my $sqltargs  = { %{$self->sql_translator_args}, %{shift @_} };
510   my $from_file = shift;
511   my $to_file   = shift;
512   my $dir       = $self->script_directory;
513   my $databases = $self->databases;
514   my $version   = $self->schema_version;
515
516   foreach my $db (@$databases) {
517     my $sql = $self->_sql_from_yaml($sqltargs, $from_file, $db ) or next;
518
519     my $filename = $self->$to_file($db, $version, $dir);
520     if (-e $filename ) {
521       if ($self->force_overwrite) {
522          carp "Overwriting existing DDL file - $filename";
523          unlink $filename;
524       } else {
525          die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
526       }
527     }
528     open my $file, q(>), $filename;
529     print {$file} join ";\n", @$sql;
530     close $file;
531   }
532 }
533
534 sub _resultsource_install_filename {
535   my ($self, $source_name) = @_;
536   return sub {
537     my ($self, $type, $version) = @_;
538     my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
539     mkpath($dirname) unless -d $dirname;
540
541     return catfile( $dirname, "001-auto-$source_name.sql" );
542   }
543 }
544
545 sub _resultsource_protoschema_filename {
546   my ($self, $source_name) = @_;
547   return sub {
548     my ($self, $version) = @_;
549     my $dirname = catfile( $self->script_directory, '_source', 'deploy', $version );
550     mkpath($dirname) unless -d $dirname;
551
552     return catfile( $dirname, "001-auto-$source_name.yml" );
553   }
554 }
555
556 sub install_resultsource {
557   my ($self, $args) = @_;
558   my $source          = $args->{result_source}
559     or die 'result_source must be passed to install_resultsource';
560   my $version         = $args->{version}
561     or die 'version must be passed to install_resultsource';
562   log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
563   my $rs_install_file =
564     $self->_resultsource_install_filename($source->source_name);
565
566   my $files = [
567      $self->$rs_install_file(
568       $self->storage->sqlt_type,
569       $version,
570     )
571   ];
572   $self->_run_sql_and_perl($files, '', [$version]);
573 }
574
575 sub prepare_resultsource_install {
576   my $self = shift;
577   my $source = (shift @_)->{result_source};
578   log_info { 'preparing install for resultsource ' . $source->source_name };
579
580   my $install_filename = $self->_resultsource_install_filename($source->source_name);
581   my $proto_filename = $self->_resultsource_protoschema_filename($source->source_name);
582   $self->prepare_protoschema({
583       parser_args => { sources => [$source->source_name], }
584   }, $proto_filename);
585   $self->_prepare_install({}, $proto_filename, $install_filename);
586 }
587
588 sub prepare_deploy {
589   log_info { 'preparing deploy' };
590   my $self = shift;
591   $self->prepare_protoschema({
592       # Exclude __VERSION so that it gets installed separately
593       parser_args => { sources => [grep { $_ ne '__VERSION' } $self->schema->sources], }
594   }, '_ddl_protoschema_produce_filename');
595   $self->_prepare_install({}, '_ddl_protoschema_produce_filename', '_ddl_schema_produce_filename');
596 }
597
598 sub prepare_upgrade {
599   my ($self, $args) = @_;
600   log_info {
601      "preparing upgrade from $args->{from_version} to $args->{to_version}"
602   };
603   $self->_prepare_changegrade(
604     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'upgrade'
605   );
606 }
607
608 sub prepare_downgrade {
609   my ($self, $args) = @_;
610   log_info {
611      "preparing downgrade from $args->{from_version} to $args->{to_version}"
612   };
613   $self->_prepare_changegrade(
614     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'downgrade'
615   );
616 }
617
618 sub _coderefs_per_files {
619   my ($self, $files) = @_;
620   no warnings 'redefine';
621   [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
622 }
623
624 sub _prepare_changegrade {
625   my ($self, $from_version, $to_version, $version_set, $direction) = @_;
626   my $schema    = $self->schema;
627   my $databases = $self->databases;
628   my $dir       = $self->script_directory;
629
630   my $schema_version = $self->schema_version;
631   my $diff_file_method = "_ddl_schema_${direction}_produce_filename";
632   foreach my $db (@$databases) {
633     my $diff_file = $self->$diff_file_method($db, $version_set, $dir );
634     if(-e $diff_file) {
635       if ($self->force_overwrite) {
636          carp("Overwriting existing $direction-diff file - $diff_file");
637          unlink $diff_file;
638       } else {
639          die "Cannot overwrite '$diff_file', either enable force_overwrite or delete it"
640       }
641     }
642
643     open my $file, q(>), $diff_file;
644     print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
645     close $file;
646   }
647 }
648
649 sub _read_sql_file {
650   my ($self, $file)  = @_;
651   return unless $file;
652
653    local $/ = undef;  #sluuuuuurp
654
655   open my $fh, '<', $file;
656   return [ _split_sql_chunk( <$fh> ) ];
657 }
658
659 sub downgrade_single_step {
660   my $self = shift;
661   my $version_set = (shift @_)->{version_set};
662   Dlog_info { "downgrade_single_step'ing $_" } $version_set;
663
664   my $sqlt_type = $self->storage->sqlt_type;
665   my $sql_to_run;
666   if ($self->ignore_ddl) {
667      $sql_to_run = $self->_sqldiff_from_yaml(
668        $version_set->[0], $version_set->[1], $sqlt_type, 'downgrade',
669      );
670   }
671   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_downgrade_consume_filenames(
672     $sqlt_type,
673     $version_set,
674   ), $sql_to_run, $version_set);
675
676   return ['', $sql];
677 }
678
679 sub upgrade_single_step {
680   my $self = shift;
681   my $version_set = (shift @_)->{version_set};
682   Dlog_info { "upgrade_single_step'ing $_" } $version_set;
683
684   my $sqlt_type = $self->storage->sqlt_type;
685   my $sql_to_run;
686   if ($self->ignore_ddl) {
687      $sql_to_run = $self->_sqldiff_from_yaml(
688        $version_set->[0], $version_set->[1], $sqlt_type, 'upgrade',
689      );
690   }
691   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_upgrade_consume_filenames(
692     $sqlt_type,
693     $version_set,
694   ), $sql_to_run, $version_set);
695   return ['', $sql];
696 }
697
698 sub prepare_protoschema {
699   my $self      = shift;
700   my $sqltargs  = { %{$self->sql_translator_args}, %{shift @_} };
701   my $to_file   = shift;
702   my $filename
703     = $self->$to_file($self->schema_version);
704
705   # we do this because the code that uses this sets parser args,
706   # so we just need to merge in the package
707   $sqltargs->{parser_args}{package} = $self->schema;
708   my $sqlt = SQL::Translator->new({
709     parser                  => 'SQL::Translator::Parser::DBIx::Class',
710     producer                => 'SQL::Translator::Producer::YAML',
711     %{ $sqltargs },
712   });
713
714   my $yml = $sqlt->translate;
715
716   croak("Failed to translate to YAML: " . $sqlt->error)
717     unless $yml;
718
719   if (-e $filename ) {
720     if ($self->force_overwrite) {
721        carp "Overwriting existing DDL-YML file - $filename";
722        unlink $filename;
723     } else {
724        die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
725     }
726   }
727
728   open my $file, q(>), $filename;
729   print {$file} $yml;
730   close $file;
731 }
732
733 __PACKAGE__->meta->make_immutable;
734
735 1;
736
737 # vim: ts=2 sw=2 expandtab
738
739 __END__
740
741 =head1 DESCRIPTION
742
743 This class is the meat of L<DBIx::Class::DeploymentHandler>.  It takes care
744 of generating serialized schemata  as well as sql files to move from one
745 version of a schema to the rest.  One of the hallmark features of this class
746 is that it allows for multiple sql files for deploy and upgrade, allowing
747 developers to fine tune deployment.  In addition it also allows for perl
748 files to be run at any stage of the process.
749
750 For basic usage see L<DBIx::Class::DeploymentHandler::HandlesDeploy>.  What's
751 documented here is extra fun stuff or private methods.
752
753 =head1 DIRECTORY LAYOUT
754
755 Arguably this is the best feature of L<DBIx::Class::DeploymentHandler>.
756 It's spiritually based upon L<DBIx::Migration::Directories>, but has a
757 lot of extensions and modifications, so even if you are familiar with it,
758 please read this.  I feel like the best way to describe the layout is with
759 the following example:
760
761  $sql_migration_dir
762  |- _source
763  |  |- deploy
764  |     |- 1
765  |     |  `- 001-auto.yml
766  |     |- 2
767  |     |  `- 001-auto.yml
768  |     `- 3
769  |        `- 001-auto.yml
770  |- SQLite
771  |  |- downgrade
772  |  |  `- 2-1
773  |  |     `- 001-auto.sql
774  |  |- deploy
775  |  |  `- 1
776  |  |     `- 001-auto.sql
777  |  `- upgrade
778  |     |- 1-2
779  |     |  `- 001-auto.sql
780  |     `- 2-3
781  |        `- 001-auto.sql
782  |- _common
783  |  |- downgrade
784  |  |  `- 2-1
785  |  |     `- 002-remove-customers.pl
786  |  `- upgrade
787  |     `- 1-2
788  |     |  `- 002-generate-customers.pl
789  |     `- _any
790  |        `- 999-bump-action.pl
791  `- MySQL
792     |- downgrade
793     |  `- 2-1
794     |     `- 001-auto.sql
795     |- initialize
796     |  `- 1
797     |     |- 001-create_database.pl
798     |     `- 002-create_users_and_permissions.pl
799     |- deploy
800     |  `- 1
801     |     `- 001-auto.sql
802     `- upgrade
803        `- 1-2
804           `- 001-auto.sql
805
806 So basically, the code
807
808  $dm->deploy(1)
809
810 on an C<SQLite> database that would simply run
811 C<$sql_migration_dir/SQLite/deploy/1/001-auto.sql>.  Next,
812
813  $dm->upgrade_single_step([1,2])
814
815 would run C<$sql_migration_dir/SQLite/upgrade/1-2/001-auto.sql> followed by
816 C<$sql_migration_dir/_common/upgrade/1-2/002-generate-customers.pl>, and
817 finally punctuated by
818 C<$sql_migration_dir/_common/upgrade/_any/999-bump-action.pl>.
819
820 C<.pl> files don't have to be in the C<_common> directory, but most of the time
821 they should be, because perl scripts are generally database independent.
822
823 Note that unlike most steps in the process, C<initialize> will not run SQL, as
824 there may not even be an database at initialize time.  It will run perl scripts
825 just like the other steps in the process, but nothing is passed to them.
826 Until people have used this more it will remain freeform, but a recommended use
827 of initialize is to have it prompt for username and password, and then call the
828 appropriate C<< CREATE DATABASE >> commands etc.
829
830 =head2 Directory Specification
831
832 The following subdirectories are recognized by this DeployMethod:
833
834 =over 2
835
836 =item C<_source> This directory can contain the following directories:
837
838 =over 2
839
840 =item C<deploy> This directory merely contains directories named after schema
841 versions, which in turn contain C<yaml> files that are serialized versions
842 of the schema at that version.  These files are not for editing by hand.
843
844 =back
845
846 =item C<_preprocess_schema> This directory can contain the following
847 directories:
848
849 =over 2
850
851 =item C<downgrade> This directory merely contains directories named after
852 migrations, which are of the form C<$from_version-$to_version>.  Inside of
853 these directories you may put Perl scripts which are to return a subref
854 that takes the arguments C<< $from_schema, $to_schema >>, which are
855 L<SQL::Translator::Schema> objects.
856
857 =item C<upgrade> This directory merely contains directories named after
858 migrations, which are of the form C<$from_version-$to_version>.  Inside of
859 these directories you may put Perl scripts which are to return a subref
860 that takes the arguments C<< $from_schema, $to_schema >>, which are
861 L<SQL::Translator::Schema> objects.
862
863 =back
864
865 =item C<$storage_type> This is a set of scripts that gets run depending on what
866 your storage type is.  If you are not sure what your storage type is, take a
867 look at the producers listed for L<SQL::Translator>.  Also note, C<_common>
868 is a special case.  C<_common> will get merged into whatever other files you
869 already have.  This directory can contain the following directories itself:
870
871 =over 2
872
873 =item C<initialize> Gets run before the C<deploy> is C<deploy>ed.  Has the
874 same structure as the C<deploy> subdirectory as well; that is, it has a
875 directory for each schema version.  Unlike C<deploy>, C<upgrade>, and C<downgrade>
876 though, it can only run C<.pl> files, and the coderef in the perl files get
877 no arguments passed to them.
878
879 =item C<deploy> Gets run when the schema is C<deploy>ed.  Structure is a
880 directory per schema version, and then files are merged with C<_common> and run
881 in filename order.  C<.sql> files are merely run, as expected.  C<.pl> files are
882 run according to L</PERL SCRIPTS>.
883
884 =item C<upgrade> Gets run when the schema is C<upgrade>d.  Structure is a directory
885 per upgrade step, (for example, C<1-2> for upgrading from version 1 to version
886 2,) and then files are merged with C<_common> and run in filename order.
887 C<.sql> files are merely run, as expected.  C<.pl> files are run according
888 to L</PERL SCRIPTS>.
889
890 =item C<downgrade> Gets run when the schema is C<downgrade>d.  Structure is a directory
891 per downgrade step, (for example, C<2-1> for downgrading from version 2 to version
892 1,) and then files are merged with C<_common> and run in filename order.
893 C<.sql> files are merely run, as expected.  C<.pl> files are run according
894 to L</PERL SCRIPTS>.
895
896
897 =back
898
899 =back
900
901 Note that there can be an C<_any> in the place of any of the versions (like
902 C<1-2> or C<1>), which means those scripts will be run B<every> time.  So if
903 you have an C<_any> in C<_common/upgrade>, that script will get run for every
904 upgrade.
905
906 =head1 PERL SCRIPTS
907
908 A perl script for this tool is very simple.  It merely needs to contain an
909 anonymous sub that takes a L<DBIx::Class::Schema> and the version set as it's
910 arguments.
911
912 A very basic perl script might look like:
913
914  #!perl
915
916  use strict;
917  use warnings;
918
919  use DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator::ScriptHelpers
920     'schema_from_schema_loader';
921
922  schema_from_schema_loader({ naming => 'v4' }, sub {
923    my $schema = shift;
924
925    # [1] for deploy, [1,2] for upgrade or downgrade, probably used with _any
926    my $versions = shift;
927
928    $schema->resultset('Users')->create({
929      name => 'root',
930      password => 'root',
931    })
932  })
933
934 Note that the above uses
935 L<DBIx::Class::DeploymentHanlder::DeployMethod::SQL::Translator::ScriptHelpers/schema_from_schema_loader>.
936 Using a raw coderef is strongly discouraged as it is likely to break as you
937 modify your schema.
938
939 =attr ignore_ddl
940
941 This attribute will, when set to true (default is false), cause the DM to use
942 L<SQL::Translator> to use the C<_source>'s serialized SQL::Translator::Schema
943 instead of any pregenerated SQL.  If you have a development server this is
944 probably the best plan of action as you will not be putting as many generated
945 files in your version control.  Goes well with with C<databases> of C<[]>.
946
947 =attr force_overwrite
948
949 When this attribute is true generated files will be overwritten when the
950 methods which create such files are run again.  The default is false, in which
951 case the program will die with a message saying which file needs to be deleted.
952
953 =attr schema
954
955 The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database
956 and generate the DDL.
957
958 =attr storage
959
960 The L<DBIx::Class::Storage> that is I<actually> used to talk to the database
961 and generate the DDL.  This is automatically created with L</_build_storage>.
962
963 =attr sql_translator_args
964
965 The arguments that get passed to L<SQL::Translator> when it's used.
966
967 =attr script_directory
968
969 The directory (default C<'sql'>) that scripts are stored in
970
971 =attr databases
972
973 The types of databases (default C<< [qw( MySQL SQLite PostgreSQL )] >>) to
974 generate files for
975
976 =attr txn_wrap
977
978 Set to true (which is the default) to wrap all upgrades and deploys in a single
979 transaction.
980
981 =attr schema_version
982
983 The version the schema on your harddrive is at.  Defaults to
984 C<< $self->schema->schema_version >>.
985
986 =head1 SEE ALSO
987
988 This class is an implementation of
989 L<DBIx::Class::DeploymentHandler::HandlesDeploy>.  Pretty much all the
990 documentation is there.