1 package DBIx::Class::DeploymentHandler::SqltDeployMethod;
3 use Method::Signatures::Simple;
7 method deployment_statements {
8 my $dir = $self->upgrade_directory;
9 my $schema = $self->schema;
10 my $type = $self->storage->sqlt_type;
11 my $sqltargs = $self->sqltargs;
12 my $version = $self->schema_version || '1.x';
14 my $filename = $self->ddl_filename($type, $version, $dir);
17 open $file, q(<), $filename
18 or carp "Can't open $filename ($!)";
21 return join '', @rows;
24 # sources needs to be a parser arg, but for simplicty allow at top level
26 $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
27 if exists $sqltargs->{sources};
29 my $tr = SQL::Translator->new(
30 producer => "SQL::Translator::Producer::${type}",
32 parser => 'SQL::Translator::Parser::DBIx::Class',
39 @ret = $tr->translate;
42 $ret[0] = $tr->translate;
45 $schema->throw_exception( 'Unable to produce deployment statements: ' . $tr->error)
46 unless (@ret && defined $ret[0]);
48 return $wa ? @ret : $ret[0];
52 my $schema = $self->schema;
54 my $sqltargs = $self->sqltargs;
55 my $dir = $self->upgrade_directory;
56 my $storage = $self->storage;
60 return if(!$line || $line =~ /^--|^BEGIN TRANSACTION|^COMMIT|^\s+$/);
61 $storage->_query_start($line);
63 # do a dbh_do cycle here, as we need some error checking in
64 # place (even though we will ignore errors)
65 $storage->dbh_do (sub { $_[1]->do($line) });
68 carp "$_ (running '${line}')"
70 $storage->_query_end($line);
72 my @statements = $self->deployment_statements();
73 if (@statements > 1) {
74 foreach my $statement (@statements) {
75 $deploy->( $statement );
78 elsif (@statements == 1) {
79 foreach my $line ( split(";\n", $statements[0])) {
85 method create_install_ddl {
86 my $schema = $self->schema;
87 my $databases = $self->databases;
88 my $dir = $self->upgrade_directory;
89 my $sqltargs = $self->sqltargs;
91 carp "Upgrade directory $dir does not exist, using ./\n";
95 my $version = $schema->schema_version || '1.x';
96 my $schema_version = $schema->schema_version || '1.x';
97 $version ||= $schema_version;
101 ignore_constraint_names => 1,
102 ignore_index_names => 1,
106 my $sqlt = SQL::Translator->new( $sqltargs );
108 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
109 my $sqlt_schema = $sqlt->translate({ data => $schema })
110 or $self->throw_exception ($sqlt->error);
112 foreach my $db (@$databases) {
114 $sqlt->{schema} = $sqlt_schema;
115 $sqlt->producer($db);
117 my $filename = $self->ddl_filename($db, $version, $dir);
118 if (-e $filename && ($version eq $schema_version )) {
119 # if we are dumping the current version, overwrite the DDL
120 carp "Overwriting existing DDL file - $filename";
124 my $output = $sqlt->translate;
126 carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
130 unless( open $file, q(>), $filename ) {
131 $self->throw_exception("Can't open $filename for writing ($!)");
134 print {$file} $output;
139 method create_update_ddl($version, $preversion) {
140 my $schema = $self->schema;
141 my $databases = $self->databases;
142 my $dir = $self->upgrade_directory;
143 my $sqltargs = $self->sqltargs;
146 carp "Upgrade directory $dir does not exist, using ./\n";
150 my $schema_version = $schema->schema_version || '1.x';
151 $version ||= $schema_version;
155 ignore_constraint_names => 1,
156 ignore_index_names => 1,
160 my $sqlt = SQL::Translator->new( $sqltargs );
162 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
163 my $sqlt_schema = $sqlt->translate({ data => $schema })
164 or $self->throw_exception ($sqlt->error);
166 foreach my $db (@$databases) {
168 $sqlt->{schema} = $sqlt_schema;
169 $sqlt->producer($db);
171 my $prefilename = $self->ddl_filename($db, $preversion, $dir);
172 unless(-e $prefilename) {
173 carp("No previous schema file found ($prefilename)");
177 my $diff_file = $self->ddl_filename($db, $version, $dir, $preversion);
179 carp("Overwriting existing diff file - $diff_file");
185 my $t = SQL::Translator->new({
191 $t->parser( $db ) # could this really throw an exception?
192 or $self->throw_exception ($t->error);
194 my $out = $t->translate( $prefilename )
195 or $self->throw_exception ($t->error);
197 $source_schema = $t->schema;
199 $source_schema->name( $prefilename )
200 unless $source_schema->name;
203 # The "new" style of producers have sane normalization and can support
204 # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
205 # And we have to diff parsed SQL against parsed SQL.
206 my $dest_schema = $sqlt_schema;
208 unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
209 my $t = SQL::Translator->new({
215 $t->parser( $db ) # could this really throw an exception?
216 or $self->throw_exception ($t->error);
218 my $filename = $self->ddl_filename($db, $version, $dir);
219 my $out = $t->translate( $filename )
220 or $self->throw_exception ($t->error);
222 $dest_schema = $t->schema;
224 $dest_schema->name( $filename )
225 unless $dest_schema->name;
228 my $diff = SQL::Translator::Diff::schema_diff(
234 unless(open $file, q(>), $diff_file) {
235 $self->throw_exception("Can't write to $diff_file ($!)");
243 method create_ddl_dir($version, $preversion) {
244 $self->create_install_ddl;
245 $self->create_update_ddl($version, $preversion) if $preversion;