1 package DBIx::Class::DeploymentHandler::SqltDeployMethod;
3 use Method::Signatures::Simple;
9 isa => 'DBIx::Class::Storage',
14 method _build_storage {
15 my $s = $self->schema->storage;
16 $s->_determine_driver;
20 has backup_directory => (
34 default => sub { {} },
36 has upgrade_directory => (
44 isa => 'DBIx::Class::ResultSet',
47 handles => [qw( is_installed db_version )],
50 method _build_version_rs {
51 $self->schema->set_us_up_the_bomb;
52 $self->schema->resultset('__VERSION')
57 isa => 'DBIx::Class::DeploymentHandler::Databases',
59 default => sub { [qw( MySQL SQLite PostgreSQL )] },
63 isa => 'DBIx::Class::Schema',
66 handles => [qw( ddl_filename schema_version )],
70 isa => 'ArrayRef[Str]',
74 method deployment_statements {
75 my $dir = $self->upgrade_directory;
76 my $schema = $self->schema;
77 my $type = $self->storage->sqlt_type;
78 my $sqltargs = $self->sqltargs;
79 my $version = $self->schema_version || '1.x';
81 my $filename = $self->ddl_filename($type, $version, $dir);
84 open $file, q(<), $filename
85 or carp "Can't open $filename ($!)";
88 return join '', @rows;
91 # sources needs to be a parser arg, but for simplicty allow at top level
93 $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
94 if exists $sqltargs->{sources};
96 my $tr = SQL::Translator->new(
97 producer => "SQL::Translator::Producer::${type}",
99 parser => 'SQL::Translator::Parser::DBIx::Class',
106 @ret = $tr->translate;
109 $ret[0] = $tr->translate;
112 $schema->throw_exception( 'Unable to produce deployment statements: ' . $tr->error)
113 unless (@ret && defined $ret[0]);
115 return $wa ? @ret : $ret[0];
119 my $storage = $self->storage;
123 return if(!$line || $line =~ /^--|^BEGIN TRANSACTION|^COMMIT|^\s+$/);
124 $storage->_query_start($line);
126 # do a dbh_do cycle here, as we need some error checking in
127 # place (even though we will ignore errors)
128 $storage->dbh_do (sub { $_[1]->do($line) });
131 carp "$_ (running '${line}')"
133 $storage->_query_end($line);
135 my @statements = $self->deployment_statements();
136 if (@statements > 1) {
137 foreach my $statement (@statements) {
138 $deploy->( $statement );
141 elsif (@statements == 1) {
142 foreach my $line ( split(";\n", $statements[0])) {
148 method create_install_ddl {
149 my $schema = $self->schema;
150 my $databases = $self->databases;
151 my $dir = $self->upgrade_directory;
152 my $sqltargs = $self->sqltargs;
154 carp "Upgrade directory $dir does not exist, using ./\n";
158 my $version = $schema->schema_version || '1.x';
159 my $schema_version = $schema->schema_version || '1.x';
160 $version ||= $schema_version;
164 ignore_constraint_names => 1,
165 ignore_index_names => 1,
169 my $sqlt = SQL::Translator->new( $sqltargs );
171 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
172 my $sqlt_schema = $sqlt->translate({ data => $schema })
173 or $self->throw_exception ($sqlt->error);
175 foreach my $db (@$databases) {
177 $sqlt->{schema} = $sqlt_schema;
178 $sqlt->producer($db);
180 my $filename = $self->ddl_filename($db, $version, $dir);
181 if (-e $filename && ($version eq $schema_version )) {
182 # if we are dumping the current version, overwrite the DDL
183 carp "Overwriting existing DDL file - $filename";
187 my $output = $sqlt->translate;
189 carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
193 unless( open $file, q(>), $filename ) {
194 $self->throw_exception("Can't open $filename for writing ($!)");
197 print {$file} $output;
202 method create_update_ddl($version, $preversion) {
203 my $schema = $self->schema;
204 my $databases = $self->databases;
205 my $dir = $self->upgrade_directory;
206 my $sqltargs = $self->sqltargs;
209 carp "Upgrade directory $dir does not exist, using ./\n";
213 my $schema_version = $schema->schema_version || '1.x';
214 $version ||= $schema_version;
218 ignore_constraint_names => 1,
219 ignore_index_names => 1,
223 my $sqlt = SQL::Translator->new( $sqltargs );
225 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
226 my $sqlt_schema = $sqlt->translate({ data => $schema })
227 or $self->throw_exception ($sqlt->error);
229 foreach my $db (@$databases) {
231 $sqlt->{schema} = $sqlt_schema;
232 $sqlt->producer($db);
234 my $prefilename = $self->ddl_filename($db, $preversion, $dir);
235 unless(-e $prefilename) {
236 carp("No previous schema file found ($prefilename)");
240 my $diff_file = $self->ddl_filename($db, $version, $dir, $preversion);
242 carp("Overwriting existing diff file - $diff_file");
248 my $t = SQL::Translator->new({
254 $t->parser( $db ) # could this really throw an exception?
255 or $self->throw_exception ($t->error);
257 my $out = $t->translate( $prefilename )
258 or $self->throw_exception ($t->error);
260 $source_schema = $t->schema;
262 $source_schema->name( $prefilename )
263 unless $source_schema->name;
266 # The "new" style of producers have sane normalization and can support
267 # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
268 # And we have to diff parsed SQL against parsed SQL.
269 my $dest_schema = $sqlt_schema;
271 unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
272 my $t = SQL::Translator->new({
278 $t->parser( $db ) # could this really throw an exception?
279 or $self->throw_exception ($t->error);
281 my $filename = $self->ddl_filename($db, $version, $dir);
282 my $out = $t->translate( $filename )
283 or $self->throw_exception ($t->error);
285 $dest_schema = $t->schema;
287 $dest_schema->name( $filename )
288 unless $dest_schema->name;
291 my $diff = SQL::Translator::Diff::schema_diff(
297 unless(open $file, q(>), $diff_file) {
298 $self->throw_exception("Can't write to $diff_file ($!)");
306 method create_ddl_dir($version, $preversion) {
307 $self->create_install_ddl;
308 $self->create_update_ddl($version, $preversion) if $preversion;
311 method _read_sql_file($file) {
314 open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)");
315 my @data = split /\n/, join '', <$fh>;
321 !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/m
328 method create_upgrade_path { }
330 method upgrade_single_step($db_version, $target_version) {
331 if ($db_version eq $target_version) {
333 carp "Upgrade not necessary\n";
337 my $upgrade_file = $self->ddl_filename(
338 $self->storage->sqlt_type,
340 $self->upgrade_directory,
344 $self->create_upgrade_path({ upgrade_file => $upgrade_file });
346 unless (-f $upgrade_file) {
348 carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
352 carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
354 $self->_filedata($self->_read_sql_file($upgrade_file)); # I don't like this --fREW 2010-02-22
355 $self->backup if $self->do_backup;
356 $self->schema->txn_do(sub { $self->do_upgrade });
358 $self->version_rs->create({
359 version => $target_version,
361 # upgrade_sql => $upgrade_sql,
365 method do_upgrade { $self->run_upgrade(qr/.*?/) }
367 method run_upgrade($stm) {
368 return unless $self->_filedata;
369 my @statements = grep { $_ =~ $stm } @{$self->_filedata};
372 $self->storage->debugobj->query_start($_) if $self->storage->debug;
373 $self->apply_statement($_);
374 $self->storage->debugobj->query_end($_) if $self->storage->debug;
378 method apply_statement($statement) {
380 $self->storage->dbh->do($_) or carp "SQL was: $_"
383 method backup { $self->storage->backup($self->backup_directory) }
385 __PACKAGE__->meta->make_immutable;
391 vim: ts=2 sw=2 expandtab