From: Luke Saunders Date: Mon, 14 Jul 2008 14:01:50 +0000 (+0000) Subject: reordered methods of Versioned.pm and factored the initialisation stuff from upgrade... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=93e4d41aa44fd36ed994e899e9cc3146ca41587d;p=dbsrgits%2FDBIx-Class-Historic.git reordered methods of Versioned.pm and factored the initialisation stuff from upgrade to install --- diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 21f055b..ce2a026 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -62,29 +62,6 @@ particular which module inherits off which. =head1 METHODS -=head2 schema_version - -Returns the current schema class' $VERSION - -=cut - -sub schema_version { - my ($self) = @_; - my $class = ref($self)||$self; - - # does -not- use $schema->VERSION - # since that varies in results depending on if version.pm is installed, and if - # so the perl or XS versions. If you want this to change, bug the version.pm - # author to make vpp and vxs behave the same. - - my $version; - { - no strict 'refs'; - $version = ${"${class}::VERSION"}; - } - return $version; -} - =head2 register_class =over 4 @@ -1201,6 +1178,29 @@ sub dclone { return Storable::dclone($obj); } +=head2 schema_version + +Returns the current schema class' $VERSION + +=cut + +sub schema_version { + my ($self) = @_; + my $class = ref($self)||$self; + + # does -not- use $schema->VERSION + # since that varies in results depending on if version.pm is installed, and if + # so the perl or XS versions. If you want this to change, bug the version.pm + # author to make vpp and vxs behave the same. + + my $version; + { + no strict 'refs'; + $version = ${"${class}::VERSION"}; + } + return $version; +} + 1; =head1 AUTHORS diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 1b864cc..3777ea5 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -103,6 +103,12 @@ NB: At the moment, only SQLite and MySQL are supported. This is due to spotty behaviour in the SQL::Translator producers, please help us by them. + +=head1 GETTING STARTED + + +=cut + =head1 METHODS =head2 upgrade_directory @@ -129,119 +135,39 @@ __PACKAGE__->mk_classdata('backup_directory'); __PACKAGE__->mk_classdata('do_backup'); __PACKAGE__->mk_classdata('do_diff_on_init'); -=head2 get_db_version - -Returns the version that your database is currently at. This is determined by the values in the -dbix_class_schema_versions table that $self->upgrade writes to. +=head2 install -=cut +=over 4 -sub get_db_version -{ - my ($self, $rs) = @_; +=item Arguments: $db_version - my $vtable = $self->{vschema}->resultset('Table'); - my $version = 0; - eval { - my $stamp = $vtable->get_column('installed')->max; - $version = $vtable->search({ installed => $stamp })->first->version; - }; - return $version; -} - -sub _source_exists -{ - my ($self, $rs) = @_; - - my $c = eval { - $rs->search({ 1, 0 })->count; - }; - return 0 if $@ || !defined $c; - - return 1; -} - -=head2 backup +=back -This is an overwritable method which is called just before the upgrade, to -allow you to make a backup of the database. Per default this method attempts -to call C<< $self->storage->backup >>, to run the standard backup on each -database type. +Call this to initialise a previously unversioned database. The table 'dbix_class_schema_versions' will be created which will be used to store the database version. -This method should return the name of the backup file, if appropriate.. +Takes one argument which should be the version that the database is currently at. Defaults to the return value of L. -This method is disabled by default. Set $schema->do_backup(1) to enable it. +See L for more details. =cut -sub backup +sub install { - my ($self) = @_; - ## Make each ::DBI::Foo do this - $self->storage->backup($self->backup_directory()); -} + my ($self, $new_version) = @_; -# is this just a waste of time? if not then merge with DBI.pm -sub _create_db_to_schema_diff { - my $self = shift; - - my %driver_to_db_map = ( - 'mysql' => 'MySQL' - ); - - my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}}; - unless ($db) { - print "Sorry, this is an unsupported DB\n"; - return; + # must be called on a fresh database + if ($self->get_db_version()) { + warn 'Install not possible as versions table already exists in database'; } - eval 'require SQL::Translator "0.09"'; - if ($@) { - $self->throw_exception("SQL::Translator 0.09 required"); - } - - my $db_tr = SQL::Translator->new({ - add_drop_table => 1, - parser => 'DBI', - parser_args => { dbh => $self->storage->dbh } - }); - - $db_tr->producer($db); - my $dbic_tr = SQL::Translator->new; - $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class'); - $dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db); - $dbic_tr->data($self); - $dbic_tr->producer($db); - - $db_tr->schema->name('db_schema'); - $dbic_tr->schema->name('dbic_schema'); + # default to current version if none passed + $new_version ||= $self->schema_version(); - # is this really necessary? - foreach my $tr ($db_tr, $dbic_tr) { - my $data = $tr->data; - $tr->parser->($tr, $$data); + unless ($new_version) { + # create versions table and version row + $self->{vschema}->deploy; + $self->_set_db_version; } - - my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db, - $dbic_tr->schema, $db, - { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 }); - - my $filename = $self->ddl_filename( - $db, - $self->schema_version, - $self->upgrade_directory, - 'PRE', - ); - my $file; - if(!open($file, ">$filename")) - { - $self->throw_exception("Can't open $filename for writing ($!)"); - next; - } - print $file $diff; - close($file); - - print "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n"; } =head2 upgrade @@ -261,12 +187,7 @@ sub upgrade # db unversioned unless ($db_version) { - # set version in dbix_class_schema_versions table, can't actually upgrade as we don 't know what version the DB is at - $self->_create_db_to_schema_diff() if ($self->do_diff_on_init); - - # create versions table and version row - $self->{vschema}->deploy; - $self->_set_db_version; + warn 'Upgrade not possible as database is unversioned. Please call install first.'; return; } @@ -303,31 +224,6 @@ sub upgrade $self->_set_db_version; } -sub _set_db_version { - my $self = shift; - - my $vtable = $self->{vschema}->resultset('Table'); - $vtable->create({ version => $self->schema_version, - installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) - }); - -} - -sub _read_sql_file { - my $self = shift; - my $file = shift || return; - - my $fh; - open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)"); - my @data = split(/\n/, join('', <$fh>)); - @data = grep(!/^--/, @data); - @data = split(/;/, join('', @data)); - close($fh); - @data = grep { $_ && $_ !~ /^-- / } @data; - @data = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @data; - return \@data; -} - =head2 do_upgrade This is an overwritable method used to run your upgrade. The freeform method @@ -377,6 +273,52 @@ sub run_upgrade return 1; } +=head2 get_db_version + +Returns the version that your database is currently at. This is determined by the values in the +dbix_class_schema_versions table that $self->upgrade writes to. + +=cut + +sub get_db_version +{ + my ($self, $rs) = @_; + + my $vtable = $self->{vschema}->resultset('Table'); + my $version = 0; + eval { + my $stamp = $vtable->get_column('installed')->max; + $version = $vtable->search({ installed => $stamp })->first->version; + }; + return $version; +} + +=head2 schema_version + +Returns the current schema class' $VERSION + +=cut + +=head2 backup + +This is an overwritable method which is called just before the upgrade, to +allow you to make a backup of the database. Per default this method attempts +to call C<< $self->storage->backup >>, to run the standard backup on each +database type. + +This method should return the name of the backup file, if appropriate.. + +This method is disabled by default. Set $schema->do_backup(1) to enable it. + +=cut + +sub backup +{ + my ($self) = @_; + ## Make each ::DBI::Foo do this + $self->storage->backup($self->backup_directory()); +} + =head2 connection Overloaded method. This checks the DBIC schema version against the DB version and @@ -441,6 +383,107 @@ sub _on_connect ", your database contains version $pversion, please call upgrade on your Schema.\n"; } +# is this just a waste of time? if not then merge with DBI.pm +sub _create_db_to_schema_diff { + my $self = shift; + + my %driver_to_db_map = ( + 'mysql' => 'MySQL' + ); + + my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}}; + unless ($db) { + print "Sorry, this is an unsupported DB\n"; + return; + } + + eval 'require SQL::Translator "0.09"'; + if ($@) { + $self->throw_exception("SQL::Translator 0.09 required"); + } + + my $db_tr = SQL::Translator->new({ + add_drop_table => 1, + parser => 'DBI', + parser_args => { dbh => $self->storage->dbh } + }); + + $db_tr->producer($db); + my $dbic_tr = SQL::Translator->new; + $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class'); + $dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db); + $dbic_tr->data($self); + $dbic_tr->producer($db); + + $db_tr->schema->name('db_schema'); + $dbic_tr->schema->name('dbic_schema'); + + # is this really necessary? + foreach my $tr ($db_tr, $dbic_tr) { + my $data = $tr->data; + $tr->parser->($tr, $$data); + } + + my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db, + $dbic_tr->schema, $db, + { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 }); + + my $filename = $self->ddl_filename( + $db, + $self->schema_version, + $self->upgrade_directory, + 'PRE', + ); + my $file; + if(!open($file, ">$filename")) + { + $self->throw_exception("Can't open $filename for writing ($!)"); + next; + } + print $file $diff; + close($file); + + print "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n"; +} + + +sub _set_db_version { + my $self = shift; + + my $vtable = $self->{vschema}->resultset('Table'); + $vtable->create({ version => $self->schema_version, + installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) + }); + +} + +sub _read_sql_file { + my $self = shift; + my $file = shift || return; + + my $fh; + open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)"); + my @data = split(/\n/, join('', <$fh>)); + @data = grep(!/^--/, @data); + @data = split(/;/, join('', @data)); + close($fh); + @data = grep { $_ && $_ !~ /^-- / } @data; + @data = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @data; + return \@data; +} + +sub _source_exists +{ + my ($self, $rs) = @_; + + my $c = eval { + $rs->search({ 1, 0 })->count; + }; + return 0 if $@ || !defined $c; + + return 1; +} + 1; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 9cfb860..efd6cd2 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1630,9 +1630,6 @@ sub deployment_statements { my $tr = SQL::Translator->new(%$sqltargs); SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema ); return "SQL::Translator::Producer::${type}"->can('produce')->($tr); - - return; - } sub deploy {